summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/Makefile.in177
-rw-r--r--lisp/abbrev.el82
-rw-r--r--lisp/align.el74
-rw-r--r--lisp/allout.el25
-rw-r--r--lisp/ansi-color.el388
-rw-r--r--lisp/apropos.el102
-rw-r--r--lisp/arc-mode.el24
-rw-r--r--lisp/array.el44
-rw-r--r--lisp/auth-source.el165
-rw-r--r--lisp/autoinsert.el22
-rw-r--r--lisp/autorevert.el2
-rw-r--r--lisp/avoid.el19
-rw-r--r--lisp/battery.el146
-rw-r--r--lisp/bindings.el67
-rw-r--r--lisp/bookmark.el386
-rw-r--r--lisp/bs.el108
-rw-r--r--lisp/buff-menu.el89
-rw-r--r--lisp/button.el88
-rw-r--r--lisp/calc/calc-embed.el3
-rw-r--r--lisp/calc/calc-ext.el38
-rw-r--r--lisp/calc/calc-graph.el3
-rw-r--r--lisp/calc/calc-help.el31
-rw-r--r--lisp/calc/calc-math.el5
-rw-r--r--lisp/calc/calc-misc.el104
-rw-r--r--lisp/calc/calc-mode.el9
-rw-r--r--lisp/calc/calc-prog.el13
-rw-r--r--lisp/calc/calc-store.el43
-rw-r--r--lisp/calc/calc-units.el39
-rw-r--r--lisp/calc/calc-yank.el20
-rw-r--r--lisp/calc/calc.el19
-rw-r--r--lisp/calculator.el42
-rw-r--r--lisp/calendar/appt.el10
-rw-r--r--lisp/calendar/cal-hebrew.el11
-rw-r--r--lisp/calendar/calendar.el31
-rw-r--r--lisp/calendar/diary-lib.el23
-rw-r--r--lisp/calendar/holidays.el64
-rw-r--r--lisp/calendar/icalendar.el17
-rw-r--r--lisp/calendar/iso8601.el12
-rw-r--r--lisp/calendar/time-date.el94
-rw-r--r--lisp/calendar/timeclock.el2
-rw-r--r--lisp/cedet/data-debug.el16
-rw-r--r--lisp/cedet/ede/emacs.el2
-rw-r--r--lisp/cedet/ede/files.el2
-rw-r--r--lisp/cedet/ede/proj-elisp.el3
-rw-r--r--lisp/cedet/ede/project-am.el3
-rw-r--r--lisp/cedet/mode-local.el11
-rw-r--r--lisp/cedet/semantic.el4
-rw-r--r--lisp/cedet/semantic/bovine/c.el40
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el13
-rw-r--r--lisp/cedet/semantic/complete.el12
-rw-r--r--lisp/cedet/semantic/db-el.el4
-rw-r--r--lisp/cedet/semantic/db.el2
-rw-r--r--lisp/cedet/semantic/decorate/mode.el1
-rw-r--r--lisp/cedet/semantic/dep.el1
-rw-r--r--lisp/cedet/semantic/edit.el2
-rw-r--r--lisp/cedet/semantic/find.el2
-rw-r--r--lisp/cedet/semantic/fw.el37
-rw-r--r--lisp/cedet/semantic/grammar.el4
-rw-r--r--lisp/cedet/semantic/grm-wy-boot.el8
-rw-r--r--lisp/cedet/semantic/html.el12
-rw-r--r--lisp/cedet/semantic/imenu.el3
-rw-r--r--lisp/cedet/semantic/java.el39
-rw-r--r--lisp/cedet/semantic/lex-spp.el13
-rw-r--r--lisp/cedet/semantic/lex.el54
-rw-r--r--lisp/cedet/semantic/senator.el9
-rw-r--r--lisp/cedet/semantic/sort.el2
-rw-r--r--lisp/cedet/semantic/symref.el6
-rw-r--r--lisp/cedet/semantic/texi.el12
-rw-r--r--lisp/cedet/semantic/wisent.el2
-rw-r--r--lisp/cedet/semantic/wisent/comp.el2
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el11
-rw-r--r--lisp/cedet/srecode/texi.el2
-rw-r--r--lisp/char-fold.el146
-rw-r--r--lisp/chistory.el2
-rw-r--r--lisp/cmuscheme.el8
-rw-r--r--lisp/color.el2
-rw-r--r--lisp/comint.el221
-rw-r--r--lisp/completion.el4
-rw-r--r--lisp/composite.el21
-rw-r--r--lisp/cus-dep.el7
-rw-r--r--lisp/cus-edit.el150
-rw-r--r--lisp/cus-face.el188
-rw-r--r--lisp/cus-start.el38
-rw-r--r--lisp/cus-theme.el34
-rw-r--r--lisp/custom.el91
-rw-r--r--lisp/dabbrev.el103
-rw-r--r--lisp/delsel.el24
-rw-r--r--lisp/descr-text.el13
-rw-r--r--lisp/desktop.el129
-rw-r--r--lisp/dframe.el4
-rw-r--r--lisp/dired-aux.el378
-rw-r--r--lisp/dired-x.el409
-rw-r--r--lisp/dired.el733
-rw-r--r--lisp/display-line-numbers.el78
-rw-r--r--lisp/dnd.el350
-rw-r--r--lisp/doc-view.el339
-rw-r--r--lisp/dos-fns.el16
-rw-r--r--lisp/ebuff-menu.el1
-rw-r--r--lisp/ecomplete.el40
-rw-r--r--lisp/edmacro.el194
-rw-r--r--lisp/ehelp.el5
-rw-r--r--lisp/elec-pair.el148
-rw-r--r--lisp/electric.el12
-rw-r--r--lisp/elide-head.el139
-rw-r--r--lisp/emacs-lisp/advice.el3
-rw-r--r--lisp/emacs-lisp/autoload.el393
-rw-r--r--lisp/emacs-lisp/backtrace.el141
-rw-r--r--lisp/emacs-lisp/benchmark.el6
-rw-r--r--lisp/emacs-lisp/bindat.el224
-rw-r--r--lisp/emacs-lisp/byte-opt.el410
-rw-r--r--lisp/emacs-lisp/byte-run.el301
-rw-r--r--lisp/emacs-lisp/bytecomp.el1147
-rw-r--r--lisp/emacs-lisp/cconv.el216
-rw-r--r--lisp/emacs-lisp/chart.el7
-rw-r--r--lisp/emacs-lisp/check-declare.el5
-rw-r--r--lisp/emacs-lisp/checkdoc.el126
-rw-r--r--lisp/emacs-lisp/cl-generic.el374
-rw-r--r--lisp/emacs-lisp/cl-indent.el7
-rw-r--r--lisp/emacs-lisp/cl-lib.el15
-rw-r--r--lisp/emacs-lisp/cl-macs.el204
-rw-r--r--lisp/emacs-lisp/cl-preloaded.el31
-rw-r--r--lisp/emacs-lisp/cl-print.el25
-rw-r--r--lisp/emacs-lisp/comp-cstr.el66
-rw-r--r--lisp/emacs-lisp/comp.el271
-rw-r--r--lisp/emacs-lisp/copyright.el2
-rw-r--r--lisp/emacs-lisp/crm.el115
-rw-r--r--lisp/emacs-lisp/debug-early.el97
-rw-r--r--lisp/emacs-lisp/debug.el137
-rw-r--r--lisp/emacs-lisp/derived.el7
-rw-r--r--lisp/emacs-lisp/easy-mmode.el92
-rw-r--r--lisp/emacs-lisp/edebug.el317
-rw-r--r--lisp/emacs-lisp/eieio-core.el152
-rw-r--r--lisp/emacs-lisp/eieio-custom.el12
-rw-r--r--lisp/emacs-lisp/eieio-opt.el5
-rw-r--r--lisp/emacs-lisp/eieio.el35
-rw-r--r--lisp/emacs-lisp/eldoc.el44
-rw-r--r--lisp/emacs-lisp/elp.el44
-rw-r--r--lisp/emacs-lisp/ert-x.el168
-rw-r--r--lisp/emacs-lisp/ert.el656
-rw-r--r--lisp/emacs-lisp/faceup.el2
-rw-r--r--lisp/emacs-lisp/find-func.el71
-rw-r--r--lisp/emacs-lisp/generate-lisp-file.el113
-rw-r--r--lisp/emacs-lisp/generator.el31
-rw-r--r--lisp/emacs-lisp/gv.el6
-rw-r--r--lisp/emacs-lisp/helper.el50
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el6
-rw-r--r--lisp/emacs-lisp/lisp-mode.el383
-rw-r--r--lisp/emacs-lisp/lisp.el36
-rw-r--r--lisp/emacs-lisp/loaddefs-gen.el710
-rw-r--r--lisp/emacs-lisp/macroexp.el410
-rw-r--r--lisp/emacs-lisp/map-ynp.el22
-rw-r--r--lisp/emacs-lisp/map.el14
-rw-r--r--lisp/emacs-lisp/memory-report.el11
-rw-r--r--lisp/emacs-lisp/multisession.el454
-rw-r--r--lisp/emacs-lisp/nadvice.el224
-rw-r--r--lisp/emacs-lisp/oclosure.el562
-rw-r--r--lisp/emacs-lisp/package.el453
-rw-r--r--lisp/emacs-lisp/pcase.el6
-rw-r--r--lisp/emacs-lisp/pp.el251
-rw-r--r--lisp/emacs-lisp/range.el467
-rw-r--r--lisp/emacs-lisp/re-builder.el86
-rw-r--r--lisp/emacs-lisp/rmc.el219
-rw-r--r--lisp/emacs-lisp/rx.el9
-rw-r--r--lisp/emacs-lisp/seq.el40
-rw-r--r--lisp/emacs-lisp/shadow.el8
-rw-r--r--lisp/emacs-lisp/shortdoc.el200
-rw-r--r--lisp/emacs-lisp/shorthands.el3
-rw-r--r--lisp/emacs-lisp/smie.el12
-rw-r--r--lisp/emacs-lisp/subr-x.el373
-rw-r--r--lisp/emacs-lisp/syntax.el118
-rw-r--r--lisp/emacs-lisp/tabulated-list.el188
-rw-r--r--lisp/emacs-lisp/testcover.el3
-rw-r--r--lisp/emacs-lisp/text-property-search.el3
-rw-r--r--lisp/emacs-lisp/timer-list.el15
-rw-r--r--lisp/emacs-lisp/timer.el16
-rw-r--r--lisp/emacs-lisp/trace.el20
-rw-r--r--lisp/emacs-lisp/vtable.el976
-rw-r--r--lisp/emacs-lisp/warnings.el4
-rw-r--r--lisp/emacs-lock.el11
-rw-r--r--lisp/emulation/cua-base.el33
-rw-r--r--lisp/emulation/cua-rect.el8
-rw-r--r--lisp/emulation/viper-cmd.el48
-rw-r--r--lisp/emulation/viper-ex.el1
-rw-r--r--lisp/emulation/viper-init.el12
-rw-r--r--lisp/emulation/viper-macs.el8
-rw-r--r--lisp/emulation/viper-mous.el12
-rw-r--r--lisp/emulation/viper-util.el50
-rw-r--r--lisp/emulation/viper.el11
-rw-r--r--lisp/env.el2
-rw-r--r--lisp/epa-hook.el18
-rw-r--r--lisp/epa-ks.el17
-rw-r--r--lisp/epa-mail.el28
-rw-r--r--lisp/epa.el17
-rw-r--r--lisp/epg.el3
-rw-r--r--lisp/erc/erc-autoaway.el2
-rw-r--r--lisp/erc/erc-backend.el311
-rw-r--r--lisp/erc/erc-button.el24
-rw-r--r--lisp/erc/erc-capab.el6
-rw-r--r--lisp/erc/erc-compat.el4
-rw-r--r--lisp/erc/erc-dcc.el150
-rw-r--r--lisp/erc/erc-desktop-notifications.el2
-rw-r--r--lisp/erc/erc-ezbounce.el2
-rw-r--r--lisp/erc/erc-fill.el2
-rw-r--r--lisp/erc/erc-goodies.el4
-rw-r--r--lisp/erc/erc-ibuffer.el2
-rw-r--r--lisp/erc/erc-identd.el2
-rw-r--r--lisp/erc/erc-imenu.el5
-rw-r--r--lisp/erc/erc-join.el123
-rw-r--r--lisp/erc/erc-lang.el14
-rw-r--r--lisp/erc/erc-list.el2
-rw-r--r--lisp/erc/erc-log.el2
-rw-r--r--lisp/erc/erc-match.el2
-rw-r--r--lisp/erc/erc-menu.el2
-rw-r--r--lisp/erc/erc-netsplit.el2
-rw-r--r--lisp/erc/erc-networks.el698
-rw-r--r--lisp/erc/erc-notify.el2
-rw-r--r--lisp/erc/erc-page.el2
-rw-r--r--lisp/erc/erc-pcomplete.el2
-rw-r--r--lisp/erc/erc-replace.el5
-rw-r--r--lisp/erc/erc-ring.el2
-rw-r--r--lisp/erc/erc-services.el58
-rw-r--r--lisp/erc/erc-sound.el2
-rw-r--r--lisp/erc/erc-speedbar.el2
-rw-r--r--lisp/erc/erc-spelling.el2
-rw-r--r--lisp/erc/erc-stamp.el2
-rw-r--r--lisp/erc/erc-status-sidebar.el2
-rw-r--r--lisp/erc/erc-track.el18
-rw-r--r--lisp/erc/erc-truncate.el2
-rw-r--r--lisp/erc/erc-xdcc.el2
-rw-r--r--lisp/erc/erc.el1083
-rw-r--r--lisp/eshell/em-banner.el3
-rw-r--r--lisp/eshell/em-basic.el93
-rw-r--r--lisp/eshell/em-cmpl.el60
-rw-r--r--lisp/eshell/em-dirs.el6
-rw-r--r--lisp/eshell/em-elecslash.el120
-rw-r--r--lisp/eshell/em-extpipe.el204
-rw-r--r--lisp/eshell/em-glob.el233
-rw-r--r--lisp/eshell/em-hist.el96
-rw-r--r--lisp/eshell/em-ls.el17
-rw-r--r--lisp/eshell/em-pred.el347
-rw-r--r--lisp/eshell/em-prompt.el8
-rw-r--r--lisp/eshell/em-rebind.el8
-rw-r--r--lisp/eshell/em-script.el18
-rw-r--r--lisp/eshell/em-term.el12
-rw-r--r--lisp/eshell/em-tramp.el118
-rw-r--r--lisp/eshell/esh-arg.el96
-rw-r--r--lisp/eshell/esh-cmd.el251
-rw-r--r--lisp/eshell/esh-io.el48
-rw-r--r--lisp/eshell/esh-mode.el104
-rw-r--r--lisp/eshell/esh-module.el1
-rw-r--r--lisp/eshell/esh-opt.el109
-rw-r--r--lisp/eshell/esh-proc.el74
-rw-r--r--lisp/eshell/esh-util.el150
-rw-r--r--lisp/eshell/esh-var.el198
-rw-r--r--lisp/eshell/eshell.el8
-rw-r--r--lisp/ezimage.el1
-rw-r--r--lisp/face-remap.el168
-rw-r--r--lisp/facemenu.el4
-rw-r--r--lisp/faces.el302
-rw-r--r--lisp/ffap.el94
-rw-r--r--lisp/filenotify.el8
-rw-r--r--lisp/files-x.el120
-rw-r--r--lisp/files.el849
-rw-r--r--lisp/filesets.el32
-rw-r--r--lisp/find-dired.el93
-rw-r--r--lisp/find-lisp.el4
-rw-r--r--lisp/finder.el63
-rw-r--r--lisp/foldout.el2
-rw-r--r--lisp/follow.el2
-rw-r--r--lisp/font-core.el4
-rw-r--r--lisp/font-lock.el194
-rw-r--r--lisp/format.el5
-rw-r--r--lisp/forms.el2
-rw-r--r--lisp/frame.el285
-rw-r--r--lisp/frameset.el48
-rw-r--r--lisp/fringe.el10
-rw-r--r--lisp/generic-x.el4
-rw-r--r--lisp/gnus/deuglify.el1
-rw-r--r--lisp/gnus/gmm-utils.el44
-rw-r--r--lisp/gnus/gnus-agent.el127
-rw-r--r--lisp/gnus/gnus-art.el425
-rw-r--r--lisp/gnus/gnus-bookmark.el49
-rw-r--r--lisp/gnus/gnus-cloud.el3
-rw-r--r--lisp/gnus/gnus-cus.el2
-rw-r--r--lisp/gnus/gnus-dired.el20
-rw-r--r--lisp/gnus/gnus-draft.el17
-rw-r--r--lisp/gnus/gnus-eform.el13
-rw-r--r--lisp/gnus/gnus-group.el614
-rw-r--r--lisp/gnus/gnus-html.el37
-rw-r--r--lisp/gnus/gnus-icalendar.el66
-rw-r--r--lisp/gnus/gnus-int.el2
-rw-r--r--lisp/gnus/gnus-kill.el23
-rw-r--r--lisp/gnus/gnus-logic.el4
-rw-r--r--lisp/gnus/gnus-ml.el17
-rw-r--r--lisp/gnus/gnus-msg.el122
-rw-r--r--lisp/gnus/gnus-range.el459
-rw-r--r--lisp/gnus/gnus-registry.el114
-rw-r--r--lisp/gnus/gnus-rmail.el142
-rw-r--r--lisp/gnus/gnus-salt.el52
-rw-r--r--lisp/gnus/gnus-score.el46
-rw-r--r--lisp/gnus/gnus-search.el356
-rw-r--r--lisp/gnus/gnus-srvr.el135
-rw-r--r--lisp/gnus/gnus-start.el23
-rw-r--r--lisp/gnus/gnus-sum.el1286
-rw-r--r--lisp/gnus/gnus-topic.el118
-rw-r--r--lisp/gnus/gnus-undo.el15
-rw-r--r--lisp/gnus/gnus-util.el159
-rw-r--r--lisp/gnus/gnus.el93
-rw-r--r--lisp/gnus/mail-source.el59
-rw-r--r--lisp/gnus/message.el457
-rw-r--r--lisp/gnus/mm-bodies.el32
-rw-r--r--lisp/gnus/mm-decode.el156
-rw-r--r--lisp/gnus/mm-url.el2
-rw-r--r--lisp/gnus/mm-util.el9
-rw-r--r--lisp/gnus/mm-view.el37
-rw-r--r--lisp/gnus/mml.el103
-rw-r--r--lisp/gnus/nndiary.el4
-rw-r--r--lisp/gnus/nnheader.el8
-rw-r--r--lisp/gnus/nnimap.el100
-rw-r--r--lisp/gnus/nnmail.el4
-rw-r--r--lisp/gnus/nnmaildir.el16
-rw-r--r--lisp/gnus/nnmairix.el4
-rw-r--r--lisp/gnus/nnmbox.el6
-rw-r--r--lisp/gnus/nnml.el19
-rw-r--r--lisp/gnus/nnnil.el2
-rw-r--r--lisp/gnus/nnregistry.el4
-rw-r--r--lisp/gnus/nnrss.el19
-rw-r--r--lisp/gnus/nnselect.el351
-rw-r--r--lisp/gnus/nntp.el19
-rw-r--r--lisp/gnus/nnvirtual.el13
-rw-r--r--lisp/gnus/smime.el11
-rw-r--r--lisp/gnus/spam-stat.el2
-rw-r--r--lisp/gnus/spam.el16
-rw-r--r--lisp/help-at-pt.el46
-rw-r--r--lisp/help-fns.el900
-rw-r--r--lisp/help-macro.el4
-rw-r--r--lisp/help-mode.el224
-rw-r--r--lisp/help.el697
-rw-r--r--lisp/hfy-cmap.el4
-rw-r--r--lisp/hi-lock.el99
-rw-r--r--lisp/hilit-chg.el2
-rw-r--r--lisp/hl-line.el18
-rw-r--r--lisp/htmlfontify.el23
-rw-r--r--lisp/ibuf-ext.el9
-rw-r--r--lisp/ibuf-macs.el13
-rw-r--r--lisp/ibuffer.el403
-rw-r--r--lisp/icomplete.el101
-rw-r--r--lisp/ido.el217
-rw-r--r--lisp/ielm.el38
-rw-r--r--lisp/iimage.el11
-rw-r--r--lisp/image-dired.el1785
-rw-r--r--lisp/image-file.el2
-rw-r--r--lisp/image-mode.el214
-rw-r--r--lisp/image.el260
-rw-r--r--lisp/image/exif.el32
-rw-r--r--lisp/image/gravatar.el6
-rw-r--r--lisp/image/image-converter.el51
-rw-r--r--lisp/imenu.el15
-rw-r--r--lisp/indent.el70
-rw-r--r--lisp/info-look.el231
-rw-r--r--lisp/info.el328
-rw-r--r--lisp/informat.el2
-rw-r--r--lisp/international/ccl.el4
-rw-r--r--lisp/international/characters.el138
-rw-r--r--lisp/international/emoji.el733
-rw-r--r--lisp/international/fontset.el97
-rw-r--r--lisp/international/iso-transl.el100
-rw-r--r--lisp/international/ja-dic-cnv.el44
-rw-r--r--lisp/international/latin1-disp.el4839
-rw-r--r--lisp/international/mule-cmds.el368
-rw-r--r--lisp/international/mule-conf.el1
-rw-r--r--lisp/international/mule-diag.el364
-rw-r--r--lisp/international/mule.el33
-rw-r--r--lisp/international/quail.el6
-rw-r--r--lisp/international/robin.el8
-rw-r--r--lisp/international/textsec-check.el78
-rw-r--r--lisp/international/textsec.el467
-rw-r--r--lisp/international/titdic-cnv.el28
-rw-r--r--lisp/international/ucs-normalize.el92
-rw-r--r--lisp/isearch.el451
-rw-r--r--lisp/jit-lock.el28
-rw-r--r--lisp/jsonrpc.el6
-rw-r--r--lisp/keymap.el585
-rw-r--r--lisp/kmacro.el288
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/greek.el4
-rw-r--r--lisp/language/hanja-util.el4
-rw-r--r--lisp/language/ind-util.el37
-rw-r--r--lisp/language/indian.el428
-rw-r--r--lisp/language/indonesian.el197
-rw-r--r--lisp/language/lao.el10
-rw-r--r--lisp/language/misc-lang.el54
-rw-r--r--lisp/language/philippine.el96
-rw-r--r--lisp/language/thai-util.el16
-rw-r--r--lisp/language/thai.el37
-rw-r--r--lisp/ldefs-boot.el15810
-rw-r--r--lisp/leim/quail/compose.el6
-rw-r--r--lisp/leim/quail/emoji.el2003
-rw-r--r--lisp/leim/quail/hangul.el4
-rw-r--r--lisp/leim/quail/indian.el1357
-rw-r--r--lisp/leim/quail/indonesian.el557
-rw-r--r--lisp/leim/quail/ipa.el10
-rw-r--r--lisp/leim/quail/latin-post.el93
-rw-r--r--lisp/leim/quail/latin-pre.el60
-rw-r--r--lisp/leim/quail/misc-lang.el1184
-rw-r--r--lisp/leim/quail/philippine.el152
-rw-r--r--lisp/leim/quail/symbol-ksc.el4
-rw-r--r--lisp/linum.el3
-rw-r--r--lisp/loadhist.el54
-rw-r--r--lisp/loadup.el24
-rw-r--r--lisp/locate.el6
-rw-r--r--lisp/longlines.el (renamed from lisp/obsolete/longlines.el)134
-rw-r--r--lisp/lpr.el2
-rw-r--r--lisp/ls-lisp.el37
-rw-r--r--lisp/macros.el96
-rw-r--r--lisp/mail/emacsbug.el62
-rw-r--r--lisp/mail/feedmail.el25
-rw-r--r--lisp/mail/footnote.el2
-rw-r--r--lisp/mail/hashcash.el4
-rw-r--r--lisp/mail/ietf-drums-date.el274
-rw-r--r--lisp/mail/ietf-drums.el50
-rw-r--r--lisp/mail/mail-extr.el115
-rw-r--r--lisp/mail/mail-hist.el2
-rw-r--r--lisp/mail/mail-parse.el3
-rw-r--r--lisp/mail/mail-utils.el28
-rw-r--r--lisp/mail/mailalias.el37
-rw-r--r--lisp/mail/rfc2047.el2
-rw-r--r--lisp/mail/rmail.el38
-rw-r--r--lisp/mail/rmailedit.el4
-rw-r--r--lisp/mail/rmailkwd.el13
-rw-r--r--lisp/mail/rmailmm.el23
-rw-r--r--lisp/mail/rmailmsc.el4
-rw-r--r--lisp/mail/rmailout.el5
-rw-r--r--lisp/mail/rmailsort.el4
-rw-r--r--lisp/mail/rmailsum.el18
-rw-r--r--lisp/mail/sendmail.el66
-rw-r--r--lisp/mail/smtpmail.el12
-rw-r--r--lisp/mail/supercite.el18
-rw-r--r--lisp/mail/undigest.el54
-rw-r--r--lisp/mail/unrmail.el2
-rw-r--r--lisp/man.el64
-rw-r--r--lisp/menu-bar.el241
-rw-r--r--lisp/mh-e/mh-acros.el39
-rw-r--r--lisp/mh-e/mh-alias.el39
-rw-r--r--lisp/mh-e/mh-comp.el59
-rw-r--r--lisp/mh-e/mh-compat.el364
-rw-r--r--lisp/mh-e/mh-e.el529
-rw-r--r--lisp/mh-e/mh-folder.el450
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-gnus.el149
-rw-r--r--lisp/mh-e/mh-identity.el27
-rw-r--r--lisp/mh-e/mh-letter.el184
-rw-r--r--lisp/mh-e/mh-limit.el14
-rw-r--r--lisp/mh-e/mh-mime.el202
-rw-r--r--lisp/mh-e/mh-scan.el11
-rw-r--r--lisp/mh-e/mh-search.el103
-rw-r--r--lisp/mh-e/mh-seq.el38
-rw-r--r--lisp/mh-e/mh-show.el298
-rw-r--r--lisp/mh-e/mh-speed.el85
-rw-r--r--lisp/mh-e/mh-thread.el50
-rw-r--r--lisp/mh-e/mh-tool-bar.el217
-rw-r--r--lisp/mh-e/mh-utils.el150
-rw-r--r--lisp/mh-e/mh-xface.el107
-rw-r--r--lisp/midnight.el6
-rw-r--r--lisp/minibuffer.el599
-rw-r--r--lisp/misc.el37
-rw-r--r--lisp/mouse.el1190
-rw-r--r--lisp/msb.el9
-rw-r--r--lisp/mwheel.el142
-rw-r--r--lisp/net/ange-ftp.el12
-rw-r--r--lisp/net/browse-url.el479
-rw-r--r--lisp/net/dbus.el33
-rw-r--r--lisp/net/dictionary-connection.el8
-rw-r--r--lisp/net/dictionary.el62
-rw-r--r--lisp/net/dig.el39
-rw-r--r--lisp/net/eudc-bob.el32
-rw-r--r--lisp/net/eudc-capf.el133
-rw-r--r--lisp/net/eudc-hotlist.el16
-rw-r--r--lisp/net/eudc-vars.el89
-rw-r--r--lisp/net/eudc.el315
-rw-r--r--lisp/net/eudcb-ldap.el41
-rw-r--r--lisp/net/eww.el495
-rw-r--r--lisp/net/hmac-def.el1
-rw-r--r--lisp/net/ldap.el12
-rw-r--r--lisp/net/mailcap.el151
-rw-r--r--lisp/net/mairix.el29
-rw-r--r--lisp/net/net-utils.el111
-rw-r--r--lisp/net/newst-backend.el95
-rw-r--r--lisp/net/newst-plainview.el23
-rw-r--r--lisp/net/newst-reader.el10
-rw-r--r--lisp/net/newst-treeview.el98
-rw-r--r--lisp/net/nsm.el3
-rw-r--r--lisp/net/ntlm.el8
-rw-r--r--lisp/net/pop3.el4
-rw-r--r--lisp/net/puny.el1
-rw-r--r--lisp/net/quickurl.el24
-rw-r--r--lisp/net/rcirc.el213
-rw-r--r--lisp/net/sasl-scram-rfc.el6
-rw-r--r--lisp/net/sasl.el23
-rw-r--r--lisp/net/secrets.el92
-rw-r--r--lisp/net/shr.el456
-rw-r--r--lisp/net/sieve-manage.el8
-rw-r--r--lisp/net/sieve-mode.el12
-rw-r--r--lisp/net/sieve.el52
-rw-r--r--lisp/net/snmp-mode.el14
-rw-r--r--lisp/net/soap-client.el16
-rw-r--r--lisp/net/socks.el9
-rw-r--r--lisp/net/telnet.el18
-rw-r--r--lisp/net/tramp-adb.el311
-rw-r--r--lisp/net/tramp-archive.el29
-rw-r--r--lisp/net/tramp-cache.el19
-rw-r--r--lisp/net/tramp-cmds.el11
-rw-r--r--lisp/net/tramp-compat.el190
-rw-r--r--lisp/net/tramp-crypt.el19
-rw-r--r--lisp/net/tramp-ftp.el26
-rw-r--r--lisp/net/tramp-fuse.el12
-rw-r--r--lisp/net/tramp-gvfs.el214
-rw-r--r--lisp/net/tramp-integration.el270
-rw-r--r--lisp/net/tramp-rclone.el25
-rw-r--r--lisp/net/tramp-sh.el1353
-rw-r--r--lisp/net/tramp-smb.el589
-rw-r--r--lisp/net/tramp-sshfs.el65
-rw-r--r--lisp/net/tramp-sudoedit.el114
-rw-r--r--lisp/net/tramp.el1189
-rw-r--r--lisp/net/trampver.el18
-rw-r--r--lisp/net/webjump.el7
-rw-r--r--lisp/newcomment.el30
-rw-r--r--lisp/notifications.el2
-rw-r--r--lisp/novice.el122
-rw-r--r--lisp/nxml/nxml-mode.el51
-rw-r--r--lisp/nxml/nxml-outln.el54
-rw-r--r--lisp/nxml/nxml-parse.el2
-rw-r--r--lisp/nxml/rng-cmpct.el2
-rw-r--r--lisp/nxml/rng-valid.el4
-rw-r--r--lisp/nxml/xmltok.el10
-rw-r--r--lisp/nxml/xsd-regexp.el9
-rw-r--r--lisp/obsolete/abbrevlist.el56
-rw-r--r--lisp/obsolete/assoc.el140
-rw-r--r--lisp/obsolete/autoarg.el (renamed from lisp/autoarg.el)1
-rw-r--r--lisp/obsolete/cl-compat.el1
-rw-r--r--lisp/obsolete/cl.el9
-rw-r--r--lisp/obsolete/complete.el1122
-rw-r--r--lisp/obsolete/crisp.el22
-rw-r--r--lisp/obsolete/cust-print.el674
-rw-r--r--lisp/obsolete/eieio-compat.el (renamed from lisp/emacs-lisp/eieio-compat.el)25
-rw-r--r--lisp/obsolete/erc-hecomplete.el218
-rw-r--r--lisp/obsolete/eudcb-ph.el4
-rw-r--r--lisp/obsolete/fast-lock.el35
-rw-r--r--lisp/obsolete/gs.el2
-rw-r--r--lisp/obsolete/info-edit.el1
-rw-r--r--lisp/obsolete/iswitchb.el23
-rw-r--r--lisp/obsolete/mailpost.el101
-rw-r--r--lisp/obsolete/mouse-sel.el731
-rw-r--r--lisp/obsolete/old-emacs-lock.el102
-rw-r--r--lisp/obsolete/otodo-mode.el3
-rw-r--r--lisp/obsolete/patcomp.el24
-rw-r--r--lisp/obsolete/pc-mode.el56
-rw-r--r--lisp/obsolete/pc-select.el410
-rw-r--r--lisp/obsolete/pgg-parse.el3
-rw-r--r--lisp/obsolete/pgg.el3
-rw-r--r--lisp/obsolete/rlogin.el (renamed from lisp/net/rlogin.el)34
-rw-r--r--lisp/obsolete/s-region.el123
-rw-r--r--lisp/obsolete/sregex.el605
-rw-r--r--lisp/obsolete/starttls.el3
-rw-r--r--lisp/obsolete/tpu-edt.el23
-rw-r--r--lisp/obsolete/tpu-mapper.el54
-rw-r--r--lisp/obsolete/uce.el (renamed from lisp/mail/uce.el)52
-rw-r--r--lisp/obsolete/vc-arch.el2
-rw-r--r--lisp/obsolete/vc-mtn.el (renamed from lisp/vc/vc-mtn.el)1
-rw-r--r--lisp/obsolete/vt-control.el (renamed from lisp/vt-control.el)1
-rw-r--r--lisp/obsolete/vt100-led.el (renamed from lisp/vt100-led.el)1
-rw-r--r--lisp/org/ob-comint.el2
-rw-r--r--lisp/org/ob-core.el2
-rw-r--r--lisp/org/ob-julia.el8
-rw-r--r--lisp/org/ob-lua.el2
-rw-r--r--lisp/org/ob-table.el2
-rw-r--r--lisp/org/oc.el25
-rw-r--r--lisp/org/ol-doi.el2
-rw-r--r--lisp/org/ol-eshell.el2
-rw-r--r--lisp/org/ol-eww.el2
-rw-r--r--lisp/org/ol-man.el8
-rw-r--r--lisp/org/ol-w3m.el2
-rw-r--r--lisp/org/ol.el8
-rw-r--r--lisp/org/org-agenda.el6
-rw-r--r--lisp/org/org-capture.el11
-rw-r--r--lisp/org/org-clock.el8
-rw-r--r--lisp/org/org-compat.el7
-rw-r--r--lisp/org/org-element.el3
-rw-r--r--lisp/org/org-feed.el2
-rw-r--r--lisp/org/org-id.el3
-rw-r--r--lisp/org/org-macs.el8
-rw-r--r--lisp/org/org-mouse.el2
-rw-r--r--lisp/org/org-plot.el2
-rw-r--r--lisp/org/org-refile.el14
-rw-r--r--lisp/org/org-table.el2
-rw-r--r--lisp/org/org.el4
-rw-r--r--lisp/org/ox-html.el2
-rw-r--r--lisp/org/ox-icalendar.el7
-rw-r--r--lisp/org/ox-publish.el2
-rw-r--r--lisp/org/ox.el157
-rw-r--r--lisp/outline.el347
-rw-r--r--lisp/paren.el189
-rw-r--r--lisp/pcmpl-gnu.el2
-rw-r--r--lisp/pcomplete.el75
-rw-r--r--lisp/pgtk-dnd.el396
-rw-r--r--lisp/pixel-scroll.el512
-rw-r--r--lisp/play/5x5.el64
-rw-r--r--lisp/play/animate.el14
-rw-r--r--lisp/play/blackbox.el46
-rw-r--r--lisp/play/bubbles.el31
-rw-r--r--lisp/play/decipher.el55
-rw-r--r--lisp/play/doctor.el8
-rw-r--r--lisp/play/dunnet.el2
-rw-r--r--lisp/play/gamegrid.el11
-rw-r--r--lisp/play/gametree.el63
-rw-r--r--lisp/play/gomoku.el114
-rw-r--r--lisp/play/handwrite.el71
-rw-r--r--lisp/play/morse.el24
-rw-r--r--lisp/play/mpuz.el17
-rw-r--r--lisp/play/pong.el34
-rw-r--r--lisp/play/snake.el47
-rw-r--r--lisp/play/solitaire.el82
-rw-r--r--lisp/play/spook.el2
-rw-r--r--lisp/play/tetris.el73
-rw-r--r--lisp/plstore.el1
-rw-r--r--lisp/proced.el117
-rw-r--r--lisp/profiler.el2
-rw-r--r--lisp/progmodes/antlr-mode.el1
-rw-r--r--lisp/progmodes/asm-mode.el30
-rw-r--r--lisp/progmodes/bat-mode.el6
-rw-r--r--lisp/progmodes/bug-reference.el24
-rw-r--r--lisp/progmodes/cc-align.el120
-rw-r--r--lisp/progmodes/cc-awk.el118
-rw-r--r--lisp/progmodes/cc-cmds.el2215
-rw-r--r--lisp/progmodes/cc-defs.el22
-rw-r--r--lisp/progmodes/cc-engine.el131
-rw-r--r--lisp/progmodes/cc-fonts.el51
-rw-r--r--lisp/progmodes/cc-guess.el13
-rw-r--r--lisp/progmodes/cc-langs.el8
-rw-r--r--lisp/progmodes/cc-mode.el533
-rw-r--r--lisp/progmodes/cc-styles.el13
-rw-r--r--lisp/progmodes/cc-vars.el2
-rw-r--r--lisp/progmodes/cfengine.el17
-rw-r--r--lisp/progmodes/compile.el323
-rw-r--r--lisp/progmodes/cperl-mode.el60
-rw-r--r--lisp/progmodes/cpp.el7
-rw-r--r--lisp/progmodes/cwarn.el3
-rw-r--r--lisp/progmodes/ebrowse.el44
-rw-r--r--lisp/progmodes/elisp-mode.el233
-rw-r--r--lisp/progmodes/erts-mode.el223
-rw-r--r--lisp/progmodes/etags.el24
-rw-r--r--lisp/progmodes/executable.el13
-rw-r--r--lisp/progmodes/f90.el17
-rw-r--r--lisp/progmodes/flymake-proc.el2
-rw-r--r--lisp/progmodes/flymake.el18
-rw-r--r--lisp/progmodes/fortran.el1
-rw-r--r--lisp/progmodes/gdb-mi.el110
-rw-r--r--lisp/progmodes/grep.el169
-rw-r--r--lisp/progmodes/gud.el71
-rw-r--r--lisp/progmodes/hideif.el42
-rw-r--r--lisp/progmodes/icon.el21
-rw-r--r--lisp/progmodes/idlw-shell.el11
-rw-r--r--lisp/progmodes/idlwave.el10
-rw-r--r--lisp/progmodes/inf-lisp.el2
-rw-r--r--lisp/progmodes/js.el1191
-rw-r--r--lisp/progmodes/m4-mode.el12
-rw-r--r--lisp/progmodes/make-mode.el9
-rw-r--r--lisp/progmodes/meta-mode.el44
-rw-r--r--lisp/progmodes/mixal-mode.el17
-rw-r--r--lisp/progmodes/modula2.el5
-rw-r--r--lisp/progmodes/octave.el15
-rw-r--r--lisp/progmodes/opascal.el2
-rw-r--r--lisp/progmodes/pascal.el25
-rw-r--r--lisp/progmodes/perl-mode.el6
-rw-r--r--lisp/progmodes/prog-mode.el8
-rw-r--r--lisp/progmodes/project.el278
-rw-r--r--lisp/progmodes/prolog.el20
-rw-r--r--lisp/progmodes/python.el511
-rw-r--r--lisp/progmodes/ruby-mode.el45
-rw-r--r--lisp/progmodes/scheme.el105
-rw-r--r--lisp/progmodes/sh-script.el176
-rw-r--r--lisp/progmodes/sql.el258
-rw-r--r--lisp/progmodes/tcl.el10
-rw-r--r--lisp/progmodes/verilog-mode.el42
-rw-r--r--lisp/progmodes/vhdl-mode.el10
-rw-r--r--lisp/progmodes/which-func.el5
-rw-r--r--lisp/progmodes/xref.el270
-rw-r--r--lisp/progmodes/xscheme.el5
-rw-r--r--lisp/ps-mule.el4
-rw-r--r--lisp/ps-print.el148
-rw-r--r--lisp/recentf.el196
-rw-r--r--lisp/rect.el27
-rw-r--r--lisp/register.el7
-rw-r--r--lisp/repeat.el75
-rw-r--r--lisp/replace.el261
-rw-r--r--lisp/rot13.el32
-rw-r--r--lisp/ruler-mode.el70
-rw-r--r--lisp/savehist.el43
-rw-r--r--lisp/saveplace.el31
-rw-r--r--lisp/scroll-bar.el7
-rw-r--r--lisp/scroll-lock.el18
-rw-r--r--lisp/select.el481
-rw-r--r--lisp/server.el182
-rw-r--r--lisp/ses.el139
-rw-r--r--lisp/shell.el274
-rw-r--r--lisp/simple.el1424
-rw-r--r--lisp/skeleton.el9
-rw-r--r--lisp/so-long.el6
-rw-r--r--lisp/sort.el52
-rw-r--r--lisp/speedbar.el63
-rw-r--r--lisp/sqlite-mode.el225
-rw-r--r--lisp/sqlite.el43
-rw-r--r--lisp/startup.el341
-rw-r--r--lisp/strokes.el23
-rw-r--r--lisp/subr.el765
-rw-r--r--lisp/tab-bar.el148
-rw-r--r--lisp/tab-line.el35
-rw-r--r--lisp/tar-mode.el4
-rw-r--r--lisp/term.el508
-rw-r--r--lisp/term/common-win.el38
-rw-r--r--lisp/term/haiku-win.el516
-rw-r--r--lisp/term/ns-win.el135
-rw-r--r--lisp/term/pc-win.el8
-rw-r--r--lisp/term/pgtk-win.el400
-rw-r--r--lisp/term/w32-win.el4
-rw-r--r--lisp/term/x-win.el142
-rw-r--r--lisp/term/xterm.el2
-rw-r--r--lisp/textmodes/artist.el144
-rw-r--r--lisp/textmodes/bibtex.el91
-rw-r--r--lisp/textmodes/css-mode.el109
-rw-r--r--lisp/textmodes/dns-mode.el6
-rw-r--r--lisp/textmodes/emacs-news-mode.el269
-rw-r--r--lisp/textmodes/enriched.el24
-rw-r--r--lisp/textmodes/etc-authors-mode.el10
-rw-r--r--lisp/textmodes/fill.el150
-rw-r--r--lisp/textmodes/flyspell.el17
-rw-r--r--lisp/textmodes/glyphless-mode.el68
-rw-r--r--lisp/textmodes/ispell.el149
-rw-r--r--lisp/textmodes/page-ext.el15
-rw-r--r--lisp/textmodes/page.el17
-rw-r--r--lisp/textmodes/paragraphs.el90
-rw-r--r--lisp/textmodes/pixel-fill.el240
-rw-r--r--lisp/textmodes/reftex-cite.el6
-rw-r--r--lisp/textmodes/reftex-global.el10
-rw-r--r--lisp/textmodes/reftex-index.el15
-rw-r--r--lisp/textmodes/reftex-parse.el29
-rw-r--r--lisp/textmodes/reftex-sel.el4
-rw-r--r--lisp/textmodes/reftex-toc.el43
-rw-r--r--lisp/textmodes/reftex-vars.el39
-rw-r--r--lisp/textmodes/reftex.el3
-rw-r--r--lisp/textmodes/remember.el5
-rw-r--r--lisp/textmodes/rst.el151
-rw-r--r--lisp/textmodes/sgml-mode.el98
-rw-r--r--lisp/textmodes/string-edit.el136
-rw-r--r--lisp/textmodes/table.el119
-rw-r--r--lisp/textmodes/tex-mode.el189
-rw-r--r--lisp/textmodes/texinfo.el139
-rw-r--r--lisp/textmodes/texnfo-upd.el2
-rw-r--r--lisp/textmodes/tildify.el5
-rw-r--r--lisp/textmodes/word-wrap-mode.el80
-rw-r--r--lisp/thingatpt.el26
-rw-r--r--lisp/thread.el7
-rw-r--r--lisp/thumbs.el126
-rw-r--r--lisp/time.el16
-rw-r--r--lisp/timezone.el14
-rw-r--r--lisp/tool-bar.el27
-rw-r--r--lisp/tooltip.el65
-rw-r--r--lisp/transient.el14
-rw-r--r--lisp/tree-widget.el18
-rw-r--r--lisp/tutorial.el20
-rw-r--r--lisp/type-break.el8
-rw-r--r--lisp/uniquify.el35
-rw-r--r--lisp/url/url-auth.el30
-rw-r--r--lisp/url/url-cache.el2
-rw-r--r--lisp/url/url-cookie.el18
-rw-r--r--lisp/url/url-dired.el10
-rw-r--r--lisp/url/url-file.el30
-rw-r--r--lisp/url/url-handlers.el3
-rw-r--r--lisp/url/url-history.el2
-rw-r--r--lisp/url/url-http.el208
-rw-r--r--lisp/url/url-privacy.el1
-rw-r--r--lisp/url/url-queue.el19
-rw-r--r--lisp/url/url-tramp.el50
-rw-r--r--lisp/url/url-util.el7
-rw-r--r--lisp/url/url-vars.el26
-rw-r--r--lisp/url/url.el2
-rw-r--r--lisp/userlock.el64
-rw-r--r--lisp/vc/add-log.el23
-rw-r--r--lisp/vc/compare-w.el5
-rw-r--r--lisp/vc/cvs-status.el26
-rw-r--r--lisp/vc/diff-mode.el318
-rw-r--r--lisp/vc/diff.el24
-rw-r--r--lisp/vc/ediff-diff.el5
-rw-r--r--lisp/vc/ediff-help.el4
-rw-r--r--lisp/vc/ediff-init.el14
-rw-r--r--lisp/vc/ediff-merg.el2
-rw-r--r--lisp/vc/ediff-mult.el6
-rw-r--r--lisp/vc/ediff-ptch.el29
-rw-r--r--lisp/vc/ediff-util.el14
-rw-r--r--lisp/vc/ediff-wind.el29
-rw-r--r--lisp/vc/ediff.el4
-rw-r--r--lisp/vc/emerge.el6
-rw-r--r--lisp/vc/log-edit.el40
-rw-r--r--lisp/vc/log-view.el57
-rw-r--r--lisp/vc/pcvs-defs.el154
-rw-r--r--lisp/vc/pcvs-info.el8
-rw-r--r--lisp/vc/pcvs.el147
-rw-r--r--lisp/vc/smerge-mode.el52
-rw-r--r--lisp/vc/vc-annotate.el5
-rw-r--r--lisp/vc/vc-cvs.el9
-rw-r--r--lisp/vc/vc-dir.el32
-rw-r--r--lisp/vc/vc-dispatcher.el21
-rw-r--r--lisp/vc/vc-git.el42
-rw-r--r--lisp/vc/vc-hg.el7
-rw-r--r--lisp/vc/vc-hooks.el26
-rw-r--r--lisp/vc/vc-rcs.el17
-rw-r--r--lisp/vc/vc-sccs.el11
-rw-r--r--lisp/vc/vc-src.el2
-rw-r--r--lisp/vc/vc-svn.el6
-rw-r--r--lisp/vc/vc.el131
-rw-r--r--lisp/vcursor.el73
-rw-r--r--lisp/version.el4
-rw-r--r--lisp/view.el192
-rw-r--r--lisp/w32-fns.el21
-rw-r--r--lisp/wdired.el117
-rw-r--r--lisp/whitespace.el132
-rw-r--r--lisp/wid-edit.el43
-rw-r--r--lisp/widget.el5
-rw-r--r--lisp/windmove.el5
-rw-r--r--lisp/window.el594
-rw-r--r--lisp/winner.el6
-rw-r--r--lisp/woman.el21
-rw-r--r--lisp/x-dnd.el1333
-rw-r--r--lisp/xdg.el42
-rw-r--r--lisp/xml.el10
-rw-r--r--lisp/xwidget.el718
-rw-r--r--lisp/yank-media.el190
837 files changed, 67280 insertions, 47129 deletions
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 80955abfb5b..9516f2fc364 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -59,15 +59,6 @@ BYTE_COMPILE_EXTRA_FLAGS =
# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))'
# The example above is just for developers, it should not be used by default.
-# Those automatically generated autoload files that need special rules
-# to build; ie not including things created via generated-autoload-file
-# (eg calc/calc-loaddefs.el).
-LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
- $(lisp)/calendar/diary-loaddefs.el \
- $(lisp)/calendar/hol-loaddefs.el \
- $(lisp)/mh-e/mh-loaddefs.el \
- $(lisp)/net/tramp-loaddefs.el
-
# All generated autoload files.
loaddefs = $(shell find ${srcdir} -name '*loaddefs.el' ! -name '.*')
# Elisp files auto-generated.
@@ -76,14 +67,20 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \
# Set load-prefer-newer for the benefit of the non-bootstrappers.
BYTE_COMPILE_FLAGS = \
- --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS)
+ --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \
+ $(BYTE_COMPILE_EXTRA_FLAGS)
+# ... but we must prefer .elc files for those in the early bootstrap.
+# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el.
+compile-first: BYTE_COMPILE_FLAGS = \
+ --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process. They're ordered by size, so we use
-# the slowest-compiler on the smallest file and move to larger files as the
-# compiler gets faster. 'autoload.elc' comes last because it is not used by
-# the compiler (so its compilation does not speed up subsequent compilations),
-# it's only placed here so as to speed up generation of the loaddefs.el file.
+# the slowest-compiler on the smallest file and move to larger files
+# as the compiler gets faster. 'loaddefs-gen.elc'/'radix-tree.el'
+# comes last because they're not used by the compiler (so its
+# compilation does not speed up subsequent compilations), it's only
+# placed here so as to speed up generation of the loaddefs.el files.
COMPILE_FIRST = \
$(lisp)/emacs-lisp/macroexp.elc \
@@ -91,32 +88,27 @@ COMPILE_FIRST = \
$(lisp)/emacs-lisp/byte-opt.elc \
$(lisp)/emacs-lisp/bytecomp.elc
ifeq ($(HAVE_NATIVE_COMP),yes)
-COMPILE_FIRST += \
- $(lisp)/emacs-lisp/comp.elc \
- $(lisp)/emacs-lisp/comp-cstr.elc \
- $(lisp)/emacs-lisp/cl-macs.elc \
- $(lisp)/emacs-lisp/rx.elc \
- $(lisp)/emacs-lisp/cl-seq.elc \
- $(lisp)/help-mode.elc \
- $(lisp)/emacs-lisp/cl-extra.elc \
- $(lisp)/emacs-lisp/gv.elc \
- $(lisp)/emacs-lisp/seq.elc \
- $(lisp)/emacs-lisp/cl-lib.elc \
- $(lisp)/emacs-lisp/warnings.elc \
- $(lisp)/emacs-lisp/subr-x.elc
+COMPILE_FIRST += $(lisp)/emacs-lisp/comp.elc
+COMPILE_FIRST += $(lisp)/emacs-lisp/comp-cstr.elc
endif
-COMPILE_FIRST += $(lisp)/emacs-lisp/autoload.elc
+COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc
+COMPILE_FIRST += $(lisp)/emacs-lisp/radix-tree.elc
# Files to compile early in compile-main. Works around bug#25556.
+# Also compile the ja-dic file used to convert the Japanese dictionary
+# to speed things up. The org files are used to convert org files to
+# texi files.
MAIN_FIRST = ./emacs-lisp/eieio.el ./emacs-lisp/eieio-base.el \
- ./cedet/semantic/db.el
+ ./cedet/semantic/db.el ./emacs-lisp/cconv.el \
+ ./international/ja-dic-cnv.el \
+ ./org/ox.el ./org/ox-texinfo.el ./org/org-macro.el ./org/org-element.el \
+ ./org/oc.el ./org/ol.el ./emacs-lisp/cl-lib.el
# Prevent any settings in the user environment causing problems.
-unexport EMACSDATA EMACSDOC EMACSPATH
+unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH
# The actual Emacs command run in the targets below.
-# Prevent any setting of EMACSLOADPATH in user environment causing problems.
-emacs = EMACSLOADPATH= '$(EMACS)' $(EMACSOPT)
+emacs = '$(EMACS)' $(EMACSOPT)
## Subdirectories, relative to builddir.
SUBDIRS = $(sort $(shell find ${srcdir} -type d -print))
@@ -133,10 +125,12 @@ SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS})
# cus-load and finder-inf are not explicitly requested by anything, so
# we add them here to make sure they get built.
-all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el
+all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el generate-ja-dic \
+ org-manuals
PHONY_EXTRAS =
-.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS)
+.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) \
+ generate-ja-dic org-manuals
# custom-deps and finder-data both used to scan _all_ the *.el files.
# This could lead to problems in parallel builds if automatically
@@ -167,6 +161,14 @@ $(lisp)/finder-inf.el:
--eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \
-f finder-compile-keywords-make-dist ${SUBDIRS_FINDER}
+# This is the OKURO-NASI compilation trigger.
+generate-ja-dic: main-first
+ $(AM_V_at)$(MAKE) -C ../leim generate-ja-dic EMACS="$(EMACS)"
+ $(AM_V_at)$(MAKE) compile-targets TARGETS="./leim/ja-dic/ja-dic.elc"
+
+org-manuals: main-first
+ $(AM_V_at)$(MAKE) -C ../doc/misc org.texi modus-themes.texi
+
## Comments on loaddefs generation:
# loaddefs depends on gen-lisp for two reasons:
@@ -175,6 +177,9 @@ $(lisp)/finder-inf.el:
# gets created before the final emacs is dumped. Having leim
# dependencies in ../src as well would create a parallel race condition.
#
+# FIXME: 2) is no longer correct, so perhaps we could add unidata to
+# gen-lisp now?
+#
# 2) Files that are marked no-update-autoloads still get recorded in loaddefs.
# So those files should be generated before we make autoloads, if we
# don't want a successive make autoloads to change the output file.
@@ -194,19 +199,13 @@ $(lisp)/finder-inf.el:
# We make $(lisp)/loaddefs.el a dependency of .PHONY to cause Make to
# ignore its time stamp. That's because the real dependencies of
# loaddefs.el aren't known to Make, they are implemented in
-# batch-update-autoloads, which only updates the autoloads whose
-# sources have changed.
-
-# Use expand-file-name rather than $abs_scrdir so that Emacs does not
-# get confused when it compares file-names for equality.
+# loaddefs-generate--emacs-batch.
autoloads .PHONY: $(lisp)/loaddefs.el
-$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS)
- $(AM_V_GEN)$(emacs) -l autoload \
- --eval '(setq autoload-ensure-writable t)' \
- --eval '(setq autoload-builtin-package-versions t)' \
- --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \
- -f batch-update-autoloads ${SUBDIRS_ALMOST}
+$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) $(lisp)/emacs-lisp/loaddefs-gen.elc
+ $(AM_V_GEN)$(emacs) \
+ -l $(lisp)/emacs-lisp/loaddefs-gen.elc \
+ -f loaddefs-generate--emacs-batch ${SUBDIRS_ALMOST}
# autoloads only runs when loaddefs.el is nonexistent, although it
# generates a number of different files. Provide a force option to enable
@@ -216,6 +215,9 @@ autoloads-force:
rm -f $(lisp)/loaddefs.el
$(MAKE) autoloads
+ldefs-boot.el: autoloads-force
+ cp $(lisp)/loaddefs.el $(lisp)/ldefs-boot.el
+
# This is required by the bootstrap-emacs target in ../src/Makefile, so
# we know that if we have an emacs executable, we also have a subdirs.el.
$(lisp)/subdirs.el:
@@ -263,9 +265,9 @@ ${ETAGS}: FORCE
## compile-main. But maybe this is not even necessary any more now
## that this uses relative filenames.
TAGS: ${ETAGS} ${tagsfiles}
- $(AM_V_at)rm -f $@
+ $(AM_V_GEN)rm -f $@
$(AM_V_at)touch $@
- $(AM_V_GEN)ls ${tagsfiles} | xargs $(XARGS_LIMIT) "${ETAGS}" -a -o $@
+ $(AM_V_at)ls ${tagsfiles} | xargs $(XARGS_LIMIT) "${ETAGS}" -a -o $@
# The src/Makefile.in has its own set of dependencies and when they decide
@@ -312,9 +314,23 @@ endif
# An old-fashioned suffix rule, which, according to the GNU Make manual,
# cannot have prerequisites.
ifeq ($(HAVE_NATIVE_COMP),yes)
+ifeq ($(ANCIENT),yes)
+# The first compilation of compile-first, using an interpreted compiler:
+# The resulting .elc files get given a date of 1971-01-01 so that their
+# date stamp is earlier than the source files, causing these to be compiled
+# into native code at the second recursive invocation of this $(MAKE),
+# using these .elc's. This is faster than just compiling the native code
+# directly using the interpreted compile-first files. (Note: 1970-01-01
+# fails on some systems.)
+.el.elc:
+ $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
+ -l comp -f batch-byte-compile $<
+ touch -t 197101010000 $@
+else
.el.elc:
$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
-l comp -f batch-byte+native-compile $<
+endif
else
.el.elc:
$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $<
@@ -346,10 +362,10 @@ endif
# Compile all the Elisp files that need it. Beware: it approximates
# 'no-byte-compile', so watch out for false-positives!
-compile-main: gen-lisp compile-clean
+compile-main: gen-lisp compile-clean main-first
@(cd $(lisp) && \
els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
- for el in ${MAIN_FIRST} $$els; do \
+ for el in $$els; do \
test -f $$el || continue; \
test ! -f $${el}c && \
GREP_OPTIONS= grep '^;.*[^a-zA-Z]no-byte-compile: *t' $$el > /dev/null && \
@@ -362,6 +378,18 @@ compile-main: gen-lisp compile-clean
TARGETS="$$chunk"; \
done
+# Compile some important files first.
+main-first:
+ @(cd $(lisp) && \
+ for el in ${MAIN_FIRST}; do \
+ echo "$${el}c"; \
+ done | xargs $(XARGS_LIMIT) echo) | \
+ while read chunk; do \
+ $(MAKE) compile-targets \
+ NATIVE_DISABLED=$(NATIVE_SKIP_NONDUMP) \
+ TARGETS="$$chunk"; \
+ done
+
.PHONY: compile-clean
# Erase left-over .elc files that do not have a corresponding .el file.
compile-clean:
@@ -435,57 +463,6 @@ compile-one-process: $(LOADDEFS) compile-first
$(emacs) $(BYTE_COMPILE_FLAGS) \
--eval "(batch-byte-recompile-directory 0)" $(lisp)
-# Update MH-E internal autoloads. These are not to be confused with
-# the autoloads for the MH-E entry points, which are already in loaddefs.el.
-MH_E_DIR = $(lisp)/mh-e
-MH_E_SRC = $(sort $(wildcard ${MH_E_DIR}/mh*.el))
-MH_E_SRC := $(filter-out ${MH_E_DIR}/mh-loaddefs.el,${MH_E_SRC})
-
-.PHONY: mh-autoloads
-mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el
-$(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
- $(AM_V_GEN)$(emacs) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
- --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
- -f batch-update-autoloads $(MH_E_DIR)
-
-# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
-# an own subdirectory. OTOH, it does not hurt to keep them in
-# lisp/net.
-TRAMP_DIR = $(lisp)/net
-TRAMP_SRC = $(sort $(wildcard ${TRAMP_DIR}/tramp*.el))
-TRAMP_SRC := $(filter-out ${TRAMP_DIR}/tramp-loaddefs.el,${TRAMP_SRC})
-
-$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
- $(AM_V_GEN)$(emacs) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \
- --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
- -f batch-update-autoloads $(TRAMP_DIR)
-
-CAL_DIR = $(lisp)/calendar
-## Those files that may contain internal calendar autoload cookies.
-CAL_SRC = $(addprefix ${CAL_DIR}/,diary-lib.el holidays.el lunar.el solar.el)
-CAL_SRC := $(sort ${CAL_SRC} $(wildcard ${CAL_DIR}/cal-*.el))
-CAL_SRC := $(filter-out ${CAL_DIR}/cal-loaddefs.el,${CAL_SRC})
-
-$(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC)
- $(AM_V_GEN)$(emacs) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \
- --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
- -f batch-update-autoloads $(CAL_DIR)
-
-$(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/cal-loaddefs.el
- $(AM_V_GEN)$(emacs) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \
- --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
- -f batch-update-autoloads $(CAL_DIR)
-
-$(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el
- $(AM_V_GEN)$(emacs) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \
- --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
- -f batch-update-autoloads $(CAL_DIR)
-
.PHONY: bootstrap-clean distclean maintainer-clean
bootstrap-clean:
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index b7216f5d633..718938df0cb 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -68,13 +68,11 @@ be replaced by its expansion."
(define-obsolete-variable-alias 'edit-abbrevs-map
'edit-abbrevs-mode-map "24.4")
-(defvar edit-abbrevs-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-s" 'abbrev-edit-save-buffer)
- (define-key map "\C-x\C-w" 'abbrev-edit-save-to-file)
- (define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
- map)
- "Keymap used in `edit-abbrevs'.")
+(defvar-keymap edit-abbrevs-mode-map
+ :doc "Keymap used in `edit-abbrevs'."
+ "C-x C-s" #'abbrev-edit-save-buffer
+ "C-x C-w" #'abbrev-edit-save-to-file
+ "C-c C-c" #'edit-abbrevs-redefine)
(defun kill-all-abbrevs ()
"Undefine all defined abbrevs."
@@ -176,7 +174,7 @@ that may be omitted (it is usually omitted)."
(defun edit-abbrevs-redefine ()
"Redefine abbrevs according to current buffer contents."
- (interactive)
+ (interactive nil edit-abbrevs-mode)
(save-restriction
(widen)
(define-abbrevs t)
@@ -279,7 +277,8 @@ abbrevs have been saved."
(list (read-file-name "Save abbrevs to file: "
(file-name-directory
(expand-file-name abbrev-file-name))
- abbrev-file-name)))
+ abbrev-file-name))
+ edit-abbrevs-mode)
(edit-abbrevs-redefine)
(write-abbrev-file file t))
@@ -287,14 +286,17 @@ abbrevs have been saved."
"Save all the user-level abbrev definitions in current buffer.
The saved abbrevs are written to the file specified by
`abbrev-file-name'."
- (interactive)
+ (interactive nil edit-abbrevs-mode)
(abbrev-edit-save-to-file abbrev-file-name))
(defun add-mode-abbrev (arg)
"Define a mode-specific abbrev whose expansion is the last word before point.
+If there's an active region, use that as the expansion.
+
Prefix argument ARG says how many words before point to use for the expansion;
zero means the entire region is the expansion.
+
A negative ARG means to undefine the specified abbrev.
This command reads the abbreviation from the minibuffer.
@@ -304,7 +306,7 @@ if the abbreviation is already in the buffer, use that command to define
a mode-specific abbrev by specifying its expansion in the minibuffer.
Don't use this function in a Lisp program; use `define-abbrev' instead."
- (interactive "p")
+ (interactive "P")
(add-abbrev
(if only-global-abbrevs
global-abbrev-table
@@ -314,8 +316,11 @@ Don't use this function in a Lisp program; use `define-abbrev' instead."
(defun add-global-abbrev (arg)
"Define a global (all modes) abbrev whose expansion is last word before point.
+If there's an active region, use that as the expansion.
+
Prefix argument ARG says how many words before point to use for the expansion;
zero means the entire region is the expansion.
+
A negative ARG means to undefine the specified abbrev.
This command reads the abbreviation from the minibuffer.
@@ -325,15 +330,21 @@ if the abbreviation is already in the buffer, use that command to define
a global abbrev by specifying its expansion in the minibuffer.
Don't use this function in a Lisp program; use `define-abbrev' instead."
- (interactive "p")
+ (interactive "P")
(add-abbrev global-abbrev-table "Global" arg))
(defun add-abbrev (table type arg)
- (let ((exp (and (>= arg 0)
- (buffer-substring-no-properties
- (point)
- (if (= arg 0) (mark)
- (save-excursion (forward-word (- arg)) (point))))))
+ (let ((exp
+ (cond
+ ((or (and (null arg) (use-region-p))
+ (zerop (prefix-numeric-value arg)))
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ ((> (prefix-numeric-value arg) 0)
+ (buffer-substring-no-properties
+ (point)
+ (save-excursion
+ (forward-word (- (prefix-numeric-value arg)))
+ (point))))))
name)
(setq name
(read-string (format (if exp "%s abbrev that expands into \"%s\": "
@@ -491,7 +502,8 @@ PROPS is a list of properties."
(defun abbrev-table-p (object)
"Return non-nil if OBJECT is an abbrev table."
(and (obarrayp object)
- (numberp (abbrev-table-get object :abbrev-table-modiff))))
+ (numberp (ignore-error 'wrong-type-argument
+ (abbrev-table-get object :abbrev-table-modiff)))))
(defun abbrev-table-empty-p (object &optional ignore-system)
"Return nil if there are no abbrev symbols in OBJECT.
@@ -604,7 +616,8 @@ PROPS is a property list. The following properties are special:
An obsolete but still supported calling form is:
-\(define-abbrev TABLE ABBREV EXPANSION &optional HOOK COUNT SYSTEM)."
+\(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
+ (declare (indent defun))
(when (and (consp props) (or (null (car props)) (numberp (car props))))
;; Old-style calling convention.
(setq props `(:count ,(car props)
@@ -884,8 +897,8 @@ longer than the abbrev, the benefit of informing the user is not
significant. If you always want to be informed about existing
abbrevs for the text you type, set this value to zero or less.
This setting only applies if `abbrev-suggest' is non-nil."
- :type 'number
- :version "28.1")
+ :type 'natnum
+ :version "28.1")
(defun abbrev--suggest-get-active-tables-including-parents ()
"Return a list of all active abbrev tables, including parent tables."
@@ -1164,7 +1177,7 @@ Properties with special meaning:
- `:enable-function' can be set to a function of no arguments which returns
non-nil if and only if the abbrevs in this table should be used for this
instance of `expand-abbrev'."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
;; We used to manually add the docstring, but we also want to record this
;; location as the definition of the variable (in load-history), so we may
;; as well just use `defvar'.
@@ -1212,7 +1225,30 @@ SORTFUN is passed to `sort' to change the default ordering."
(define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs"
"Major mode for editing the list of abbrev definitions.
This mode is for editing abbrevs in a buffer prepared by `edit-abbrevs',
-which see.")
+which see."
+ :interactive nil)
+
+(defun abbrev--possibly-save (query &optional arg)
+ ;; Query mode.
+ (if (eq query 'query)
+ (and save-abbrevs abbrevs-changed)
+ ;; Maybe save abbrevs, and record whether we either saved them or
+ ;; asked to.
+ (and save-abbrevs
+ abbrevs-changed
+ (progn
+ (if (or arg
+ (eq save-abbrevs 'silently)
+ (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
+ (progn
+ (write-abbrev-file nil)
+ nil)
+ ;; Don't keep bothering user if they say no.
+ (setq abbrevs-changed nil)
+ ;; Inhibit message in `save-some-buffers'.
+ t)))))
+
+(add-hook 'save-some-buffers-functions #'abbrev--possibly-save)
(provide 'abbrev)
diff --git a/lisp/align.el b/lisp/align.el
index 5e02520aae0..be70f8f9d4f 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -86,10 +86,9 @@
;; '((my-rule
;; (regexp . "Sample")))
;; :type align-rules-list-type
+;; :risky t
;; :group 'my-package)
;;
-;; (put 'my-align-rules-list 'risky-local-variable t)
-;;
;; (add-to-list 'align-dq-string-modes 'my-package-mode)
;; (add-to-list 'align-open-comment-modes 'my-package-mode)
;;
@@ -160,7 +159,8 @@ string), this heuristic is used to determine how far before and after
point we should search in looking for a region separator. Larger
values can mean slower performance in large files, although smaller
values may cause unexpected behavior at times."
- :type 'integer
+ :type '(choice (const :tag "Don't use heuristic when aligning a region" nil)
+ integer)
:group 'align)
(defcustom align-highlight-change-face 'highlight
@@ -176,7 +176,7 @@ values may cause unexpected behavior at times."
(defcustom align-large-region 10000
"If an integer, defines what constitutes a \"large\" region.
If nil, then no messages will ever be printed to the minibuffer."
- :type 'integer
+ :type '(choice (const :tag "Align a large region silently" nil) integer)
:group 'align)
(defcustom align-c++-modes '(c++-mode c-mode java-mode)
@@ -318,10 +318,9 @@ The possible settings for `align-region-separate' are:
; (const largest)
(regexp :tag "Regexp defines section boundaries")
(function :tag "Function defines section boundaries"))
+ :risky t
:group 'align)
-(put 'align-region-separate 'risky-local-variable t)
-
(defvar align-rules-list-type
'(repeat
(cons
@@ -356,11 +355,11 @@ The possible settings for `align-region-separate' are:
(cons :tag "Valid"
(const :tag "(Return non-nil if rule is valid)"
valid)
- (function :value t))
+ (function :value always))
(cons :tag "Run If"
(const :tag "(Return non-nil if rule should run)"
run-if)
- (function :value t))
+ (function :value always))
(cons :tag "Column"
(const :tag "(Column to fix alignment at)" column)
(choice :value comment-column
@@ -545,16 +544,16 @@ The possible settings for `align-region-separate' are:
(regexp . "\\(\\s-*\\)\\\\\\\\")
(modes . align-tex-modes))
- ;; With a numeric prefix argument, or C-u, space delimited text
- ;; tables will be aligned.
+ ;; Align space delimited text as columns.
(text-column
(regexp . "\\(^\\|\\S-\\)\\([ \t]+\\)\\(\\S-\\|$\\)")
(group . 2)
(modes . align-text-modes)
(repeat . t)
(run-if . ,(lambda ()
- (and current-prefix-arg
- (not (eq '- current-prefix-arg))))))
+ (and (not (eq '- current-prefix-arg))
+ (not (apply #'provided-mode-derived-p
+ major-mode align-tex-modes))))))
;; With a negative prefix argument, lists of dollar figures will
;; be aligned.
@@ -698,10 +697,9 @@ The following attributes are meaningful:
(see the documentation of that variable for possible
values), and any separation argument passed to `align'."
:type align-rules-list-type
+ :risky t
:group 'align)
-(put 'align-rules-list 'risky-local-variable t)
-
(defvar align-exclude-rules-list-type
'(repeat
(cons
@@ -769,10 +767,9 @@ The following attributes are meaningful:
"A list describing text that should be excluded from alignment.
See the documentation for `align-rules-list' for more info."
:type align-exclude-rules-list-type
+ :risky t
:group 'align)
-(put 'align-exclude-rules-list 'risky-local-variable t)
-
;;; Internal Variables:
(defvar-local align-mode-rules-list nil
@@ -822,8 +819,8 @@ See the variable `align-exclude-rules-list' for more details.")
(regexp . "\\(\\s-+\\)use\\s-+entity")))
"Alignment rules for `vhdl-mode'. See `align-rules-list' for more info."
:type align-rules-list-type
+ :risky t
:group 'align)
-(put 'align-vhdl-rules-list 'risky-local-variable t)
(make-obsolete-variable 'align-vhdl-rules-list "no longer used." "27.1")
(defun align-set-vhdl-rules ()
@@ -836,11 +833,22 @@ See the variable `align-exclude-rules-list' for more details.")
;;;###autoload
(defun align (beg end &optional separate rules exclude-rules)
"Attempt to align a region based on a set of alignment rules.
-BEG and END mark the region. If BEG and END are specifically set to
-nil (this can only be done programmatically), the beginning and end of
-the current alignment section will be calculated based on the location
-of point, and the value of `align-region-separate' (or possibly each
-rule's `separate' attribute).
+Interactively, BEG and END are the mark/point of the current region.
+
+Many modes define specific alignment rules, and some of these
+rules in some modes react to the current prefix argument. For
+instance, in `text-mode', \\`M-x align' will align into columns
+based on space delimiters, while \\`C-u -' \\`M-x align' will align
+into columns based on the \"$\" character. See the
+`align-rules-list' variable definition for the specific rules.
+
+Also see `align-regexp', which will guide you through various
+parameters for aligning text.
+
+Non-interactively, if BEG and END are nil, the beginning and end
+of the current alignment section will be calculated based on the
+location of point, and the value of `align-region-separate' (or
+possibly each rule's `separate' attribute).
If SEPARATE is non-nil, it overrides the value of
`align-region-separate' for all rules, except those that have their
@@ -889,6 +897,15 @@ on the format of these lists."
BEG and END mark the limits of the region. Interactively, this function
prompts for the regular expression REGEXP to align with.
+Interactively, if you specify a prefix argument, the function
+will guide you through entering the full regular expression, and
+then prompts for which subexpression parenthesis GROUP (default
+1) within REGEXP to modify, the amount of SPACING (default
+`align-default-spacing') to use, and whether or not to REPEAT the
+rule throughout the line.
+
+See `align-rules-list' for more information about these options.
+
For example, let's say you had a list of phone numbers, and wanted to
align them so that the opening parentheses would line up:
@@ -908,15 +925,8 @@ regular expression after you enter it. Interactively, you only
need to supply the characters to be lined up, and any preceding
whitespace is replaced.
-Non-interactively (or if you specify a prefix argument), you must
-enter the full regular expression, including the subexpression.
-Interactively, the function also then prompts for which
-subexpression parenthesis GROUP (default 1) within REGEXP to
-modify, the amount of SPACING (default `align-default-spacing')
-to use, and whether or not to REPEAT the rule throughout the
-line.
-
-See `align-rules-list' for more information about these options.
+Non-interactively, you must enter the full regular expression,
+including the subexpression.
The non-interactive form of the previous example would look something like:
(align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\")
@@ -928,7 +938,7 @@ construct a rule to pass to `align-region', which does the real work."
(list (region-beginning) (region-end))
(if current-prefix-arg
(list (read-string "Complex align using regexp: "
- "\\(\\s-*\\)" 'align-regexp-history)
+ "\\(\\s-*\\) " 'align-regexp-history)
(string-to-number
(read-string
"Parenthesis group to modify (justify if negative): " "1"))
diff --git a/lisp/allout.el b/lisp/allout.el
index b49945d85e7..e07bac4ef99 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -26,7 +26,7 @@
;;; Commentary:
;; Allout outline minor mode provides extensive outline formatting and
-;; and manipulation beyond standard Emacs outline mode. Some features:
+;; manipulation beyond standard Emacs outline mode. Some features:
;;
;; - Classic outline-mode topic-oriented navigation and exposure adjustment
;; - Topic-oriented editing including coherent topic and subtopic
@@ -133,15 +133,10 @@ respective `allout-mode' keybinding variables, `allout-command-prefix',
(when (boundp 'allout-unprefixed-keybindings)
(dolist (entry allout-unprefixed-keybindings)
(define-key map (car (read-from-string (car entry))) (cadr entry))))
- (substitute-key-definition #'beginning-of-line #'allout-beginning-of-line
- map global-map)
- (substitute-key-definition #'move-beginning-of-line
- #'allout-beginning-of-line
- map global-map)
- (substitute-key-definition #'end-of-line #'allout-end-of-line
- map global-map)
- (substitute-key-definition #'move-end-of-line #'allout-end-of-line
- map global-map)
+ (define-key map [remap beginning-of-line] #'allout-beginning-of-line)
+ (define-key map [remap move-beginning-of-line] #'allout-beginning-of-line)
+ (define-key map [remap end-of-line] #'allout-end-of-line)
+ (define-key map [remap move-end-of-line] #'allout-end-of-line)
(allout-institute-keymap map)))
;;;_ > allout-institute-keymap (map)
(defun allout-institute-keymap (map)
@@ -738,8 +733,6 @@ Set this var to the bullet you want to use for file cross-references."
(put 'allout-presentation-padding 'safe-local-variable #'integerp)
;;;_ = allout-flattened-numbering-abbreviation
-(define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering
- 'allout-flattened-numbering-abbreviation "24.1")
(defcustom allout-flattened-numbering-abbreviation nil
"If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic
numbers to minimal amount with some context. Otherwise, entire
@@ -1355,11 +1348,6 @@ their settings before `allout-mode' was started."
;;;_ = allout-mode-hook
(defvar allout-mode-hook nil
"Hook run when allout mode starts.")
-;;;_ = allout-mode-deactivate-hook
-(define-obsolete-variable-alias 'allout-mode-deactivate-hook
- 'allout-mode-off-hook "24.1")
-(defvar allout-mode-deactivate-hook nil
- "Hook run when allout mode ends.")
;;;_ = allout-exposure-category
(defvar allout-exposure-category nil
"Symbol for use as allout invisible-text overlay category.")
@@ -1784,7 +1772,6 @@ hooks, by which independent code can cooperate with allout
without changes to the allout core. Here are key ones:
`allout-mode-hook'
-`allout-mode-deactivate-hook' (deprecated)
`allout-mode-off-hook'
`allout-exposure-change-functions'
`allout-structure-added-functions'
@@ -3079,6 +3066,8 @@ Move to buffer limit in indicated direction if headings are exhausted."
(backward (if (< arg 0) (setq arg (* -1 arg))))
(step (if backward -1 1))
(progress (allout-current-bullet-pos))
+ ;; Move to the next physical line.
+ (line-move-visual nil)
prev got)
(while (> arg 0)
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index b379e710940..6f1c270c239 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -91,7 +91,7 @@ as a PDF file."
:group 'processes)
(defface ansi-color-bold
- '((t :inherit 'bold))
+ '((t :inherit bold))
"Face used to render bold text."
:group 'ansi-colors
:version "28.1")
@@ -103,13 +103,13 @@ as a PDF file."
:version "28.1")
(defface ansi-color-italic
- '((t :inherit 'italic))
+ '((t :inherit italic))
"Face used to render italic text."
:group 'ansi-colors
:version "28.1")
(defface ansi-color-underline
- '((t :inherit 'underline))
+ '((t :inherit underline))
"Face used to render underlined text."
:group 'ansi-colors
:version "28.1")
@@ -234,7 +234,7 @@ This vector holds the faces used for SGR control sequence parameters 0
to 7.
This variable is obsolete. To customize the display of faces used by
-ansi-color, change 'ansi-color-FACE', e.g. `ansi-color-bold'. To
+ansi-color, change `ansi-color-FACE', e.g. `ansi-color-bold'. To
customize the actual faces used (e.g. to temporarily display SGR
control sequences differently), use `ansi-color-basic-faces-vector'."
:type '(vector face face face face face face face face)
@@ -249,7 +249,7 @@ This vector holds the colors used for SGR control sequence parameters
30 to 37 (foreground colors) and 40 to 47 (background colors).
This variable is obsolete. To customize the display of colors used by
-ansi-color, change 'ansi-color-COLOR', e.g. `ansi-color-red'. To
+ansi-color, change `ansi-color-COLOR', e.g. `ansi-color-red'. To
customize the actual faces used (e.g. to temporarily display SGR
control sequences differently), use `ansi-color-normal-colors-vector'."
:type '(vector (choice color (cons color color))
@@ -347,6 +347,10 @@ version of that color."
"\e\\[[\x30-\x3F]*[\x20-\x2F]*[\x40-\x7E]"
"Regexp matching an ANSI control sequence.")
+(defconst ansi-color--control-seq-fragment-regexp
+ "\e\\[[\x30-\x3F]*[\x20-\x2F]*\\|\e"
+ "Regexp matching a partial ANSI control sequence.")
+
(defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
"Regexp that matches SGR control sequence parameters.")
@@ -452,17 +456,21 @@ variable, and is meant to be used in `compilation-filter-hook'."
(_
(ansi-color-apply-on-region compilation-filter-start (point))))))
-(define-obsolete-function-alias 'ansi-color-unfontify-region
- 'font-lock-default-unfontify-region "24.1")
-
;; Working with strings
(defvar-local ansi-color-context nil
"Context saved between two calls to `ansi-color-apply'.
-This is a list of the form (CODES FRAGMENT) or nil. CODES
+This is a list of the form (FACE-VEC FRAGMENT) or nil. FACE-VEC
represents the state the last call to `ansi-color-apply' ended
-with, currently a list of ansi codes, and FRAGMENT is a string
-starting with an escape sequence, possibly the start of a new
-escape sequence.")
+with, currently a list of the form:
+
+ (BASIC-FACES FG BG)
+
+BASIC-FACES is a bool-vector that specifies which basic faces
+from `ansi-color-basic-faces-vector' to apply. FG and BG are
+ANSI color codes for the foreground and background color.
+
+FRAGMENT is a string starting with an escape sequence, possibly
+the start of a new escape sequence.")
(defun ansi-color-filter-apply (string)
"Filter out all ANSI control sequences from STRING.
@@ -473,43 +481,31 @@ will be used for the next call to `ansi-color-apply'. Set
`ansi-color-context' to nil if you don't want this.
This function can be added to `comint-preoutput-filter-functions'."
- (let ((start 0) end result)
+ (let ((context (ansi-color--ensure-context 'ansi-color-context nil))
+ (start 0) end result)
;; if context was saved and is a string, prepend it
- (if (cadr ansi-color-context)
- (setq string (concat (cadr ansi-color-context) string)
- ansi-color-context nil))
+ (setq string (concat (cadr context) string))
+ (setcar (cdr context) "")
;; find the next escape sequence
(while (setq end (string-match ansi-color-control-seq-regexp string start))
(push (substring string start end) result)
(setq start (match-end 0)))
;; save context, add the remainder of the string to the result
- (let (fragment)
+ (let ((fragment ""))
(push (substring string start
- (if (string-match "\033" string start)
+ (if (string-match
+ (concat "\\(?:"
+ ansi-color--control-seq-fragment-regexp
+ "\\)\\'")
+ string start)
(let ((pos (match-beginning 0)))
(setq fragment (substring string pos))
pos)
nil))
result)
- (setq ansi-color-context (if fragment (list nil fragment))))
+ (setcar (cdr context) fragment))
(apply #'concat (nreverse result))))
-(defun ansi-color--find-face (codes)
- "Return the face corresponding to CODES."
- ;; Sort the codes in ascending order to guarantee that "bold" comes before
- ;; any of the colors. This ensures that `ansi-color-bold-is-bright' is
- ;; applied correctly.
- (let (faces bright (codes (sort (copy-sequence codes) #'<)))
- (while codes
- (when-let ((face (ansi-color-get-face-1 (pop codes) bright)))
- (when (and ansi-color-bold-is-bright (eq face 'ansi-color-bold))
- (setq bright t))
- (push face faces)))
- ;; Avoid some long-lived conses in the common case.
- (if (cdr faces)
- (nreverse faces)
- (car faces))))
-
(defun ansi-color-apply (string)
"Translates SGR control sequences into text properties.
Delete all other control sequences without processing them.
@@ -524,49 +520,159 @@ This information will be used for the next call to `ansi-color-apply'.
Set `ansi-color-context' to nil if you don't want this.
This function can be added to `comint-preoutput-filter-functions'."
- (let ((codes (car ansi-color-context))
- (start 0) end result)
+ (let* ((context
+ (ansi-color--ensure-context 'ansi-color-context nil))
+ (face-vec (car context))
+ (start 0)
+ end result)
;; If context was saved and is a string, prepend it.
- (if (cadr ansi-color-context)
- (setq string (concat (cadr ansi-color-context) string)
- ansi-color-context nil))
+ (setq string (concat (cadr context) string))
+ (setcar (cdr context) "")
;; Find the next escape sequence.
(while (setq end (string-match ansi-color-control-seq-regexp string start))
(let ((esc-end (match-end 0)))
;; Colorize the old block from start to end using old face.
- (when codes
+ (when-let ((face (ansi-color--face-vec-face face-vec)))
(put-text-property start end 'font-lock-face
- (ansi-color--find-face codes) string))
+ face string))
(push (substring string start end) result)
(setq start (match-end 0))
;; If this is a color escape sequence,
(when (eq (aref string (1- esc-end)) ?m)
;; create a new face from it.
- (setq codes (ansi-color-apply-sequence
- (substring string end esc-end) codes)))))
+ (let ((cur-pos end))
+ (ansi-color--update-face-vec
+ face-vec
+ (lambda ()
+ (when (string-match ansi-color-parameter-regexp
+ string cur-pos)
+ (setq cur-pos (match-end 0))
+ (when (<= cur-pos esc-end)
+ (string-to-number (match-string 1 string))))))))))
;; if the rest of the string should have a face, put it there
- (when codes
+ (when-let ((face (ansi-color--face-vec-face face-vec)))
(put-text-property start (length string)
- 'font-lock-face (ansi-color--find-face codes) string))
+ 'font-lock-face face string))
;; save context, add the remainder of the string to the result
- (let (fragment)
- (if (string-match "\033" string start)
- (let ((pos (match-beginning 0)))
- (setq fragment (substring string pos))
- (push (substring string start pos) result))
- (push (substring string start) result))
- (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
+ (if (string-match
+ (concat "\\(?:" ansi-color--control-seq-fragment-regexp "\\)\\'")
+ string start)
+ (let ((pos (match-beginning 0)))
+ (setcar (cdr context) (substring string pos))
+ (push (substring string start pos) result))
+ (push (substring string start) result))
(apply 'concat (nreverse result))))
+(defun ansi-color--ensure-context (context-sym position)
+ "Return CONTEXT-SYM's value as a valid context.
+If it is nil, set CONTEXT-SYM's value to a new context and return
+it. Context is a list of the form as described in
+`ansi-color-context' if POSITION is nil, or
+`ansi-color-context-region' if POSITION is non-nil.
+
+If CONTEXT-SYM's value is already non-nil, return it. If its
+marker doesn't point anywhere yet, position it before character
+number POSITION, if non-nil."
+ (let ((context (symbol-value context-sym)))
+ (if context
+ (if position
+ (let ((marker (cadr context)))
+ (unless (marker-position marker)
+ (set-marker marker position))
+ context)
+ context)
+ (set context-sym
+ (list (list (make-bool-vector 8 nil)
+ nil nil)
+ (if position
+ (copy-marker position)
+ ""))))))
+
+(defun ansi-color--face-vec-face (face-vec)
+ "Return the face corresponding to FACE-VEC.
+FACE-VEC is a list containing information about the ANSI sequence
+code. It is usually stored as the car of the variable
+`ansi-color-context-region'."
+ (let* ((basic-faces (car face-vec))
+ (colors (cdr face-vec))
+ (bright (and ansi-color-bold-is-bright (aref basic-faces 1)))
+ (faces nil))
+
+ (when-let ((fg (car colors)))
+ (push
+ `(:foreground
+ ,(or (ansi-color--code-as-hex fg)
+ (face-foreground
+ (aref (if (or bright (>= fg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod fg 8))
+ nil 'default)))
+ faces))
+ (when-let ((bg (cadr colors)))
+ (push
+ `(:background
+ ,(or (ansi-color--code-as-hex bg)
+ (face-background
+ (aref (if (or bright (>= bg 8))
+ ansi-color-bright-colors-vector
+ ansi-color-normal-colors-vector)
+ (mod bg 8))
+ nil 'default)))
+ faces))
+
+ (let ((i 8))
+ (while (> i 0)
+ (setq i (1- i))
+ (when (aref basic-faces i)
+ (push (aref ansi-color-basic-faces-vector i) faces))))
+ ;; Avoid some long-lived conses in the common case.
+ (if (cdr faces)
+ faces
+ (car faces))))
+
+(defun ansi-color--code-as-hex (color)
+ "Convert COLOR to hexadecimal string representation.
+COLOR is an ANSI color code. If it is between 16 and 255
+inclusive, it corresponds to a color from an 8-bit color cube.
+If it is greater or equal than 256, it is subtracted by 256 to
+directly specify a 24-bit color.
+
+Return a hexadecimal string, specifying the color, or nil, if
+COLOR is less than 16."
+ (cond
+ ((< color 16) nil)
+ ((>= color 256) (format "#%06X" (- color 256)))
+ ((>= color 232) ;; Grayscale
+ (format "#%06X" (* #x010101 (+ 8 (* 10 (- color 232))))))
+ (t ;; 6x6x6 color cube
+ (setq color (- color 16))
+ (let ((res 0)
+ (frac (* 6 6)))
+ (while (<= 1 frac) ; Repeat 3 times
+ (setq res (* res #x000100))
+ (let ((color-num (mod (/ color frac) 6)))
+ (unless (zerop color-num)
+ (setq res (+ res #x37 (* #x28 color-num)))))
+ (setq frac (/ frac 6)))
+ (format "#%06X" res)))))
+
;; Working with regions
(defvar-local ansi-color-context-region nil
"Context saved between two calls to `ansi-color-apply-on-region'.
-This is a list of the form (CODES MARKER) or nil. CODES
+This is a list of the form (FACE-VEC MARKER) or nil. FACE-VEC
represents the state the last call to `ansi-color-apply-on-region'
-ended with, currently a list of ansi codes, and MARKER is a
-buffer position within an escape sequence or the last position
-processed.")
+ended with, currently a list of the form:
+
+ (BASIC-FACES FG BG).
+
+BASIC-FACES is a bool-vector that specifies which basic faces
+from `ansi-color-basic-faces-vector' to apply. FG and BG are
+ANSI color codes for the foreground and background color.
+
+MARKER is a buffer position within an escape sequence or the last
+position processed.")
(defun ansi-color-filter-region (begin end)
"Filter out all ANSI control sequences from region BEGIN to END.
@@ -576,17 +682,23 @@ Every call to this function will set and use the buffer-local variable
used for the next call to `ansi-color-apply-on-region'. Specifically,
it will override BEGIN, the start of the region. Set
`ansi-color-context-region' to nil if you don't want this."
- (let ((end-marker (copy-marker end))
- (start (or (cadr ansi-color-context-region) begin)))
+ (let* ((end-marker (copy-marker end))
+ (context (ansi-color--ensure-context
+ 'ansi-color-context-region begin))
+ (start (cadr context)))
(save-excursion
(goto-char start)
;; Delete escape sequences.
(while (re-search-forward ansi-color-control-seq-regexp end-marker t)
(delete-region (match-beginning 0) (match-end 0)))
;; save context, add the remainder of the string to the result
- (if (re-search-forward "\033" end-marker t)
- (setq ansi-color-context-region (list nil (match-beginning 0)))
- (setq ansi-color-context-region nil)))))
+ (set-marker start (point))
+ (while (re-search-forward ansi-color--control-seq-fragment-regexp
+ end-marker t))
+ (if (and (/= (point) start)
+ (= (point) end-marker))
+ (set-marker start (match-beginning 0))
+ (set-marker start nil)))))
(defun ansi-color-apply-on-region (begin end &optional preserve-sequences)
"Translates SGR control sequences into overlays or extents.
@@ -608,58 +720,60 @@ this.
If PRESERVE-SEQUENCES is t, the sequences are hidden instead of
being deleted."
- (let ((codes (car ansi-color-context-region))
- (start-marker (or (cadr ansi-color-context-region)
- (copy-marker begin)))
- (end-marker (copy-marker end)))
+ (let* ((context (ansi-color--ensure-context
+ 'ansi-color-context-region begin))
+ (face-vec (car context))
+ (start-marker (cadr context))
+ (end-marker (copy-marker end)))
(save-excursion
(goto-char start-marker)
;; Find the next escape sequence.
(while (re-search-forward ansi-color-control-seq-regexp end-marker t)
;; Extract escape sequence.
- (let ((esc-seq (buffer-substring
- (match-beginning 0) (point))))
- (if preserve-sequences
- ;; Make the escape sequence transparent.
- (overlay-put (make-overlay (match-beginning 0) (point))
- 'invisible t)
- ;; Otherwise, strip.
- (delete-region (match-beginning 0) (point)))
-
+ (let ((esc-beg (match-beginning 0))
+ (esc-end (point)))
;; Colorize the old block from start to end using old face.
(funcall ansi-color-apply-face-function
(prog1 (marker-position start-marker)
;; Store new start position.
- (set-marker start-marker (point)))
- (match-beginning 0) (ansi-color--find-face codes))
+ (set-marker start-marker esc-end))
+ esc-beg (ansi-color--face-vec-face face-vec))
;; If this is a color sequence,
- (when (eq (aref esc-seq (1- (length esc-seq))) ?m)
- ;; update the list of ansi codes.
- (setq codes (ansi-color-apply-sequence esc-seq codes)))))
+ (when (eq (char-before esc-end) ?m)
+ (goto-char esc-beg)
+ (ansi-color--update-face-vec
+ face-vec (lambda ()
+ (when (re-search-forward ansi-color-parameter-regexp
+ esc-end t)
+ (string-to-number (match-string 1))))))
+
+ (if preserve-sequences
+ ;; Make the escape sequence transparent.
+ (overlay-put (make-overlay esc-beg esc-end) 'invisible t)
+ ;; Otherwise, strip.
+ (delete-region esc-beg esc-end))))
;; search for the possible start of a new escape sequence
- (if (re-search-forward "\033" end-marker t)
- (progn
- ;; if the rest of the region should have a face, put it there
- (funcall ansi-color-apply-face-function
- start-marker (point) (ansi-color--find-face codes))
- ;; save codes and point
- (setq ansi-color-context-region
- (list codes (copy-marker (match-beginning 0)))))
- ;; if the rest of the region should have a face, put it there
- (funcall ansi-color-apply-face-function
- start-marker end-marker (ansi-color--find-face codes))
- ;; Save a restart position when there are codes active. It's
- ;; convenient for man.el's process filter to pass `begin'
- ;; positions that overlap regions previously colored; these
- ;; `codes' should not be applied to that overlap, so we need
- ;; to know where they should really start.
- (setq ansi-color-context-region
- (if codes (list codes (copy-marker (point)))))))
- ;; Clean up our temporary markers.
- (unless (eq start-marker (cadr ansi-color-context-region))
- (set-marker start-marker nil))
- (unless (eq end-marker (cadr ansi-color-context-region))
- (set-marker end-marker nil))))
+ (while (re-search-forward ansi-color--control-seq-fragment-regexp
+ end-marker t))
+ (if (and (/= (point) start-marker)
+ (= (point) end-marker))
+ (progn
+ (goto-char (match-beginning 0))
+ (funcall ansi-color-apply-face-function
+ start-marker (point)
+ (ansi-color--face-vec-face face-vec))
+ (set-marker start-marker (point)))
+ (let ((faces (ansi-color--face-vec-face face-vec)))
+ (funcall ansi-color-apply-face-function
+ start-marker end-marker faces)
+ ;; Save a restart position when there are codes active. It's
+ ;; convenient for man.el's process filter to pass `begin'
+ ;; positions that overlap regions previously colored; these
+ ;; `codes' should not be applied to that overlap, so we need
+ ;; to know where they should really start.
+ (set-marker start-marker (when faces end-marker)))))
+ ;; Clean up our temporary marker.
+ (set-marker end-marker nil)))
(defun ansi-color-apply-overlay-face (beg end face)
"Make an overlay from BEG to END, and apply face FACE.
@@ -767,6 +881,7 @@ the foreground color code is replaced or added resp. deleted; if it
is 40-47 (or 100-107) resp. 49, the background color code is replaced
or added resp. deleted; any other code is discarded together with the
old codes. Finally, the so changed list of codes is returned."
+ (declare (obsolete ansi-color--update-face-vec "29.1"))
(let ((new-codes (ansi-color-parse-sequence escape-sequence)))
(while new-codes
(let* ((new (pop new-codes))
@@ -795,6 +910,72 @@ old codes. Finally, the so changed list of codes is returned."
(_ nil)))))
codes))
+(defun ansi-color--update-face-vec (face-vec iterator)
+ "Apply escape sequences to FACE-VEC.
+
+Destructively modify FACE-VEC, which should be a list containing
+face information. It is described in
+`ansi-color-context-region'. ITERATOR is a function which is
+called repeatedly with zero arguments and should return either
+the next ANSI code in the current sequence as a number or nil if
+there are no more ANSI codes left.
+
+For each new code, the following happens: if it is 1-7, set the
+corresponding properties; if it is 21-25 or 27, unset appropriate
+properties; if it is 30-37 (or 90-97) or resp. 39, set the
+foreground color or resp. unset it; if it is 40-47 (or 100-107)
+resp. 49, set the background color or resp. unset it; if it is 38
+or 48, the following codes are used to set the foreground or
+background color and the correct color mode; any other code will
+unset all properties and colors."
+ (let ((basic-faces (car face-vec))
+ (colors (cdr face-vec))
+ new q do-clear)
+ (while (setq new (funcall iterator))
+ (setq q (/ new 10))
+ (pcase q
+ (0 (if (memq new '(0 8 9))
+ (setq do-clear t)
+ (aset basic-faces new t)))
+ (2 (if (memq new '(20 26 28 29))
+ (setq do-clear t)
+ ;; The standard says `21 doubly underlined' while
+ ;; https://en.wikipedia.org/wiki/ANSI_escape_code claims
+ ;; `21 Bright/Bold: off or Underline: Double'.
+ (aset basic-faces (- new 20) nil)
+ (aset basic-faces (pcase new (22 1) (25 6) (_ 0)) nil)))
+ ((or 3 4 9 10)
+ (let ((r (mod new 10))
+ (cell (if (memq q '(3 9)) colors (cdr colors))))
+ (pcase r
+ (8
+ (pcase (funcall iterator)
+ (5 (setq new (setcar cell (funcall iterator)))
+ (setq do-clear (or (null new) (>= new 256))))
+ (2
+ (let ((red (funcall iterator))
+ (green (funcall iterator))
+ (blue (funcall iterator)))
+ (if (and red green blue
+ (progn
+ (setq new (+ (* #x010000 red)
+ (* #x000100 green)
+ (* #x000001 blue)))
+ (<= new #xFFFFFF)))
+ (setcar cell (+ 256 new))
+ (setq do-clear t))))
+ (_ (setq do-clear t))))
+ (9 (setcar cell nil))
+ (_ (setcar cell (+ (if (memq q '(3 4)) 0 8) r))))))
+ (_ (setq do-clear t)))
+
+ (when do-clear
+ (setq do-clear nil)
+ ;; Zero out our bool vector without any allocation.
+ (bool-vector-intersection basic-faces #&8"\0" basic-faces)
+ (setcar colors nil)
+ (setcar (cdr colors) nil)))))
+
(defun ansi-color-make-color-map ()
"Create a vector of face definitions and return it.
@@ -859,6 +1040,7 @@ This function is obsolete, and no longer needed to use ansi-color."
"Get face definition for ANSI-CODE.
BRIGHT, if non-nil, requests \"bright\" ANSI colors, even if ANSI-CODE
is a normal-intensity color."
+ (declare (obsolete ansi-color--face-vec-face "29.1"))
(when (and bright (<= 30 ansi-code 49))
(setq ansi-code (+ ansi-code 60)))
(cond ((<= 0 ansi-code 7)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 5ff29206d96..0b84f9fa63b 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -493,7 +493,12 @@ Intended as a value for `revert-buffer-function'."
\\{apropos-mode-map}"
(make-local-variable 'apropos--current)
- (setq-local revert-buffer-function #'apropos--revert-buffer))
+ (setq-local revert-buffer-function #'apropos--revert-buffer)
+ (setq-local outline-regexp "^[^ \n]+"
+ outline-level (lambda () 1)
+ outline-minor-mode-cycle t
+ outline-minor-mode-highlight t
+ outline-minor-mode-use-buttons t))
(defvar apropos-multi-type t
"If non-nil, this apropos query concerns multiple types.
@@ -513,11 +518,11 @@ variables, not just user options."
(if (or current-prefix-arg apropos-do-all)
"variable" "user option"))
current-prefix-arg))
- (apropos-command pattern nil
+ (apropos-command pattern (or do-all apropos-do-all)
(if (or do-all apropos-do-all)
- #'(lambda (symbol)
- (and (boundp symbol)
- (get symbol 'variable-documentation)))
+ (lambda (symbol)
+ (and (boundp symbol)
+ (get symbol 'variable-documentation)))
#'custom-variable-p)))
;;;###autoload
@@ -658,7 +663,10 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Return list of symbols and documentation found."
+Return list of symbols and documentation found.
+
+The *Apropos* window will be selected if `help-window-select' is
+non-nil."
(interactive (list (apropos-read-pattern "symbol")
current-prefix-arg))
(setq apropos--current (list #'apropos pattern do-all))
@@ -846,7 +854,7 @@ Returns list of symbols and values found."
f v p)
apropos-accumulator))))))
(let ((apropos-multi-type do-all))
- (apropos-print nil "\n----------------\n")))
+ (apropos-print nil "\n")))
;;;###autoload
(defun apropos-local-value (pattern &optional buffer)
@@ -866,7 +874,7 @@ Optional arg BUFFER (default: current buffer) is the buffer to check."
apropos-all-words apropos-accumulator))
(setq var (apropos-value-internal #'local-variable-if-set-p symb
#'symbol-value)))
- (when (and (fboundp 'apropos-false-hit-str) (apropos-false-hit-str var))
+ (when (apropos-false-hit-str var)
(setq var nil))
(when var
(setq apropos-accumulator (cons (list symb (apropos-score-str var) nil var)
@@ -940,13 +948,14 @@ Returns list of symbols and documentation found."
(defun apropos-value-internal (predicate symbol function)
(when (funcall predicate symbol)
- (setq symbol (prin1-to-string
- (if (memq symbol '(command-history minibuffer-history))
- ;; The value we're looking for will always be in
- ;; the first element of these two lists, so skip
- ;; that value.
- (cdr (funcall function symbol))
- (funcall function symbol))))
+ (let ((print-escape-newlines t))
+ (setq symbol (prin1-to-string
+ (if (memq symbol '(command-history minibuffer-history))
+ ;; The value we're looking for will always be in
+ ;; the first element of these two lists, so skip
+ ;; that value.
+ (cdr (funcall function symbol))
+ (funcall function symbol)))))
(when (string-match apropos-regexp symbol)
(if apropos-match-face
(put-text-property (match-beginning 0) (match-end 0)
@@ -1046,7 +1055,13 @@ non-nil."
(setq sepa (goto-char sepb)))))
(defun apropos-documentation-check-elc-file (file)
- (if (member file apropos-files-scanned)
+ ;; .elc files have the location of the file specified as #$, but for
+ ;; built-in files, that's a relative name (while for the rest, it's
+ ;; absolute). So expand the name in the former case.
+ (unless (file-name-absolute-p file)
+ (setq file (expand-file-name file lisp-directory)))
+ (if (or (member file apropos-files-scanned)
+ (not (file-exists-p file)))
nil
(let (symbol doc beg end this-is-a-variable)
(setq apropos-files-scanned (cons file apropos-files-scanned))
@@ -1156,13 +1171,15 @@ as a heading."
(old-buffer (current-buffer))
(inhibit-read-only t)
(button-end 0)
+ (first t)
symbol item)
(set-buffer standard-output)
(apropos-mode)
(apropos--preamble text)
(dolist (apropos-item p)
- (when (and spacing (not (bobp)))
- (princ spacing))
+ (if (and spacing (not first))
+ (princ spacing)
+ (setq first nil))
(setq symbol (car apropos-item))
;; Insert dummy score element for backwards compatibility with 21.x
;; apropos-item format.
@@ -1236,12 +1253,27 @@ as a heading."
'apropos-user-option
'apropos-variable)
(not nosubst))
+ ;; Insert an excerpt of variable values.
+ (when (boundp symbol)
+ (insert " Value: ")
+ (let* ((print-escape-newlines t)
+ (value (prin1-to-string (symbol-value symbol)))
+ (truncated (truncate-string-to-width
+ value (- (window-width) 20) nil nil t)))
+ (insert truncated)
+ (unless (equal value truncated)
+ (buttonize-region (1- (point)) (point)
+ (lambda (_)
+ (message "Value: %s" value))))
+ (insert "\n")))
(apropos-print-doc 7 'apropos-group t)
(apropos-print-doc 6 'apropos-face t)
(apropos-print-doc 5 'apropos-widget t)
(apropos-print-doc 4 'apropos-plist nil))
(setq-local truncate-partial-width-windows t)
- (setq-local truncate-lines t))))
+ (setq-local truncate-lines t)))
+ (when help-window-select
+ (select-window (get-buffer-window "*Apropos*"))))
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
@@ -1249,12 +1281,13 @@ as a heading."
(let ((doc (nth i apropos-item)))
(when (stringp doc)
(if apropos-compact-layout
- (insert (propertize "\t" 'display '(space :align-to 32)) " ")
- (insert " "))
+ (insert (propertize "\t" 'display '(space :align-to 32)))
+ (insert " "))
(if apropos-multi-type
(let ((button-face (button-type-get type 'face)))
(unless (consp button-face)
(setq button-face (list button-face)))
+ (insert " ")
(insert-text-button
(if apropos-compact-layout
(format "<%s>" (button-type-get type 'apropos-short-label))
@@ -1276,7 +1309,9 @@ as a heading."
(cond ((equal doc "")
(setq doc "(not documented)"))
(do-keys
- (setq doc (substitute-command-keys doc))))
+ (setq doc (or (ignore-errors
+ (substitute-command-keys doc))
+ doc))))
(insert doc)
(if (equal doc "(not documented)")
(put-text-property opoint (point) 'font-lock-face 'shadow))
@@ -1322,17 +1357,18 @@ as a heading."
(defun apropos-describe-plist (symbol)
"Display a pretty listing of SYMBOL's plist."
- (help-setup-xref (list 'apropos-describe-plist symbol)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (set-buffer standard-output)
- (princ "Symbol ")
- (prin1 symbol)
- (princ (substitute-command-keys "'s plist is\n ("))
- (put-text-property (+ (point-min) 7) (- (point) 14)
- 'face 'apropos-symbol)
- (insert (apropos-format-plist symbol "\n "))
- (princ ")")))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list 'apropos-describe-plist symbol)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (set-buffer standard-output)
+ (princ "Symbol ")
+ (prin1 symbol)
+ (princ (substitute-command-keys "'s plist is\n ("))
+ (put-text-property (+ (point-min) 7) (- (point) 14)
+ 'face 'apropos-symbol)
+ (insert (apropos-format-plist symbol "\n "))
+ (princ ")"))))
(provide 'apropos)
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index b1042be348c..c52f2a44322 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -101,6 +101,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
;; -------------------------------------------------------------------------
;;; Section: Configuration.
@@ -431,12 +432,8 @@ be added."
;; Let mouse-1 follow the link.
(define-key map [follow-link] 'mouse-face)
- (if (fboundp 'command-remapping)
- (progn
- (define-key map [remap advertised-undo] 'archive-undo)
- (define-key map [remap undo] 'archive-undo))
- (substitute-key-definition 'advertised-undo 'archive-undo map global-map)
- (substitute-key-definition 'undo 'archive-undo map global-map))
+ (define-key map [remap advertised-undo] #'archive-undo)
+ (define-key map [remap undo] #'archive-undo)
(define-key map [mouse-2] 'archive-extract)
@@ -621,12 +618,8 @@ OLDMODE will be modified accordingly just like chmod(2) would have done."
(defun archive-unixdate (low high)
"Stringify Unix (LOW HIGH) date."
- (let* ((time (list high low))
- (str (current-time-string time)))
- (format "%s-%s-%s"
- (substring str 8 10)
- (substring str 4 7)
- (format-time-string "%Y" time))))
+ (let ((system-time-locale "C"))
+ (format-time-string "%e-%b-%Y" (list high low))))
(defun archive-unixtime (low high)
"Stringify Unix (LOW HIGH) time."
@@ -1071,7 +1064,8 @@ NEW-NAME."
#'archive--file-desc-ext-file-name
(or (archive-get-marked ?*) (list (archive-get-descr))))))
(list names
- (read-file-name (format "Copy %s to: " (string-join names ", "))))))
+ (read-file-name (format "Copy %s to: " (string-join names ", "))
+ nil default-directory))))
(unless (consp files)
(setq files (list files)))
(when (and (> (length files) 1)
@@ -1348,7 +1342,8 @@ NEW-NAME."
t)
(defun archive-*-write-file-member (archive descr command)
- (let* ((ename (archive--file-desc-ext-file-name descr))
+ (let* ((archive (expand-file-name archive))
+ (ename (archive--file-desc-ext-file-name descr))
(tmpfile (expand-file-name ename archive-tmpdir))
(top (directory-file-name (file-name-as-directory archive-tmpdir)))
(default-directory (file-name-as-directory top)))
@@ -1372,6 +1367,7 @@ NEW-NAME."
(setq ename
(encode-coding-string ename archive-file-name-coding-system))
(let* ((coding-system-for-write 'no-conversion)
+ (default-directory (file-name-as-directory archive-tmpdir))
(exitcode (apply #'call-process
(car command)
nil
diff --git a/lisp/array.el b/lisp/array.el
index 31cf9cf3028..08c5ff45ddd 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -767,29 +767,27 @@ Return COLUMN."
;;; Array mode.
-(defvar array-mode-map
- (let ((map (make-keymap)))
- (define-key map "\M-ad" #'array-display-local-variables)
- (define-key map "\M-am" #'array-make-template)
- (define-key map "\M-ae" #'array-expand-rows)
- (define-key map "\M-ar" #'array-reconfigure-rows)
- (define-key map "\M-a=" #'array-what-position)
- (define-key map "\M-ag" #'array-goto-cell)
- (define-key map "\M-af" #'array-fill-rectangle)
- (define-key map "\C-n" #'array-next-row)
- (define-key map "\C-p" #'array-previous-row)
- (define-key map "\C-f" #'array-forward-column)
- (define-key map "\C-b" #'array-backward-column)
- (define-key map "\M-n" #'array-copy-down)
- (define-key map "\M-p" #'array-copy-up)
- (define-key map "\M-f" #'array-copy-forward)
- (define-key map "\M-b" #'array-copy-backward)
- (define-key map "\M-\C-n" #'array-copy-row-down)
- (define-key map "\M-\C-p" #'array-copy-row-up)
- (define-key map "\M-\C-f" #'array-copy-column-forward)
- (define-key map "\M-\C-b" #'array-copy-column-backward)
- map)
- "Keymap used in array mode.")
+(defvar-keymap array-mode-map
+ :doc "Keymap used in array mode."
+ "M-a d" #'array-display-local-variables
+ "M-a m" #'array-make-template
+ "M-a e" #'array-expand-rows
+ "M-a r" #'array-reconfigure-rows
+ "M-a =" #'array-what-position
+ "M-a g" #'array-goto-cell
+ "M-a f" #'array-fill-rectangle
+ "C-n" #'array-next-row
+ "C-p" #'array-previous-row
+ "C-f" #'array-forward-column
+ "C-b" #'array-backward-column
+ "M-n" #'array-copy-down
+ "M-p" #'array-copy-up
+ "M-f" #'array-copy-forward
+ "M-b" #'array-copy-backward
+ "C-M-n" #'array-copy-row-down
+ "C-M-p" #'array-copy-row-up
+ "C-M-f" #'array-copy-column-forward
+ "C-M-b" #'array-copy-column-backward)
(put 'array-mode 'mode-class 'special)
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index dc89622f425..12da2c3d73d 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -45,6 +45,9 @@
(require 'cl-lib)
(require 'eieio)
+(declare-function gnutls-symmetric-decrypt "gnutls.c")
+(declare-function gnutls-ciphers "gnutls.c")
+
(autoload 'secrets-create-item "secrets")
(autoload 'secrets-delete-item "secrets")
(autoload 'secrets-get-alias "secrets")
@@ -161,8 +164,6 @@ Overrides `password-cache-expiry' through a let-binding."
(defvar auth-source-creation-prompts nil
"Default prompts for token values. Usually let-bound.")
-(make-obsolete 'auth-source-hide-passwords nil "24.1")
-
(defcustom auth-source-save-behavior 'ask
"If set, auth-source will respect it for save behavior."
:version "23.2" ;; No Gnus
@@ -253,7 +254,7 @@ can get pretty complex."
(choice :tag "Authentication backend choice"
(string :tag "Authentication Source (file)")
(list
- :tag "Secret Service API/KWallet/GNOME Keyring"
+ :tag "Secret Service API/KWallet/GNOME Keyring/KeyPassXC"
(const :format "" :value :secrets)
(choice :tag "Collection to use"
(string :tag "Collection name")
@@ -277,15 +278,16 @@ can get pretty complex."
(const :tag "default" default))))
(repeat :tag "Extra Parameters" :inline t
(choice :tag "Extra parameter"
+ :value (:host t)
(list
- :tag "Host"
+ :tag "Host" :inline t
(const :format "" :value :host)
(choice :tag "Host (machine) choice"
(const :tag "Any" t)
(regexp
:tag "Regular expression")))
(list
- :tag "Protocol"
+ :tag "Protocol" :inline t
(const :format "" :value :port)
(choice
:tag "Protocol"
@@ -569,19 +571,24 @@ which says:
or P. The resulting token will only have keys user, host, and
port.\"
-:create \\='(A B C) also means to create a token if possible.
+:create \\='(A B C) or
+:create \\='(:unencrypted A B :encrypted C)
+also means to create a token if possible.
The behavior is like :create t but if the list contains any
parameter, that parameter will be required in the resulting
-token. The value for that parameter will be obtained from the
-search parameters or from user input. If any queries are needed,
-the alist `auth-source-creation-defaults' will be checked for the
-default value. If the user, host, or port are missing, the alist
-`auth-source-creation-prompts' will be used to look up the
-prompts IN THAT ORDER (so the `user' prompt will be queried first,
-then `host', then `port', and finally `secret'). Each prompt string
-can use %u, %h, and %p to show the user, host, and port. The prompt
-is formatted with `format-prompt', a trailing \": \" is removed.
+token (the second form is used only with the plstore backend and
+specifies if any of the extra parameters should be stored in
+encrypted format.) The value for that parameter will be obtained
+from the search parameters or from user input. If any queries
+are needed, the alist `auth-source-creation-defaults' will be
+checked for the default value. If the user, host, or port are
+missing, the alist `auth-source-creation-prompts' will be used to
+look up the prompts IN THAT ORDER (so the `user' prompt will be
+queried first, then `host', then `port', and finally `secret').
+Each prompt string can use %u, %h, and %p to show the user, host,
+and port. The prompt is formatted with `format-prompt', a
+trailing \": \" is removed.
Here's an example:
@@ -850,15 +857,17 @@ while \(:host t) would find all host entries."
(cl-return 'no)))
'no))))
-(defun auth-source-pick-first-password (&rest spec)
- "Pick the first secret found from applying SPEC to `auth-source-search'."
- (let* ((result (nth 0 (apply #'auth-source-search (plist-put spec :max 1))))
- (secret (plist-get result :secret)))
-
+(defun auth-info-password (auth-info)
+ "Return the :secret password from the AUTH-INFO."
+ (let ((secret (plist-get auth-info :secret)))
(if (functionp secret)
(funcall secret)
secret)))
+(defun auth-source-pick-first-password (&rest spec)
+ "Pick the first secret found by applying `auth-source-search' to SPEC."
+ (auth-info-password (car (apply #'auth-source-search (plist-put spec :max 1)))))
+
(defun auth-source-format-prompt (prompt alist)
"Format PROMPT using %x (for any character x) specifiers in ALIST.
Remove trailing \": \"."
@@ -1797,10 +1806,9 @@ authentication tokens:
(plist-put
artificial
:save-function
- (let* ((collection collection)
- (item (plist-get artificial :label))
- (secret (plist-get artificial :secret))
- (secret (if (functionp secret) (funcall secret) secret)))
+ (let ((collection collection)
+ (item (plist-get artificial :label))
+ (secret (auth-info-password artificial)))
(lambda ()
(auth-source-secrets-saver collection item secret args)))))
@@ -1948,7 +1956,7 @@ entries for git.gnus.org:
(defun auth-source--decode-octal-string (string)
- "Convert octal STRING to utf-8 string. E.g: 'a\134b' to 'a\b'."
+ "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"."
(let ((list (string-to-list string))
(size (length string)))
(decode-coding-string
@@ -2126,12 +2134,17 @@ entries for git.gnus.org:
(let* ((base-required '(host user port secret))
(base-secret '(secret))
;; we know (because of an assertion in auth-source-search) that the
- ;; :create parameter is either t or a list (which includes nil)
- (create-extra (if (eq t create) nil create))
+ ;; :create parameter is either t, or a list (which includes nil
+ ;; or a plist)
+ (create-extra-secret (plist-get create :encrypted))
+ (create-extra (if (eq t create) nil
+ (or (append (plist-get create :unencrypted)
+ create-extra-secret) create)))
(current-data (car (auth-source-search :max 1
:host host
:port port)))
(required (append base-required create-extra))
+ (required-secret (append base-secret create-extra-secret))
;; `valist' is an alist
valist
;; `artificial' will be returned if no creation is needed
@@ -2153,10 +2166,11 @@ entries for git.gnus.org:
(auth-source--aput valist br br-choice))))))
;; for extra required elements, see if the spec includes a value for them
- (dolist (er create-extra)
- (let ((k (auth-source--symbol-keyword er))
- (keys (cl-loop for i below (length spec) by 2
- collect (nth i spec))))
+ (let ((keys (cl-loop for i below (length spec) by 2
+ collect (nth i spec)))
+ k)
+ (dolist (er create-extra)
+ (setq k (auth-source--symbol-keyword er))
(when (memq k keys)
(auth-source--aput valist er (plist-get spec k)))))
@@ -2220,7 +2234,7 @@ entries for git.gnus.org:
(eval default)))))
(when data
- (if (member r base-secret)
+ (if (member r required-secret)
(setq secret-artificial
(plist-put secret-artificial
(auth-source--symbol-keyword r)
@@ -2309,89 +2323,6 @@ See `auth-source-search' for details on SPEC."
(push item all)))
(nreverse all)))
-;;; older API
-
-;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
-
-;; deprecate the old interface
-(make-obsolete 'auth-source-user-or-password
- 'auth-source-search "24.1")
-(make-obsolete 'auth-source-forget-user-or-password
- 'auth-source-forget "24.1")
-
-(defun auth-source-user-or-password
- (mode host port &optional username create-missing delete-existing)
- "Find MODE (string or list of strings) matching HOST and PORT.
-
-DEPRECATED in favor of `auth-source-search'!
-
-USERNAME is optional and will be used as \"login\" in a search
-across the Secret Service API (see secrets.el) if the resulting
-items don't have a username. This means that if you search for
-username \"joe\" and it matches an item but the item doesn't have
-a :user attribute, the username \"joe\" will be returned.
-
-A non-nil DELETE-EXISTING means deleting any matching password
-entry in the respective sources. This is useful only when
-CREATE-MISSING is non-nil as well; the intended use case is to
-remove wrong password entries.
-
-If no matching entry is found, and CREATE-MISSING is non-nil,
-the password will be retrieved interactively, and it will be
-stored in the password database which matches best (see
-`auth-sources').
-
-MODE can be \"login\" or \"password\"."
- (auth-source-do-debug
- "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
- mode host port username)
-
- (let* ((listy (listp mode))
- (mode (if listy mode (list mode)))
- ;; (cname (if username
- ;; (format "%s %s:%s %s" mode host port username)
- ;; (format "%s %s:%s" mode host port)))
- (search (list :host host :port port))
- (search (if username (append search (list :user username)) search))
- (search (if create-missing
- (append search (list :create t))
- search))
- (search (if delete-existing
- (append search (list :delete t))
- search))
- ;; (found (if (not delete-existing)
- ;; (gethash cname auth-source-cache)
- ;; (remhash cname auth-source-cache)
- ;; nil)))
- (found nil))
- (if found
- (progn
- (auth-source-do-debug
- "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
- mode
- ;; don't show the password
- (if (and (member "password" mode) t)
- "SECRET"
- found)
- host port username)
- found) ; return the found data
- ;; else, if not found, search with a max of 1
- (let ((choice (nth 0 (apply #'auth-source-search
- (append '(:max 1) search)))))
- (when choice
- (dolist (m mode)
- (cond
- ((equal "password" m)
- (push (if (plist-get choice :secret)
- (funcall (plist-get choice :secret))
- nil) found))
- ((equal "login" m)
- (push (plist-get choice :user) found)))))
- (setq found (nreverse found))
- (setq found (if listy found (car-safe found)))))
-
- found))
-
(defun auth-source-user-and-password (host &optional user)
(let* ((auth-info (car
(if user
@@ -2407,9 +2338,7 @@ MODE can be \"login\" or \"password\"."
:require '(:user :secret)
:create nil))))
(user (plist-get auth-info :user))
- (password (plist-get auth-info :secret)))
- (when (functionp password)
- (setq password (funcall password)))
+ (password (auth-info-password auth-info)))
(list user password auth-info)))
;;; Tiny mode for editing .netrc/.authinfo modes (that basically just
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 727e383bb52..29d10bc6295 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -67,7 +67,7 @@ Possible values:
other insert if possible, but mark as unmodified.
Insertion is possible when something appropriate is found in
`auto-insert-alist'. When the insertion is marked as unmodified, you can
-save it with \\[write-file] RET.
+save it with \\[write-file] \\`RET'.
This variable is used when the function `auto-insert' is called, e.g.
when you do (add-hook \\='find-file-hook \\='auto-insert).
With \\[auto-insert], this is always treated as if it were t."
@@ -76,6 +76,9 @@ With \\[auto-insert], this is always treated as if it were t."
(other :tag "insert if possible, mark as unmodified."
not-modified)))
+;;;###autoload
+(put 'auto-insert 'safe-local-variable #'null)
+
(defcustom auto-insert-query 'function
"Non-nil means ask user before auto-inserting.
When this is `function', only ask when called non-interactively."
@@ -89,9 +92,10 @@ If this contains a %s, that will be replaced by the matching rule."
:type 'string
:version "28.1")
+(declare-function sgml-tag "textmodes/sgml-mode" (&optional str arg))
(defcustom auto-insert-alist
- '((("\\.\\([Hh]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'" . "C / C++ header")
+ `((("\\.\\([Hh]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'" . "C / C++ header")
(replace-regexp-in-string
"[^A-Z0-9]" "_"
(string-replace
@@ -113,7 +117,7 @@ If this contains a %s, that will be replaced by the matching rule."
(("[Mm]akefile\\'" . "Makefile") . "makefile.inc")
- (html-mode . (lambda () (sgml-tag "html")))
+ (html-mode . ,(lambda () (sgml-tag "html")))
(plain-tex-mode . "tex-insert.tex")
(bibtex-mode . "tex-insert.tex")
@@ -128,9 +132,9 @@ If this contains a %s, that will be replaced by the matching rule."
"\n\\end{document}")
(("/bin/.*[^/]\\'" . "Shell-Script mode magic number") .
- (lambda ()
- (if (eq major-mode (default-value 'major-mode))
- (sh-mode))))
+ ,(lambda ()
+ (if (eq major-mode (default-value 'major-mode))
+ (sh-mode))))
(ada-mode . ada-header)
@@ -171,7 +175,7 @@ If this contains a %s, that will be replaced by the matching rule."
'(setq v1 (let (modes)
(mapatoms (lambda (mode)
(let ((name (symbol-name mode)))
- (when (string-match "-mode$" name)
+ (when (string-match "-mode\\'" name)
(push name modes)))))
(sort modes 'string<)))
(completing-read "Local variables for mode: " v1 nil t)
@@ -210,7 +214,8 @@ If this contains a %s, that will be replaced by the matching rule."
"\n"))
((let ((minibuffer-help-form v2))
(completing-read "Keyword, C-h: " v1 nil t))
- str ", ") & -2 "
+ str ", ")
+ & -2 "
\;; 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
@@ -415,6 +420,7 @@ Matches the visited file name against the elements of `auto-insert-alist'."
"Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
Optional AFTER means to insert action after all existing actions for CONDITION,
or if CONDITION had no actions, after all other CONDITIONs."
+ (declare (indent defun))
(let ((elt (assoc condition auto-insert-alist)))
(if elt
(setcdr elt
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 97a122b7bcf..918c0c7f19d 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -692,7 +692,7 @@ system.")
(defun auto-revert-notify-handler (event)
"Handle an EVENT returned from file notification."
- (with-demoted-errors
+ (with-demoted-errors "Error while auto-reverting: %S"
(let* ((descriptor (car event))
(action (nth 1 event))
(file (nth 2 event))
diff --git a/lisp/avoid.el b/lisp/avoid.el
index b53d84d2e8d..2e77c8feff1 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -293,6 +293,8 @@ accumulated, and tries to keep it close to zero."
(mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax)
(+ (cdr (cdr cur)) deltay))))))
+(defvar x-pointer-invisible) ; silence byte-compiler
+
(defun mouse-avoidance-random-shape ()
"Return a random cursor shape.
This assumes that any variable whose name begins with x-pointer- and
@@ -300,12 +302,14 @@ has an integer value is a valid cursor shape. You might want to
redefine this function to suit your own tastes."
(if (null mouse-avoidance-pointer-shapes)
(progn
- (setq mouse-avoidance-pointer-shapes
- (mapcar (lambda (x) (symbol-value (intern x)))
- (all-completions "x-pointer-" obarray
- (lambda (x)
- (and (boundp x)
- (integerp (symbol-value x)))))))))
+ (dolist (i (all-completions "x-pointer-" obarray
+ (lambda (x)
+ (and (boundp x)
+ (integerp (symbol-value x))))))
+ (ignore-errors
+ (let ((value (symbol-value (intern i))))
+ (when (< value x-pointer-invisible)
+ (push value mouse-avoidance-pointer-shapes)))))))
(seq-random-elt mouse-avoidance-pointer-shapes))
(defun mouse-avoidance-ignore-p ()
@@ -317,7 +321,8 @@ redefine this function to suit your own tastes."
(not (eq (car mp) (selected-frame)))
;; Don't interfere with ongoing `mouse-drag-and-drop-region'
;; (Bug#36269).
- (eq track-mouse 'dropping)
+ (or (eq track-mouse 'dropping)
+ (eq track-mouse 'drag-source))
;; Don't do anything if last event was a mouse event.
;; FIXME: this code fails in the case where the mouse was moved
;; since the last key-press but without generating any event.
diff --git a/lisp/battery.el b/lisp/battery.el
index c899fb6e438..3cff3167a6c 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -96,12 +96,14 @@ Value does not include \".\" or \"..\"."
(cond ((member battery-upower-service (dbus-list-activatable-names))
#'battery-upower)
((and (eq system-type 'gnu/linux)
+ (file-readable-p "/sys/")
(battery--find-linux-sysfs-batteries))
#'battery-linux-sysfs)
((and (eq system-type 'gnu/linux)
(file-directory-p "/proc/acpi/battery"))
#'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
+ (file-readable-p "/proc/")
(file-readable-p "/proc/apm"))
#'battery-linux-proc-apm)
((and (eq system-type 'berkeley-unix)
@@ -113,6 +115,10 @@ Value does not include \".\" or \"..\"."
(and (eq (call-process "pmset" nil t nil "-g" "ps") 0)
(not (bobp))))))
#'battery-pmset)
+ ((and (eq system-type 'haiku)
+ ;; TODO: Support the Haiku APM battery driver.
+ (file-directory-p "/dev/power/acpi_battery"))
+ #'battery-haiku-acpi-battery)
((fboundp 'w32-battery-status)
#'w32-battery-status))
"Function for getting battery status information.
@@ -226,6 +232,40 @@ The text being displayed in the echo area is controlled by the variables
(funcall battery-status-function))
"Battery status not available")))
+(defcustom battery-update-functions nil
+ "Functions run by `display-battery-mode' after updating the status.
+These functions will be called with one parameter, an alist that
+contains data about the current battery status. The keys in the
+alist are single characters and the values are strings.
+Different battery backends deliver different information, so some
+of the following information may or may not be available:
+
+ v: driver-version
+ V: bios-version
+ I: bios-interface
+ L: line-status
+ B: battery-status
+ b: battery-status-symbol
+ p: load-percentage
+ s: seconds
+ m: minutes
+ h: hours
+ t: remaining-time
+
+For instance, to play an alarm when the battery power dips below
+10%, you could use a function like the following:
+
+(defvar my-prev-battery nil)
+(defun my-battery-alarm (data)
+ (when (and my-prev-battery
+ (equal (alist-get ?L data) \"off-line\")
+ (< (string-to-number (alist-get ?p data)) 10)
+ (>= (string-to-number (alist-get ?p my-prev-battery)) 10))
+ (play-sound-file \"~/alarm.wav\" 5))
+ (setq my-prev-battery data))"
+ :version "29.1"
+ :type '(repeat function))
+
;;;###autoload
(define-minor-mode display-battery-mode
"Toggle battery status display in mode line (Display Battery mode).
@@ -233,7 +273,11 @@ The text being displayed in the echo area is controlled by the variables
The text displayed in the mode line is controlled by
`battery-mode-line-format' and `battery-status-function'.
The mode line is be updated every `battery-update-interval'
-seconds."
+seconds.
+
+The function which updates the mode-line display will call the
+functions in `battery-update-functions', which can be used to
+trigger actions based on battery-related events."
:global t
(setq battery-mode-line-string "")
(or global-mode-string (setq global-mode-string '("")))
@@ -273,7 +317,8 @@ seconds."
((< percentage battery-load-low)
(add-face-text-property 0 len 'battery-load-low t res)))
(put-text-property 0 len 'help-echo "Battery status information" res))
- (setq battery-mode-line-string (or res "")))
+ (setq battery-mode-line-string (or res ""))
+ (run-hook-with-args 'battery-update-functions data))
(force-mode-line-update t))
@@ -600,6 +645,103 @@ The following %-sequences are provided:
(_ "N/A"))))))
+;;; `/dev/power/acpi_battery' interface for Haiku.
+
+(defun battery--search-haiku-acpi-status ()
+ "Search forward for battery status in the current buffer.
+Return a property list once all relevant properties are found.
+The following properties may be inside the list:
+
+ - `:capacity' (the current capacity of the battery.)
+ - `:voltage' (the current voltage of the battery.)
+ - `:rate', (the current rate of charge or discharge.)
+ - `:state' (the current state of the battery.)
+ - `:design-capacity' (the design capacity of the battery.)
+ - `:design-voltage' (the design voltage of the battery.)
+ - `:last-full-charge' (the capacity at the last full charge of
+ the battery.)
+
+`:capacity' and `:design-capacity' are both represented in
+terms of milliamp-hours."
+ (let ((state-regexp "State \\([[:digit:]]+\\), Current Rate \\([[:digit:]]+\\), \
+Capacity \\([[:digit:]]+\\), Voltage \\([[:digit:]]+\\)")
+ (pu-regexp "Power Unit \\([[:digit:]]\\)+, Design Capacity \\([[:digit:]]+\\), \
+Last Full Charge \\([[:digit:]]+\\)")
+ (design-regexp "Design Voltage \\([[:digit:]]+\\)")
+ power-unit last-full-charge state rate capacity
+ voltage design-capacity design-voltage)
+ (when (re-search-forward state-regexp)
+ (setq state (string-to-number (match-string 1)))
+ (setq rate (string-to-number (match-string 2)))
+ (setq capacity (string-to-number (match-string 3)))
+ (setq voltage (/ (string-to-number (match-string 4)) 1000.0)))
+ (when (re-search-forward pu-regexp)
+ (setq power-unit (string-to-number (match-string 1)))
+ (setq design-capacity (string-to-number (match-string 2)))
+ (setq last-full-charge (string-to-number (match-string 3))))
+ (when (re-search-forward design-regexp)
+ (setq design-voltage (/ (string-to-number (match-string 1)) 1000.0)))
+ ;; Convert capacity fields to milliamp-hours if they're
+ ;; specified as miliwatt-hours.
+ (when (eq power-unit 0)
+ (setq capacity (/ capacity voltage))
+ (setq design-capacity (/ design-capacity design-voltage))
+ (setq last-full-charge (/ last-full-charge voltage)))
+ (list :capacity capacity :voltage voltage
+ :rate rate :state (cond
+ ((not (zerop (logand state 2))) 'charging)
+ ((not (zerop (logand state 1))) 'discharging)
+ ((not (zerop (logand state 4))) 'critical)
+ (t 'fully-charged))
+ :design-capacity design-capacity
+ :design-voltage design-voltage
+ :last-full-charge last-full-charge)))
+
+(defun battery-haiku-acpi-battery ()
+ "Get battery status from `/dev/power/acpi_battery'.
+This function only works on Haiku systems with an ACPI battery.
+
+The following %-sequences are provided:
+%c Current capacity (mAh)
+%r Current rate of charge or discharge
+%L AC line status (verbose)
+%B Battery status (verbose)
+%b Battery status: empty means high, `-' means low,
+ `!' means critical, and `+' means charging
+%p Battery load percentage"
+ (with-temp-buffer
+ (dolist (file (battery--files "/dev/power/acpi_battery"))
+ (insert-file-contents (expand-file-name file "/dev/power/acpi_battery")))
+ ;; I don't think Haiku actually supports multiple batteries yet,
+ ;; since the code in PowerStatus doesn't take care of that
+ ;; situation.
+ (let ((list (ignore-errors (battery--search-haiku-acpi-status))))
+ (if list
+ (list (cons ?c (format "%.0f" (plist-get list :capacity)))
+ (cons ?r (format "%.0f" (plist-get list :rate)))
+ (cons ?B (symbol-name (plist-get list :state)))
+ (cons ?b (let ((state (plist-get list :state)))
+ (cond
+ ((eq state 'charging) "+")
+ ((and (eq state 'discharging)
+ (< (/ (plist-get list :capacity)
+ (plist-get list :last-full-charge))
+ 0.15))
+ "-")
+ ((eq state 'critical) "!")
+ (t ""))))
+ (cons ?L (if (not (eq (plist-get list :state) 'discharging))
+ "on-line" "off-line"))
+ (cons ?p (format "%.0f"
+ (* 100 (/ (plist-get list :capacity)
+ (plist-get list :last-full-charge))))))
+ '((?c . "N/A")
+ (?r . "N/A")
+ (?B . "N/A")
+ (?b . "N/A")
+ (?p . "N/A"))))))
+
+
;;; UPower interface.
(defconst battery-upower-interface "org.freedesktop.UPower"
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 56f742a2704..14ab69b8f02 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1,7 +1,6 @@
;;; bindings.el --- define standard key bindings and some variables -*- lexical-binding: t; -*-
-;; Copyright (C) 1985-1987, 1992-1996, 1999-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -231,6 +230,7 @@ mnemonics of the following coding systems:
(:propertize ("" (:eval (if (frame-parameter nil 'client) "@" "")))
help-echo ,(purecopy "emacsclient frame")))
"Mode line construct for identifying emacsclient frames.")
+;; Autoload if this file no longer dumped.
;;;###autoload
(put 'mode-line-client 'risky-local-variable t)
@@ -288,7 +288,7 @@ mnemonics of the following coding systems:
Value is used for `mode-line-frame-identification', which see."
(if (or (null window-system)
(eq window-system 'pc))
- "-%F "
+ " %F "
" "))
;; We need to defer the call to mode-line-frame-control to the time
@@ -458,8 +458,8 @@ displayed in `mode-line-position', a component of the default
(const :tag "\"%q\": Offsets of both top and bottom of window"
(6 "%q")))
:version "26.1"
+ :risky t
:group 'mode-line)
-(put 'mode-line-percent-position 'risky-local-variable t)
(defcustom mode-line-position-line-format '(" L%l")
"Format used to display line numbers in the mode line.
@@ -501,8 +501,9 @@ mouse-1: Display Line and Column Mode Menu"))
(defvar mode-line-position
`((:propertize
- mode-line-percent-position
+ ("" mode-line-percent-position)
local-map ,mode-line-column-line-number-mode-map
+ display (min-width (5.0))
mouse-face mode-line-highlight
;; XXX needs better description
help-echo "Window Scroll Percentage
@@ -521,26 +522,31 @@ mouse-1: Display Line and Column Mode Menu")))
(10
(:propertize
mode-line-position-column-line-format
+ display (min-width (10.0))
,@mode-line-position--column-line-properties))
(10
(:propertize
(:eval (string-replace
"%c" "%C" (car mode-line-position-column-line-format)))
+ display (min-width (10.0))
,@mode-line-position--column-line-properties)))
(6
(:propertize
mode-line-position-line-format
+ display (min-width (6.0))
,@mode-line-position--column-line-properties))))
(column-number-mode
(column-number-indicator-zero-based
(6
(:propertize
mode-line-position-column-format
+ display (min-width (6.0))
(,@mode-line-position--column-line-properties)))
(6
(:propertize
(:eval (string-replace
"%c" "%C" (car mode-line-position-column-format)))
+ display (min-width (6.0))
,@mode-line-position--column-line-properties))))))
"Mode line construct for displaying the position in the buffer.
Normally displays the buffer percentage and, optionally, the
@@ -597,10 +603,14 @@ By default, this shows the information specified by `global-mode-string'.")
(let ((standard-mode-line-format
(list "%e"
'mode-line-front-space
- 'mode-line-mule-info
- 'mode-line-client
- 'mode-line-modified
- 'mode-line-remote
+ (list
+ :propertize
+ (list ""
+ 'mode-line-mule-info
+ 'mode-line-client
+ 'mode-line-modified
+ 'mode-line-remote)
+ 'display '(min-width (5.0)))
'mode-line-frame-identification
'mode-line-buffer-identification
" "
@@ -644,6 +654,18 @@ By default, this shows the information specified by `global-mode-string'.")
(with-selected-window (posn-window (event-start event))
(previous-buffer)))
+(defun mode-line-window-selected-p ()
+ "Return non-nil if we're updating the mode line for the selected window.
+This function is meant to be called in `:eval' mode line
+constructs to allow altering the look of the mode line depending
+on whether the mode line belongs to the currently selected window
+or not."
+ (let ((window (selected-window)))
+ (or (eq window (old-selected-window))
+ (and (minibuffer-window-active-p (minibuffer-window))
+ (with-selected-window (minibuffer-window)
+ (eq window (minibuffer-selected-window)))))))
+
(defmacro bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil.
Note that if `lexical-binding' is in effect, this function isn't
@@ -968,7 +990,7 @@ if `inhibit-field-text-motion' is non-nil."
(define-key esc-map "\\" 'delete-horizontal-space)
(define-key esc-map "m" 'back-to-indentation)
(define-key ctl-x-map "\C-o" 'delete-blank-lines)
-(define-key esc-map " " 'just-one-space)
+(define-key esc-map " " 'cycle-spacing)
(define-key esc-map "z" 'zap-to-char)
(define-key esc-map "=" 'count-words-region)
(define-key ctl-x-map "=" 'what-cursor-position)
@@ -991,7 +1013,7 @@ if `inhibit-field-text-motion' is non-nil."
(let ((map (make-sparse-keymap)))
(define-key map "u" 'undo)
map)
- "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.")
+ "Keymap to repeat undo key sequences \\`C-x u u'. Used in `repeat-mode'.")
(put 'undo 'repeat-map 'undo-repeat-map)
(define-key global-map '[(control ??)] 'undo-redo)
@@ -1105,6 +1127,7 @@ if `inhibit-field-text-motion' is non-nil."
(define-key goto-map "p" 'previous-error)
(define-key goto-map "\M-p" 'previous-error)
(define-key goto-map "\t" 'move-to-column)
+(define-key goto-map "i" 'imenu)
(defvar search-map (make-sparse-keymap)
"Keymap for search related commands.")
@@ -1138,7 +1161,9 @@ if `inhibit-field-text-motion' is non-nil."
;(define-key global-map [delete] 'backward-delete-char)
;; natural bindings for terminal keycaps --- defined in X keysym order
-(define-key global-map [Scroll_Lock] 'scroll-lock-mode)
+(define-key global-map
+ (if (eq system-type 'windows-nt) [scroll] [Scroll_Lock])
+ #'scroll-lock-mode)
(define-key global-map [C-S-backspace] 'kill-whole-line)
(define-key global-map [home] 'move-beginning-of-line)
(define-key global-map [C-home] 'beginning-of-buffer)
@@ -1251,6 +1276,8 @@ if `inhibit-field-text-motion' is non-nil."
;; (define-key global-map [kp-9] 'function-key-error)
;; (define-key global-map [kp-equal] 'function-key-error)
+(define-key global-map [touch-end] 'ignore)
+
;; X11 distinguishes these keys from the non-kp keys.
;; Make them behave like the non-kp keys unless otherwise bound.
;; FIXME: rather than list such mappings for every modifier-combination,
@@ -1312,7 +1339,15 @@ if `inhibit-field-text-motion' is non-nil."
;; can use S-tab instead to access that binding.
(define-key function-key-map [S-tab] [backtab])
-(define-key global-map [mouse-movement] 'ignore)
+(defun ignore-preserving-kill-region (&rest _)
+ "Like `ignore', but don't overwrite `last-event' if it's `kill-region'."
+ (declare (completion ignore))
+ (interactive)
+ (when (eq last-command 'kill-region)
+ (setq this-command 'kill-region))
+ nil)
+
+(define-key global-map [mouse-movement] #'ignore-preserving-kill-region)
(define-key global-map "\C-t" 'transpose-chars)
(define-key esc-map "t" 'transpose-words)
@@ -1376,10 +1411,8 @@ if `inhibit-field-text-motion' is non-nil."
(define-key esc-map [?\C-\ ] 'mark-sexp)
(define-key esc-map "\C-d" 'down-list)
(define-key esc-map "\C-k" 'kill-sexp)
-;;; These are dangerous in various situations,
-;;; so let's not encourage anyone to use them.
-;;;(define-key global-map [C-M-delete] 'backward-kill-sexp)
-;;;(define-key global-map [C-M-backspace] 'backward-kill-sexp)
+(define-key global-map [C-M-delete] 'backward-kill-sexp)
+(define-key global-map [C-M-backspace] 'backward-kill-sexp)
(define-key esc-map [C-delete] 'backward-kill-sexp)
(define-key esc-map [C-backspace] 'backward-kill-sexp)
(define-key esc-map "\C-n" 'forward-list)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index cc9956c80a9..b2130557dcc 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -115,10 +115,18 @@ just use the value of `version-control'."
(defcustom bookmark-sort-flag t
- "Non-nil means that bookmarks will be displayed sorted by bookmark name.
-Otherwise they will be displayed in LIFO order (that is, most
-recently set ones come first, oldest ones come last)."
- :type 'boolean)
+ "This controls the bookmark display sorting.
+nil means they will be displayed in LIFO order (that is, most
+recently created ones come first, oldest ones come last).
+
+`last-modified' means that bookmarks will be displayed sorted
+from most recently modified to least recently modified.
+
+Other values means that bookmarks will be displayed sorted by
+bookmark name."
+ :type '(choice (const :tag "By name" t)
+ (const :tag "By modified time" last-modified)
+ (const :tag "By creation time" nil)))
(defcustom bookmark-menu-confirm-deletion nil
@@ -152,7 +160,7 @@ This includes the annotations column.")
(defcustom bookmark-bmenu-file-column 30
"Column at which to display filenames in a buffer listing bookmarks.
You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
- :type 'integer)
+ :type 'natnum)
(defcustom bookmark-bmenu-toggle-filenames t
@@ -166,7 +174,7 @@ A non-nil value may result in truncated bookmark names."
(defcustom bookmark-menu-length 70
"Maximum length of a bookmark name displayed on a popup menu."
- :type 'integer)
+ :type 'natnum)
;; FIXME: Is it really worth a customization option?
(defcustom bookmark-search-delay 0.2
@@ -208,37 +216,34 @@ A non-nil value may result in truncated bookmark names."
;; Set up these bindings dumping time *only*;
;; if the user alters them, don't override the user when loading bookmark.el.
-;;;###autoload (define-key ctl-x-r-map "b" 'bookmark-jump)
-;;;###autoload (define-key ctl-x-r-map "m" 'bookmark-set)
-;;;###autoload (define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite)
-;;;###autoload (define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
+;;;###autoload (keymap-set ctl-x-r-map "b" #'bookmark-jump)
+;;;###autoload (keymap-set ctl-x-r-map "m" #'bookmark-set)
+;;;###autoload (keymap-set ctl-x-r-map "M" #'bookmark-set-no-overwrite)
+;;;###autoload (keymap-set ctl-x-r-map "l" #'bookmark-bmenu-list)
;;;###autoload
-(defvar bookmark-map
- (let ((map (make-sparse-keymap)))
- ;; Read the help on all of these functions for details...
- (define-key map "x" 'bookmark-set)
- (define-key map "m" 'bookmark-set) ;"m"ark
- (define-key map "M" 'bookmark-set-no-overwrite) ;"M"aybe mark
- (define-key map "j" 'bookmark-jump)
- (define-key map "g" 'bookmark-jump) ;"g"o
- (define-key map "o" 'bookmark-jump-other-window)
- (define-key map "5" 'bookmark-jump-other-frame)
- (define-key map "i" 'bookmark-insert)
- (define-key map "e" 'edit-bookmarks)
- (define-key map "f" 'bookmark-insert-location) ;"f"ind
- (define-key map "r" 'bookmark-rename)
- (define-key map "d" 'bookmark-delete)
- (define-key map "D" 'bookmark-delete-all)
- (define-key map "l" 'bookmark-load)
- (define-key map "w" 'bookmark-write)
- (define-key map "s" 'bookmark-save)
- map)
- "Keymap containing bindings to bookmark functions.
+(defvar-keymap bookmark-map
+ :doc "Keymap containing bindings to bookmark functions.
It is not bound to any key by default: to bind it
so that you have a bookmark prefix, just use `global-set-key' and bind a
key of your choice to variable `bookmark-map'. All interactive bookmark
-functions have a binding in this keymap.")
+functions have a binding in this keymap."
+ "x" #'bookmark-set
+ "m" #'bookmark-set ;"m"ark
+ "M" #'bookmark-set-no-overwrite ;"M"aybe mark
+ "j" #'bookmark-jump
+ "g" #'bookmark-jump ;"g"o
+ "o" #'bookmark-jump-other-window
+ "5" #'bookmark-jump-other-frame
+ "i" #'bookmark-insert
+ "e" #'edit-bookmarks
+ "f" #'bookmark-insert-location ;"f"ind
+ "r" #'bookmark-rename
+ "d" #'bookmark-delete
+ "D" #'bookmark-delete-all
+ "l" #'bookmark-load
+ "w" #'bookmark-write
+ "s" #'bookmark-save)
;;;###autoload (fset 'bookmark-map bookmark-map)
@@ -349,6 +354,17 @@ This point is in `bookmark-current-buffer'.")
BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'."
(car bookmark-record))
+(defun bookmark-type-from-full-record (bookmark-record)
+ "Return then type of BOOKMARK-RECORD.
+BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. It's
+type is read from the symbol property named
+`bookmark-handler-type' read on the record handler function."
+ (let ((handler (bookmark-get-handler bookmark-record)))
+ (when (autoloadp (symbol-function handler))
+ (autoload-do-load (symbol-function handler)))
+ (if (symbolp handler)
+ (get handler 'bookmark-handler-type)
+ "")))
(defun bookmark-all-names ()
"Return a list of all current bookmark names."
@@ -452,6 +468,17 @@ In other words, return all information but the name."
"Return the handler function for BOOKMARK-NAME-OR-RECORD, or nil if none."
(bookmark-prop-get bookmark-name-or-record 'handler))
+
+(defun bookmark-get-last-modified (bookmark-name-or-record)
+ "Return the last-modified for BOOKMARK-NAME-OR-RECORD, or nil if none."
+ (bookmark-prop-get bookmark-name-or-record 'last-modified))
+
+
+(defun bookmark-update-last-modified (bookmark-name-or-record)
+ "Update the last-modified date of BOOKMARK-NAME-OR-RECORD to the current time."
+ (bookmark-prop-set bookmark-name-or-record 'last-modified (current-time)))
+
+
(defvar bookmark-history nil
"The history list for bookmark functions.")
@@ -489,6 +516,24 @@ See user option `bookmark-set-fringe'."
(when (eq 'bookmark (overlay-get temp 'category))
(delete-overlay (setq found temp))))))))))
+(defun bookmark-maybe-sort-alist ()
+ "Return `bookmark-alist' for display.
+If `bookmark-sort-flag' is T, then return a sorted by name copy of the alist.
+If `bookmark-sort-flag' is LAST-MODIFIED, then return a sorted by last modified
+copy of the alist. Otherwise, just return `bookmark-alist', which by default
+is ordered from most recently created to least recently created bookmark."
+ (let ((copy (copy-alist bookmark-alist)))
+ (cond ((eq bookmark-sort-flag t)
+ (sort copy (lambda (x y) (string-lessp (car x) (car y)))))
+ ((eq bookmark-sort-flag 'last-modified)
+ (sort copy (lambda (x y)
+ (let ((tx (bookmark-get-last-modified x))
+ (ty (bookmark-get-last-modified y)))
+ (cond ((null tx) nil)
+ ((null ty) t)
+ (t (time-less-p ty tx)))))))
+ (t copy))))
+
(defun bookmark-completing-read (prompt &optional default)
"Prompting with PROMPT, read a bookmark name in completion.
PROMPT will get a \": \" stuck on the end no matter what, so you
@@ -498,16 +543,11 @@ If DEFAULT is nil then return empty string for empty input."
(bookmark-maybe-load-default-file) ; paranoia
(if (listp last-nonmenu-event)
(bookmark-menu-popup-paned-menu t prompt
- (if bookmark-sort-flag
- (sort (bookmark-all-names)
- 'string-lessp)
- (bookmark-all-names)))
+ (mapcar 'bookmark-name-from-full-record
+ (bookmark-maybe-sort-alist)))
(let* ((completion-ignore-case bookmark-completion-ignore-case)
- (default (unless (equal "" default) default))
- (prompt (concat prompt (if default
- (format " (%s): " default)
- ": "))))
- (completing-read prompt
+ (default (unless (equal "" default) default)))
+ (completing-read (format-prompt prompt default)
(lambda (string pred action)
(if (eq action 'metadata)
'(metadata (category . bookmark))
@@ -518,8 +558,9 @@ If DEFAULT is nil then return empty string for empty input."
(defmacro bookmark-maybe-historicize-string (string)
"Put STRING into the bookmark prompt history, if caller non-interactive.
-We need this because sometimes bookmark functions are invoked from
-menus, so `completing-read' never gets a chance to set `bookmark-history'."
+We need this because sometimes bookmark functions are invoked
+from other commands that pass in the bookmark name, so
+`completing-read' never gets a chance to set `bookmark-history'."
`(or
(called-interactively-p 'interactive)
(setq bookmark-history (cons ,string bookmark-history))))
@@ -624,7 +665,8 @@ If POSN is non-nil, record POSN as the point instead of `(point)'."
(point)
(- (point) bookmark-search-size))
nil))))
- (position . ,(or posn (point)))))
+ (position . ,(or posn (point)))
+ (last-modified . ,(current-time))))
;;; File format stuff
@@ -818,11 +860,9 @@ CODING is the symbol of the coding-system in which the file is encoded."
(define-obsolete-function-alias 'bookmark-maybe-message 'message "27.1")
-(defvar bookmark-minibuffer-read-name-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "\C-w" 'bookmark-yank-word)
- map))
+(defvar-keymap bookmark-minibuffer-read-name-map
+ :parent minibuffer-local-map
+ "C-w" #'bookmark-yank-word)
(defun bookmark-set-internal (prompt name overwrite-or-push)
"Set a bookmark using specified NAME or prompting with PROMPT.
@@ -926,7 +966,7 @@ it removes only the first instance of a bookmark with that name from
the list of bookmarks.)"
(interactive (list nil current-prefix-arg))
(let ((prompt
- (if no-overwrite "Set bookmark" "Set bookmark unconditionally")))
+ (if no-overwrite "Append bookmark named" "Set bookmark named")))
(bookmark-set-internal prompt name (if no-overwrite 'push 'overwrite))))
;;;###autoload
@@ -987,22 +1027,24 @@ annotations."
bookmark-name)
(format-message
"# All lines which start with a `#' will be deleted.\n")
- "# Type C-c C-c when done.\n#\n"
+ (substitute-command-keys
+ (concat
+ "# Type \\[bookmark-edit-annotation-confirm] when done. Type "
+ "\\[bookmark-edit-annotation-cancel] to cancel.\n#\n"))
"# Author: " (user-full-name) " <" (user-login-name) "@"
(system-name) ">\n"
- "# Date: " (current-time-string) "\n"))
+ "# Date: " (current-time-string) "\n"))
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
"Function to return default text to use for a bookmark annotation.
It takes one argument, the name of the bookmark, as a string.")
-(defvar bookmark-edit-annotation-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map text-mode-map)
- (define-key map "\C-c\C-c" 'bookmark-send-edited-annotation)
- map)
- "Keymap for editing an annotation of a bookmark.")
+(defvar-keymap bookmark-edit-annotation-mode-map
+ :doc "Keymap for editing an annotation of a bookmark."
+ :parent text-mode-map
+ "C-c C-c" #'bookmark-edit-annotation-confirm
+ "C-c C-k" #'bookmark-edit-annotation-cancel)
(defun bookmark-insert-annotation (bookmark-name-or-record)
"Insert annotation for BOOKMARK-NAME-OR-RECORD at point."
@@ -1016,12 +1058,32 @@ It takes one argument, the name of the bookmark, as a string.")
(define-derived-mode bookmark-edit-annotation-mode
text-mode "Edit Bookmark Annotation"
"Mode for editing the annotation of bookmarks.
-When you have finished composing, type \\[bookmark-send-edited-annotation].
+\\<bookmark-edit-annotation-mode-map>\
+When you have finished composing, type \\[bookmark-edit-annotation-confirm] \
+or \\[bookmark-edit-annotation-cancel] to cancel.
\\{bookmark-edit-annotation-mode-map}")
+(defmacro bookmark-edit-annotation--maybe-display-list (&rest body)
+ "Display bookmark list after editing if appropriate."
+ `(let ((from-bookmark-list bookmark--annotation-from-bookmark-list)
+ (old-buffer (current-buffer)))
+ ,@body
+ (quit-window)
+ (bookmark-bmenu-surreptitiously-rebuild-list)
+ (when from-bookmark-list
+ (pop-to-buffer (get-buffer bookmark-bmenu-buffer))
+ (goto-char (point-min))
+ (bookmark-bmenu-bookmark))
+ (kill-buffer old-buffer)))
+
+(defun bookmark-edit-annotation-cancel ()
+ "Cancel the current annotation edit."
+ (interactive nil bookmark-edit-annotation-mode)
+ (bookmark-edit-annotation--maybe-display-list
+ (message "Canceled by user")))
-(defun bookmark-send-edited-annotation ()
+(defun bookmark-edit-annotation-confirm ()
"Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
(interactive nil bookmark-edit-annotation-mode)
@@ -1033,21 +1095,14 @@ Lines beginning with `#' are ignored."
(bookmark-kill-line t)
(forward-line 1)))
;; Take no chances with text properties.
- (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
- (bookmark-name bookmark-annotation-name)
- (from-bookmark-list bookmark--annotation-from-bookmark-list)
- (old-buffer (current-buffer)))
- (bookmark-set-annotation bookmark-name annotation)
- (setq bookmark-alist-modification-count
- (1+ bookmark-alist-modification-count))
- (message "Annotation updated for \"%s\"" bookmark-name)
- (quit-window)
- (bookmark-bmenu-surreptitiously-rebuild-list)
- (when from-bookmark-list
- (pop-to-buffer (get-buffer bookmark-bmenu-buffer))
- (goto-char (point-min))
- (bookmark-bmenu-bookmark))
- (kill-buffer old-buffer)))
+ (bookmark-edit-annotation--maybe-display-list
+ (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
+ (bookmark-name bookmark-annotation-name))
+ (bookmark-set-annotation bookmark-name annotation)
+ (bookmark-update-last-modified bookmark-name)
+ (setq bookmark-alist-modification-count
+ (1+ bookmark-alist-modification-count))
+ (message "Annotation updated for \"%s\"" bookmark-name))))
(defun bookmark-edit-annotation (bookmark-name-or-record &optional from-bookmark-list)
@@ -1055,8 +1110,8 @@ Lines beginning with `#' are ignored."
If optional argument FROM-BOOKMARK-LIST is non-nil, return to the
bookmark list when editing is done."
(pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
- (bookmark-insert-annotation bookmark-name-or-record)
(bookmark-edit-annotation-mode)
+ (bookmark-insert-annotation bookmark-name-or-record)
(setq bookmark--annotation-from-bookmark-list from-bookmark-list)
(setq bookmark-annotation-name bookmark-name-or-record))
@@ -1138,15 +1193,6 @@ it to the name of the bookmark currently being set, advancing
(car bookmark-bookmarks-timestamp)))))))
(bookmark-load (car bookmark-bookmarks-timestamp) t t))))
-(defun bookmark-maybe-sort-alist ()
- "Return `bookmark-alist' for display.
-If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist.
-Otherwise, just return `bookmark-alist', which by default is ordered
-from most recently created to least recently created bookmark."
- (if bookmark-sort-flag
- (sort (copy-alist bookmark-alist)
- (lambda (x y) (string-lessp (car x) (car y))))
- bookmark-alist))
(defvar bookmark-after-jump-hook nil
@@ -1287,7 +1333,10 @@ then offer interactively to relocate BOOKMARK-NAME-OR-RECORD."
(defun bookmark-default-handler (bmk-record)
"Default handler to jump to a particular bookmark location.
BMK-RECORD is a bookmark record, not a bookmark name (i.e., not a string).
-Changes current buffer and point and returns nil, or signals a `file-error'."
+Changes current buffer and point and returns nil, or signals a `file-error'.
+
+If BMK-RECORD has a property called `buffer', it should be a live
+buffer object, and this buffer will be selected."
(let ((file (bookmark-get-filename bmk-record))
(buf (bookmark-prop-get bmk-record 'buffer))
(forward-str (bookmark-get-front-context-string bmk-record))
@@ -1330,6 +1379,7 @@ after a bookmark was set in it."
(format "Relocate %s to: " bookmark-name)
(file-name-directory bmrk-filename))))))
(bookmark-set-filename bookmark-name newloc)
+ (bookmark-update-last-modified bookmark-name)
(setq bookmark-alist-modification-count
(1+ bookmark-alist-modification-count))
(if (bookmark-time-to-save-p)
@@ -1361,7 +1411,6 @@ minibuffer history list `bookmark-history'."
(bookmark-get-filename bookmark-name-or-record)
"-- Unknown location --"))
-
;;;###autoload
(defun bookmark-rename (old-name &optional new-name)
"Change the name of OLD-NAME bookmark to NEW-NAME name.
@@ -1387,12 +1436,13 @@ name."
(read-from-minibuffer
"New name: "
nil
- (let ((now-map (copy-keymap minibuffer-local-map)))
- (define-key now-map "\C-w" 'bookmark-yank-word)
- now-map)
+ (define-keymap
+ :parent minibuffer-local-map
+ "C-w" #'bookmark-yank-word)
nil
'bookmark-history))))
(bookmark-set-name old-name final-new-name)
+ (bookmark-update-last-modified final-new-name)
(setq bookmark-current-bookmark final-new-name)
(bookmark-bmenu-surreptitiously-rebuild-list)
(setq bookmark-alist-modification-count
@@ -1707,44 +1757,43 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(defvar bookmark-bmenu-hidden-bookmarks ())
-
-(defvar bookmark-bmenu-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map tabulated-list-mode-map)
- (define-key map "v" 'bookmark-bmenu-select)
- (define-key map "w" 'bookmark-bmenu-locate)
- (define-key map "5" 'bookmark-bmenu-other-frame)
- (define-key map "2" 'bookmark-bmenu-2-window)
- (define-key map "1" 'bookmark-bmenu-1-window)
- (define-key map "j" 'bookmark-bmenu-this-window)
- (define-key map "\C-c\C-c" 'bookmark-bmenu-this-window)
- (define-key map "f" 'bookmark-bmenu-this-window)
- (define-key map "\C-m" 'bookmark-bmenu-this-window)
- (define-key map "o" 'bookmark-bmenu-other-window)
- (define-key map "\C-o" 'bookmark-bmenu-switch-other-window)
- (define-key map "s" 'bookmark-bmenu-save)
- (define-key map "\C-x\C-s" 'bookmark-bmenu-save)
- (define-key map "k" 'bookmark-bmenu-delete)
- (define-key map "\C-d" 'bookmark-bmenu-delete-backwards)
- (define-key map "x" 'bookmark-bmenu-execute-deletions)
- (define-key map "d" 'bookmark-bmenu-delete)
- (define-key map "D" 'bookmark-bmenu-delete-all)
- (define-key map " " 'next-line)
- (define-key map "\177" 'bookmark-bmenu-backup-unmark)
- (define-key map "u" 'bookmark-bmenu-unmark)
- (define-key map "U" 'bookmark-bmenu-unmark-all)
- (define-key map "m" 'bookmark-bmenu-mark)
- (define-key map "M" 'bookmark-bmenu-mark-all)
- (define-key map "l" 'bookmark-bmenu-load)
- (define-key map "r" 'bookmark-bmenu-rename)
- (define-key map "R" 'bookmark-bmenu-relocate)
- (define-key map "t" 'bookmark-bmenu-toggle-filenames)
- (define-key map "a" 'bookmark-bmenu-show-annotation)
- (define-key map "A" 'bookmark-bmenu-show-all-annotations)
- (define-key map "e" 'bookmark-bmenu-edit-annotation)
- (define-key map "/" 'bookmark-bmenu-search)
- (define-key map [mouse-2] 'bookmark-bmenu-other-window-with-mouse)
- map))
+(defvar-keymap bookmark-bmenu-mode-map
+ :doc "Keymap for `bookmark-bmenu-mode'."
+ :parent tabulated-list-mode-map
+ "v" #'bookmark-bmenu-select
+ "w" #'bookmark-bmenu-locate
+ "5" #'bookmark-bmenu-other-frame
+ "2" #'bookmark-bmenu-2-window
+ "1" #'bookmark-bmenu-1-window
+ "j" #'bookmark-bmenu-this-window
+ "C-c C-c" #'bookmark-bmenu-this-window
+ "f" #'bookmark-bmenu-this-window
+ "C-m" #'bookmark-bmenu-this-window
+ "o" #'bookmark-bmenu-other-window
+ "C-o" #'bookmark-bmenu-switch-other-window
+ "s" #'bookmark-bmenu-save
+ "C-x C-s" #'bookmark-bmenu-save
+ "k" #'bookmark-bmenu-delete
+ "C-d" #'bookmark-bmenu-delete-backwards
+ "x" #'bookmark-bmenu-execute-deletions
+ "d" #'bookmark-bmenu-delete
+ "D" #'bookmark-bmenu-delete-all
+ "S-SPC" #'previous-line
+ "SPC" #'next-line
+ "DEL" #'bookmark-bmenu-backup-unmark
+ "u" #'bookmark-bmenu-unmark
+ "U" #'bookmark-bmenu-unmark-all
+ "m" #'bookmark-bmenu-mark
+ "M" #'bookmark-bmenu-mark-all
+ "l" #'bookmark-bmenu-load
+ "r" #'bookmark-bmenu-rename
+ "R" #'bookmark-bmenu-relocate
+ "t" #'bookmark-bmenu-toggle-filenames
+ "a" #'bookmark-bmenu-show-annotation
+ "A" #'bookmark-bmenu-show-all-annotations
+ "e" #'bookmark-bmenu-edit-annotation
+ "/" #'bookmark-bmenu-search
+ "<mouse-2>" #'bookmark-bmenu-other-window-with-mouse)
(easy-menu-define bookmark-menu bookmark-bmenu-mode-map
"Menu for `bookmark-bmenu'."
@@ -1802,6 +1851,7 @@ Don't affect the buffer ring order."
(let (entries)
(dolist (full-record (bookmark-maybe-sort-alist))
(let* ((name (bookmark-name-from-full-record full-record))
+ (type (bookmark-type-from-full-record full-record))
(annotation (bookmark-get-annotation full-record))
(location (bookmark-location full-record)))
(push (list
@@ -1815,11 +1865,39 @@ Don't affect the buffer ring order."
'follow-link t
'help-echo "mouse-2: go to this bookmark in other window")
name)
+ ,(or type "")
,@(if bookmark-bmenu-toggle-filenames
(list location))])
entries)))
- (tabulated-list-init-header)
- (setq tabulated-list-entries entries))
+ ;; The value of `bookmark-sort-flag' might have changed since the
+ ;; last time the buffer contents were generated, so re-check it.
+ (cond ((eq bookmark-sort-flag t)
+ (setq tabulated-list-sort-key '("Bookmark Name" . nil)
+ tabulated-list-entries entries))
+ ((or (null bookmark-sort-flag)
+ (eq bookmark-sort-flag 'last-modified))
+ (setq tabulated-list-sort-key nil)
+ ;; And since we're not sorting by bookmark name, show bookmarks
+ ;; according to order of creation, with the most recently
+ ;; created bookmarks at the top and the least recently created
+ ;; at the bottom.
+ ;;
+ ;; Note that clicking the column sort toggle for the bookmark
+ ;; name column will invoke the `tabulated-list-mode' sort, which
+ ;; uses `bookmark-bmenu--name-predicate' to sort lexically by
+ ;; bookmark name instead of by (reverse) creation order.
+ ;; Clicking the toggle again will reverse the lexical sort, but
+ ;; the sort will still be lexical not creation-order. However,
+ ;; if the user reverts the buffer, then the above check of
+ ;; `bookmark-sort-flag' will happen again and the buffer will
+ ;; go back to a creation-order sort. This is all expected
+ ;; behavior, as documented in `bookmark-bmenu-mode'.
+ (setq tabulated-list-entries (reverse entries))))
+ ;; Generate the header only after `tabulated-list-sort-key' is
+ ;; settled, because if that's non-nil then the sort-direction
+ ;; indicator will be shown in the named column, but if it's
+ ;; nil then the indicator will not be shown.
+ (tabulated-list-init-header))
(tabulated-list-print t))
;;;###autoload
@@ -1863,6 +1941,18 @@ deletion, or > if it is flagged for displaying."
Each line describes one of the bookmarks in Emacs.
Letters do not insert themselves; instead, they are commands.
Bookmark names preceded by a \"*\" have annotations.
+
+If `bookmark-sort-flag' is non-nil, then sort the list by
+bookmark name (case-insensitively, in collation order); the
+direction of that sort can be reversed by using the column sort
+toggle for the bookmark name column.
+
+If `bookmark-sort-flag' is nil, then sort the list by bookmark
+creation order, with most recently created bookmarks on top.
+However, the column sort toggle will still activate (and
+thereafter toggle the direction of) lexical sorting by bookmark name.
+At any time you may use \\[revert-buffer] to go back to sorting by creation order.
+
\\<bookmark-bmenu-mode-map>
\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
\\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed.
@@ -1895,18 +1985,24 @@ Bookmark names preceded by a \"*\" have annotations.
in another buffer.
\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark.
-\\[bookmark-bmenu-search] -- incrementally search for bookmarks."
+\\[bookmark-bmenu-search] -- incrementally search for bookmarks.
+\\[revert-buffer] -- refresh the buffer, and thus refresh the sort order (useful
+ if `bookmark-sort-flag' is nil)."
(setq truncate-lines t)
(setq buffer-read-only t)
;; FIXME: The header could also display the current default bookmark file
;; according to `bookmark-bookmarks-timestamp'.
(setq tabulated-list-format
`[("" 1) ;; Space to add "*" for bookmark with annotation
- ("Bookmark" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate)
+ ("Bookmark Name"
+ ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate)
+ ("Type" 8 bookmark-bmenu--type-predicate)
,@(if bookmark-bmenu-toggle-filenames
'(("File" 0 bookmark-bmenu--file-predicate)))])
(setq tabulated-list-padding bookmark-bmenu-marks-width)
- (setq tabulated-list-sort-key '("Bookmark" . nil))
+ (when (and bookmark-sort-flag
+ (not (eq bookmark-sort-flag 'last-modified)))
+ (setq tabulated-list-sort-key '("Bookmark Name" . nil)))
(add-hook 'tabulated-list-revert-hook #'bookmark-bmenu--revert nil t)'
(setq revert-buffer-function 'bookmark-bmenu--revert)
(tabulated-list-init-header))
@@ -1915,13 +2011,19 @@ Bookmark names preceded by a \"*\" have annotations.
(defun bookmark-bmenu--name-predicate (a b)
"Predicate to sort \"*Bookmark List*\" buffer by the name column.
This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
- (string< (caar a) (caar b)))
+ (string-collate-lessp (caar a) (caar b) nil t))
+(defun bookmark-bmenu--type-predicate (a b)
+ "Predicate to sort \"*Bookmark List*\" buffer by the type column.
+This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
+ (string-collate-lessp (elt (cadr a) 2) (elt (cadr b) 2) nil t))
(defun bookmark-bmenu--file-predicate (a b)
"Predicate to sort \"*Bookmark List*\" buffer by the file column.
This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
- (string< (bookmark-location (car a)) (bookmark-location (car b))))
+ (string-collate-lessp (bookmark-location (car a))
+ (bookmark-location (car b))
+ nil t))
(defun bookmark-bmenu-toggle-filenames (&optional show)
@@ -2324,10 +2426,10 @@ Prompt with completion for the new path."
(lambda ()
(setq timer (run-with-idle-timer
bookmark-search-delay 'repeat
- #'(lambda (buf)
- (with-current-buffer buf
- (bookmark-bmenu-filter-alist-by-regexp
- (minibuffer-contents))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (bookmark-bmenu-filter-alist-by-regexp
+ (minibuffer-contents))))
(current-buffer))))
(read-string "Pattern: ")
(when timer (cancel-timer timer) (setq timer nil)))
@@ -2469,6 +2571,12 @@ This also runs `bookmark-exit-hook'."
(run-hooks 'bookmark-load-hook)
+
+;;; Obsolete:
+
+(define-obsolete-function-alias 'bookmark-send-edited-annotation
+ #'bookmark-edit-annotation-confirm "29.1")
+
(provide 'bookmark)
;;; bookmark.el ends here
diff --git a/lisp/bs.el b/lisp/bs.el
index cff19c81cb0..00d8326115e 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -1,6 +1,7 @@
;;; bs.el --- menu for selecting and displaying buffers -*- lexical-binding: t -*-
;; Copyright (C) 1998-2022 Free Software Foundation, Inc.
+
;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
@@ -434,58 +435,61 @@ Used internally, only.")
(defvar bs--marked-buffers nil
"Currently marked buffers in Buffer Selection Menu.")
-(defvar bs-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map " " 'bs-select)
- (define-key map "f" 'bs-select)
- (define-key map "v" 'bs-view)
- (define-key map "!" 'bs-select-in-one-window)
- (define-key map [mouse-2] 'bs-mouse-select)
- (define-key map "F" 'bs-select-other-frame)
- (let ((key ?1))
- (while (<= key ?9)
- (define-key map (char-to-string key) 'digit-argument)
- (setq key (1+ key))))
- (define-key map "-" 'negative-argument)
- (define-key map "\e-" 'negative-argument)
- (define-key map "o" 'bs-select-other-window)
- (define-key map "\C-o" 'bs-tmp-select-other-window)
- (define-key map [mouse-3] 'bs-mouse-select-other-frame)
- (define-key map [up] 'bs-up)
- (define-key map "n" 'bs-down)
- (define-key map "p" 'bs-up)
- (define-key map [down] 'bs-down)
- (define-key map "\C-m" 'bs-select)
- (define-key map "b" 'bs-bury-buffer)
- (define-key map "s" 'bs-save)
- (define-key map "S" 'bs-show-sorted)
- (define-key map "a" 'bs-toggle-show-all)
- (define-key map "d" 'bs-delete)
- (define-key map "\C-d" 'bs-delete-backward)
- (define-key map "k" 'bs-delete)
- (define-key map "g" 'bs-refresh)
- (define-key map "C" 'bs-set-configuration-and-refresh)
- (define-key map "c" 'bs-select-next-configuration)
- (define-key map "q" 'bs-kill)
- ;; (define-key map "z" 'bs-kill)
- (define-key map "\C-c\C-c" 'bs-kill)
- (define-key map "\C-g" 'bs-abort)
- (define-key map "\C-]" 'bs-abort)
- (define-key map "%" 'bs-toggle-readonly)
- (define-key map "~" 'bs-clear-modified)
- (define-key map "M" 'bs-toggle-current-to-show)
- (define-key map "+" 'bs-set-current-buffer-to-show-always)
- ;;(define-key map "-" 'bs-set-current-buffer-to-show-never)
- (define-key map "t" 'bs-visit-tags-table)
- (define-key map "m" 'bs-mark-current)
- (define-key map "u" 'bs-unmark-current)
- (define-key map "U" 'bs-unmark-all)
- (define-key map "\177" 'bs-unmark-previous)
- (define-key map ">" 'scroll-right)
- (define-key map "<" 'scroll-left)
- (define-key map "?" 'bs-help)
- map)
- "Keymap of `bs-mode'.")
+(defvar-keymap bs-mode-map
+ :doc "Keymap of `bs-mode'."
+ "SPC" #'bs-select
+ "f" #'bs-select
+ "v" #'bs-view
+ "!" #'bs-select-in-one-window
+ "F" #'bs-select-other-frame
+ "1" #'digit-argument
+ "2" #'digit-argument
+ "3" #'digit-argument
+ "4" #'digit-argument
+ "5" #'digit-argument
+ "6" #'digit-argument
+ "7" #'digit-argument
+ "8" #'digit-argument
+ "9" #'digit-argument
+ "-" #'negative-argument
+ "ESC -" #'negative-argument
+ "o" #'bs-select-other-window
+ "C-o" #'bs-tmp-select-other-window
+ "<up>" #'bs-up
+ "n" #'bs-down
+ "p" #'bs-up
+ "<down>" #'bs-down
+ "C-m" #'bs-select
+ "b" #'bs-bury-buffer
+ "s" #'bs-save
+ "S" #'bs-show-sorted
+ "a" #'bs-toggle-show-all
+ "d" #'bs-delete
+ "C-d" #'bs-delete-backward
+ "k" #'bs-delete
+ "g" #'bs-refresh
+ "C" #'bs-set-configuration-and-refresh
+ "c" #'bs-select-next-configuration
+ "q" #'bs-kill
+ ;; "z" #'bs-kill
+ "C-c C-c" #'bs-kill
+ "C-g" #'bs-abort
+ "C-]" #'bs-abort
+ "%" #'bs-toggle-readonly
+ "~" #'bs-clear-modified
+ "M" #'bs-toggle-current-to-show
+ "+" #'bs-set-current-buffer-to-show-always
+ ;; "-" #'bs-set-current-buffer-to-show-never
+ "t" #'bs-visit-tags-table
+ "m" #'bs-mark-current
+ "u" #'bs-unmark-current
+ "U" #'bs-unmark-all
+ "DEL" #'bs-unmark-previous
+ ">" #'scroll-right
+ "<" #'scroll-left
+ "?" #'bs-help
+ "<mouse-2>" #'bs-mouse-select
+ "<mouse-3>" #'bs-mouse-select-other-frame)
;; ----------------------------------------------------------------------
;; Functions
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 59040371c9f..539ef673f0b 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -92,13 +92,13 @@ number."
(defcustom Buffer-menu-size-width 7
"Width of buffer size column in the Buffer Menu."
- :type 'number
+ :type 'natnum
:group 'Buffer-menu
:version "24.3")
(defcustom Buffer-menu-mode-width 16
"Width of mode name column in the Buffer Menu."
- :type 'number
+ :type 'natnum
:group 'Buffer-menu)
(defcustom Buffer-menu-use-frame-buffer-list t
@@ -116,43 +116,41 @@ as it is by default."
This is set by the prefix argument to `buffer-menu' and related
commands.")
-(defvar Buffer-menu-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map tabulated-list-mode-map)
- (define-key map "v" 'Buffer-menu-select)
- (define-key map "2" 'Buffer-menu-2-window)
- (define-key map "1" 'Buffer-menu-1-window)
- (define-key map "f" 'Buffer-menu-this-window)
- (define-key map "e" 'Buffer-menu-this-window)
- (define-key map "\C-m" 'Buffer-menu-this-window)
- (define-key map "o" 'Buffer-menu-other-window)
- (define-key map "\C-o" 'Buffer-menu-switch-other-window)
- (define-key map "s" 'Buffer-menu-save)
- (define-key map "d" 'Buffer-menu-delete)
- (define-key map "k" 'Buffer-menu-delete)
- (define-key map "\C-k" 'Buffer-menu-delete)
- (define-key map "\C-d" 'Buffer-menu-delete-backwards)
- (define-key map "x" 'Buffer-menu-execute)
- (define-key map " " 'next-line)
- (define-key map "\177" 'Buffer-menu-backup-unmark)
- (define-key map "~" 'Buffer-menu-not-modified)
- (define-key map "u" 'Buffer-menu-unmark)
- (define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers)
- (define-key map "U" 'Buffer-menu-unmark-all)
- (define-key map "m" 'Buffer-menu-mark)
- (define-key map "t" 'Buffer-menu-visit-tags-table)
- (define-key map "%" 'Buffer-menu-toggle-read-only)
- (define-key map "b" 'Buffer-menu-bury)
- (define-key map "V" 'Buffer-menu-view)
- (define-key map "T" 'Buffer-menu-toggle-files-only)
- (define-key map (kbd "M-s a C-s") 'Buffer-menu-isearch-buffers)
- (define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp)
- (define-key map (kbd "M-s a C-o") 'Buffer-menu-multi-occur)
-
- (define-key map [mouse-2] 'Buffer-menu-mouse-select)
- (define-key map [follow-link] 'mouse-face)
- map)
- "Local keymap for `Buffer-menu-mode' buffers.")
+(defvar-keymap Buffer-menu-mode-map
+ :doc "Local keymap for `Buffer-menu-mode' buffers."
+ :parent tabulated-list-mode-map
+ "v" #'Buffer-menu-select
+ "2" #'Buffer-menu-2-window
+ "1" #'Buffer-menu-1-window
+ "f" #'Buffer-menu-this-window
+ "e" #'Buffer-menu-this-window
+ "C-m" #'Buffer-menu-this-window
+ "o" #'Buffer-menu-other-window
+ "C-o" #'Buffer-menu-switch-other-window
+ "s" #'Buffer-menu-save
+ "d" #'Buffer-menu-delete
+ "k" #'Buffer-menu-delete
+ "C-k" #'Buffer-menu-delete
+ "C-d" #'Buffer-menu-delete-backwards
+ "x" #'Buffer-menu-execute
+ "SPC" #'next-line
+ "DEL" #'Buffer-menu-backup-unmark
+ "~" #'Buffer-menu-not-modified
+ "u" #'Buffer-menu-unmark
+ "M-DEL" #'Buffer-menu-unmark-all-buffers
+ "U" #'Buffer-menu-unmark-all
+ "m" #'Buffer-menu-mark
+ "t" #'Buffer-menu-visit-tags-table
+ "%" #'Buffer-menu-toggle-read-only
+ "b" #'Buffer-menu-bury
+ "V" #'Buffer-menu-view
+ "T" #'Buffer-menu-toggle-files-only
+ "M-s a C-s" #'Buffer-menu-isearch-buffers
+ "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp
+ "M-s a C-o" #'Buffer-menu-multi-occur
+
+ "<mouse-2>" #'Buffer-menu-mouse-select
+ "<follow-link>" 'mouse-face)
(easy-menu-define Buffer-menu-mode-menu Buffer-menu-mode-map
"Menu for `Buffer-menu-mode' buffers."
@@ -529,13 +527,18 @@ If UNMARK is non-nil, unmark them."
(multi-occur (Buffer-menu-marked-buffers) regexp nlines))
+(autoload 'etags-verify-tags-table "etags")
(defun Buffer-menu-visit-tags-table ()
"Visit the tags table in the buffer on this line. See `visit-tags-table'."
(interactive nil Buffer-menu-mode)
- (let ((file (buffer-file-name (Buffer-menu-buffer t))))
- (if file
- (visit-tags-table file)
- (error "Specified buffer has no file"))))
+ (let* ((buf (Buffer-menu-buffer t))
+ (file (buffer-file-name buf)))
+ (cond
+ ((not file) (error "Specified buffer has no file"))
+ ((and buf (with-current-buffer buf
+ (etags-verify-tags-table)))
+ (visit-tags-table file))
+ (t (error "Specified buffer is not a tags-table")))))
(defun Buffer-menu-1-window ()
"Select this line's buffer, alone, in full frame."
diff --git a/lisp/button.el b/lisp/button.el
index 4e9448844cc..80b73033d68 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -55,29 +55,24 @@
"Default face used for buttons."
:group 'basic-faces)
-(defvar button-map
- (let ((map (make-sparse-keymap)))
- ;; The following definition needs to avoid using escape sequences that
- ;; might get converted to ^M when building loaddefs.el
- (define-key map [(control ?m)] 'push-button)
- (define-key map [mouse-2] 'push-button)
- (define-key map [follow-link] 'mouse-face)
- ;; FIXME: You'd think that for keymaps coming from text-properties on the
- ;; mode-line or header-line, the `mode-line' or `header-line' prefix
- ;; shouldn't be necessary!
- (define-key map [mode-line mouse-2] 'push-button)
- (define-key map [header-line mouse-2] 'push-button)
- map)
- "Keymap used by buttons.")
-
-(defvar button-buffer-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\t] 'forward-button)
- (define-key map "\e\t" 'backward-button)
- (define-key map [backtab] 'backward-button)
- map)
- "Keymap useful for buffers containing buttons.
-Mode-specific keymaps may want to use this as their parent keymap.")
+(defvar-keymap button-buffer-map
+ :doc "Keymap useful for buffers containing buttons.
+Mode-specific keymaps may want to use this as their parent keymap."
+ "TAB" #'forward-button
+ "ESC TAB" #'backward-button
+ "<backtab>" #'backward-button)
+
+(defvar-keymap button-map
+ :doc "Keymap used by buttons."
+ :parent button-buffer-map
+ "RET" #'push-button
+ "<mouse-2>" #'push-button
+ "<follow-link>" 'mouse-face
+ ;; FIXME: You'd think that for keymaps coming from text-properties on the
+ ;; mode-line or header-line, the `mode-line' or `header-line' prefix
+ ;; shouldn't be necessary!
+ "<mode-line> <mouse-2>" #'push-button
+ "<header-line> <mouse-2>" #'push-button)
(define-minor-mode button-mode
"A minor mode for navigating to buttons with the TAB key."
@@ -130,6 +125,7 @@ In addition, the keyword argument :supertype may be used to specify a
`button-type' from which NAME inherits its default property values
(however, the inheritance happens only when NAME is defined; subsequent
changes to a supertype are not reflected in its subtypes)."
+ (declare (indent defun))
(let ((catsym (make-symbol (concat (symbol-name name) "-button")))
(super-catsym
(button-category-symbol
@@ -603,7 +599,8 @@ When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a
buffer position where a button is present. If BUTTON-OR-POS is nil, the
button at point is the button to describe."
(interactive "d")
- (let* ((button (cond ((integer-or-marker-p button-or-pos)
+ (let* ((help-buffer-under-preparation t)
+ (button (cond ((integer-or-marker-p button-or-pos)
(button-at button-or-pos))
((null button-or-pos) (button-at (point)))
((overlayp button-or-pos) button-or-pos)))
@@ -615,19 +612,42 @@ button at point is the button to describe."
(button--describe props)
t)))
-(defun button-buttonize (string callback &optional data)
+(define-obsolete-function-alias 'button-buttonize #'buttonize "29.1")
+
+(defun buttonize (string callback &optional data help-echo)
"Make STRING into a button and return it.
When clicked, CALLBACK will be called with the DATA as the
function argument. If DATA isn't present (or is nil), the button
-itself will be used instead as the function argument."
- (propertize string
- 'face 'button
- 'button t
- 'follow-link t
- 'category t
- 'button-data data
- 'keymap button-map
- 'action callback))
+itself will be used instead as the function argument.
+
+If HELP-ECHO, use that as the `help-echo' property.
+
+Also see `buttonize-region'."
+ (apply #'propertize string
+ (button--properties callback data help-echo)))
+
+(defun button--properties (callback data help-echo)
+ (list 'face 'button
+ 'font-lock-face 'button
+ 'mouse-face 'highlight
+ 'help-echo help-echo
+ 'button t
+ 'follow-link t
+ 'category t
+ 'button-data data
+ 'keymap button-map
+ 'action callback))
+
+(defun buttonize-region (start end callback &optional data help-echo)
+ "Make the region between START and END into a button.
+When clicked, CALLBACK will be called with the DATA as the
+function argument. If DATA isn't present (or is nil), the button
+itself will be used instead as the function argument.
+
+If HELP-ECHO, use that as the `help-echo' property.
+
+Also see `buttonize'."
+ (add-text-properties start end (button--properties callback data help-echo)))
(provide 'button)
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index 9a580d9602a..bb427ef86e6 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -335,7 +335,8 @@
(message (concat
"Embedded Calc mode enabled; "
(if calc-embedded-quiet
- "Type `C-x * x'"
+ (substitute-command-keys
+ "Type \\`C-x * x'")
"Give this command again")
" to return to normal")))))
(scroll-down 0))) ; fix a bug which occurs when truncate-lines is changed.
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 058d78e8476..7ee73d100a0 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1266,27 +1266,23 @@ calc-kill calc-kill-region calc-yank))))
(math-normalize val)))))
-(defvar calc-help-map nil)
-
-(if calc-help-map
- nil
- (setq calc-help-map (make-keymap))
- (define-key calc-help-map "b" 'calc-describe-bindings)
- (define-key calc-help-map "c" 'calc-describe-key-briefly)
- (define-key calc-help-map "f" 'calc-describe-function)
- (define-key calc-help-map "h" 'calc-full-help)
- (define-key calc-help-map "i" 'calc-info)
- (define-key calc-help-map "k" 'calc-describe-key)
- (define-key calc-help-map "n" 'calc-view-news)
- (define-key calc-help-map "s" 'calc-info-summary)
- (define-key calc-help-map "t" 'calc-tutorial)
- (define-key calc-help-map "v" 'calc-describe-variable)
- (define-key calc-help-map "\C-c" 'calc-describe-copying)
- (define-key calc-help-map "\C-d" 'calc-describe-distribution)
- (define-key calc-help-map "\C-n" 'calc-view-news)
- (define-key calc-help-map "\C-w" 'calc-describe-no-warranty)
- (define-key calc-help-map "?" 'calc-help-for-help)
- (define-key calc-help-map "\C-h" 'calc-help-for-help))
+(defvar-keymap calc-help-map
+ "b" 'calc-describe-bindings
+ "c" 'calc-describe-key-briefly
+ "f" 'calc-describe-function
+ "h" 'calc-full-help
+ "i" 'calc-info
+ "k" 'calc-describe-key
+ "n" 'calc-view-news
+ "s" 'calc-info-summary
+ "t" 'calc-tutorial
+ "v" 'calc-describe-variable
+ "C-c" 'calc-describe-copying
+ "C-d" 'calc-describe-distribution
+ "C-n" 'calc-view-news
+ "C-w" 'calc-describe-no-warranty
+ "?" 'calc-help-for-help
+ "C-h" 'calc-help-for-help)
(defvar calc-prefix-help-retry nil)
(defvar calc-prefix-help-phase 0)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 14890e14030..a95967bef4e 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -969,7 +969,8 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
(use-local-map calc-dumb-map)
(setq truncate-lines t)
- (message "Type `q' or `C-c C-c' to return to Calc")
+ (message (substitute-command-keys
+ "Type \\`q' or \\`C-c C-c' to return to Calc"))
(recursive-edit)
(bury-buffer "*Gnuplot Trail*")))
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 3355b63b6e1..a513a7de0c5 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -50,25 +50,25 @@
(beep))))
(defun calc-help-for-help (arg)
- "You have typed `h', the Calc help character. Type a Help option:
+ "You have typed \\`h', the Calc help character. Type a Help option:
-B calc-describe-bindings. Display a table of all key bindings.
-H calc-full-help. Display all `?' key messages at once.
+\\`B' calc-describe-bindings. Display a table of all key bindings.
+\\`H' calc-full-help. Display all \\`?' key messages at once.
-I calc-info. Read the Calc manual using the Info system.
-T calc-tutorial. Read the Calc tutorial using the Info system.
-S calc-info-summary. Read the Calc summary using the Info system.
+\\`I' calc-info. Read the Calc manual using the Info system.
+\\`T' calc-tutorial. Read the Calc tutorial using the Info system.
+\\`S' calc-info-summary. Read the Calc summary using the Info system.
-C calc-describe-key-briefly. Look up the command name for a given key.
-K calc-describe-key. Look up a key's documentation in the manual.
-F calc-describe-function. Look up a function's documentation in the manual.
-V calc-describe-variable. Look up a variable's documentation in the manual.
+\\`C' calc-describe-key-briefly. Look up the command name for a given key.
+\\`K' calc-describe-key. Look up a key's documentation in the manual.
+\\`F' calc-describe-function. Look up a function's documentation in the manual.
+\\`V' calc-describe-variable. Look up a variable's documentation in the manual.
-N calc-view-news. Display Calc history of changes.
+\\`N' calc-view-news. Display Calc history of changes.
-C-c Describe conditions for copying Calc.
-C-d Describe how you can get a new copy of Calc or report a bug.
-C-w Describe how there is no warranty for Calc."
+\\`C-c' Describe conditions for copying Calc.
+\\`C-d' Describe how you can get a new copy of Calc or report a bug.
+\\`C-w' Describe how there is no warranty for Calc."
(interactive "P")
(if calc-dispatch-help
(let (key)
@@ -111,9 +111,6 @@ C-w Describe how there is no warranty for Calc."
(with-current-buffer "*Help*"
(let ((inhibit-read-only t))
(goto-char (point-min))
- (when (search-forward "Major Mode Bindings:" nil t)
- (delete-region (point-min) (point))
- (insert "Calc Mode Bindings:"))
(when (search-forward "Global bindings:" nil t)
(forward-line -1)
(delete-region (point) (point-max)))
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 5fd07d57d81..40236e452cc 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -618,8 +618,9 @@ If this can't be done, return NIL."
(defun math-nth-root-float (a nrf-n &optional guess)
(math-inexact-result)
(math-with-extra-prec 1
- (let ((math-nrf-nf (math-float nrf-n))
- (math-nrf-nfm1 (math-float (1- nrf-n))))
+ (let ((math-nrf-n nrf-n)
+ (math-nrf-nf (math-float nrf-n))
+ (math-nrf-nfm1 (math-float (1- nrf-n))))
(math-nth-root-float-iter a (or guess
(math-make-float
1 (/ (+ (math-numdigs (nth 1 a))
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index e944f812525..7c75e79a268 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -61,48 +61,48 @@
;;;###autoload
(defun calc-dispatch-help (arg)
- "C-x* is a prefix key sequence; follow it with one of these letters:
+ "\\`C-x *' is a prefix key sequence; follow it with one of these letters:
For turning Calc on and off:
- C calc. Start the Calculator in a window at the bottom of the screen.
- O calc-other-window. Start the Calculator but don't select its window.
- B calc-big-or-small. Control whether to use the full Emacs screen for Calc.
- Q quick-calc. Use the Calculator in the minibuffer.
- K calc-keypad. Start the Calculator in keypad mode (X window system only).
- E calc-embedded. Use the Calculator on a formula in this editing buffer.
- J calc-embedded-select. Like E, but select appropriate half of => or :=.
- W calc-embedded-word. Like E, but activate a single word, i.e., a number.
- Z calc-user-invocation. Invoke Calc in the way you defined with `Z I' cmd.
- X calc-quit. Turn Calc off.
+ \\`C' calc. Start the Calculator in a window at the bottom of the screen.
+ \\`O' calc-other-window. Start the Calculator but don't select its window.
+ \\`B' calc-big-or-small. Toggle using the full Emacs screen for Calc.
+ \\`Q' quick-calc. Use the Calculator in the minibuffer.
+ \\`K' calc-keypad. Start the Calculator in keypad mode (X window system only).
+ \\`E' calc-embedded. Use the Calculator on a formula in this editing buffer.
+ \\`J' calc-embedded-select. Like \\`E', but select appropriate half of => or :=.
+ \\`W' calc-embedded-word. Like \\`E', but activate a single word, i.e., a number.
+ \\`Z' calc-user-invocation. Invoke Calc in the way you defined with `Z I' cmd.
+ \\`X' calc-quit. Turn Calc off.
For moving data into and out of Calc:
- G calc-grab-region. Grab the region defined by mark and point into Calc.
- R calc-grab-rectangle. Grab the rectangle defined by mark, point into Calc.
- : calc-grab-sum-down. Grab a rectangle and sum the columns.
- _ calc-grab-sum-across. Grab a rectangle and sum the rows.
- Y calc-copy-to-buffer. Copy a value from the stack into the editing buffer.
+ \\`G' calc-grab-region. Grab the region defined by mark and point into Calc.
+ \\`R' calc-grab-rectangle. Grab the rectangle defined by mark, point into Calc.
+ \\`:' calc-grab-sum-down. Grab a rectangle and sum the columns.
+ \\`_' calc-grab-sum-across. Grab a rectangle and sum the rows.
+ \\`Y' calc-copy-to-buffer. Copy a value from the stack into the editing buffer.
For use with Embedded mode:
- A calc-embedded-activate. Find and activate all :='s and =>'s in buffer.
- D calc-embedded-duplicate. Make a copy of this formula and select it.
- F calc-embedded-new-formula. Insert a new formula at current point.
- N calc-embedded-next. Advance cursor to next known formula in buffer.
- P calc-embedded-previous. Advance cursor to previous known formula.
- U calc-embedded-update-formula. Re-evaluate formula at point.
- \\=` calc-embedded-edit. Use calc-edit to edit formula at point.
+ \\`A' calc-embedded-activate. Find and activate all :='s and =>'s in buffer.
+ \\`D' calc-embedded-duplicate. Make a copy of this formula and select it.
+ \\`F' calc-embedded-new-formula. Insert a new formula at current point.
+ \\`N' calc-embedded-next. Advance cursor to next known formula in buffer.
+ \\`P' calc-embedded-previous. Advance cursor to previous known formula.
+ \\`U' calc-embedded-update-formula. Re-evaluate formula at point.
+ \\``' calc-embedded-edit. Use calc-edit to edit formula at point.
Documentation:
- I calc-info. Read the Calculator manual in the Emacs Info system.
- T calc-tutorial. Run the Calculator Tutorial using the Emacs Info system.
- S calc-summary. Read the Summary from the Calculator manual in Info.
+ \\`I' calc-info. Read the Calculator manual in the Emacs Info system.
+ \\`T' calc-tutorial. Run the Calculator Tutorial using the Emacs Info system.
+ \\`S' calc-summary. Read the Summary from the Calculator manual in Info.
Miscellaneous:
- L calc-load-everything. Load all parts of the Calculator into memory.
- M read-kbd-macro. Read a region of keystroke names as a keyboard macro.
- 0 (zero) calc-reset. Reset Calc stack and modes to default state.
+ \\`L' calc-load-everything. Load all parts of the Calculator into memory.
+ \\`M' read-kbd-macro. Read a region of keystroke names as a keyboard macro.
+ \\`0' (zero) calc-reset. Reset Calc stack and modes to default state.
-Press `*' twice (`C-x * *') to turn Calc on or off using the same
-Calc user interface as before (either C-x * C or C-x * K; initially C-x * C)."
+Press \\`*' twice (\\`C-x * *') to turn Calc on or off using the same
+Calc user interface as before (either \\`C-x * C' or \\`C-x * K'; initially \\`C-x * C')."
(interactive "P")
(calc-check-defines)
(if calc-dispatch-help
@@ -216,26 +216,28 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C)."
(defun calc-help ()
(interactive)
(let ((msgs
- '("Press `h' for complete help; press `?' repeatedly for a summary"
- "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit"
- "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option"
- "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB"
- "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi"
- "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args"
- "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
- "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
- "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)"
- "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)"
- "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)"
- "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)"
- "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
- "Prefix keys: Algebra, Binary/business, Convert, Display"
- "Prefix keys: Functions, Graphics, Help, J (select)"
- "Prefix keys: Kombinatorics/statistics, Modes, Store/recall"
- "Prefix keys: Trail/time, Units/statistics, Vector/matrix"
- "Prefix keys: Z (user), SHIFT + Z (define)"
- "Prefix keys: prefix + ? gives further help for that prefix"
- " Calc by Dave Gillespie, daveg@synaptics.com")))
+ ;; FIXME: Change these to `substitute-command-keys' syntax.
+ (mapcar #'substitute-command-keys
+ '("Press \\`h' for complete help; press \\`?' repeatedly for a summary"
+ "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit"
+ "Letter keys: SHIFT + Undo, reDo; Inverse, Hyperbolic, Option"
+ "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB"
+ "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi"
+ "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args"
+ "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
+ "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
+ "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)"
+ "Other keys: \\`SPC'/\\`RET' (enter/dup), LFD (over); < > (scroll horiz)"
+ "Other keys: \\`DEL' (drop), \\`M-DEL' (drop-above); { } (scroll vert)"
+ "Other keys: \\`TAB' (swap/roll-dn), \\`M-TAB' (roll-up)"
+ "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
+ "Prefix keys: Algebra, Binary/business, Convert, Display"
+ "Prefix keys: Functions, Graphics, Help, J (select)"
+ "Prefix keys: Kombinatorics/statistics, Modes, Store/recall"
+ "Prefix keys: Trail/time, Units/statistics, Vector/matrix"
+ "Prefix keys: Z (user), SHIFT + Z (define)"
+ "Prefix keys: prefix + ? gives further help for that prefix"
+ " Calc by Dave Gillespie, daveg@synaptics.com"))))
(if calc-full-help-flag
msgs
(if (or calc-inverse-flag calc-hyperbolic-flag)
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index ff00a4a2a68..5690f101182 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -109,11 +109,14 @@
(setq n (and (not (eq calc-auto-why t)) (if calc-auto-why t 1))))
(calc-change-mode 'calc-auto-why n nil)
(cond ((null n)
- (message "User must press `w' to explain unsimplified results"))
+ (message (substitute-command-keys
+ "User must press \\`w' to explain unsimplified results")))
((eq n t)
- (message "Automatically doing `w' to explain unsimplified results"))
+ (message (substitute-command-keys
+ "Automatically doing \\`w' to explain unsimplified results")))
(t
- (message "Automatically doing `w' only for unusual messages")))))
+ (message (substitute-command-keys
+ "Automatically doing \\`w' only for unusual messages"))))))
(defun calc-group-digits (n)
(interactive "P")
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 44b967c3859..f11d9741ec7 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -205,9 +205,8 @@
(progn
(setq cmd-base-default (concat "User-" keyname))
(setq cmd (completing-read
- (concat "Define M-x command name (default calc-"
- cmd-base-default
- "): ")
+ (format-prompt "Define M-x command name"
+ (concat "calc-" cmd-base-default))
obarray 'commandp nil
(if (and odef (symbolp (cdr odef)))
(symbol-name (cdr odef))
@@ -241,8 +240,8 @@
(setq func
(concat "calcFunc-"
(completing-read
- (concat "Define algebraic function name (default "
- cmd-base-default "): ")
+ (format-prompt "Define algebraic function name"
+ cmd-base-default)
(mapcar (lambda (x) (substring x 9))
(all-completions "calcFunc-"
obarray))
@@ -679,7 +678,7 @@
(or last-kbd-macro
(error "No keyboard macro defined"))
(setq calc-invocation-macro last-kbd-macro)
- (message "Use `C-x * Z' to invoke this macro"))
+ (message (substitute-command-keys "Use \\`C-x * Z' to invoke this macro")))
(defun calc-user-define-edit ()
(interactive) ; but no calc-wrapper!
@@ -1950,7 +1949,7 @@ Redefine the corresponding command."
;; The variable math-exp-env is local to math-define-body, but is
;; used by math-define-exp, which is called (indirectly) by
-;; by math-define-body.
+;; math-define-body.
(defvar math-exp-env)
(defun math-define-body (body exp-env)
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index c0dd77d9b2a..023dd40c155 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -163,19 +163,19 @@
tag (and (not val) 1))
(message "Variable \"%s\" changed" (calc-var-name var)))))))
-(defvar calc-var-name-map nil "Keymap for reading Calc variable names.")
-(if calc-var-name-map
- ()
- (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
- (define-key calc-var-name-map " " 'self-insert-command)
- (mapc (lambda (x)
- (define-key calc-var-name-map (char-to-string x)
- 'calcVar-digit))
- "0123456789")
- (mapc (lambda (x)
- (define-key calc-var-name-map (char-to-string x)
- 'calcVar-oper))
- "+-*/^|"))
+(defvar calc-var-name-map
+ (let ((map (copy-keymap minibuffer-local-completion-map)))
+ (define-key map " " #'self-insert-command)
+ (mapc (lambda (x)
+ (define-key map (char-to-string x)
+ #'calcVar-digit))
+ "0123456789")
+ (mapc (lambda (x)
+ (define-key map (char-to-string x)
+ #'calcVar-oper))
+ "+-*/^|")
+ map)
+ "Keymap for reading Calc variable names.")
(defvar calc-store-opers)
@@ -188,12 +188,15 @@
(let* ((calc-store-opers store-opers)
(var (concat
"var-"
- (let ((minibuffer-completion-table
- (mapcar (lambda (x) (substring x 4))
- (all-completions "var-" obarray)))
- (minibuffer-completion-predicate
- (lambda (x) (boundp (intern (concat "var-" x)))))
- (minibuffer-completion-confirm t))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-completion-table
+ (mapcar (lambda (x) (substring x 4))
+ (all-completions "var-" obarray)))
+ (setq-local minibuffer-completion-predicate
+ (lambda (x)
+ (boundp (intern (concat "var-" x)))))
+ (setq-local minibuffer-completion-confirm t))
(read-from-minibuffer
prompt nil calc-var-name-map nil
'calc-read-var-name-history)))))
@@ -586,7 +589,7 @@
(defun calc-permanent-variable (&optional var)
(interactive)
(calc-wrapper
- (or var (setq var (calc-read-var-name "Save variable (default all): ")))
+ (or var (setq var (calc-read-var-name (format-prompt "Save variable" "all"))))
(let (calc-pv-pos)
(and var (or (and (boundp var) (symbol-value var))
(error "No such variable")))
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index d1565e74a04..c8405c7d1a0 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -486,18 +486,13 @@ If COMP or STD is non-nil, put that in the units table instead."
(setq defunits (math-get-default-units expr))
(unless new-units
(setq new-units
- (read-string (concat
+ (read-string (format-prompt
(if (and uoldname (not nouold))
(concat "Old units: "
uoldname
", new units")
"New units")
- (if defunits
- (concat
- " (default "
- defunits
- "): ")
- ": "))))
+ defunits)))
(if (and
(string= new-units "")
defunits)
@@ -533,14 +528,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(let* ((old-units (math-extract-units expr))
(defunits (math-get-default-units expr))
units
- (new-units
- (read-string (concat "New units"
- (if defunits
- (concat
- " (default "
- defunits
- "): ")
- ": ")))))
+ (new-units (read-string (format-prompt "New units" defunits))))
(if (and
(string= new-units "")
defunits)
@@ -596,19 +584,14 @@ If COMP or STD is non-nil, put that in the units table instead."
(setq expr (math-mul expr uold)))
(setq defunits (math-get-default-units expr))
(setq unew (or new-units
- (completing-read
- (concat
- (if uoldname
- (concat "Old temperature units: "
- uoldname
- ", new units")
- "New temperature units")
- (if defunits
- (concat " (default "
- defunits
- "): ")
- ": "))
- tempunits)))
+ (completing-read (format-prompt
+ (if uoldname
+ (concat "Old temperature units: "
+ uoldname
+ ", new units")
+ "New temperature units")
+ defunits)
+ tempunits)))
(setq unew (math-read-expr (if (string= unew "") defunits unew)))
(when (eq (car-safe unew) 'error)
(error "Bad format in units expression: %s" (nth 2 unew)))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index 8c6d3f51e5d..71cc68b0c20 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -47,6 +47,8 @@
(calc-check-stack num)
(let ((stuff (calc-top-list n (- num n -1))))
(calc-cursor-stack-index num)
+ (unless calc-kill-line-numbering
+ (re-search-forward "\\=[0-9]+:\\s-+" (point-at-eol) t))
(let ((first (point)))
(calc-cursor-stack-index (- num n))
(if (null nn)
@@ -264,14 +266,16 @@ as well as set the contents of the Emacs register REGISTER to TEXT."
"Return the CALCVAL portion of the contents of the Calc register REG,
unless the TEXT portion doesn't match the contents of the Emacs register REG,
in which case either return the contents of the Emacs register (if it is
-text) or nil."
+text or a number) or nil."
(let ((cval (cdr (assq reg calc-register-alist)))
(val (cdr (assq reg register-alist))))
- (if (stringp val)
- (if (and (stringp (car cval))
- (string= (car cval) val))
- (cdr cval)
- val))))
+ (cond
+ ((stringp val)
+ (if (and (stringp (car cval))
+ (string= (car cval) val))
+ (cdr cval)
+ val))
+ ((numberp val) (number-to-string val)))))
(defun calc-copy-to-register (register start end &optional delete-flag)
"Copy the lines in the region into register REGISTER.
@@ -711,9 +715,9 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(insert (propertize
(concat
(or title title "Calc Edit Mode. ")
- (format-message "Press `C-c C-c'")
+ (substitute-command-keys "Press \\`C-c C-c'")
(if allow-ret "" " or RET")
- (format-message " to finish, `C-x k RET' to cancel.\n\n"))
+ (substitute-command-keys " to finish, \\`C-x k RET' to cancel.\n\n"))
'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
(setq-local calc-edit-top (point))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 171f7711324..254c703ee22 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -412,7 +412,7 @@ and deleted by `calc-pop'."
(defcustom calc-undo-length 100
"The number of undo steps that will be preserved when Calc is quit."
- :type 'integer)
+ :type 'natnum)
(defcustom calc-highlight-selections-with-faces nil
"If non-nil, use a separate face to indicate selected sub-formulas.
@@ -439,6 +439,14 @@ to be identified as that note."
:version "24.1"
:type 'string)
+(defcustom calc-kill-line-numbering t
+ "If non-nil, calculator kills include any line numbering.
+
+This option does not affect calc kill and copy commands which
+operate on the region, such as `calc-copy-region-as-kill'."
+ :version "29.1"
+ :type 'boolean)
+
(defvar math-format-date-cache) ; calc-forms.el
(defface calc-nonselected-face
@@ -494,7 +502,7 @@ This setting only applies to floats in normal display mode.")
(defmacro defcalcmodevar (var defval &optional doc)
"Declare VAR as a Calc variable, with default value DEFVAL and doc-string DOC.
The variable VAR will be added to `calc-mode-var-list'."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
`(progn
(defvar ,var ,defval ,doc)
(add-to-list 'calc-mode-var-list (list (quote ,var) ,defval))))
@@ -1375,7 +1383,7 @@ Notations: 3.14e6 3.14 * 10^6
LONG is a desired text for a wide window, SHORT is a desired
abbreviated text, and width is the buffer width, which will be
-some fraction of the 'parent' window width (At the time of
+some fraction of the \"parent\" window width (At the time of
writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a
trial-and-error adjustment number for the edge-cases at the
border of the two cases."
@@ -1621,7 +1629,8 @@ See calc-keypad for details."
(stringp (nth 1 err))
(string-match "max-specpdl-size\\|max-lisp-eval-depth"
(nth 1 err)))
- (error "Computation got stuck or ran too long. Type `M' to increase the limit")
+ (error (substitute-command-keys
+ "Computation got stuck or ran too long. Type \\`M' to increase the limit"))
(setq calc-aborted-prefix nil)
(signal (car err) (cdr err)))))
(when calc-aborted-prefix
@@ -3439,7 +3448,7 @@ The prefix `calcFunc-' is added to the specified name to get the
actual Lisp function name.
See Info node `(calc)Defining Functions'."
- (declare (doc-string 3)) ;; FIXME: Edebug spec?
+ (declare (doc-string 3) (indent defun)) ;; FIXME: Edebug spec?
(require 'calc-ext)
(math-do-defmath func args body))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 44c7fcecc8e..a80437d6ecf 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -593,15 +593,15 @@ except when using a non-decimal radix mode for input (in this case `e'
will be the hexadecimal digit).
Here are the editing keys:
-* `RET' `=' evaluate the current expression
-* `C-insert' copy the whole current expression to the `kill-ring'
-* `C-return' evaluate, save result the `kill-ring' and exit
-* `insert' paste a number if the one was copied (normally)
-* `delete' `C-d' clear last argument or whole expression (hit twice)
-* `backspace' delete a digit or a previous expression element
-* `h' `?' pop-up a quick reference help
-* `ESC' `q' exit (`ESC' can be used if `calculator-bind-escape' is
- non-nil, otherwise use three consecutive `ESC's)
+* \\`RET' \\`=' evaluate the current expression
+* \\`C-<insert>' copy the whole current expression to the `kill-ring'
+* \\`C-<return>' evaluate, save result the `kill-ring' and exit
+* \\`<insert>' paste a number if the one was copied (normally)
+* \\`<delete>' \\`C-d' clear last argument or whole expression (hit twice)
+* \\`<backspace>' delete a digit or a previous expression element
+* \\`h' \\`?' pop-up a quick reference help
+* \\`ESC' \\`q' exit (\\`ESC' can be used if `calculator-bind-escape' is
+ non-nil, otherwise use three consecutive \\`ESC's)
These operators are pre-defined:
* `+' `-' `*' `/' the common binary operators
@@ -623,10 +623,10 @@ argument.
hex/oct/bin modes can be set for input and for display separately.
Another toggle-able mode is for using degrees instead of radians for
trigonometric functions.
-The keys to switch modes are (both `H' and `X' are for hex):
-* `D' switch to all-decimal mode, or toggle degrees/radians
-* `B' `O' `H' `X' binary/octal/hexadecimal modes for input & display
-* `i' `o' followed by one of `D' `B' `O' `H' `X' (case
+The keys to switch modes are (both \\`H' and \\`X' are for hex):
+* \\`D' switch to all-decimal mode, or toggle degrees/radians
+* \\`B' \\`O' \\`H' \\`X' binary/octal/hexadecimal modes for input & display
+* \\`i' \\`o' followed by one of \\`D' \\`B' \\`O' \\`H' \\`X' (case
insensitive) sets only the input or display radix mode
The prompt indicates the current modes:
* \"==\": decimal mode (using radians);
@@ -649,17 +649,17 @@ collected data. It is possible to navigate in this list, and if the
value shown is the current one on the list, an indication is displayed
as \"[N]\" if this is the last number and there are N numbers, or
\"[M/N]\" if the M-th value is shown.
-* `SPC' evaluate the current value as usual, but also adds
+* \\`SPC' evaluate the current value as usual, but also adds
the result to the list of saved values
-* `l' `v' computes total / average of saved values
-* `up' `C-p' browse to the previous value in the list
-* `down' `C-n' browse to the next value in the list
-* `delete' `C-d' remove current value from the list (if it is on it)
-* `C-delete' `C-c' delete the whole list
+* \\`l' \\`v' computes total / average of saved values
+* \\`<up>' \\`C-p' browse to the previous value in the list
+* \\`<down>' \\`C-n' browse to the next value in the list
+* \\`<delete>' \\`C-d' remove current value from the list (if it is on it)
+* \\`C-<delete>' \\`C-c' delete the whole list
Registers are variable-like place-holders for values:
-* `s' followed by a character attach the current value to that character
-* `g' followed by a character fetches the attached value
+* \\`s' followed by a character attach the current value to that character
+* \\`g' followed by a character fetches the attached value
There are many variables that can be used to customize the calculator.
Some interesting customization variables are:
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index ebdafb438e3..a7d13cff9a1 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -510,9 +510,13 @@ The time should be in either 24 hour format or am/pm format.
Optional argument WARNTIME is an integer (or string) giving the number
of minutes before the appointment at which to start warning.
The default is `appt-message-warning-time'."
- (interactive "sTime (hh:mm[am/pm]): \nsMessage: \n\
-sMinutes before the appointment to start warning: ")
- (unless (string-match appt-time-regexp time)
+ (interactive (list (let ((time (read-string "Time (hh:mm[am/pm]): ")))
+ (unless (string-match-p appt-time-regexp time)
+ (user-error "Unacceptable time-string"))
+ time)
+ (read-string "Message: ")
+ (read-string "Minutes before the appointment to start warning: ")))
+ (unless (string-match-p appt-time-regexp time)
(user-error "Unacceptable time-string"))
(and (stringp warntime)
(setq warntime (unless (string-equal warntime "")
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 61ce029e077..1c08de53fbd 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -798,6 +798,10 @@ In this case, the following civil date corresponds to the Hebrew birthday."
(diary-ordinal-suffix age)
(if (= b-date d) "" " (evening)")))))
+(defvar diary-hebrew-omer-sefirot
+ ["Hesed" "Gevurah" "Tiferet" "Netzach" "Hod" "Yesod" "Malchut"]
+ "The order of Sefirot for counting the Omer.
+See https://opensiddur.org/prayers/solilunar/solar-cycles/sefirat-haomer/the-order-of-counting-the-omer-in-the-spring/")
;;;###diary-autoload
(defun diary-hebrew-omer (&optional mark)
"Omer count diary entry.
@@ -813,7 +817,7 @@ use when highlighting the day in the calendar."
(day (% omer 7)))
(if (and (> omer 0) (< omer 50))
(cons mark
- (format "Day %d%s of the omer (until sunset)"
+ (format "Day %d%s of the omer (until sunset) %s she'be'%s"
omer
(if (zerop week)
""
@@ -823,7 +827,10 @@ use when highlighting the day in the calendar."
(if (zerop day)
""
(format " and %d day%s"
- day (if (= day 1) "" "s"))))))))))
+ day (if (= day 1) "" "s")))))
+ (aref diary-hebrew-omer-sefirot (% (+ 6 day) 7))
+ (aref diary-hebrew-omer-sefirot
+ (+ (if (zerop day) -1 0) week)))))))
(autoload 'diary-make-date "diary-lib")
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 48d308afade..c1f176050c2 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -211,7 +211,7 @@ If you change this variable directly (without using customize)
after starting `calendar', you should call `calendar-redraw' to
update the calendar display to reflect the change, otherwise
movement commands will not work correctly."
- :type 'integer
+ :type 'natnum
;; Change the initialize so that if you reload calendar.el, it will not
;; cause a redraw.
:initialize 'custom-initialize-default
@@ -511,7 +511,7 @@ Then redraw the calendar, if necessary."
:initialize #'custom-initialize-default
:set (lambda (sym val)
(calendar-set-layout-variable sym val 1))
- :type 'integer
+ :type 'natnum
:version "23.1")
;; FIXME calendar-month-column-width?
@@ -520,7 +520,7 @@ Then redraw the calendar, if necessary."
:initialize #'custom-initialize-default
:set (lambda (sym val)
(calendar-set-layout-variable sym val 3))
- :type 'integer
+ :type 'natnum
:version "23.1")
(defun calendar-day-header-construct (&optional width)
@@ -553,7 +553,7 @@ Must be at least one less than `calendar-column-width'."
:initialize #'custom-initialize-default
:set (lambda (sym val)
(calendar-set-layout-variable sym val 2))
- :type 'integer
+ :type 'natnum
:version "23.1")
(defcustom calendar-intermonth-header nil
@@ -565,7 +565,7 @@ See `calendar-intermonth-text'."
:set (lambda (sym val)
(set sym val)
(calendar-redraw))
- :type '(choice (const nil :tag "Nothing")
+ :type '(choice (const :value nil :tag "Nothing")
(string :tag "Fixed string")
(sexp :value
(propertize "WK" 'font-lock-face
@@ -597,7 +597,7 @@ See also `calendar-intermonth-header'."
:set (lambda (sym val)
(set sym val)
(calendar-redraw))
- :type '(choice (const nil :tag "Nothing")
+ :type '(choice (const :value nil :tag "Nothing")
(string :tag "Fixed string")
(sexp :value
(propertize
@@ -742,9 +742,9 @@ Setting this variable directly does not take effect (if the
calendar package is already loaded). Rather, use either
\\[customize] or the function `calendar-set-date-style'."
:version "23.1"
- :type '(choice (const american :tag "Month/Day/Year")
- (const european :tag "Day/Month/Year")
- (const iso :tag "Year/Month/Day"))
+ :type '(choice (const :value american :tag "American (Month/Day/Year)")
+ (const :value european :tag "European (Day/Month/Year)")
+ (const :value iso :tag "ISO 8601 (Year/Month/Day)"))
:initialize 'custom-initialize-default
:set (lambda (_symbol value)
(calendar-set-date-style value))
@@ -1066,7 +1066,7 @@ calendar."
;; fixme should have a :set that changes calendar-standard-time-zone-name etc.
(defcustom calendar-time-zone-style 'symbolic
"Your preferred style for time zones.
-If 'numeric, use numeric time zones like \"+0100\".
+If `numeric', use numeric time zones like \"+0100\".
Otherwise, use symbolic time zones like \"CET\"."
:type '(choice (const numeric) (other symbolic))
:version "28.1"
@@ -1861,7 +1861,9 @@ concatenated and the result truncated."
buffs))
(defun calendar-exit (&optional kill)
- "Get out of the calendar window and hide it and related buffers."
+ "Get out of the calendar window and hide it and related buffers.
+If KILL (interactively, the prefix), kill the buffers instead of
+hiding them."
(interactive "P")
(let ((diary-buffer (get-file-buffer diary-file))
(calendar-buffers (calendar-buffer-list)))
@@ -1880,7 +1882,12 @@ concatenated and the result truncated."
(iconify-frame (window-frame w)))
(quit-window kill w))))
(dolist (b calendar-buffers)
- (quit-windows-on b kill))))))
+ (quit-windows-on b kill)))
+ ;; Finally, kill non-displayed buffers (if requested).
+ (when kill
+ (dolist (b calendar-buffers)
+ (when (buffer-live-p b)
+ (kill-buffer b)))))))
(defun calendar-current-date (&optional offset)
"Return the current date in a list (month day year).
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 45df0c6259c..084d2d7d55e 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1,7 +1,6 @@
;;; diary-lib.el --- diary functions -*- lexical-binding:t -*-
-;; Copyright (C) 1989-1990, 1992-1995, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1989-2022 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -101,11 +100,11 @@ are: `string', `symbol', `int', `tnil', `stringtnil'."
:type '(repeat (list (regexp :tag "Regular expression")
(integer :tag "Sub-expression")
(symbol :tag "Attribute (e.g. :foreground)")
- (choice (const string :tag "A string")
- (const symbol :tag "A symbol")
- (const int :tag "An integer")
- (const tnil :tag "t or nil")
- (const stringtnil
+ (choice (const :value string :tag "A string")
+ (const :value symbol :tag "A symbol")
+ (const :value int :tag "An integer")
+ (const :value tnil :tag "t or nil")
+ (const :value stringtnil
:tag "A string, t, or nil"))))
:group 'diary)
@@ -2246,12 +2245,10 @@ Prefix argument ARG makes the entry nonmarking."
;; Return value suitable for `write-contents-functions'.
nil)
-(defvar diary-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-s" 'diary-show-all-entries)
- (define-key map "\C-c\C-q" 'quit-window)
- map)
- "Keymap for `diary-mode'.")
+(defvar-keymap diary-mode-map
+ :doc "Keymap for `diary-mode'."
+ "C-c C-s" #'diary-show-all-entries
+ "C-c C-q" #'quit-window)
(defun diary-font-lock-sexps (limit)
"Recognize sexp diary entry up to LIMIT for font-locking."
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 2afa667a56c..5aa0d26d192 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -30,7 +30,7 @@
;;; Code:
(require 'calendar)
-(load "hol-loaddefs" nil t)
+(load "holiday-loaddefs" nil t)
(defgroup holidays nil
"Holidays support in calendar."
@@ -400,6 +400,36 @@ This function is suitable for execution in an init file."
(displayed-year (calendar-extract-year date)))
(calendar-list-holidays))))
+(defun holiday-available-holiday-lists ()
+ "Return a list of all holiday lists.
+This is used by `list-holidays', and you can customize the return
+value by using `add-function'."
+ (delq
+ nil
+ (list
+ (cons "All" calendar-holidays)
+ (cons "Equinoxes/Solstices"
+ (list (list 'solar-equinoxes-solstices)))
+ (if holiday-general-holidays
+ (cons "General" holiday-general-holidays))
+ (if holiday-local-holidays
+ (cons "Local" holiday-local-holidays))
+ (if holiday-other-holidays
+ (cons "Other" holiday-other-holidays))
+ (if holiday-christian-holidays
+ (cons "Christian" holiday-christian-holidays))
+ (if holiday-hebrew-holidays
+ (cons "Hebrew" holiday-hebrew-holidays))
+ (if holiday-islamic-holidays
+ (cons "Islamic" holiday-islamic-holidays))
+ (if holiday-bahai-holidays
+ (cons "Bahá’í" holiday-bahai-holidays))
+ (if holiday-oriental-holidays
+ (cons "Oriental" holiday-oriental-holidays))
+ (if holiday-solar-holidays
+ (cons "Solar" holiday-solar-holidays))
+ (cons "Ask" nil))))
+
;; rms: "Emacs commands to display a list of something generally start
;; with `list-'. Please make `list-holidays' the principal name."
;;;###autoload
@@ -421,7 +451,12 @@ documentation of `calendar-holidays' for a list of the variables
that control the choices, as well as a description of the format
of a holiday list.
-The optional LABEL is used to label the buffer created."
+The optional LABEL is used to label the buffer created.
+
+The list of holiday lists is computed by the
+`holiday-available-holiday-lists' and you can alter the results
+by redefining that function, or use `add-function' to add
+values."
(interactive
(let* ((start-year (calendar-read-sexp
"Starting year of holidays (>0)"
@@ -433,30 +468,7 @@ The optional LABEL is used to label the buffer created."
start-year
start-year))
(completion-ignore-case t)
- (lists
- (list
- (cons "All" calendar-holidays)
- (cons "Equinoxes/Solstices"
- (list (list 'solar-equinoxes-solstices)))
- (if holiday-general-holidays
- (cons "General" holiday-general-holidays))
- (if holiday-local-holidays
- (cons "Local" holiday-local-holidays))
- (if holiday-other-holidays
- (cons "Other" holiday-other-holidays))
- (if holiday-christian-holidays
- (cons "Christian" holiday-christian-holidays))
- (if holiday-hebrew-holidays
- (cons "Hebrew" holiday-hebrew-holidays))
- (if holiday-islamic-holidays
- (cons "Islamic" holiday-islamic-holidays))
- (if holiday-bahai-holidays
- (cons "Bahá’í" holiday-bahai-holidays))
- (if holiday-oriental-holidays
- (cons "Oriental" holiday-oriental-holidays))
- (if holiday-solar-holidays
- (cons "Solar" holiday-solar-holidays))
- (cons "Ask" nil)))
+ (lists (holiday-available-holiday-lists))
(choice (capitalize
(completing-read "List (TAB for choices): " lists nil t)))
(which (if (string-equal choice "Ask")
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 439fb6dd29a..cf542939897 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -644,13 +644,13 @@ FIXME: multiple comma-separated values should be allowed!"
;; seconds present
(setq second (read (substring isodatetimestring 13 15))))
;; FIXME: Support subseconds.
- (when (and (> (length isodatetimestring) 15)
- ;; UTC specifier present
- (char-equal ?Z (aref isodatetimestring 15)))
- (setq source-zone t
- ;; decode to local time unless result-zone is explicitly given,
- ;; i.e. do not decode to UTC, i.e. do not (setq result-zone t)
- ))
+ (when (> (length isodatetimestring) 15)
+ (pcase (aref isodatetimestring 15)
+ (?Z
+ (setq source-zone t))
+ ((or ?- ?+)
+ (setq source-zone
+ (concat "UTC" (substring isodatetimestring 15))))))
;; shift if necessary
(if day-shift
(let ((mdy (calendar-gregorian-from-absolute
@@ -1144,7 +1144,8 @@ FExport diary data into iCalendar file: ")
(cdr contents-n-summary))))
(setq result (concat result header contents alarm
"\nEND:VEVENT")))
- (if (consp cns-cons-or-list)
+ (if (and (consp cns-cons-or-list)
+ (not (listp (cdr cns-cons-or-list))))
(list cns-cons-or-list)
cns-cons-or-list)))
;; handle errors
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
index e31120f52ff..6827a957a6f 100644
--- a/lisp/calendar/iso8601.el
+++ b/lisp/calendar/iso8601.el
@@ -114,6 +114,11 @@
iso8601--duration-week-match
iso8601--duration-combined-match)))
+;; "Z" dnd "z" are standard time; nil and [-+][0-9][0-9]... are local time
+;; with unknown DST.
+(defun iso8601--zone-dst (zone)
+ (if (= (length zone) 1) nil -1))
+
(defun iso8601-parse (string &optional form)
"Parse an ISO 8601 date/time string and return a `decode-time' structure.
@@ -140,7 +145,7 @@ See `decode-time' for the meaning of FORM."
(setf (decoded-time-zone date)
;; The time zone in decoded times are in seconds.
(* (iso8601-parse-zone zone-string) 60))
- (setf (decoded-time-dst date) nil))
+ (setf (decoded-time-dst date) (iso8601--zone-dst zone-string)))
date)))
(defun iso8601-parse-date (string)
@@ -256,6 +261,7 @@ See `decode-time' for the meaning of FORM."
(iso8601--decoded-time :hour hour
:minute (or minute 0)
:second (or second 0)
+ :dst (iso8601--zone-dst zone)
:zone (and zone
(* 60 (iso8601-parse-zone
zone)))))))))
@@ -364,7 +370,7 @@ Return the number of minutes."
(cl-defun iso8601--decoded-time (&key second minute hour
day month year
- dst zone)
+ (dst -1) zone)
(list (iso8601--value second)
(iso8601--value minute)
(iso8601--value hour)
@@ -372,7 +378,7 @@ Return the number of minutes."
(iso8601--value month)
(iso8601--value year)
nil
- (if (or dst zone) dst -1)
+ dst
zone))
(defun iso8601--encode-time (time)
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 83a57751474..d1afd8ce95a 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -69,7 +69,7 @@ list (HIGH LOW MICRO PICO)."
(pop elt)))
(time-value (car elt))
(gensym (make-symbol "time")))
- `(let* ,(append `((,gensym (or ,time-value (current-time)))
+ `(let* ,(append `((,gensym (or ,time-value (time-convert nil 'list)))
(,gensym
(cond
((integerp ,gensym)
@@ -154,7 +154,10 @@ it is assumed that PICO was omitted and should be treated as zero."
DATE should be in one of the forms recognized by `parse-time-string'.
If DATE lacks timezone information, GMT is assumed."
(condition-case err
- (encode-time (parse-time-string date))
+ (let ((parsed (parse-time-string date)))
+ (when (decoded-time-year parsed)
+ (decoded-time-set-defaults parsed))
+ (encode-time parsed))
(error
(let ((overflow-error '(error "Specified time is not representable")))
(if (equal err overflow-error)
@@ -284,17 +287,23 @@ use. \"%,1s\" means \"use one decimal\".
The \"%z\" specifier does not print anything. When it is used, specifiers
must be given in order of decreasing size. To the left of \"%z\", nothing
-is output until the first non-zero unit is encountered."
+is output until the first non-zero unit is encountered.
+
+The \"%x\" specifier does not print anything. When it is used,
+specifiers must be given in order of decreasing size. To the
+right of \"%x\", trailing zero units are not output."
(let ((start 0)
(units '(("y" "year" 31536000)
("d" "day" 86400)
("h" "hour" 3600)
("m" "minute" 60)
("s" "second" 1)
- ("z")))
+ ("z")
+ ("x")))
(case-fold-search t)
- spec match usedunits zeroflag larger prev name unit num zeropos
- fraction)
+ spec match usedunits zeroflag larger prev name unit num
+ leading-zeropos trailing-zeropos fraction
+ chop-leading chop-trailing)
(while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start)
(setq start (match-end 0)
spec (match-string 2 string))
@@ -303,15 +312,16 @@ is output until the first non-zero unit is encountered."
(error "Bad format specifier: `%s'" spec))
(if (assoc (downcase spec) usedunits)
(error "Multiple instances of specifier: `%s'" spec))
- (if (string-equal (car match) "z")
+ (if (or (string-equal (car match) "z")
+ (string-equal (car match) "x"))
(setq zeroflag t)
(unless larger
(setq unit (nth 2 match)
larger (and prev (> unit prev))
prev unit)))
(push match usedunits)))
- (and zeroflag larger
- (error "Units are not in decreasing order of size"))
+ (when (and zeroflag larger)
+ (error "Units are not in decreasing order of size"))
(unless (numberp seconds)
(setq seconds (float-time seconds)))
(setq fraction (mod seconds 1)
@@ -323,18 +333,28 @@ is output until the first non-zero unit is encountered."
(when (string-match
(format "%%\\(\\.?[0-9]+\\)?\\(,[0-9]+\\)?\\(%s\\)" spec)
string)
- (if (string-equal spec "z") ; must be last in units
- (setq string
- (replace-regexp-in-string
- "%z" ""
- (substring string (min (or zeropos (match-end 0))
- (match-beginning 0)))))
+ (cond
+ ((string-equal spec "z")
+ (setq chop-leading (and leading-zeropos
+ (min leading-zeropos (match-beginning 0)))))
+ ((string-equal spec "x")
+ (setq chop-trailing t))
+ (t
;; Cf article-make-date-line in gnus-art.
(setq num (floor seconds unit)
seconds (- seconds (* num unit)))
- ;; Start position of the first non-zero unit.
- (or zeropos
- (setq zeropos (unless (zerop num) (match-beginning 0))))
+ (let ((is-zero (zerop (if (= unit 1)
+ (+ num fraction)
+ num))))
+ ;; Start position of the first non-zero unit.
+ (when (and (not leading-zeropos)
+ (not is-zero))
+ (setq leading-zeropos (match-beginning 0)))
+ (unless is-zero
+ (setq trailing-zeropos nil))
+ (when (and (not trailing-zeropos)
+ is-zero)
+ (setq trailing-zeropos (match-beginning 0))))
(setq string
(replace-match
(format (if (match-string 2 string)
@@ -357,7 +377,17 @@ is output until the first non-zero unit is encountered."
(format " %s%s" name
(if (= num 1) "" "s"))))
t t string))))))
- (string-replace "%%" "%" string))
+ (let ((pre string))
+ (when (and chop-trailing trailing-zeropos)
+ (setq string (substring string 0 trailing-zeropos)))
+ (when chop-leading
+ (setq string (substring string chop-leading)))
+ ;; If we ended up removing everything, return the formatted
+ ;; string in full.
+ (when (equal string "")
+ (setq string pre)))
+ (setq string (replace-regexp-in-string "%[zx]" "" string)))
+ (string-trim (string-replace "%%" "%" string)))
(defvar seconds-to-string
(list (list 1 "ms" 0.001)
@@ -406,7 +436,11 @@ entries only for the values that should be altered.
For instance, if you want to \"add two months\" to TIME, then
leave all other fields but the month field in DELTA nil, and make
-the month field 2. The values in DELTA can be negative.
+the month field 2. For instance:
+
+ (decoded-time-add (decode-time) (make-decoded-time :month 2))
+
+The values in DELTA can be negative.
If applying a month/year delta leaves the time spec invalid, it
is decreased to be valid (\"add one month\" to January 31st 2019
@@ -518,16 +552,20 @@ changes in daylight saving time are not taken into account."
(cl-defun make-decoded-time (&key second minute hour
day month year
- dst zone)
+ (dst -1) zone)
"Return a `decoded-time' structure with only the keywords given filled out."
(list second minute hour day month year nil dst zone))
(defun decoded-time-set-defaults (time &optional default-zone)
- "Set any nil values in `decoded-time' TIME to default values.
+ "Set most nil values in `decoded-time' TIME to default values.
+This can set TIME's year, month, day, hour, minute and second.
The default value is based on January 1st, 1970 at midnight.
This year is used to guarantee portability; see Info
node `(elisp) Time of Day'.
+Optional argument DEFAULT-ZONE specifies what time zone to
+default to when TIME's time zone is nil (meaning local time).
+
TIME is modified and returned."
(unless (decoded-time-second time)
(setf (decoded-time-second time) 0))
@@ -543,18 +581,16 @@ TIME is modified and returned."
(unless (decoded-time-year time)
(setf (decoded-time-year time) 1970))
- ;; When we don't have a time zone, default to DEFAULT-ZONE without
- ;; DST if DEFAULT-ZONE if given, and to unknown DST otherwise.
(unless (decoded-time-zone time)
- (if default-zone
- (progn (setf (decoded-time-zone time) default-zone)
- (setf (decoded-time-dst time) nil))
- (setf (decoded-time-dst time) -1)))
+ (setf (decoded-time-zone time) default-zone))
+
+ ;; Do not set decoded-time-weekday or decoded-time-dst,
+ ;; as encode-time can infer them well enough when unknown.
time)
(defun decoded-time-period (time)
- "Interpret DECODED as a period and return its length in seconds.
+ "Interpret TIME as a period and return its length in seconds.
For computational purposes, years are 365 days long and months
are 30 days long."
(+ (if (consp (decoded-time-second time))
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 1c6a557a0d3..7bdaf7ceff6 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -86,7 +86,7 @@
(defcustom timeclock-workday (* 8 60 60)
"The length of a work period in seconds."
- :type 'integer)
+ :type 'natnum)
(defvar timeclock--previous-workday nil)
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index 0edc853edda..e7635c0aec5 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -854,7 +854,6 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
table)
"Syntax table used in data-debug macro buffers.")
-(define-obsolete-variable-alias 'data-debug-map 'data-debug-mode-map "24.1")
(defvar data-debug-mode-map
(let ((km (make-sparse-keymap)))
(suppress-keymap km)
@@ -1028,11 +1027,9 @@ Do nothing if already contracted."
(defun data-debug-edebug-expr (expr)
"Dump out the contents of some expression EXPR in edebug with ddebug."
(interactive
- (list (let ((minibuffer-completing-symbol t))
- (read-from-minibuffer "Eval: "
- nil read-expression-map t
- 'read-expression-history))
- ))
+ (list (read-from-minibuffer "Eval: "
+ nil read-expression-map t
+ 'read-expression-history)))
(let ((v (eval expr t)))
(if (not v)
(message "Expression %s is nil." expr)
@@ -1043,10 +1040,9 @@ Do nothing if already contracted."
If the result is something simple, show it in the echo area.
If the result is a list or vector, then use the data debugger to display it."
(interactive
- (list (let ((minibuffer-completing-symbol t))
- (read-from-minibuffer "Eval: "
- nil read-expression-map t
- 'read-expression-history))))
+ (list (read-from-minibuffer "Eval: "
+ nil read-expression-map t
+ 'read-expression-history)))
(let (result)
(if (null eval-expression-debug-on-error)
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index 5a23f504f78..cbe766cedb6 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -59,7 +59,7 @@ Return a tuple of ( EMACSNAME . VERSION )."
(file-exists-p (setq configure_ac "configure.in")))
(insert-file-contents configure_ac)
(goto-char (point-min))
- (re-search-forward "AC_INIT(\\(?:GNU \\)?[eE]macs,\\s-*\\([0-9.]+\\)\\s-*[,)]")
+ (re-search-forward "AC_INIT(\\[?\\(?:GNU \\)?[eE]macs]?,\\s-*\\[?\\([0-9.]+\\)]?\\s-*[,)]")
(setq ver (match-string 1))
)
)
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index 3b9002a6e31..b8acb192c17 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -257,7 +257,7 @@ If optional EXACT is non-nil, only return exact matches for DIR."
(defun ede-flush-directory-hash ()
"Flush the project directory hash.
Do this only when developing new projects that are incorrectly putting
-'nomatch tokens into the hash."
+`nomatch' tokens into the hash."
(interactive)
(setq ede-project-directory-hash (make-hash-table :test 'equal))
;; Also slush the current project's locator hash.
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index 0c65af15c4a..7c56ca19936 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -319,8 +319,7 @@ Lays claim to all .elc files that match .el files in this target."
("require" . "$(foreach r,$(1),(require (quote $(r))))"))
:commands
'("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \
---eval '(setq generated-autoload-file \"$(abspath $(LOADDEFS))\")' \
--f batch-update-autoloads $(abspath $(LOADDIRS))")
+-f loaddefs-generate-batch $(abspath $(LOADDEFS)) $(abspath $(LOADDIRS))")
:rules (list (ede-makefile-rule :target "clean-autoloads" :phony t :rules '("rm -f $(LOADDEFS)")))
:sourcetype '(ede-source-emacs)
)
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 2803e1c3071..544e39b8729 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -191,8 +191,9 @@ other meta-variable based on this name.")
"Encode one makefile.")
;;; Code:
-(cl-defmethod project-add-file ((ot project-am-target))
+(cl-defmethod project-add-file ((ot project-am-target) &optional _file)
"Add the current buffer into a project.
+_FILE is ignored.
OT is the object target. DIR is the directory to start in."
(let* ((target (if ede-object (error "Already associated w/ a target")
(let ((amf (project-am-load default-directory)))
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index f1fdcbca1ad..ce37a28c351 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -156,7 +156,7 @@ local variables have been defined."
DOCSTRING is optional and not used.
To work properly, this should be put after PARENT mode local variables
definition."
- (declare (obsolete define-derived-mode "27.1"))
+ (declare (obsolete define-derived-mode "27.1") (indent 2))
`(mode-local--set-parent ',mode ',parent))
(defun mode-local-use-bindings-p (this-mode desired-mode)
@@ -567,6 +567,7 @@ appropriate arguments deduced from ARGS.
OVERARGS is a list of arguments passed to the override and
`NAME-default' function, in place of those deduced from ARGS."
(declare (doc-string 3)
+ (indent defun)
(debug (&define name lambda-list stringp def-body)))
`(eval-and-compile
(defun ,name ,args
@@ -595,6 +596,7 @@ DOCSTRING is the documentation string.
BODY is the implementation of this function."
;; FIXME: Make this obsolete and use cl-defmethod with &context instead.
(declare (doc-string 4)
+ (indent defun)
(debug (&define name symbolp lambda-list stringp def-body)))
(let ((newname (intern (format "%s-%s" name mode))))
`(progn
@@ -875,10 +877,9 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
"Display mode local bindings active in BUFFER-OR-MODE.
Optional argument INTERACTIVE-P is non-nil if the calling command was
invoked interactively."
- (when (fboundp 'help-setup-xref)
- (help-setup-xref
- (list 'mode-local-describe-bindings-1 buffer-or-mode)
- interactive-p))
+ (help-setup-xref
+ (list 'mode-local-describe-bindings-1 buffer-or-mode)
+ interactive-p)
(with-output-to-temp-buffer (help-buffer) ; "*Help*"
(with-current-buffer standard-output
(mode-local-describe-bindings-2 buffer-or-mode))))
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index dc6751db6cf..78002dd8abc 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -497,8 +497,8 @@ is requested."
(defvar semantic-working-type 'percent
"The type of working message to use when parsing.
-'percent means we are doing a linear parse through the buffer.
-'dynamic means we are reparsing specific tags.")
+`percent' means we are doing a linear parse through the buffer.
+`dynamic' means we are reparsing specific tags.")
(defvar semantic-minimum-working-buffer-size (* 1024 5)
"The minimum size of a buffer before working messages are displayed.
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index e099ef7902e..ee1cbcad4da 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1466,36 +1466,32 @@ Override function for `semantic-tag-protection'."
(prot nil))
;; Check the modifiers for protection if we are not a child
;; of some class type.
- (when (or (not parent) (not (eq (semantic-tag-class parent) 'type)))
- (while (and (not prot) mods)
- (if (stringp (car mods))
- (let ((s (car mods)))
- ;; A few silly defaults to get things started.
- (cond ((or (string= s "extern")
- (string= s "export"))
- 'public)
- ((string= s "static")
- 'private))))
- (setq mods (cdr mods))))
- ;; If we have a typed parent, look for :public style labels.
- (when (and parent (eq (semantic-tag-class parent) 'type))
+ (if (not (and parent (eq (semantic-tag-class parent) 'type)))
+ (while (and (not prot) mods)
+ (if (stringp (car mods))
+ (let ((s (car mods)))
+ ;; A few silly defaults to get things started.
+ (setq prot (pcase s
+ ((or "extern" "export") 'public)
+ ("static" 'private)))))
+ (setq mods (cdr mods)))
+ ;; If we have a typed parent, look for :public style labels.
(let ((pp (semantic-tag-type-members parent)))
(while (and pp (not (semantic-equivalent-tag-p (car pp) tag)))
(when (eq (semantic-tag-class (car pp)) 'label)
(setq prot
- (cond ((string= (semantic-tag-name (car pp)) "public")
- 'public)
- ((string= (semantic-tag-name (car pp)) "private")
- 'private)
- ((string= (semantic-tag-name (car pp)) "protected")
- 'protected)))
+ (pcase (semantic-tag-name (car pp))
+ ("public" 'public)
+ ("private" 'private)
+ ("protected" 'protected)))
)
(setq pp (cdr pp)))))
(when (and (not prot) (eq (semantic-tag-class parent) 'type))
(setq prot
- (cond ((string= (semantic-tag-type parent) "class") 'private)
- ((string= (semantic-tag-type parent) "struct") 'public)
- (t 'unknown))))
+ (pcase (semantic-tag-type parent)
+ ("class" 'private)
+ ("struct" 'public)
+ (_ 'unknown))))
(or prot
(if (and parent (semantic-tag-of-class-p parent 'type))
'public
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index d478b12f645..67366ad445e 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -260,7 +260,8 @@ QUOTEMODE is the mode in which quoted symbols are slurred."
(insert ")\n")))
)
-(defun bovine-grammar-parsetable-builder ()
+(define-mode-local-override semantic-grammar-parsetable-builder
+ bovine-grammar-mode ()
"Return the parser table expression as a string value.
The format of a bovine parser table is:
@@ -409,7 +410,8 @@ The source directory is relative to some root in the load path."
newdir))
(error (buffer-name))))
-(defun bovine-grammar-setupcode-builder ()
+(define-mode-local-override semantic-grammar-setupcode-builder
+ bovine-grammar-mode ()
"Return the text of the setup code."
(format
"(setq semantic--parse-table %s\n\
@@ -435,10 +437,7 @@ Menu items are appended to the common grammar menu.")
;;;###autoload
(define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY"
"Major mode for editing Bovine grammars."
- (semantic-grammar-setup-menu bovine-grammar-menu)
- (semantic-install-function-overrides
- '((semantic-grammar-parsetable-builder . bovine-grammar-parsetable-builder)
- (semantic-grammar-setupcode-builder . bovine-grammar-setupcode-builder))))
+ (semantic-grammar-setup-menu bovine-grammar-menu))
(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode))
@@ -461,7 +460,7 @@ Menu items are appended to the common grammar menu.")
(defun bovine--make-parser-1 (infile &optional outdir)
(if outdir (setq outdir (file-name-directory (expand-file-name outdir))))
;; It would be nicer to use a temp-buffer rather than find-file-noselect.
- ;; The only thing stopping us is bovine-grammar-setupcode-builder's
+ ;; The only thing stopping us is bovine's semantic-grammar-setupcode-builder's
;; use of (buffer-name). Perhaps that could be changed to
;; (file-name-nondirectory (buffer-file-name)) ?
;; (with-temp-buffer
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 5969232a054..6a09adca32d 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -224,11 +224,10 @@ HISTORY is a symbol representing a variable to story the history in."
;; @todo - move from () to into the editable area
(if (string-match ":" prompt)
- (setq prompt (concat
- (substring prompt 0 (match-beginning 0))
- " (default " default-as-string ")"
- (substring prompt (match-beginning 0))))
- (setq prompt (concat prompt " (" default-as-string "): "))))
+ (setq prompt (format-prompt
+ (substring prompt 0 (match-beginning 0))
+ default-as-string))
+ (setq prompt (format-prompt prompt default-as-string))))
;;
;; Perform the Completion
;;
@@ -1762,7 +1761,8 @@ Return a cons cell (X . Y)."
(defvar tooltip-frame-parameters)
-(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
+(declare-function tooltip-show "tooltip" (text &optional use-echo-area
+ text-face default-face))
(defun semantic-displayer-tooltip-show (text)
"Display a tooltip with TEXT near cursor."
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 73ef37ea2aa..02ebde40785 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -213,9 +213,7 @@ TOKTYPE is a hint to the type of tag desired."
(symbol-name sym)
nil ;; return type
(semantic-elisp-desymbolify arglist)
- :user-visible-flag (condition-case nil
- (interactive-form sym)
- (error nil)))))
+ :user-visible-flag (commandp sym))))
((and (eq toktype 'variable) (boundp sym))
(semantic-tag-new-variable
(symbol-name sym)
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 7f25a848918..82785ec6d2e 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -729,7 +729,7 @@ Exit the save between databases if there is user input."
(defvar semanticdb-project-predicate-functions nil
"List of predicates to try that indicate a directory belongs to a project.
This list is used when `semanticdb-persistent-path' contains the value
-'project. If the predicate list is nil, then presume all paths are valid.
+`project'. If the predicate list is nil, then presume all paths are valid.
Project Management software (such as EDE and JDE) should add their own
predicates with `add-hook' to this variable, and semanticdb will save tag
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index 41b50797221..ad215db0f63 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -391,6 +391,7 @@ etc., found in the semantic-decorate library.
To add other kind of decorations on a tag, `NAME-highlight' must use
`semantic-decorate-tag', and other functions of the semantic
decoration API found in this library."
+ (declare (indent 1))
(let ((predicate (semantic-decorate-style-predicate name))
(highlighter (semantic-decorate-style-highlighter name))
(predicatedef (semantic-decorate-style-predicate-default name))
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 38eb732e465..eb922a12507 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -82,6 +82,7 @@ users will customize.
Creates a customizable variable users can customize that will
keep semantic data structures up to date."
+ (declare (indent defun))
`(progn
;; Create a variable users can customize.
(defcustom ,name ,value
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 76230d438a1..4679500ed99 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -610,7 +610,7 @@ This function is for internal use by `semantic-edits-incremental-parser'."
(setq last-cond "Beginning of buffer")
(setq parse-start
;; Don't worry about parents since
- ;; there there would be an exact
+ ;; there would be an exact
;; match in the tag list otherwise
;; and the routine would fail.
(point-min)
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index e894022315f..92644ce0066 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -591,7 +591,7 @@ in the new list.
If optional argument SEARCH-PARTS is non-nil, all sub-parts of tags
are searched. The overloadable function `semantic-tag-components' is
used for the searching child lists. If SEARCH-PARTS is the symbol
-'positiononly, then only children that have positional information are
+`positiononly', then only children that have positional information are
searched.
If SEARCH-INCLUDES has not been implemented.
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 2ce6976d644..113323cb339 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -66,8 +66,6 @@
(defalias 'semantic-mode-line-update #'force-mode-line-update)
-;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
-;; run major mode hooks.
(define-obsolete-function-alias 'semantic-run-mode-hooks #'run-mode-hooks "28.1")
;; Fancy compat usage now handled in cedet-compat
@@ -193,12 +191,20 @@ will throw a warning when it encounters this symbol."
(not (string-match "cedet" (macroexp-file-name)))
)
(make-obsolete-overload oldfnalias newfn when)
- (byte-compile-warn
- "%s: `%s' obsoletes overload `%s'"
- (macroexp-file-name)
- newfn
- (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
- (semantic-overload-symbol-from-function oldfnalias)))))
+ (if (fboundp 'byte-compile-warn-x)
+ (byte-compile-warn-x
+ newfn
+ "%s: `%s' obsoletes overload `%s'"
+ (macroexp-file-name)
+ newfn
+ (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
+ (semantic-overload-symbol-from-function oldfnalias)))
+ (byte-compile-warn
+ "%s: `%s' obsoletes overload `%s'"
+ (macroexp-file-name)
+ newfn
+ (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
+ (semantic-overload-symbol-from-function oldfnalias))))))
(defun semantic-varalias-obsolete (oldvaralias newvar when)
"Make OLDVARALIAS an alias for variable NEWVAR.
@@ -211,10 +217,14 @@ will throw a warning when it encounters this symbol."
(error
;; Only throw this warning when byte compiling things.
(when (macroexp-compiling-p)
- (byte-compile-warn
- "variable `%s' obsoletes, but isn't alias of `%s'"
- newvar oldvaralias)
- ))))
+ (if (fboundp 'byte-compile-warn-x)
+ (byte-compile-warn-x
+ newvar
+ "variable `%s' obsoletes, but isn't alias of `%s'"
+ newvar oldvaralias)
+ (byte-compile-warn
+ "variable `%s' obsoletes, but isn't alias of `%s'"
+ newvar oldvaralias))))))
;;; Help debugging
;;
@@ -277,7 +287,8 @@ later installation should be done in MODE hook."
(cons (intern (format "semantic-%s" name)) (cdr e)))))
overrides)
(list 'constant-flag (not transient)
- 'override-flag t)))
+ 'override-flag t)
+ nil))
;;; User Interrupt handling
;;
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 74d4a229fac..97456265ead 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1123,8 +1123,6 @@ END is the limit of the search."
;;;; Define major mode
;;;;
-(define-obsolete-variable-alias 'semantic-grammar-syntax-table
- 'semantic-grammar-mode-syntax-table "24.1")
(defvar semantic-grammar-mode-syntax-table
(let ((table (make-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?\: "." table) ;; COLON
@@ -1197,8 +1195,6 @@ END is the limit of the search."
semantic-grammar-mode-keywords-1
"Font Lock keywords used to highlight Semantic grammar buffers.")
-(define-obsolete-variable-alias 'semantic-grammar-map
- 'semantic-grammar-mode-map "24.1")
(defvar semantic-grammar-mode-map
(let ((km (make-sparse-keymap)))
diff --git a/lisp/cedet/semantic/grm-wy-boot.el b/lisp/cedet/semantic/grm-wy-boot.el
index f61bcbdef9a..376fab89c23 100644
--- a/lisp/cedet/semantic/grm-wy-boot.el
+++ b/lisp/cedet/semantic/grm-wy-boot.el
@@ -149,10 +149,10 @@
((type_decl))
((use_macros_decl)))
(default_prec_decl
- ((DEFAULT-PREC)
- `(wisent-raw-tag
- (semantic-tag "default-prec" 'assoc :value
- '("t")))))
+ ((DEFAULT-PREC)
+ `(wisent-raw-tag
+ (semantic-tag "default-prec" 'assoc :value
+ '("t")))))
(no_default_prec_decl
((NO-DEFAULT-PREC)
`(wisent-raw-tag
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
index 718ce3c4c74..00e19dbc892 100644
--- a/lisp/cedet/semantic/html.el
+++ b/lisp/cedet/semantic/html.el
@@ -82,6 +82,11 @@ or
tag :members (mapcar #'semantic-html-expand-tag chil)))
(car (semantic--tag-expand tag))))
+(define-mode-local-override semantic-tag-components html-mode (tag)
+ "Return components belonging to TAG."
+ ;; Keep this η-regexp because `semantic-html-components' is called
+ ;; from elsewhere.
+ (semantic-html-components tag))
(defun semantic-html-components (tag)
"Return components belonging to TAG."
(semantic-tag-get-attribute tag :members))
@@ -245,12 +250,7 @@ tag with greater section value than LEVEL is found."
senator-step-at-start-end-tag-classes '(section)
senator-step-at-tag-classes '(section)
semantic-stickyfunc-sticky-classes '(section)
- )
- (semantic-install-function-overrides
- '((semantic-tag-components . semantic-html-components)
- )
- t)
- )
+ ))
;; `html-helper-mode' hasn't been updated since 2004, so it's not very
;; relevant nowadays.
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 235965a9955..37dc9632729 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -39,7 +39,8 @@
(require 'semantic/sort)
(require 'imenu)
-(declare-function pulse-momentary-highlight-one-line "pulse" (o &optional face))
+(declare-function pulse-momentary-highlight-one-line "pulse"
+ (&optional point face))
(declare-function semanticdb-semantic-init-hook-fcn "db-mode")
;; Because semantic imenu tags will hose the current imenu handling
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index a7c02032e22..53fd4de2975 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -37,25 +37,24 @@
;;; Lexical analysis
;;
(defconst semantic-java-number-regexp
- (eval-when-compile
- (concat "\\("
- "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
- "\\|"
- "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
- "\\|"
- "\\<[0-9]+[.][fFdD]\\>"
- "\\|"
- "\\<[0-9]+[.]"
- "\\|"
- "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
- "\\|"
- "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
- "\\|"
- "\\<0[xX][[:xdigit:]]+[lL]?\\>"
- "\\|"
- "\\<[0-9]+[lLfFdD]?\\>"
- "\\)"
- ))
+ (concat "\\("
+ "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
+ "\\|"
+ "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
+ "\\|"
+ "\\<[0-9]+[.][fFdD]\\>"
+ "\\|"
+ "\\<[0-9]+[.]"
+ "\\|"
+ "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
+ "\\|"
+ "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
+ "\\|"
+ "\\<0[xX][[:xdigit:]]+[lL]?\\>"
+ "\\|"
+ "\\<[0-9]+[lLfFdD]?\\>"
+ "\\)"
+ )
"Lexer regexp to match Java number terminals.
Following is the specification of Java number literals.
@@ -391,7 +390,7 @@ That is TAG `symbol-name' without the leading `@'."
Return the list of FUN results. If optional PROPERTY is non-nil only
call FUN for javadoc keywords which have a value for PROPERTY. FUN
receives two arguments: the javadoc keyword and its associated
-'javadoc property list. It can return any value. All nil values are
+`javadoc' property list. It can return any value. All nil values are
removed from the result list."
(delq nil
(mapcar
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 5912a887848..4bdaaf77acf 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -726,7 +726,7 @@ Returns position with the end of that macro."
(point))))))
(defun semantic-lex-spp-get-overlay (&optional point)
- "Return first overlay which has a 'semantic-spp property."
+ "Return first overlay which has a `semantic-spp' property."
(let ((overlays (overlays-at (or point (point)))))
(while (and overlays
(null (overlay-get (car overlays) 'semantic-spp)))
@@ -1074,7 +1074,7 @@ and variable state from the current buffer."
))
;; Second Cheat: copy key variables regarding macro state from the
- ;; the originating buffer we are parsing. We need to do this every time
+ ;; originating buffer we are parsing. We need to do this every time
;; since the state changes.
(dolist (V important-vars)
(set V (buffer-local-value V origbuff)))
@@ -1165,7 +1165,8 @@ of type `spp-macro-def' is to be created.
VALFORM are forms that return the value to be saved for this macro, or nil.
When implementing a macro, you can use `semantic-lex-spp-stream-for-macro'
to convert text into a lexical stream for storage in the macro."
- (declare (debug (&define name stringp stringp form def-body)))
+ (declare (debug (&define name stringp stringp form def-body))
+ (indent 1))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
@@ -1199,7 +1200,8 @@ REGEXP is a regular expression for the analyzer to match.
See `define-lex-regex-analyzer' for more on regexp.
TOKIDX is an index into REGEXP for which a new lexical token
of type `spp-macro-undef' is to be created."
- (declare (debug (&define name stringp stringp form)))
+ (declare (debug (&define name stringp stringp form))
+ (indent 1))
(let ((start (make-symbol "start"))
(end (make-symbol "end")))
`(define-lex-regex-analyzer ,name
@@ -1260,7 +1262,8 @@ type of include. The return value should be of the form:
(NAME . TYPE)
where NAME is the name of the include, and TYPE is the type of the include,
where a valid symbol is `system', or nil."
- (declare (debug (&define name stringp stringp form def-body)))
+ (declare (debug (&define name stringp stringp form def-body))
+ (indent 1))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 72864a8da52..9c64cc9f7e5 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -574,25 +574,24 @@ may need to be overridden for some special languages.")
(defvar-local semantic-lex-number-expression
;; This expression was written by David Ponce for Java, and copied
;; here for C and any other similar language.
- (eval-when-compile
- (concat "\\("
- "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
- "\\|"
- "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
- "\\|"
- "\\<[0-9]+[.][fFdD]\\>"
- "\\|"
- "\\<[0-9]+[.]"
- "\\|"
- "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
- "\\|"
- "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
- "\\|"
- "\\<0[xX][[:xdigit:]]+[lL]?\\>"
- "\\|"
- "\\<[0-9]+[lLfFdD]?\\>"
- "\\)"
- ))
+ (concat "\\("
+ "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
+ "\\|"
+ "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
+ "\\|"
+ "\\<[0-9]+[.][fFdD]\\>"
+ "\\|"
+ "\\<[0-9]+[.]"
+ "\\|"
+ "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
+ "\\|"
+ "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
+ "\\|"
+ "\\<0[xX][[:xdigit:]]+[lL]?\\>"
+ "\\|"
+ "\\<[0-9]+[lLfFdD]?\\>"
+ "\\)"
+ )
"Regular expression for matching a number.
If this value is nil, no number extraction is done during lex.
This expression tries to match C and Java like numbers.
@@ -760,7 +759,7 @@ If two analyzers can match the same text, it is important to order the
analyzers so that the one you want to match first occurs first. For
example, it is good to put a number analyzer in front of a symbol
analyzer which might mistake a number for a symbol."
- (declare (debug (&define name stringp (&rest symbolp))))
+ (declare (debug (&define name stringp (&rest symbolp))) (indent 1))
`(defun ,name (start end &optional depth length)
,(concat doc "\nSee `semantic-lex' for more information.")
;; Make sure the state of block parsing starts over.
@@ -1096,7 +1095,7 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to
after the location of the analyzed entry, and to add any discovered tokens
at the beginning of `semantic-lex-token-stream'.
This can be done by using `semantic-lex-push-token'."
- (declare (debug (&define name stringp form def-body)))
+ (declare (debug (&define name stringp form def-body)) (indent 1))
`(eval-and-compile
;; This is the real info used by `define-lex' (via semantic-lex-one-token).
(defconst ,name '(,condition ,@forms) ,doc)
@@ -1118,7 +1117,7 @@ This can be done by using `semantic-lex-push-token'."
"Create a lexical analyzer with NAME and DOC that will match REGEXP.
FORMS are evaluated upon a successful match.
See `define-lex-analyzer' for more about analyzers."
- (declare (debug (&define name stringp form def-body)))
+ (declare (debug (&define name stringp form def-body)) (indent 1))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@@ -1137,7 +1136,8 @@ FORMS are evaluated upon a successful match BEFORE the new token is
created. It is valid to ignore FORMS.
See `define-lex-analyzer' for more about analyzers."
(declare (debug
- (&define name stringp form symbolp [ &optional form ] def-body)))
+ (&define name stringp form symbolp [ &optional form ] def-body))
+ (indent 1))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@@ -1162,7 +1162,8 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM
and CLOSE-DELIM are respectively the open and close delimiters
identifying a block. OPEN-SYM and CLOSE-SYM are respectively the
symbols returned in open and close tokens."
- (declare (debug (&define name stringp form (&rest form))))
+ (declare (debug (&define name stringp form (&rest form)))
+ (indent 1))
(let ((specs (cons spec1 specs))
spec open olist clist)
(while specs
@@ -1471,6 +1472,7 @@ syntax as specified by the syntax table."
(defmacro define-lex-keyword-type-analyzer (name doc syntax)
"Define a keyword type analyzer NAME with DOC string.
SYNTAX is the regexp that matches a keyword syntactic expression."
+ (declare (indent 1))
(let ((key (make-symbol "key")))
`(define-lex-analyzer ,name
,doc
@@ -1486,6 +1488,7 @@ SYNTAX is the regexp that matches a keyword syntactic expression."
"Define a sexp type analyzer NAME with DOC string.
SYNTAX is the regexp that matches the beginning of the s-expression.
TOKEN is the lexical token returned when SYNTAX matches."
+ (declare (indent 1))
`(define-lex-regex-analyzer ,name
,doc
,syntax
@@ -1504,6 +1507,7 @@ SYNTAX is the regexp that matches a syntactic expression.
MATCHES is an alist of lexical elements used to refine the syntactic
expression.
DEFAULT is the default lexical token returned when no MATCHES."
+ (declare (indent 1))
(if matches
(let* ((val (make-symbol "val"))
(lst (make-symbol "lst"))
@@ -1536,6 +1540,7 @@ SYNTAX is the regexp that matches a syntactic expression.
MATCHES is an alist of lexical elements used to refine the syntactic
expression.
DEFAULT is the default lexical token returned when no MATCHES."
+ (declare (indent 1))
(if matches
(let* ((val (make-symbol "val"))
(lst (make-symbol "lst"))
@@ -1633,6 +1638,7 @@ When the lexer encounters the open-paren delimiter \"(\":
- If the maximum depth of parenthesis tracking is reached (current
depth >= max depth), it returns the whole parenthesis block as
a (PAREN_BLOCK start . end) token."
+ (declare (indent 1))
(let* ((val (make-symbol "val"))
(lst (make-symbol "lst"))
(elt (make-symbol "elt")))
diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el
index ebc4159a4c5..1d16b024a5e 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -735,12 +735,9 @@ yanked to."
Optional argument KILL-FLAG will delete the text of the tag to the
kill ring.
-Interactively, reads the register using `register-read-with-preview',
-if available."
- (interactive (list (if (fboundp 'register-read-with-preview)
- (register-read-with-preview "Tag to register: ")
- (read-char "Tag to register: "))
- current-prefix-arg))
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Tag to register: ")
+ current-prefix-arg))
(semantic-fetch-tags)
(let ((ft (semantic-obtain-foreign-tag)))
(when ft
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index 1503a766dc8..756b949c0d1 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -310,7 +310,7 @@ may re-organize the list with side-effects."
;; class tag.
;;
(defvar-local semantic-orphaned-member-metaparent-type "class"
- "In `semantic-adopt-external-members', the type of 'type for metaparents.
+ "In `semantic-adopt-external-members', the type of `type' for metaparents.
A metaparent is a made-up type semantic token used to hold the child list
of orphaned members of a named type.")
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index ba236059f66..e48cefa4ca6 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -101,7 +101,7 @@ Where PREDICATE is a function that takes a directory name for the
root of a project, and returns non-nil if the tool represented by KEY
is supported.
-If no tools are supported, then 'grep is assumed.")
+If no tools are supported, then `grep' is assumed.")
(defun semantic-symref-calculate-rootdir ()
"Calculate the root directory for a symref search.
@@ -475,7 +475,7 @@ already."
Return the Semantic tag associated with HIT.
SEARCHTXT is the text that is being searched for.
Used to narrow the in-buffer search.
-SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+SEARCHTYPE is the type of search (such as `symbol' or `tagname').
If there is no database, or if the searchtype is wrong, return nil."
;; Allowed search types for this mechanism:
;; tagname, tagregexp, tagcompletions
@@ -506,7 +506,7 @@ If there is no database, or if the searchtype is wrong, return nil."
Return the Semantic tag associated with HIT.
SEARCHTXT is the text that is being searched for.
Used to narrow the in-buffer search.
-SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+SEARCHTYPE is the type of search (such as `symbol' or `tagname').
Optional OPEN-BUFFERS, when nil will use a faster version of
`find-file' when a file needs to be opened. If non-nil, then
normal buffer initialization will be used.
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
index 1917bcb40a6..d005b7a854c 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -55,20 +55,17 @@ The field position is the field number (based at 1) where the
name of this section is.")
;;; Code:
-(defun semantic-texi-parse-region (&rest _ignore)
+(define-mode-local-override semantic-parse-region texinfo-mode (&rest _ignore)
"Parse the current texinfo buffer for semantic tags.
IGNORE any arguments, always parse the whole buffer.
Each tag returned is of the form:
(\"NAME\" section (:members CHILDREN))
or
- (\"NAME\" def)
-
-It is an override of `semantic-parse-region' and must be installed by the
-function `semantic-install-function-overrides'."
+ (\"NAME\" def)"
(mapcar #'semantic-texi-expand-tag
(semantic-texi-parse-headings)))
-(defun semantic-texi-parse-changes ()
+(define-mode-local-override semantic-parse-changes texinfo-mode ()
"Parse changes in the current texinfo buffer."
;; NOTE: For now, just schedule a full reparse.
;; To be implemented later.
@@ -445,9 +442,6 @@ that start with that symbol."
(defun semantic-default-texi-setup ()
"Set up a buffer for parsing of Texinfo files."
;; This will use our parser.
- (semantic-install-function-overrides
- '((semantic-parse-region . semantic-texi-parse-region)
- (semantic-parse-changes . semantic-texi-parse-changes)))
(setq semantic-parser-name "TEXI"
;; Setup a dummy parser table to enable parsing!
semantic--parse-table t
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 454ddde219b..55eeef453ea 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -66,7 +66,7 @@ Returned tokens must have the form:
(TOKSYM VALUE START . END)
where VALUE is the buffer substring between START and END positions."
- (declare (debug (&define name stringp def-body)))
+ (declare (debug (&define name stringp def-body)) (indent 1))
`(defun
,name () ,doc
(cond
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index f842b3c364b..ba67d250604 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -65,6 +65,7 @@
(defmacro wisent-defcontext (name &rest vars)
"Define a context NAME that will bind variables VARS."
(declare (indent 1))
+ (declare-function wisent-context-name nil (name))
(let* ((context (wisent-context-name name))
(declarations (mapcar (lambda (v) (list 'defvar v)) vars)))
`(progn
@@ -75,6 +76,7 @@
(defmacro wisent-with-context (name &rest body)
"Bind variables in context NAME then eval BODY."
(declare (indent 1))
+ (declare-function wisent-context-bindings nil (name))
`(dlet ,(wisent-context-bindings name)
,@body))
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index 5ca22bac86c..a4104e333d3 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -284,13 +284,15 @@ Return the expanded expression."
(assocs (wisent-grammar-assocs)))
(cons terminals (cons assocs nonterminals))))
-(defun wisent-grammar-parsetable-builder ()
+(define-mode-local-override semantic-grammar-parsetable-builder
+ wisent-grammar-mode ()
"Return the value of the parser table."
`(wisent-compiled-grammar
,(wisent-grammar-grammar)
,(semantic-grammar-start)))
-(defun wisent-grammar-setupcode-builder ()
+(define-mode-local-override semantic-grammar-setupcode-builder
+ wisent-grammar-mode ()
"Return the parser setup code."
(format
"(semantic-install-function-overrides\n\
@@ -322,10 +324,7 @@ Menu items are appended to the common grammar menu.")
(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
"Major mode for editing Wisent grammars."
(semantic-grammar-setup-menu wisent-grammar-menu)
- (setq-local semantic-grammar-require-form '(require 'semantic/wisent))
- (semantic-install-function-overrides
- '((semantic-grammar-parsetable-builder . wisent-grammar-parsetable-builder)
- (semantic-grammar-setupcode-builder . wisent-grammar-setupcode-builder))))
+ (setq-local semantic-grammar-require-form '(require 'semantic/wisent)))
(defvar-mode-local wisent-grammar-mode semantic-grammar-macros
'(
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index 50b0e150ff3..c297429e408 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -246,7 +246,7 @@ that class.
class => @code{class} @xref{class}
unknown => @code{unknown}
\"text\" => \\=`\\=`text\\='\\='
- 'quoteme => @code{quoteme}
+ \\='quoteme => @code{quoteme}
non-nil => non-@code{nil}
t => @code{t}
:tag => @code{:tag}
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index 3eea630aa71..05ae52cae0d 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -26,6 +26,7 @@
(eval-and-compile
(put 'char-fold-table 'char-table-extra-slots 1)
+ (defconst char-fold--default-override nil)
(defconst char-fold--default-include
'((?\" """ "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝" "❠" "“" "„" "〝" "〟" "🙷" "🙶" "🙸" "«" "»")
(?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "󠀢" "❮" "❯" "‹" "›")
@@ -40,7 +41,8 @@
))
(defconst char-fold--default-symmetric nil)
(defvar char-fold--previous
- (list char-fold--default-include
+ (list char-fold--default-override
+ char-fold--default-include
char-fold--default-exclude
char-fold--default-symmetric)))
@@ -67,48 +69,50 @@
;; - A single char of the decomp might be allowed to match the
;; character.
;; Some examples in the comments below.
- (map-char-table
- (lambda (char decomp)
- (when (consp decomp)
- ;; Skip trivial cases like ?a decomposing to (?a).
- (unless (and (not (cdr decomp))
- (eq char (car decomp)))
- (if (symbolp (car decomp))
- ;; Discard a possible formatting tag.
- (setq decomp (cdr decomp))
- ;; If there's no formatting tag, ensure that char matches
- ;; its decomp exactly. This is because we want 'ä' to
- ;; match 'ä', but we don't want '¹' to match '1'.
- (aset equiv char
- (cons (apply #'string decomp)
- (aref equiv char))))
-
- ;; Allow the entire decomp to match char. If decomp has
- ;; multiple characters, this is done by adding an entry
- ;; to the alist of the first character in decomp. This
- ;; allows 'ff' to match 'ff', 'ä' to match 'ä', and '1' to
- ;; match '¹'.
- (let ((make-decomp-match-char
- (lambda (decomp char)
- (if (cdr decomp)
- (aset equiv-multi (car decomp)
- (cons (cons (apply #'string (cdr decomp))
- (regexp-quote (string char)))
- (aref equiv-multi (car decomp))))
- (aset equiv (car decomp)
- (cons (char-to-string char)
- (aref equiv (car decomp))))))))
- (funcall make-decomp-match-char decomp char)
- ;; Check to see if the first char of the decomposition
- ;; has a further decomposition. If so, add a mapping
- ;; back from that second decomposition to the original
- ;; character. This allows e.g. 'ι' (GREEK SMALL LETTER
- ;; IOTA) to match both the Basic Greek block and
- ;; Extended Greek block variants of IOTA +
- ;; diacritical(s). Repeat until there are no more
- ;; decompositions.
- (let ((dec decomp)
- next-decomp)
+ (unless (or (bound-and-true-p char-fold-override)
+ char-fold--default-override)
+ (map-char-table
+ (lambda (char decomp)
+ (when (consp decomp)
+ ;; Skip trivial cases like ?a decomposing to (?a).
+ (unless (and (not (cdr decomp))
+ (eq char (car decomp)))
+ (if (symbolp (car decomp))
+ ;; Discard a possible formatting tag.
+ (setq decomp (cdr decomp))
+ ;; If there's no formatting tag, ensure that char matches
+ ;; its decomp exactly. This is because we want 'ä' to
+ ;; match 'ä', but we don't want '¹' to match '1'.
+ (aset equiv char
+ (cons (apply #'string decomp)
+ (aref equiv char))))
+
+ ;; Allow the entire decomp to match char. If decomp has
+ ;; multiple characters, this is done by adding an entry
+ ;; to the alist of the first character in decomp. This
+ ;; allows 'ff' to match 'ff', 'ä' to match 'ä', and '1' to
+ ;; match '¹'.
+ (let ((make-decomp-match-char
+ (lambda (decomp char)
+ (if (cdr decomp)
+ (aset equiv-multi (car decomp)
+ (cons (cons (apply #'string (cdr decomp))
+ (regexp-quote (string char)))
+ (aref equiv-multi (car decomp))))
+ (aset equiv (car decomp)
+ (cons (char-to-string char)
+ (aref equiv (car decomp))))))))
+ (funcall make-decomp-match-char decomp char)
+ ;; Check to see if the first char of the decomposition
+ ;; has a further decomposition. If so, add a mapping
+ ;; back from that second decomposition to the original
+ ;; character. This allows e.g. 'ι' (GREEK SMALL LETTER
+ ;; IOTA) to match both the Basic Greek block and
+ ;; Extended Greek block variants of IOTA +
+ ;; diacritical(s). Repeat until there are no more
+ ;; decompositions.
+ (let ((dec decomp)
+ next-decomp)
(while dec
(setq next-decomp (char-table-range table (car dec)))
(when (consp next-decomp)
@@ -118,24 +122,24 @@
(car next-decomp)))
(funcall make-decomp-match-char (list (car next-decomp)) char)))
(setq dec next-decomp)))
- ;; Do it again, without the non-spacing characters.
- ;; This allows 'a' to match 'ä'.
- (let ((simpler-decomp nil)
- (found-one nil))
- (dolist (c decomp)
- (if (> (get-char-code-property c 'canonical-combining-class) 0)
- (setq found-one t)
- (push c simpler-decomp)))
- (when (and simpler-decomp found-one)
- (funcall make-decomp-match-char simpler-decomp char)
- ;; Finally, if the decomp only had one spacing
- ;; character, we allow this character to match the
- ;; decomp. This is to let 'a' match 'ä'.
- (unless (cdr simpler-decomp)
- (aset equiv (car simpler-decomp)
- (cons (apply #'string decomp)
- (aref equiv (car simpler-decomp)))))))))))
- table)
+ ;; Do it again, without the non-spacing characters.
+ ;; This allows 'a' to match 'ä'.
+ (let ((simpler-decomp nil)
+ (found-one nil))
+ (dolist (c decomp)
+ (if (> (get-char-code-property c 'canonical-combining-class) 0)
+ (setq found-one t)
+ (push c simpler-decomp)))
+ (when (and simpler-decomp found-one)
+ (funcall make-decomp-match-char simpler-decomp char)
+ ;; Finally, if the decomp only had one spacing
+ ;; character, we allow this character to match the
+ ;; decomp. This is to let 'a' match 'ä'.
+ (unless (cdr simpler-decomp)
+ (aset equiv (car simpler-decomp)
+ (cons (apply #'string decomp)
+ (aref equiv (car simpler-decomp)))))))))))
+ table))
;; Add some entries to default decomposition
(dolist (it (or (bound-and-true-p char-fold-include)
@@ -232,7 +236,9 @@ Exceptionally for the space character (32), ALIST is ignored.")
(defun char-fold-update-table ()
"Update char-fold-table only when one of the options changes its value."
- (let ((new (list (or (bound-and-true-p char-fold-include)
+ (let ((new (list (or (bound-and-true-p char-fold-override)
+ char-fold--default-override)
+ (or (bound-and-true-p char-fold-include)
char-fold--default-include)
(or (bound-and-true-p char-fold-exclude)
char-fold--default-exclude)
@@ -242,6 +248,22 @@ Exceptionally for the space character (32), ALIST is ignored.")
(setq char-fold-table (char-fold--make-table)
char-fold--previous new))))
+(defcustom char-fold-override char-fold--default-override
+ "Non-nil means to override the default definitions of equivalent characters.
+When nil (the default), the table of character equivalences used
+for character-folding is populated with the default set of equivalent
+characters; customize `char-fold-exclude' to remove unneeded equivalences,
+and `char-fold-include' to add your own.
+When this variable is non-nil, the table of equivalences starts empty,
+and you can add your own equivalences by customizing `char-fold-include'."
+ :type 'boolean
+ :initialize #'custom-initialize-default
+ :set (lambda (sym val)
+ (custom-set-default sym val)
+ (char-fold-update-table))
+ :group 'isearch
+ :version "29.1")
+
(defcustom char-fold-include char-fold--default-include
"Additional character foldings to include.
Each entry is a list of a character and the strings that fold into it."
diff --git a/lisp/chistory.el b/lisp/chistory.el
index 33b21422114..9dce60a19fe 100644
--- a/lisp/chistory.el
+++ b/lisp/chistory.el
@@ -119,8 +119,6 @@ The buffer is left in Command History mode."
(error "No command history")
(command-history-mode)))))
-(define-obsolete-variable-alias 'command-history-map
- 'command-history-mode-map "24.1")
(defvar command-history-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap lisp-mode-shared-map
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index ae4354fbbcf..22a465f5b61 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -195,6 +195,7 @@ to continue it."
(scheme-mode-variables)
(setq mode-line-process '(":%s"))
(setq comint-input-filter (function scheme-input-filter))
+ (setq-local comint-prompt-read-only t)
(setq comint-get-old-input (function scheme-get-old-input)))
(defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
@@ -237,7 +238,7 @@ is run).
(inferior-scheme-mode)))
(setq scheme-program-name cmd)
(setq scheme-buffer "*scheme*")
- (pop-to-buffer-same-window "*scheme*"))
+ (pop-to-buffer "*scheme*" display-comint-buffer-action))
(defun scheme-start-file (prog)
"Return the name of the start file corresponding to PROG.
@@ -245,7 +246,8 @@ Search in the directories \"~\" and `user-emacs-directory',
in this order. Return nil if no start file found."
(let* ((progname (file-name-nondirectory prog))
(start-file (concat "~/.emacs_" progname))
- (alt-start-file (concat user-emacs-directory "init_" progname ".scm")))
+ (alt-start-file (locate-user-emacs-file
+ (concat "init_" progname ".scm"))))
(if (file-exists-p start-file)
start-file
(and (file-exists-p alt-start-file) alt-start-file))))
@@ -356,7 +358,7 @@ With argument, position cursor at end of buffer."
(interactive "P")
(if (or (and scheme-buffer (get-buffer scheme-buffer))
(scheme-interactively-start-process))
- (pop-to-buffer-same-window scheme-buffer)
+ (pop-to-buffer scheme-buffer display-comint-buffer-action)
(error "No current process buffer. See variable `scheme-buffer'"))
(when eob-p
(push-mark)
diff --git a/lisp/color.el b/lisp/color.el
index ef3a2f58362..410659869ae 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -407,7 +407,7 @@ See `color-desaturate-hsl'."
Given a color defined in terms of hue, saturation, and luminance
\(arguments H, S, and L), return a color that is PERCENT lighter.
Returns a list (HUE SATURATION LUMINANCE)."
- (list H S (color-clamp (+ L (/ percent 100.0)))))
+ (list H S (color-clamp (+ L (* L (/ percent 100.0))))))
(defun color-lighten-name (name percent)
"Make a color with a specified NAME lighter by PERCENT.
diff --git a/lisp/comint.el b/lisp/comint.el
index 782833cc8fd..d52623c00ae 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -330,12 +330,12 @@ This variable is buffer-local in all Comint buffers."
"The maximum size in lines for Comint buffers.
Comint buffers are truncated from the top to be no greater than this number, if
the function `comint-truncate-buffer' is on `comint-output-filter-functions'."
- :type 'integer
+ :type 'natnum
:group 'comint)
(defcustom comint-input-ring-size 500
"Size of the input history ring in `comint-mode'."
- :type 'integer
+ :type 'natnum
:group 'comint
:version "23.2")
@@ -385,10 +385,12 @@ This variable is buffer-local."
"\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[::៖][[:space:]]*\\'"
;; The ccrypt encryption dialogue doesn't end with a colon, so
;; treat it specially.
- "\\|^Enter encryption key: (repeat) *\\'")
+ "\\|^Enter encryption key: (repeat) *\\'"
+ ;; openssh-8.6p1 format: "(user@host) Password:".
+ "\\|^([^)@ \t\n]+@[^)@ \t\n]+) Password: *\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
- :version "28.1"
+ :version "29.1"
:type 'regexp
:group 'comint)
@@ -728,6 +730,8 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
(or (file-remote-p default-directory) ""))
(setq-local comint-accum-marker (make-marker))
(setq-local font-lock-defaults '(nil t))
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'comint--unmark-string-as-output)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t)
(add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)
@@ -889,12 +893,13 @@ series of processes in the same Comint buffer. The hook
;; and there is no way for us to define it here.
;; Some programs that use terminfo get very confused
;; if TERM is not a valid terminal type.
- (if (and (boundp 'system-uses-terminfo) system-uses-terminfo)
- (list (format "TERM=%s" comint-terminfo-terminal)
- "TERMCAP="
- (format "COLUMNS=%d" (window-width)))
- (list "TERM=emacs"
- (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width)))))
+ (with-connection-local-variables
+ (if system-uses-terminfo
+ (list (format "TERM=%s" comint-terminfo-terminal)
+ "TERMCAP="
+ (format "COLUMNS=%d" (window-width)))
+ (list "TERM=emacs"
+ (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width))))))
(defun comint-nonblank-p (str)
"Return non-nil if STR contains non-whitespace syntax."
@@ -1105,7 +1110,8 @@ See also `comint-read-input-ring'."
(use-local-map keymap))
(forward-line 3)
(while (search-backward "completion" nil 'move)
- (replace-match "history reference")))
+ (replace-match (apply #'propertize "history reference"
+ (text-properties-at (point))))))
(sit-for 0)
(message "Hit space to flush")
(setq comint-dynamic-list-input-ring-window-conf conf)
@@ -1460,7 +1466,7 @@ A useful command to bind to SPC. See `comint-replace-by-expanded-history'."
(defcustom comint-history-isearch nil
"Non-nil to Isearch in input history only, not in comint buffer output.
-If t, usual Isearch keys like `C-r' and `C-M-r' in comint mode search
+If t, usual Isearch keys like \\`C-r' and \\`C-M-r' in comint mode search
in the input history.
If `dwim', Isearch keys search in the input history only when initial
point position is at the comint command line. When starting Isearch
@@ -1510,6 +1516,7 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
#'comint-history-isearch-wrap)
(setq-local isearch-push-state-function
#'comint-history-isearch-push-state)
+ (setq-local isearch-lazy-count nil)
(add-hook 'isearch-mode-end-hook 'comint-history-isearch-end nil t)))
(defun comint-history-isearch-end ()
@@ -1521,6 +1528,7 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
(setq isearch-message-function nil)
(setq isearch-wrap-function nil)
(setq isearch-push-state-function nil)
+ (kill-local-variable 'isearch-lazy-count)
(remove-hook 'isearch-mode-end-hook 'comint-history-isearch-end t)
(unless isearch-suspended
(custom-reevaluate-setting 'comint-history-isearch)))
@@ -1812,7 +1820,8 @@ Ignore duplicates if `comint-input-ignoredups' is non-nil."
(ring-insert comint-input-ring cmd)))
(defconst comint--prompt-rear-nonsticky
- '(field inhibit-line-move-field-capture read-only font-lock-face)
+ '( field inhibit-line-move-field-capture read-only font-lock-face
+ insert-in-front-hooks)
"Text properties we set on the prompt and don't want to leak past it.")
(defun comint-send-input (&optional no-newline artificial)
@@ -1904,6 +1913,14 @@ Similarly for Soar, Scheme, etc."
(delete-region pmark start)
copy))))
+ ;; Delete and reinsert input. This seems like a no-op, except
+ ;; for the resulting entries in the undo list: undoing this
+ ;; insertion will delete the region, moving the process mark
+ ;; back to its original position.
+ (let ((inhibit-read-only t))
+ (delete-region pmark (point))
+ (insert input))
+
(unless no-newline
(insert ?\n))
@@ -1947,7 +1964,7 @@ Similarly for Soar, Scheme, etc."
;; in case we get output amidst sending the input.
(set-marker comint-last-input-start pmark)
(set-marker comint-last-input-end (point))
- (set-marker (process-mark proc) (point))
+ (set-marker pmark (point))
;; clear the "accumulation" marker
(set-marker comint-accum-marker nil)
(let ((comint-input-sender-no-newline no-newline))
@@ -2022,7 +2039,7 @@ the start, the cdr to the end of the last prompt recognized.")
Freezes the `font-lock-face' text property in place."
(when comint-last-prompt
(with-silent-modifications
- (font-lock-prepend-text-property
+ (font-lock-append-text-property
(car comint-last-prompt)
(cdr comint-last-prompt)
'font-lock-face 'comint-highlight-prompt))
@@ -2141,14 +2158,7 @@ Make backspaces delete the previous character."
(goto-char (process-mark process)) ; In case a filter moved it.
(unless comint-use-prompt-regexp
- (with-silent-modifications
- (add-text-properties comint-last-output-start (point)
- `(rear-nonsticky
- ,comint--prompt-rear-nonsticky
- front-sticky
- (field inhibit-line-move-field-capture)
- field output
- inhibit-line-move-field-capture t))))
+ (comint--mark-as-output comint-last-output-start (point)))
;; Highlight the prompt, where we define `prompt' to mean
;; the most recent output that doesn't end with a newline.
@@ -2180,6 +2190,46 @@ Make backspaces delete the previous character."
,comint--prompt-rear-nonsticky)))
(goto-char saved-point)))))))
+(defun comint--mark-as-output (beg end)
+ (with-silent-modifications
+ (add-text-properties
+ beg end
+ `(rear-nonsticky
+ ,comint--prompt-rear-nonsticky
+ front-sticky
+ (field inhibit-line-move-field-capture)
+ field output
+ inhibit-line-move-field-capture t
+ ;; Text inserted by a user in the middle of process output
+ ;; should be marked as output. This is needed for commands
+ ;; such as `yank' or `just-one-space' which don't use
+ ;; `insert-and-inherit' and thus bypass default text property
+ ;; inheritance.
+ insert-in-front-hooks
+ (,#'comint--mark-as-output ,#'comint--mark-yanked-as-output)))))
+
+(defun comint--mark-yanked-as-output (beg end)
+ ;; `yank' removes the field text property from the text it inserts
+ ;; due to `yank-excluded-properties', so arrange for this text
+ ;; property to be reapplied in the `after-change-functions'.
+ (let (fun)
+ (setq
+ fun
+ (lambda (beg1 end1 _len1)
+ (remove-hook 'after-change-functions fun t)
+ (when (and (= beg beg1)
+ (= end end1))
+ (comint--mark-as-output beg1 end1))))
+ (add-hook 'after-change-functions fun nil t)))
+
+(defun comint--unmark-string-as-output (string)
+ (remove-list-of-text-properties
+ 0 (length string)
+ '( rear-nonsticky front-sticky field
+ inhibit-line-move-field-capture insert-in-front-hooks)
+ string)
+ string)
+
(defun comint-preinput-scroll-to-bottom ()
"Go to the end of buffer in all windows showing it.
Movement occurs if point in the selected window is not after the process mark,
@@ -2455,11 +2505,20 @@ This function could be in the list `comint-output-filter-functions'."
(when (let ((case-fold-search t))
(string-match comint-password-prompt-regexp
(string-replace "\r" "" string)))
- (let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
- (if (> comint--prompt-recursion-depth 10)
- (message "Password prompt recursion too deep")
- (comint-send-invisible
- (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+"))))))
+ ;; Use `run-at-time' in order not to pause execution of the
+ ;; process filter with a minibuffer
+ (run-at-time
+ 0 nil
+ (lambda (current-buf)
+ (with-current-buffer current-buf
+ (let ((comint--prompt-recursion-depth
+ (1+ comint--prompt-recursion-depth)))
+ (if (> comint--prompt-recursion-depth 10)
+ (message "Password prompt recursion too deep")
+ (when (get-buffer-process (current-buffer))
+ (comint-send-invisible
+ (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+")))))))
+ (current-buffer))))
;; Low-level process communication
@@ -2753,7 +2812,7 @@ Interactively, if no prefix argument is given, the last argument is inserted.
Repeated interactive invocations will cycle through the same argument
from progressively earlier commands (using the value of INDEX specified
with the first command). Values of INDEX < 0 count from the end, so
-INDEX = -1 is the last argument. This command is like `M-.' in
+INDEX = -1 is the last argument. This command is like \"M-.\" in
Bash and zsh."
(interactive "P")
(unless (null index)
@@ -3136,8 +3195,8 @@ inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters.
(while (not giveup)
(let ((startpoint (point)))
(skip-chars-backward (concat "\\\\" word-chars))
- (if (and comint-file-name-quote-list
- (eq (char-before (1- (point))) ?\\))
+ (if (and (eq (char-before (1- (point))) ?\\)
+ (memq (char-before) comint-file-name-quote-list))
(forward-char -2))
;; FIXME: This isn't consistent with Bash, at least -- not
;; all non-ASCII chars should be word constituents.
@@ -3240,10 +3299,6 @@ Magic characters are those in `comint-file-name-quote-list'."
(defun comint-completion-at-point ()
(run-hook-with-args-until-success 'comint-dynamic-complete-functions))
-(define-obsolete-function-alias
- 'comint-dynamic-complete
- 'completion-at-point "24.1")
-
(defun comint-dynamic-complete-filename ()
"Dynamically complete the filename at point.
Completes if after a filename.
@@ -3324,13 +3379,6 @@ See `completion-table-with-quoting' and `comint-unquote-function'.")
(goto-char (match-end 0))
(insert filesuffix)))))))))
-(defun comint-dynamic-complete-as-filename ()
- "Dynamically complete at point as a filename.
-See `comint-dynamic-complete-filename'. Returns t if successful."
- (declare (obsolete comint-filename-completion "24.1"))
- (let ((data (comint--complete-file-name-data)))
- (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))
-
(defun comint-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point.
Replace the filename with an expanded, canonicalized and
@@ -3345,65 +3393,6 @@ filename absolute. For expansion see `expand-file-name' and
(replace-match (expand-file-name filename) t t)
(comint-dynamic-complete-filename))))
-
-(defun comint-dynamic-simple-complete (stub candidates)
- "Dynamically complete STUB from CANDIDATES list.
-This function inserts completion characters at point by
-completing STUB from the strings in CANDIDATES. If completion is
-ambiguous, possibly show a completions listing in a separate
-buffer.
-
-Return nil if no completion was inserted.
-Return `sole' if completed with the only completion match.
-Return `shortest' if completed with the shortest match.
-Return `partial' if completed as far as possible.
-Return `listed' if a completion listing was shown.
-
-See also `comint-dynamic-complete-filename'."
- (declare (obsolete completion-in-region "24.1"))
- (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
- (minibuffer-p (window-minibuffer-p))
- (suffix (cond ((not comint-completion-addsuffix) "")
- ((not (consp comint-completion-addsuffix)) " ")
- (t (cdr comint-completion-addsuffix))))
- (completions (all-completions stub candidates)))
- (cond ((null completions)
- (if minibuffer-p
- (minibuffer-message "No completions of %s" stub)
- (message "No completions of %s" stub))
- nil)
- ((= 1 (length completions)) ; Gotcha!
- (let ((completion (car completions)))
- (if (string-equal completion stub)
- (unless minibuffer-p
- (message "Sole completion"))
- (insert (substring completion (length stub)))
- (unless minibuffer-p
- (message "Completed")))
- (insert suffix)
- 'sole))
- (t ; There's no unique completion.
- (let ((completion (try-completion stub candidates)))
- ;; Insert the longest substring.
- (insert (substring completion (length stub)))
- (cond ((and comint-completion-recexact comint-completion-addsuffix
- (string-equal stub completion)
- (member completion completions))
- ;; It's not unique, but user wants shortest match.
- (insert suffix)
- (unless minibuffer-p
- (message "Completed shortest"))
- 'shortest)
- ((or comint-completion-autolist
- (string-equal stub completion))
- ;; It's not unique, list possible completions.
- (comint-dynamic-list-completions completions stub)
- 'listed)
- (t
- (unless minibuffer-p
- (message "Partially completed"))
- 'partial)))))))
-
(defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point."
(interactive)
@@ -3509,6 +3498,20 @@ to send all the accumulated input, at once.
The entire accumulated text becomes one item in the input history
when you send it."
(interactive)
+ (when-let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (process-mark proc))
+ ((or (marker-position comint-accum-marker)
+ (set-marker comint-accum-marker pmark)
+ t))
+ ((>= (point) comint-accum-marker pmark)))
+ ;; Delete and reinsert input. This seems like a no-op, except for
+ ;; the resulting entries in the undo list: undoing this insertion
+ ;; will delete the region, moving the accumulation marker back to
+ ;; its original position.
+ (let ((text (buffer-substring comint-accum-marker (point)))
+ (inhibit-read-only t))
+ (delete-region comint-accum-marker (point))
+ (insert text)))
(insert "\n")
(set-marker comint-accum-marker (point))
(if comint-input-ring-index
@@ -3906,10 +3909,12 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
;;; OSC escape sequences (Operating System Commands)
;;============================================================================
-;; Adding `comint-osc-process-output' to `comint-output-filter-functions'
-;; enables the interpretation of OSC escape sequences. By default, only
-;; OSC 8, for hyperlinks, is acted upon. Adding more entries to
-;; `comint-osc-handlers' allows a customized treatment of further sequences.
+;; Adding `comint-osc-process-output' to
+;; `comint-output-filter-functions' enables the interpretation of OSC
+;; escape sequences. By default, OSC 7 and 8 (for current directory
+;; and hyperlinks respectively) are acted upon. Adding more entries
+;; to `comint-osc-handlers' allows a customized treatment of further
+;; sequences.
(defvar-local comint-osc-handlers '(("7" . comint-osc-directory-tracker)
("8" . comint-osc-hyperlink-handler))
@@ -3954,9 +3959,9 @@ arguments, with point where the escape sequence was located."
;; Current directory tracking (OSC 7)
-(declare-function url-host "url-parse.el")
-(declare-function url-type "url-parse.el")
-(declare-function url-filename "url-parse.el")
+(declare-function url-host "url/url-parse.el")
+(declare-function url-type "url/url-parse.el")
+(declare-function url-filename "url/url-parse.el")
(defun comint-osc-directory-tracker (_ text)
"Update `default-directory' from OSC 7 escape sequences.
diff --git a/lisp/completion.el b/lisp/completion.el
index 6040ff4d334..fb700954b0e 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -492,7 +492,7 @@ Used to decide whether to save completions.")
table))
;; Old name, non-namespace-clean.
-(defvaralias 'cmpl-syntax-table 'completion-syntax-table)
+(define-obsolete-variable-alias 'cmpl-syntax-table 'completion-syntax-table "29.1")
(defvar-local completion-syntax-table completion-standard-syntax-table
"This variable holds the current completion syntax table.")
@@ -2220,7 +2220,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(completion-def-wrapper 'delete-backward-char-untabify :backward)
;; Old name, non-namespace-clean.
-(defalias 'initialize-completions #'completion-initialize)
+(define-obsolete-function-alias 'initialize-completions #'completion-initialize "29.1")
(provide 'completion)
diff --git a/lisp/composite.el b/lisp/composite.el
index fc931474606..6fcf637584e 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -474,6 +474,25 @@ after a sequence of character events."
(aset gstring (1- len) nil))
gstring)
+(defun lgstring-glyph-boundary (gstring startpos endpos)
+ "Return buffer position at or after ENDPOS where grapheme from GSTRING ends.
+STARTPOS is the position where the grapheme cluster starts; it is returned
+by `find-composition'."
+ (let ((nglyphs (lgstring-glyph-len gstring))
+ (idx 0)
+ glyph found)
+ (while (and (not found) (< idx nglyphs))
+ (setq glyph (lgstring-glyph gstring idx))
+ (cond
+ ((or (null glyph)
+ (= (+ startpos (lglyph-from glyph)) endpos))
+ (setq found endpos))
+ ((>= (+ startpos (lglyph-to glyph)) endpos)
+ (setq found (+ startpos (lglyph-to glyph) 1)))
+ (t
+ (setq idx (1+ idx)))))
+ (or found endpos)))
+
(defun compose-glyph-string (gstring from to)
(let ((glyph (lgstring-glyph gstring from))
from-pos to-pos)
@@ -901,6 +920,4 @@ For more information on Auto Composition mode, see
(provide 'composite)
-
-
;;; composite.el ends here
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 87dcbbb004f..47d2cac3be1 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -156,9 +156,9 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(set-buffer (find-file-noselect generated-custom-dependencies-file))
(setq buffer-undo-list t)
(erase-buffer)
- (insert (autoload-rubric generated-custom-dependencies-file
- "custom dependencies" t))
- (search-backward " ")
+ (generate-lisp-file-heading
+ generated-custom-dependencies-file 'custom-make-dependencies
+ :title "custom dependencies")
(let (alist)
(mapatoms (lambda (symbol)
(let ((members (get symbol 'custom-group))
@@ -241,6 +241,7 @@ This is an alist whose members have as car a version string, and as
elements the files that have variables or faces that contain that
version. These files should be loaded before showing the customization
buffer that `customize-changed' generates.\")\n\n"))
+ (generate-lisp-file-trailer generated-custom-dependencies-file)
(save-buffer)
(byte-compile-info
(format "Generating %s...done" generated-custom-dependencies-file) t))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index fd42c542b46..50dce5ee285 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -441,6 +441,7 @@ Use group `text' for this instead. This group is deprecated."
(define-key map "u" 'Custom-goto-parent)
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
+ (define-key map "H" 'custom-toggle-hide-all-widgets)
map)
"Keymap for `Custom-mode'.")
@@ -745,6 +746,9 @@ groups after non-groups, if nil do not order groups at all."
(or custom-file user-init-file)
"Un-customize settings in this and future sessions." "delete" "Uncustomize"
(modified set changed rogue saved))
+ (" Toggle hiding all values " custom-toggle-hide-all-widgets
+ t "Toggle hiding all values."
+ "hide" "Hide" t)
(" Help for Customize " Custom-help t "Get help for using Customize."
"help" "Help" t)
(" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit" t))
@@ -1045,6 +1049,36 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
value)
;;;###autoload
+(defmacro setopt (&rest pairs)
+ "Set VARIABLE/VALUE pairs, and return the final VALUE.
+This is like `setq', but is meant for user options instead of
+plain variables. This means that `setopt' will execute any
+`custom-set' form associated with VARIABLE.
+
+\(fn [VARIABLE VALUE]...)"
+ (declare (debug setq))
+ (unless (zerop (mod (length pairs) 2))
+ (error "PAIRS must have an even number of variable/value members"))
+ (let ((expr nil))
+ (while pairs
+ (unless (symbolp (car pairs))
+ (error "Attempting to set a non-symbol: %s" (car pairs)))
+ (push `(setopt--set ',(car pairs) ,(cadr pairs))
+ expr)
+ (setq pairs (cddr pairs)))
+ (macroexp-progn (nreverse expr))))
+
+;;;###autoload
+(defun setopt--set (variable value)
+ (custom-load-symbol variable)
+ ;; Check that the type is correct.
+ (when-let ((type (get variable 'custom-type)))
+ (unless (widget-apply (widget-convert type) :match value)
+ (user-error "Value `%S' does not match type %s" value type)))
+ (put variable 'custom-check-value (list value))
+ (funcall (or (get variable 'custom-set) #'set-default) variable value))
+
+;;;###autoload
(defun customize-save-variable (variable value &optional comment)
"Set the default for VARIABLE to VALUE, and save it for future sessions.
Return VALUE.
@@ -1133,7 +1167,7 @@ for the MODE to customize."
(defun customize-read-group ()
(let ((completion-ignore-case t))
- (completing-read "Customize group (default emacs): "
+ (completing-read (format-prompt "Customize group" "emacs")
obarray
(lambda (symbol)
(or (and (get symbol 'custom-loads)
@@ -1205,7 +1239,7 @@ Show the buffer in another window, but don't select it."
(unless (eq symbol basevar)
(message "`%s' is an alias for `%s'" symbol basevar))))
-(defvar customize-changed-options-previous-release "27.2"
+(defvar customize-changed-options-previous-release "28.1"
"Version for `customize-changed' to refer back to by default.")
;; Packages will update this variable, so make it available.
@@ -1465,7 +1499,7 @@ symbols `custom-face' or `custom-variable'."
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Saved*"))))
-(declare-function apropos-parse-pattern "apropos" (pattern))
+(declare-function apropos-parse-pattern "apropos" (pattern &optional di-all))
(defvar apropos-regexp)
;;;###autoload
@@ -2176,7 +2210,7 @@ and `face'."
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 ns) (class color)) ; Like default mode line
+ '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
@@ -2184,7 +2218,7 @@ and `face'."
:group 'custom-faces)
(defface custom-button-mouse
- '((((type x w32 ns) (class color))
+ '((((type x w32 ns haiku pgtk) (class color))
:box (:line-width 2 :style released-button)
:background "grey90" :foreground "black")
(t
@@ -2209,7 +2243,7 @@ and `face'."
(if custom-raised-buttons 'custom-button-mouse 'highlight))
(defface custom-button-pressed
- '((((type x w32 ns) (class color))
+ '((((type x w32 ns haiku pgtk) (class color))
:box (:line-width 2 :style pressed-button)
:background "lightgrey" :foreground "black")
(t :inverse-video t))
@@ -2550,7 +2584,13 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
Normally just return the docstring. But if VARIABLE automatically
becomes buffer local when set, append a message to that effect.
Also append any obsolescence information."
- (format "%s%s%s" (documentation-property variable 'variable-documentation t)
+ (format "%s%s%s"
+ (with-temp-buffer
+ (insert
+ (or (documentation-property variable 'variable-documentation t)
+ ""))
+ (untabify (point-min) (point-max))
+ (buffer-string))
(if (and (local-variable-if-set-p variable)
(or (not (local-variable-p variable))
(with-temp-buffer
@@ -2805,6 +2845,39 @@ try matching its doc string against `custom-guess-doc-alist'."
(custom-add-parent-links widget))
(custom-add-see-also widget)))))
+(defvar custom--hidden-state)
+
+(defun custom-toggle-hide-all-widgets ()
+ "Hide or show details of all customizable settings in a Custom buffer.
+This command is for use in a Custom buffer that shows many
+customizable settings, like \"*Customize Group*\" or \"*Customize Faces*\".
+It toggles the display of each of the customizable settings in the buffer
+between the expanded view, where the values of the settings and the value
+menus to change them are visible; and the concise view, where only the
+minimal details are shown, usually the name, the doc string and little
+else."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ ;; Surely there's a better way to find all the "top level" widgets
+ ;; in a buffer, but I couldn't find it.
+ (while (not (eobp))
+ (when-let* ((widget (widget-at (point)))
+ (parent (widget-get widget :parent))
+ (state (widget-get parent :custom-state)))
+ (when (eq state 'changed)
+ (setq state 'standard))
+ (when (and (eq (widget-type widget) 'custom-visibility)
+ (eq state custom--hidden-state))
+ (custom-toggle-parent widget)))
+ (forward-line 1)))
+ (setq custom--hidden-state (if (eq custom--hidden-state 'hidden)
+ 'standard
+ 'hidden))
+ (if (eq custom--hidden-state 'hidden)
+ (message "All variables hidden")
+ (message "All variables shown")))
+
(defun custom-toggle-hide-variable (visibility-widget &rest _ignore)
"Toggle the visibility of a `custom-variable' parent widget.
By default, this signals an error if the parent has unsaved
@@ -3458,6 +3531,10 @@ MS Windows.")
:sibling-args (:help-echo "\
GNUstep or Macintosh OS Cocoa interface.")
ns)
+ (const :format "PGTK "
+ :sibling-args (:help-echo "\
+Pure-GTK interface.")
+ ns)
(const :format "DOS "
:sibling-args (:help-echo "\
Plain MS-DOS.")
@@ -3972,6 +4049,18 @@ Optional EVENT is the location for the menu."
(setq comment nil)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
+ ;; When modifying the default face, we need to save the standard or themed
+ ;; attrs, in case the user asks to revert to them in the future.
+ ;; In GUIs, when resetting the attributes of the default face, the frame
+ ;; parameters associated with this face won't change, unless explicitly
+ ;; passed a value. Storing this known attrs allows us to tell faces.el to
+ ;; set those attributes to specified values, making the relevant frame
+ ;; parameters stay in sync with the default face.
+ (when (and (eq symbol 'default)
+ (not (get symbol 'custom-face-default-attrs))
+ (memq (custom-face-state symbol) '(standard themed)))
+ (put symbol 'custom-face-default-attrs
+ (custom-face-get-current-spec symbol)))
(custom-push-theme 'theme-face symbol 'user 'set value)
(face-spec-set symbol value 'customized-face)
(put symbol 'face-comment comment)
@@ -3990,6 +4079,12 @@ Optional EVENT is the location for the menu."
(setq comment nil)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
+ ;; See the comments in `custom-face-set'.
+ (when (and (eq symbol 'default)
+ (not (get symbol 'custom-face-default-attrs))
+ (memq (custom-face-state symbol) '(standard themed)))
+ (put symbol 'custom-face-default-attrs
+ (custom-face-get-current-spec symbol)))
(custom-push-theme 'theme-face symbol 'user 'set value)
(face-spec-set symbol value (if standard 'reset 'saved-face))
(put symbol 'face-comment comment)
@@ -4003,7 +4098,14 @@ Optional EVENT is the location for the menu."
(defun custom-face-save (widget)
"Save the face edited by WIDGET."
- (let ((form (widget-get widget :custom-form)))
+ (let ((form (widget-get widget :custom-form))
+ (symbol (widget-value widget)))
+ ;; See the comments in `custom-face-set'.
+ (when (and (eq symbol 'default)
+ (not (get symbol 'custom-face-default-attrs))
+ (memq (custom-face-state symbol) '(standard themed)))
+ (put symbol 'custom-face-default-attrs
+ (custom-face-get-current-spec symbol)))
(if (memq form '(all lisp))
(custom-face-mark-to-save widget)
;; The user is working on only a selected terminal type;
@@ -4031,10 +4133,20 @@ uncustomized (themed or standard) face."
(saved-face (get face 'saved-face))
(comment (get face 'saved-face-comment))
(comment-widget (widget-get widget :comment-widget)))
+ ;; If resetting the default face and there isn't a saved value,
+ ;; push a fake user setting, so that reverting to the default
+ ;; attributes works.
(custom-push-theme 'theme-face face 'user
- (if saved-face 'set 'reset)
- saved-face)
+ (if (or saved-face (eq face 'default)) 'set 'reset)
+ (or saved-face
+ ;; If this is t, then MODE is 'reset,
+ ;; and `custom-push-theme' ignores this argument.
+ (not (eq face 'default))
+ (get face 'custom-face-default-attrs)))
(face-spec-set face saved-face 'saved-face)
+ (when (and (not saved-face) (eq face 'default))
+ ;; Remove the fake user setting.
+ (custom-push-theme 'theme-face face 'user 'reset))
(put face 'face-comment comment)
(put face 'customized-face-comment nil)
(widget-value-set child saved-face)
@@ -4056,8 +4168,15 @@ redraw the widget immediately."
(comment-widget (widget-get widget :comment-widget)))
(unless value
(user-error "No standard setting for this face"))
- (custom-push-theme 'theme-face symbol 'user 'reset)
+ ;; If erasing customizations for the default face, push a fake user setting,
+ ;; so that reverting to the default attributes works.
+ (custom-push-theme 'theme-face symbol 'user
+ (if (eq symbol 'default) 'set 'reset)
+ (or (not (eq symbol 'default))
+ (get symbol 'custom-face-default-attrs)))
(face-spec-set symbol value 'reset)
+ ;; Remove the fake user setting.
+ (custom-push-theme 'theme-face symbol 'user 'reset)
(put symbol 'face-comment nil)
(put symbol 'customized-face-comment nil)
(if (and custom-reset-standard-faces-list
@@ -4723,7 +4842,11 @@ if only the first line of the docstring is shown."))
(delay-mode-hooks (emacs-lisp-mode)))
(let ((inhibit-read-only t)
(print-length nil)
- (print-level nil))
+ (print-level nil)
+ ;; We might be saving byte-code with embedded NULs, which
+ ;; can cause problems when read back, so print them
+ ;; readably. (Bug#52554)
+ (print-escape-control-characters t))
(atomic-change-group
(custom-save-variables)
(custom-save-faces)))
@@ -5151,7 +5274,8 @@ if that value is non-nil."
:label (nth 5 arg)))
custom-commands)
(setq custom-tool-bar-map map))))
- (setq-local custom--invocation-options nil)
+ (setq-local custom--invocation-options nil
+ custom--hidden-state 'hidden)
(setq-local revert-buffer-function #'custom--revert-buffer)
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 8e629e26d0b..73a33f064c8 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -31,6 +31,9 @@
(defun custom-declare-face (face spec doc &rest args)
"Like `defface', but with FACE evaluated as a normal argument."
+ (when (and doc
+ (not (stringp doc)))
+ (error "Invalid (or missing) doc string %S" doc))
(unless (get face 'face-defface-spec)
(face-spec-set face (purecopy spec) 'face-defface-spec)
(push (cons 'defface face) current-load-list)
@@ -43,7 +46,7 @@
;;; Face attributes.
(defconst custom-face-attributes
- '((:family
+ `((:family
(string :tag "Font Family"
:help-echo "Font family or fontset alias name."))
@@ -51,6 +54,7 @@
(string :tag "Font Foundry"
:help-echo "Font foundry name."))
+ ;; The width, weight, and slant should be in sync with font.c.
(:width
(choice :tag "Width"
:help-echo "Font width."
@@ -60,44 +64,60 @@
(const :tag "demiexpanded" semi-expanded)
(const :tag "expanded" expanded)
(const :tag "extracondensed" extra-condensed)
+ (const :tag "extra-condensed" extra-condensed)
(const :tag "extraexpanded" extra-expanded)
- (const :tag "medium" normal)
+ (const :tag "extra-expanded" extra-expanded)
(const :tag "narrow" condensed)
(const :tag "normal" normal)
+ (const :tag "medium" normal)
(const :tag "regular" normal)
(const :tag "semicondensed" semi-condensed)
+ (const :tag "demicondensed" semi-condensed)
+ (const :tag "semi-condensed" semi-condensed)
(const :tag "semiexpanded" semi-expanded)
(const :tag "ultracondensed" ultra-condensed)
+ (const :tag "ultra-condensed" ultra-condensed)
(const :tag "ultraexpanded" ultra-expanded)
+ (const :tag "ultra-expanded" ultra-expanded)
(const :tag "wide" extra-expanded)))
(:height
(choice :tag "Height"
- :help-echo "Face's font height."
+ :help-echo "Face's font size."
:value 1.0 ; default
- (integer :tag "Height in 1/10 pt")
+ (integer :tag "Font size in 1/10 pt")
(number :tag "Scale" 1.0)))
(:weight
(choice :tag "Weight"
:help-echo "Font weight."
:value normal ; default
+ (const :tag "thin" thin)
(const :tag "ultralight" ultra-light)
- (const :tag "extralight" extra-light)
+ (const :tag "ultra-light" ultra-light)
+ (const :tag "extralight" ultra-light)
+ (const :tag "extra-light" ultra-light)
(const :tag "light" light)
- (const :tag "thin" thin)
(const :tag "semilight" semi-light)
- (const :tag "book" semi-light)
+ (const :tag "semi-light" semi-light)
+ (const :tag "demilight" semi-light)
(const :tag "normal" normal)
- (const :tag "regular" normal)
- (const :tag "medium" normal)
+ (const :tag "regular" regular)
+ (const :tag "book" normal)
+ (const :tag "medium" medium)
(const :tag "semibold" semi-bold)
+ (const :tag "semi-bold" semi-bold)
(const :tag "demibold" semi-bold)
+ (const :tag "demi-bold" semi-bold)
(const :tag "bold" bold)
(const :tag "extrabold" extra-bold)
- (const :tag "heavy" extra-bold)
- (const :tag "ultrabold" ultra-bold)
- (const :tag "black" ultra-bold)))
+ (const :tag "extra-bold" extra-bold)
+ (const :tag "ultrabold" extra-bold)
+ (const :tag "ultra-bold" extra-bold)
+ (const :tag "heavy" heavy)
+ (const :tag "black" heavy)
+ (const :tag "ultra-heavy" ultra-heavy)
+ (const :tag "ultraheavy" ultra-heavy)))
(:slant
(choice :tag "Slant"
@@ -113,7 +133,7 @@
:help-echo "Control text underlining."
(const :tag "Off" nil)
(list :tag "On"
- :value (:color foreground-color :style line)
+ :value (:color foreground-color :style line :position nil)
(const :format "" :value :color)
(choice :tag "Color"
(const :tag "Foreground Color" foreground-color)
@@ -121,28 +141,36 @@
(const :format "" :value :style)
(choice :tag "Style"
(const :tag "Line" line)
- (const :tag "Wave" wave))))
+ (const :tag "Wave" wave))
+ (const :format "" :value :position)
+ (choice :tag "Position"
+ (const :tag "At Default Position" nil)
+ (const :tag "At Bottom Of Text" t)
+ (integer :tag "Pixels Above Bottom Of Text"))))
;; filter to make value suitable for customize
- (lambda (real-value)
- (and real-value
- (let ((color
- (or (and (consp real-value) (plist-get real-value :color))
- (and (stringp real-value) real-value)
- 'foreground-color))
- (style
- (or (and (consp real-value) (plist-get real-value :style))
- 'line)))
- (list :color color :style style))))
+ ,(lambda (real-value)
+ (and real-value
+ (let ((color
+ (or (and (consp real-value) (plist-get real-value :color))
+ (and (stringp real-value) real-value)
+ 'foreground-color))
+ (style
+ (or (and (consp real-value) (plist-get real-value :style))
+ 'line))
+ (position (and (consp real-value)
+ (plist-get real-value :style))))
+ (list :color color :style style :position position))))
;; filter to make customized-value suitable for storing
- (lambda (cus-value)
- (and cus-value
- (let ((color (plist-get cus-value :color))
- (style (plist-get cus-value :style)))
- (cond ((eq style 'line)
- ;; Use simple value for default style
- (if (eq color 'foreground-color) t color))
- (t
- `(:color ,color :style ,style)))))))
+ ,(lambda (cus-value)
+ (and cus-value
+ (let ((color (plist-get cus-value :color))
+ (style (plist-get cus-value :style))
+ (position (plist-get cus-value :position)))
+ (cond ((and (eq style 'line) (not position))
+ ;; Use simple value for default style
+ (if (eq color 'foreground-color) t color))
+ (t
+ `(:color ,color :style ,style :position ,position)))))))
(:overline
(choice :tag "Overline"
@@ -178,40 +206,40 @@
(const :tag "Flat" flat-button)
(const :tag "None" nil))))
;; filter to make value suitable for customize
- (lambda (real-value)
- (and real-value
- (let ((lwidth
- (or (and (consp real-value)
- (if (listp (cdr real-value))
- (plist-get real-value :line-width)
- real-value))
- (and (integerp real-value) real-value)
- '(1 . 1)))
- (color
- (or (and (consp real-value) (plist-get real-value :color))
- (and (stringp real-value) real-value)
- nil))
- (style
- (and (consp real-value) (plist-get real-value :style))))
- (if (integerp lwidth)
- (setq lwidth (cons (abs lwidth) lwidth)))
- (list :line-width lwidth :color color :style style))))
+ ,(lambda (real-value)
+ (and real-value
+ (let ((lwidth
+ (or (and (consp real-value)
+ (if (listp (cdr real-value))
+ (plist-get real-value :line-width)
+ real-value))
+ (and (integerp real-value) real-value)
+ '(1 . 1)))
+ (color
+ (or (and (consp real-value) (plist-get real-value :color))
+ (and (stringp real-value) real-value)
+ nil))
+ (style
+ (and (consp real-value) (plist-get real-value :style))))
+ (if (integerp lwidth)
+ (setq lwidth (cons (abs lwidth) lwidth)))
+ (list :line-width lwidth :color color :style style))))
;; filter to make customized-value suitable for storing
- (lambda (cus-value)
- (and cus-value
- (let ((lwidth (plist-get cus-value :line-width))
- (color (plist-get cus-value :color))
- (style (plist-get cus-value :style)))
- (cond ((and (null color) (null style))
- lwidth)
- ((and (null lwidth) (null style))
- ;; actually can't happen, because LWIDTH is always an int
- color)
- (t
- ;; Keep as a plist, but remove null entries
- (nconc (and lwidth `(:line-width ,lwidth))
- (and color `(:color ,color))
- (and style `(:style ,style)))))))))
+ ,(lambda (cus-value)
+ (and cus-value
+ (let ((lwidth (plist-get cus-value :line-width))
+ (color (plist-get cus-value :color))
+ (style (plist-get cus-value :style)))
+ (cond ((and (null color) (null style))
+ lwidth)
+ ((and (null lwidth) (null style))
+ ;; actually can't happen, because LWIDTH is always an int
+ color)
+ (t
+ ;; Keep as a plist, but remove null entries
+ (nconc (and lwidth `(:line-width ,lwidth))
+ (and color `(:color ,color))
+ (and style `(:style ,style)))))))))
(:inverse-video
(choice :tag "Inverse-video"
@@ -248,18 +276,18 @@
:help-echo "List of faces to inherit attributes from."
(face :Tag "Face" default))
;; filter to make value suitable for customize
- (lambda (real-value)
- (cond ((or (null real-value) (eq real-value 'unspecified))
- nil)
- ((symbolp real-value)
- (list real-value))
- (t
- real-value)))
+ ,(lambda (real-value)
+ (cond ((or (null real-value) (eq real-value 'unspecified))
+ nil)
+ ((symbolp real-value)
+ (list real-value))
+ (t
+ real-value)))
;; filter to make customized-value suitable for storing
- (lambda (cus-value)
- (if (and (consp cus-value) (null (cdr cus-value)))
- (car cus-value)
- cus-value))))
+ ,(lambda (cus-value)
+ (if (and (consp cus-value) (null (cdr cus-value)))
+ (car cus-value)
+ cus-value))))
"Alist of face attributes.
@@ -301,12 +329,12 @@ If FRAME is nil, use the global defaults for FACE."
"Apply a list of face specs for user customizations.
This works by calling `custom-theme-set-faces' for the `user'
theme, a special theme referring to settings made via Customize.
-The arguments should be a list where each entry has the form:
+The arguments ARGS should be a list where each entry has the form:
(FACE SPEC [NOW [COMMENT]])
See the documentation of `custom-theme-set-faces' for details."
- (apply 'custom-theme-set-faces 'user args))
+ (apply #'custom-theme-set-faces 'user args))
(defun custom-theme-set-faces (theme &rest args)
"Apply a list of face specs associated with theme THEME.
@@ -391,7 +419,7 @@ Each of the arguments ARGS has this form:
(FACE FROM-THEME)
This means reset FACE to its value in FROM-THEME."
- (apply 'custom-theme-reset-faces 'user args))
+ (apply #'custom-theme-reset-faces 'user args))
(define-obsolete-function-alias 'custom-facep #'facep "28.1")
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 38e328a7c64..df919fd7155 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -356,6 +356,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const :tag "Iconify" t))
"26.1")
(tooltip-reuse-hidden-frame tooltip boolean "26.1")
+ (use-system-tooltips tooltip boolean "29.1")
;; fringe.c
(overflow-newline-into-fringe fringe boolean)
;; image.c
@@ -369,7 +370,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(auto-save-timeout auto-save (choice (const :tag "off" nil)
(integer :format "%v")))
(echo-keystrokes minibuffer number)
- (polling-period keyboard integer)
+ (polling-period keyboard float)
(double-click-time mouse (restricted-sexp
:match-alternatives (integerp 'nil 't)))
(double-click-fuzz mouse integer "22.1")
@@ -386,7 +387,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const :tag "When sent SIGUSR1" sigusr1)
(const :tag "When sent SIGUSR2" sigusr2))
"24.1")
-
+ (translate-upper-case-key-bindings keyboard boolean "29.1")
;; This is not good news because it will use the wrong
;; version-specific directories when you upgrade. We need
;; customization of the front of the list, maintaining the
@@ -397,6 +398,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; (const :tag " current dir" nil)
;; (directory :format "%v"))))
(load-prefer-newer lisp boolean "24.4")
+ (record-all-keys keyboard boolean)
;; minibuf.c
(minibuffer-follows-selected-frame
minibuffer (choice (const :tag "Always" t)
@@ -572,8 +574,10 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(ns-use-native-fullscreen ns boolean "24.4")
(ns-use-fullscreen-animation ns boolean "25.1")
(ns-use-srgb-colorspace ns boolean "24.4")
+ (ns-scroll-event-delta-factor ns float "29.1")
;; process.c
(delete-exited-processes processes-basics boolean)
+ (process-error-pause-time processes-basics integer "29.1")
;; syntax.c
(parse-sexp-ignore-comments editing-basics boolean)
(words-include-escapes editing-basics boolean)
@@ -808,6 +812,7 @@ since it could result in memory overflow and make Emacs crash."
character)
"27.1"
:safe (lambda (value) (or (characterp value) (null value))))
+ (composition-break-at-point display boolean "29.1")
;; xfaces.c
(scalable-fonts-allowed
display (choice (const :tag "Don't allow scalable fonts" nil)
@@ -826,10 +831,18 @@ since it could result in memory overflow and make Emacs crash."
(x-underline-at-descent-line display boolean "22.1")
(x-stretch-cursor display boolean "21.1")
(scroll-bar-adjust-thumb-portion windows boolean "24.4")
+ (x-scroll-event-delta-factor mouse float "29.1")
+ (x-gtk-use-native-input keyboard boolean "29.1")
+ (x-dnd-disable-motif-drag dnd boolean "29.1")
+ (x-auto-preserve-selections x boolean "29.1")
;; xselect.c
(x-select-enable-clipboard-manager killing boolean "24.1")
;; xsettings.c
- (font-use-system-font font-selection boolean "23.2")))
+ (font-use-system-font font-selection boolean "23.2")
+ ;; haikuterm.c
+ (haiku-debug-on-fatal-error debug boolean "29.1")
+ ;; haikufns.c
+ (haiku-use-system-tooltips tooltip boolean "29.1")))
(setq ;; If we did not specify any standard value expression above,
;; use the current value as the standard value.
standard (if (setq prop (memq :standard rest))
@@ -846,10 +859,26 @@ since it could result in memory overflow and make Emacs crash."
(eq system-type 'windows-nt))
((string-match "\\`ns-" (symbol-name symbol))
(featurep 'ns))
+ ((string-match "\\`haiku-" (symbol-name symbol))
+ (featurep 'haiku))
+ ((eq symbol 'process-error-pause-time)
+ (not (eq system-type 'ms-dos)))
+ ((eq symbol 'x-gtk-use-native-input)
+ (and (featurep 'x)
+ (featurep 'gtk)))
((string-match "\\`x-.*gtk" (symbol-name symbol))
(featurep 'gtk))
((string-match "clipboard-manager" (symbol-name symbol))
(boundp 'x-select-enable-clipboard-manager))
+ ((or (equal "scroll-bar-adjust-thumb-portion"
+ (symbol-name symbol))
+ (equal "x-scroll-event-delta-factor"
+ (symbol-name symbol))
+ (equal "x-dnd-disable-motif-drag"
+ (symbol-name symbol))
+ (equal "x-auto-preserve-selections"
+ (symbol-name symbol)))
+ (featurep 'x))
((string-match "\\`x-" (symbol-name symbol))
(fboundp 'x-create-frame))
((string-match "selection" (symbol-name symbol))
@@ -870,9 +899,6 @@ since it could result in memory overflow and make Emacs crash."
(symbol-name symbol))
;; Any function from fontset.c will do.
(fboundp 'new-fontset))
- ((equal "scroll-bar-adjust-thumb-portion"
- (symbol-name symbol))
- (featurep 'x))
(t t))))
(if (not (boundp symbol))
;; If variables are removed from C code, give an error here!
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 8aab636f853..69ec837db88 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -627,22 +627,24 @@ Theme files are named *-theme.el in `"))
(let ((help-echo "mouse-2: Enable this theme for this session")
widget)
(dolist (theme (custom-available-themes))
- (setq widget (widget-create 'checkbox
- :value (custom-theme-enabled-p theme)
- :theme-name theme
- :help-echo help-echo
- :action #'custom-theme-checkbox-toggle))
- (push (cons theme widget) custom--listed-themes)
- (widget-create-child-and-convert widget 'push-button
- :button-face-get 'ignore
- :mouse-face-get 'ignore
- :value (format " %s" theme)
- :action #'widget-parent-action
- :help-echo help-echo)
- (widget-insert " -- "
- (propertize (custom-theme-summary theme)
- 'face 'shadow)
- ?\n)))
+ ;; Don't list obsolete themes.
+ (unless (get theme 'byte-obsolete-info)
+ (setq widget (widget-create 'checkbox
+ :value (custom-theme-enabled-p theme)
+ :theme-name theme
+ :help-echo help-echo
+ :action #'custom-theme-checkbox-toggle))
+ (push (cons theme widget) custom--listed-themes)
+ (widget-create-child-and-convert widget 'push-button
+ :button-face-get 'ignore
+ :mouse-face-get 'ignore
+ :value (format " %s" theme)
+ :action #'widget-parent-action
+ :help-echo help-echo)
+ (widget-insert " -- "
+ (propertize (custom-theme-summary theme)
+ 'face 'shadow)
+ ?\n))))
(goto-char (point-min))
(widget-setup))
diff --git a/lisp/custom.el b/lisp/custom.el
index 968b28f7a89..bbbe70c5ea8 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -67,8 +67,10 @@ symbol."
(defun custom-initialize-set (symbol exp)
"Initialize SYMBOL based on EXP.
-If the symbol doesn't have a default binding already,
-then set it using its `:set' function (or `set-default' if it has none).
+If the symbol doesn't have a default binding already, then set it
+using its `:set' function (or `set-default-toplevel-value' if it
+has none).
+
The value is either the value in the symbol's `saved-value' property,
if any, or the value of EXP."
(condition-case nil
@@ -81,11 +83,27 @@ if any, or the value of EXP."
(defun custom-initialize-reset (symbol exp)
"Initialize SYMBOL based on EXP.
-Set the symbol, using its `:set' function (or `set-default' if it has none).
+Set the symbol, using its `:set' function (or `set-default-toplevel-value'
+if it has none).
+
The value is either the symbol's current value
(as obtained using the `:get' function), if any,
or the value in the symbol's `saved-value' property if any,
or (last of all) the value of EXP."
+ ;; If this value has been set with `setopt' (for instance in
+ ;; ~/.emacs), we didn't necessarily know the type of the user option
+ ;; then. So check now, and issue a warning if it's wrong.
+ (let ((value (get symbol 'custom-check-value)))
+ (when value
+ (let ((type (get symbol 'custom-type)))
+ (when (and type
+ (boundp symbol)
+ (eq (car value) (symbol-value symbol))
+ ;; Check that the type is correct.
+ (not (widget-apply (widget-convert type)
+ :match (car value))))
+ (warn "Value `%S' for `%s' does not match type %s"
+ value symbol type)))))
(funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
symbol
(condition-case nil
@@ -100,7 +118,7 @@ or (last of all) the value of EXP."
"Initialize SYMBOL with EXP.
Like `custom-initialize-reset', but only use the `:set' function if
not using the standard setting.
-For the standard setting, use `set-default'."
+For the standard setting, use `set-default-toplevel-value'."
(condition-case nil
(let ((def (default-toplevel-value symbol)))
(funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
@@ -114,7 +132,7 @@ For the standard setting, use `set-default'."
symbol
(eval (car (get symbol 'saved-value)))))
(t
- (set-default symbol (eval exp)))))))
+ (set-default-toplevel-value symbol (eval exp)))))))
(defvar custom-delayed-init-variables nil
"List of variables whose initialization is pending until startup.
@@ -262,11 +280,11 @@ The following keywords are meaningful:
when using the Customize user interface. It takes two arguments,
the symbol to set and the value to give it. The function should
not modify its value argument destructively. The default choice
- of function is `set-default'.
+ of function is `set-default-toplevel-value'.
:get VALUE should be a function to extract the value of symbol.
The function takes one argument, a symbol, and should return
the current value for that symbol. The default choice of function
- is `default-value'.
+ is `default-toplevel-value'.
:require
VALUE should be a feature symbol. If you save a value
for this option, then when your init file loads the value,
@@ -364,7 +382,8 @@ call that function directly.
See Info node `(elisp) Customization' in the Emacs Lisp manual
for more information."
- (declare (doc-string 3) (debug (name body)))
+ (declare (doc-string 3) (debug (name body))
+ (indent defun))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
@@ -447,7 +466,7 @@ In the ATTS property list, possible attributes are `:family',
See Info node `(elisp) Faces' in the Emacs Lisp manual for more
information."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
@@ -515,7 +534,7 @@ non-nil.
See Info node `(elisp) Customization' in the Emacs Lisp manual
for more information."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
@@ -716,7 +735,7 @@ this sets the local binding in that buffer instead."
(if custom-local-buffer
(with-current-buffer custom-local-buffer
(set variable value))
- (set-default variable value)))
+ (set-default-toplevel-value variable value)))
(defun custom-set-minor-mode (variable value)
":set function for minor mode variables.
@@ -1135,29 +1154,24 @@ list, in which A occurs before B if B was defined with a
;; (provide-theme 'THEME)
-;; The IGNORED arguments to deftheme come from the XEmacs theme code, where
-;; they were used to supply keyword-value pairs like `:immediate',
-;; `:variable-reset-string', etc. We don't use any of these, so ignore them.
-
-(defmacro deftheme (theme &optional doc &rest _ignored)
+(defmacro deftheme (theme &optional doc)
"Declare THEME to be a Custom theme.
The optional argument DOC is a doc string describing the theme.
Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
(declare (doc-string 2)
- (advertised-calling-convention (theme &optional doc) "22.1"))
+ (indent 1))
(let ((feature (custom-make-theme-feature theme)))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
(list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc)))
-(defun custom-declare-theme (theme feature &optional doc &rest _ignored)
+(defun custom-declare-theme (theme feature &optional doc)
"Like `deftheme', but THEME is evaluated as a normal argument.
FEATURE is the feature this theme provides. Normally, this is a symbol
created from THEME by `custom-make-theme-feature'."
- (declare (advertised-calling-convention (theme feature &optional doc) "22.1"))
(unless (custom-theme-name-valid-p theme)
(error "Custom theme cannot be named %S" theme))
(unless (memq theme custom-known-themes)
@@ -1335,6 +1349,13 @@ Return t if THEME was successfully loaded, nil otherwise."
t))))
(t
(error "Unable to load theme `%s'" theme))))
+ (when-let ((obs (get theme 'byte-obsolete-info)))
+ (display-warning 'initialization
+ (format "The `%s' theme is obsolete%s"
+ theme
+ (if (nth 2 obs)
+ (format " since Emacs %s" (nth 2 obs))
+ ""))))
;; Optimization: if the theme changes the `default' face, put that
;; entry first. This avoids some `frame-set-background-mode' rigmarole
;; by assigning the new background immediately.
@@ -1419,6 +1440,22 @@ are not directories are omitted from the expansion."
;;; Enabling and disabling loaded themes.
+(defcustom enable-theme-functions nil
+ "Abnormal hook that is run after a theme has been enabled.
+The functions in the hook are called with one parameter -- the
+ name of the theme that's been enabled (as a symbol)."
+ :type 'hook
+ :group 'customize
+ :version "29.1")
+
+(defcustom disable-theme-functions nil
+ "Abnormal hook that is run after a theme has been disabled.
+The functions in the hook are called with one parameter -- the
+ name of the theme that's been disabled (as a symbol)."
+ :type 'hook
+ :group 'customize
+ :version "29.1")
+
(defun enable-theme (theme)
"Reenable all variable and face settings defined by THEME.
THEME should be either `user', or a theme loaded via `load-theme'.
@@ -1427,7 +1464,9 @@ After this function completes, THEME will have the highest
precedence (after `user') among enabled themes.
Note that any already-enabled themes remain enabled after this
-function runs. To disable other themes, use `disable-theme'."
+function runs. To disable other themes, use `disable-theme'.
+
+After THEME has been enabled, runs `enable-theme-functions'."
(interactive (list (intern
(completing-read
"Enable custom theme: "
@@ -1475,7 +1514,9 @@ function runs. To disable other themes, use `disable-theme'."
(setq custom-enabled-themes
(cons theme (remq theme custom-enabled-themes)))
;; Give the `user' theme the highest priority.
- (enable-theme 'user)))
+ (enable-theme 'user))
+ ;; Allow callers to react to the enabling.
+ (run-hook-with-args 'enable-theme-functions theme))
(defcustom custom-enabled-themes nil
"List of enabled Custom Themes, highest precedence first.
@@ -1520,7 +1561,9 @@ Setting this variable through Customize calls `enable-theme' or
(defun disable-theme (theme)
"Disable all variable and face settings defined by THEME.
-See `custom-enabled-themes' for a list of enabled themes."
+See `custom-enabled-themes' for a list of enabled themes.
+
+After THEME has been disabled, runs `disable-theme-functions'."
(interactive (list (intern
(completing-read
"Disable custom theme: "
@@ -1564,7 +1607,9 @@ See `custom-enabled-themes' for a list of enabled themes."
"unspecified-fg" "black"))
(face-set-after-frame-default frame))
(setq custom-enabled-themes
- (delq theme custom-enabled-themes))))
+ (delq theme custom-enabled-themes))
+ ;; Allow callers to react to the disabling.
+ (run-hook-with-args 'disable-theme-functions theme)))
;; Only used if window-system not null.
(declare-function x-get-resource "frame.c"
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 220a2f52e92..215425f1367 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -225,18 +225,27 @@ or matched by `dabbrev-ignored-buffer-regexps'."
(defcustom dabbrev-ignored-buffer-names '("*Messages*" "*Buffer List*")
"List of buffer names that dabbrev should not check.
-See also `dabbrev-ignored-buffer-regexps'."
+See also `dabbrev-ignored-buffer-regexps' and
+`dabbrev-ignored-buffer-modes'."
:type '(repeat (string :tag "Buffer name"))
:group 'dabbrev
:version "20.3")
(defcustom dabbrev-ignored-buffer-regexps nil
"List of regexps matching names of buffers that dabbrev should not check.
-See also `dabbrev-ignored-buffer-names'."
+See also `dabbrev-ignored-buffer-names' and
+`dabbrev-ignored-buffer-modes'."
:type '(repeat regexp)
:group 'dabbrev
:version "21.1")
+(defcustom dabbrev-ignored-buffer-modes '(archive-mode image-mode)
+ "Inhibit looking for abbreviations in buffers derived from these modes.
+See also `dabbrev-ignored-buffer-names' and
+`dabbrev-ignored-buffer-regexps'."
+ :type '(repeat symbol)
+ :version "29.1")
+
(defcustom dabbrev-check-other-buffers t
"Should \\[dabbrev-expand] look in other buffers?
nil: Don't look in other buffers.
@@ -383,6 +392,14 @@ If the prefix argument is 16 (which comes from \\[universal-argument] \\[univers
then it searches *all* buffers."
(interactive "*P")
(dabbrev--reset-global-variables)
+ (setq dabbrev--check-other-buffers (and arg t))
+ (setq dabbrev--check-all-buffers
+ (and arg (= (prefix-numeric-value arg) 16)))
+ (let ((completion-at-point-functions '(dabbrev-capf)))
+ (completion-at-point)))
+
+(defun dabbrev-capf ()
+ "Dabbrev completion function for `completion-at-point-functions'."
(let* ((abbrev (dabbrev--abbrev-at-point))
(beg (progn (search-backward abbrev) (point)))
(end (progn (search-forward abbrev) (point)))
@@ -420,10 +437,7 @@ then it searches *all* buffers."
(t
(mapcar #'downcase completion-list)))))))
(complete-with-action a list s p)))))
- (setq dabbrev--check-other-buffers (and arg t))
- (setq dabbrev--check-all-buffers
- (and arg (= (prefix-numeric-value arg) 16)))
- (completion-in-region beg end table)))
+ (list beg end table)))
;;;###autoload
(defun dabbrev-expand (arg)
@@ -537,8 +551,9 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]."
(if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found)
(minibuffer-window-active-p (selected-window))))
(progn
- (message "Expansion found in `%s'"
- (buffer-name dabbrev--last-buffer))
+ (when (buffer-name dabbrev--last-buffer)
+ (message "Expansion found in `%s'"
+ (buffer-name dabbrev--last-buffer)))
(setq dabbrev--last-buffer-found dabbrev--last-buffer))
(message nil))
(if (and (or (eq (current-buffer) dabbrev--last-buffer)
@@ -632,19 +647,29 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]."
"Return a list of other buffers to search for a possible abbrev.
The current buffer is not included in the list.
-This function makes a list of all the buffers returned by `buffer-list',
-then discards buffers whose names match `dabbrev-ignored-buffer-names'
-or `dabbrev-ignored-buffer-regexps'. It also discards buffers for which
-`dabbrev-friend-buffer-function', if it is bound, returns nil when called
-with the buffer as argument.
-It returns the list of the buffers that are not discarded."
+This function makes a list of all the buffers returned by
+`buffer-list', then discards buffers whose names match
+`dabbrev-ignored-buffer-names' or
+`dabbrev-ignored-buffer-regexps', and major modes that match
+`dabbrev-ignored-buffer-modes'. It also discards buffers for
+which `dabbrev-friend-buffer-function', if it is bound, returns
+nil when called with the buffer as argument. It returns the list
+of the buffers that are not discarded."
(dabbrev-filter-elements
- buffer (buffer-list)
+ buffer (dabbrev--filter-buffer-modes)
(and (not (eq (current-buffer) buffer))
(not (dabbrev--ignore-buffer-p buffer))
(boundp 'dabbrev-friend-buffer-function)
(funcall dabbrev-friend-buffer-function buffer))))
+(defun dabbrev--filter-buffer-modes ()
+ (seq-filter (lambda (buffer)
+ (not (apply
+ #'provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ dabbrev-ignored-buffer-modes)))
+ (buffer-list)))
+
(defun dabbrev--try-find (abbrev reverse n ignore-case)
"Search for ABBREV, backwards if REVERSE, N times.
If IGNORE-CASE is non-nil, ignore case while searching.
@@ -746,17 +771,41 @@ of the start of the occurrence."
(make-progress-reporter
"Scanning for dabbrevs..."
(- (length dabbrev--friend-buffer-list)) 0 0 1 1.5))))
- ;; Walk through the buffers till we find a match.
- (let (expansion)
- (while (and (not expansion) dabbrev--friend-buffer-list)
- (setq dabbrev--last-buffer (pop dabbrev--friend-buffer-list))
- (set-buffer dabbrev--last-buffer)
- (progress-reporter-update dabbrev--progress-reporter
- (- (length dabbrev--friend-buffer-list)))
- (setq dabbrev--last-expansion-location (point-min))
- (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case)))
- (progress-reporter-done dabbrev--progress-reporter)
- expansion)))))
+ (let ((file-name (buffer-file-name))
+ file-name-buffer)
+ (unwind-protect
+ (progn
+ ;; Include the file name components into the abbrev
+ ;; list (because if you have a file name "foobar", it's
+ ;; somewhat likely that you'll be talking about foobar
+ ;; stuff in the file itself).
+ (when file-name
+ (setq file-name-buffer (generate-new-buffer " *abbrev-file*"))
+ (with-current-buffer file-name-buffer
+ (dolist (part (file-name-split file-name))
+ (insert part "\n")))
+ (setq dabbrev--friend-buffer-list
+ (append dabbrev--friend-buffer-list
+ (list file-name-buffer))))
+ ;; Walk through the buffers till we find a match.
+ (let (expansion)
+ (while (and (not expansion) dabbrev--friend-buffer-list)
+ (setq dabbrev--last-buffer
+ (pop dabbrev--friend-buffer-list))
+ (set-buffer dabbrev--last-buffer)
+ (progress-reporter-update
+ dabbrev--progress-reporter
+ (- (length dabbrev--friend-buffer-list)))
+ (setq dabbrev--last-expansion-location (point-min))
+ (setq expansion (dabbrev--try-find
+ abbrev nil 1 ignore-case)))
+ (progress-reporter-done dabbrev--progress-reporter)
+ expansion))
+ (when (buffer-live-p file-name-buffer)
+ (kill-buffer file-name-buffer))
+ (setq dabbrev--friend-buffer-list
+ (seq-filter #'buffer-live-p
+ dabbrev--friend-buffer-list))))))))
;; Compute the list of buffers to scan.
;; If dabbrev-search-these-buffers-only, then the current buffer
@@ -779,7 +828,7 @@ of the start of the occurrence."
(setq list
(append list
(dabbrev-filter-elements
- buffer (buffer-list)
+ buffer (dabbrev--filter-buffer-modes)
(and (not (memq buffer list))
(not (dabbrev--ignore-buffer-p buffer)))))))
;; Remove the current buffer.
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 554b1e7249a..723a52b17d4 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -64,6 +64,19 @@
"If non-nil, deleted region text is stored in this register.
Value must be the register (key) to use.")
+(defcustom delete-selection-temporary-region nil
+ "Whether to delete only temporary regions.
+When non-nil, typed text replaces only the regions set by
+mouse-dragging, shift-selection, and \"\\[universal-argument] \\[exchange-point-and-mark]\" when
+`transient-mark-mode' is turned off. If the value is the symbol
+`selection', then replace only the regions set by mouse-dragging
+and shift-selection."
+ :version "29.1"
+ :group 'editing-basics
+ :type '(choice (const :tag "Replace all regions" nil)
+ (const :tag "Replace region from mouse, shift-selection, and \"C-u C-x C-x\"" t)
+ (const :tag "Replace region from mouse and shift-selection" selection)))
+
;;;###autoload
(defalias 'pending-delete-mode 'delete-selection-mode)
@@ -252,7 +265,13 @@ property on their symbol; commands which insert text but don't
have this property won't delete the selection.
See `delete-selection-helper'."
(when (and delete-selection-mode (use-region-p)
- (not buffer-read-only))
+ (not buffer-read-only)
+ (or (null delete-selection-temporary-region)
+ (and delete-selection-temporary-region
+ (consp transient-mark-mode)
+ (eq (car transient-mark-mode) 'only))
+ (and (not (eq delete-selection-temporary-region 'selection))
+ (eq transient-mark-mode 'lambda))))
(delete-selection-helper (and (symbolp this-command)
(get this-command 'delete-selection)))))
@@ -281,6 +300,9 @@ to `delete-selection-mode'."
(put 'yank-pop 'delete-selection 'yank)
(put 'yank-from-kill-ring 'delete-selection 'yank)
(put 'clipboard-yank 'delete-selection 'yank)
+(put 'mouse-yank-primary 'delete-selection 'yank)
+(put 'mouse-yank-secondary 'delete-selection 'yank)
+(put 'mouse-yank-at-click 'delete-selection 'yank)
(put 'insert-register 'delete-selection t)
;; delete-backward-char and delete-forward-char already delete the selection by
;; default, but not delete-char.
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 7427817a8ec..16971aa6611 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -176,6 +176,10 @@ otherwise."
(insert "\n"))
;; Text properties
(when properties
+ (when (plist-get properties 'invisible)
+ (insert "\nNote that character has an invisibility property,\n"
+ " so the character displayed at point in the buffer may\n"
+ " differ from the character described here.\n"))
(newline)
(insert "There are text properties here:\n")
(describe-property-list properties)))))
@@ -417,6 +421,7 @@ The character information includes:
(display-table (or (window-display-table)
buffer-display-table
standard-display-table))
+ (composition-string nil)
(disp-vector (and display-table (aref display-table char)))
(multibyte-p enable-multibyte-characters)
(overlays (mapcar (lambda (o) (overlay-properties o))
@@ -538,7 +543,8 @@ The character information includes:
(setcar composition nil)))
(setcar (cdr composition)
(format "composed to form \"%s\" (see below)"
- (buffer-substring from to)))))
+ (setq composition-string
+ (buffer-substring from to))))))
(setq composition nil)))
(setq item-list
@@ -682,6 +688,11 @@ The character information includes:
(if display
(format "terminal code %s" display)
"not encodable for terminal"))))))
+ ,@(when-let ((composition-name
+ (and composition-string
+ (eq (aref char-script-table char) 'emoji)
+ (emoji-describe composition-string))))
+ (list (list "composition name" composition-name)))
,@(let ((face
(if (not (or disp-vector composition))
(cond
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 041dbcf7c11..850d2a86efa 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -231,16 +231,26 @@ Zero or nil means disable auto-saving due to idleness."
(defcustom desktop-load-locked-desktop 'ask
"Specifies whether the desktop should be loaded if locked.
Possible values are:
- t -- load anyway.
- nil -- don't load.
- ask -- ask the user.
-If the value is nil, or `ask' and the user chooses not to load the desktop,
-the normal hook `desktop-not-loaded-hook' is run."
+ t -- load anyway.
+ nil -- don't load.
+ ask -- ask the user.
+ check-pid -- load if locking Emacs process is missing locally.
+
+If the value is nil, or `ask' and the user chooses not to load
+the desktop, the normal hook `desktop-not-loaded-hook' is run.
+
+If the value is `check-pid', load the desktop if the Emacs
+process that has locked it is not running on the local machine.
+This should not be used in circumstances where the locking Emacs
+might still be running on another machine. That could be the
+case if you have remotely mounted (NFS) paths in
+`desktop-dirname'."
:type
'(choice
(const :tag "Load anyway" t)
(const :tag "Don't load" nil)
- (const :tag "Ask the user" ask))
+ (const :tag "Ask the user" ask)
+ (const :tag "Load if no local process" check-pid))
:group 'desktop
:version "22.2")
@@ -425,7 +435,9 @@ If `all', also restores frames that are partially offscreen onscreen.
Note that checking of frame boundaries is only approximate.
It can fail to reliably detect frames whose onscreen/offscreen state
depends on a few pixels, especially near the right / bottom borders
-of the screen."
+of the screen.
+Text-mode frames are always considered onscreen, so this option has
+no effect on restoring frames in a non-GUI session."
:type '(choice (const :tag "Only fully offscreen frames" t)
(const :tag "Also partially offscreen frames" all)
(const :tag "Do not force frames onscreen" nil))
@@ -469,7 +481,7 @@ If value is t, all buffers are restored immediately."
(defcustom desktop-lazy-idle-delay 5
"Idle delay before starting to create buffers.
See `desktop-restore-eager'."
- :type 'integer
+ :type 'natnum
:group 'desktop
:version "22.1")
@@ -636,6 +648,14 @@ Only valid during frame saving & restoring; intended for internal use.")
"When the desktop file was last modified to the knowledge of this Emacs.
Used to detect desktop file conflicts.")
+(defun desktop--get-file-modtime ()
+ "Get desktop file modtime, in list form for desktop format version 208."
+ (setq desktop-file-modtime
+ (time-convert (file-attribute-modification-time
+ (file-attributes
+ (desktop-full-file-name)))
+ 'list)))
+
(defvar desktop-var-serdes-funs
(list (list
'mark-ring
@@ -663,6 +683,44 @@ DIRNAME omitted or nil means use `desktop-dirname'."
(integerp owner)))
owner)))
+(defun desktop--emacs-pid-running-p (pid)
+ "Return non-nil if an Emacs process whose ID is PID might still be running."
+ (when-let ((attr (process-attributes pid)))
+ (let ((proc-cmd (alist-get 'comm attr))
+ (my-cmd (file-name-nondirectory (car command-line-args)))
+ (case-fold-search t))
+ (or (equal proc-cmd my-cmd)
+ (and (eq system-type 'windows-nt)
+ (eq t (compare-strings proc-cmd
+ nil
+ (if (string-suffix-p ".exe" proc-cmd t)
+ -4)
+ my-cmd
+ nil
+ (if (string-suffix-p ".exe" my-cmd t)
+ -4))))
+ ;; We should err on the safe side here: if any of the
+ ;; executables is something like "emacs-nox" or "emacs-42.1"
+ ;; or "gemacs" or "xemacs", let's recognize them as well.
+ (and (string-match-p "emacs" proc-cmd)
+ (string-match-p "emacs" my-cmd))))))
+
+(defun desktop--load-locked-desktop-p (owner)
+ "Return t if a locked desktop should be loaded.
+OWNER is the pid in the lock file.
+The return value of this function depends on the value of
+`desktop-load-locked-desktop'."
+ (pcase desktop-load-locked-desktop
+ ('ask
+ (unless (daemonp)
+ (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\
+Using it may cause conflicts. Use it anyway? " owner))))
+ ('check-pid
+ (or (eq (emacs-pid) owner)
+ (not (desktop--emacs-pid-running-p owner))))
+ ('nil nil)
+ (_ t)))
+
(defun desktop-claim-lock (&optional dirname)
"Record this Emacs process as the owner of the desktop file in DIRNAME.
DIRNAME omitted or nil means use `desktop-dirname'."
@@ -800,15 +858,16 @@ buffer, which is (in order):
,(buffer-name)
,major-mode
;; minor modes
- ,(let (ret)
- (dolist (minor-mode (mapcar #'car minor-mode-alist) ret)
- (and (boundp minor-mode)
- (symbol-value minor-mode)
- (let* ((special (assq minor-mode desktop-minor-mode-table))
- (value (cond (special (cadr special))
- ((get minor-mode :minor-mode-function))
- ((functionp minor-mode) minor-mode))))
- (when value (cl-pushnew value ret))))))
+ ,(seq-filter
+ (lambda (minor-mode)
+ ;; Just two sanity checks.
+ (and (boundp minor-mode)
+ (symbol-value minor-mode)
+ (let ((special
+ (assq minor-mode desktop-minor-mode-table)))
+ (or (not special)
+ (cadr special)))))
+ local-minor-modes)
;; point and mark, and read-only status
,(point)
,(list (mark t) mark-active)
@@ -1073,7 +1132,7 @@ no questions asked."
(file-attributes (desktop-full-file-name)))))
(when
(or (not new-modtime) ; nothing to overwrite
- (equal desktop-file-modtime new-modtime)
+ (time-equal-p desktop-file-modtime new-modtime)
(yes-or-no-p (if desktop-file-modtime
(if (time-less-p desktop-file-modtime
new-modtime)
@@ -1173,9 +1232,7 @@ no questions asked."
(write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
(setq desktop-file-checksum checksum)
;; We remember when it was modified (which is presumably just now).
- (setq desktop-file-modtime (file-attribute-modification-time
- (file-attributes
- (desktop-full-file-name)))))))))))
+ (desktop--get-file-modtime))))))))
;; ----------------------------------------------------------------------------
;;;###autoload
@@ -1197,7 +1254,11 @@ This function also sets `desktop-dirname' to nil."
;; ----------------------------------------------------------------------------
(defun desktop-restoring-frameset-p ()
"True if calling `desktop-restore-frameset' will actually restore it."
- (and desktop-restore-frames desktop-saved-frameset (display-graphic-p) t))
+ (and desktop-restore-frames desktop-saved-frameset
+ ;; Don't restore frames when the selected frame is the daemon's
+ ;; initial frame.
+ (not (and (daemonp) (not (frame-parameter nil 'client))))
+ t))
(defun desktop-restore-frameset ()
"Restore the state of a set of frames.
@@ -1208,7 +1269,17 @@ being set (usually, by reading it from the desktop)."
:reuse-frames (eq desktop-restore-reuses-frames t)
:cleanup-frames (not (eq desktop-restore-reuses-frames 'keep))
:force-display desktop-restore-in-current-display
- :force-onscreen desktop-restore-forces-onscreen)))
+ :force-onscreen (and desktop-restore-forces-onscreen
+ (display-graphic-p)))
+ ;; When at least one restored frame contains a tab bar,
+ ;; enable `tab-bar-mode' that takes care about recalculating
+ ;; the correct values of the frame parameter `tab-bar-lines'
+ ;; (that depends on `tab-bar-show'), and also loads graphical buttons.
+ (when (seq-some
+ (lambda (frame)
+ (menu-bar-positive-p (frame-parameter frame 'tab-bar-lines)))
+ (frame-list))
+ (tab-bar-mode 1))))
;; Just to silence the byte compiler.
;; Dynamically bound in `desktop-read'.
@@ -1264,13 +1335,7 @@ It returns t if a desktop file was loaded, nil otherwise.
(desktop-save nil)
(desktop-autosave-was-enabled))
(if (and owner
- (memq desktop-load-locked-desktop '(nil ask))
- (or (null desktop-load-locked-desktop)
- (daemonp)
- (not (y-or-n-p (format "
-Warning: desktop file appears to be in use by process with PID %s.\n\
-Using it may cause conflicts if that process still runs.\n\
-Use desktop file anyway? " owner)))))
+ (not (desktop--load-locked-desktop-p owner)))
(let ((default-directory desktop-dirname))
(setq desktop-dirname nil)
(run-hooks 'desktop-not-loaded-hook)
@@ -1290,9 +1355,7 @@ Use desktop file anyway? " owner)))))
'window-configuration-change-hook)))
(desktop-auto-save-disable)
;; Evaluate desktop buffer and remember when it was modified.
- (setq desktop-file-modtime (file-attribute-modification-time
- (file-attributes
- (desktop-full-file-name))))
+ (desktop--get-file-modtime)
(load (desktop-full-file-name) t t t)
;; If it wasn't already, mark it as in-use, to bother other
;; desktop instances.
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 6593708a13c..9580a3187fd 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -120,9 +120,7 @@
:prefix "dframe-"
:group 'dframe)
-(defvar dframe-have-timer-flag (if (fboundp 'display-graphic-p)
- (display-graphic-p)
- window-system)
+(defvar dframe-have-timer-flag (display-graphic-p)
"Non-nil means that timers are available for this Emacs.
This is nil for terminals, since updating a frame in a terminal
is not useful to the user.")
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index b62e94fa77a..b9f33036e31 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -444,10 +444,10 @@ List has a form of (file-name full-file-name (attribute-list))."
((eq op-symbol 'chgrp)
(file-attribute-group-id
(file-attributes default-file 'string))))))
- (prompt (concat "Change " attribute-name " of %s to"
- (if (eq op-symbol 'touch)
- " (default now): "
- ": ")))
+ (prompt (format-prompt "Change %s of %%s to"
+ (when (eq op-symbol 'touch)
+ "now")
+ attribute-name))
(new-attribute (dired-mark-read-string prompt nil op-symbol
arg files default
(cond ((eq op-symbol 'chown)
@@ -796,6 +796,15 @@ offer a smarter default choice of shell command."
'read-shell-command prompt nil nil))))
;;;###autoload
+(defcustom dired-confirm-shell-command t
+ "Whether to prompt for confirmation for `dired-do-shell-command'.
+If non-nil, prompt for confirmation if the command contains potentially
+dangerous characters. If nil, never prompt for confirmation."
+ :type 'boolean
+ :group 'dired
+ :version "29.1")
+
+;;;###autoload
(defun dired-do-async-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files asynchronously.
@@ -810,7 +819,9 @@ are executed in the background on each file sequentially waiting
for each command to terminate before running the next command.
In shell syntax this means separating the individual commands with `;'.
-The output appears in the buffer named by `shell-command-buffer-name-async'."
+The output appears in the buffer named by `shell-command-buffer-name-async'.
+
+Commands that are run asynchronously do not accept user input."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
@@ -873,7 +884,9 @@ can be produced by `dired-get-marked-files', for example.
`dired-guess-shell-alist-default' and
`dired-guess-shell-alist-user' are consulted when the user is
-prompted for the shell command to use interactively."
+prompted for the shell command to use interactively.
+
+Also see the `dired-confirm-shell-command' variable."
;; Functions dired-run-shell-command and dired-shell-stuff-it do the
;; actual work and can be redefined for customization.
(interactive
@@ -891,6 +904,8 @@ prompted for the shell command to use interactively."
(ok (cond
((not (or on-each no-subst))
(error "You can not combine `*' and `?' substitution marks"))
+ ((not dired-confirm-shell-command)
+ t)
((setq confirmations (dired--need-confirm-positions command "*"))
(dired--no-subst-confirm confirmations command))
((setq confirmations (dired--need-confirm-positions command "?"))
@@ -954,6 +969,13 @@ prompted for the shell command to use interactively."
(setq retval (replace-match x t t retval 2)))
retval))
(lambda (x) (concat cmd-prefix command dired-mark-separator x)))))
+ ;; If a file name starts with "-", add a "./" to avoid the command
+ ;; interpreting it as a command line switch.
+ (setq file-list (mapcar (lambda (file)
+ (if (string-match "\\`-" file)
+ (concat "./" file)
+ file))
+ file-list))
(concat
(cond
(on-each
@@ -976,8 +998,15 @@ prompted for the shell command to use interactively."
file-list dired-mark-separator)))
(when (cdr file-list)
(setq files (concat dired-mark-prefix files dired-mark-postfix)))
- (funcall stuff-it files))))
- (or (and in-background "&") ""))))
+ (concat
+ (funcall stuff-it files)
+ ;; Be consistent in how we treat inputs to commands -- do
+ ;; the same here as in the `on-each' case.
+ (if (and in-background (not w32-shell))
+ "&wait"
+ "")))))
+ (or (and in-background "&")
+ ""))))
;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
@@ -1009,6 +1038,7 @@ the offending ARGUMENTS or PROGRAM if no ARGUMENTS were provided."
(erase-buffer)
(setq default-directory dir ; caller's default-directory
err (not (eq 0 (apply #'process-file program nil t nil arguments))))
+ (dired-uncache dir)
(if err
(progn
(dired-log (concat program " " (prin1-to-string arguments) "\n"))
@@ -1026,17 +1056,19 @@ Return the result of `process-file' - zero for success."
(dir default-directory))
(with-current-buffer (get-buffer-create out-buffer)
(erase-buffer)
- (let* ((default-directory dir)
- (res (process-file
- shell-file-name
- nil
- t
- nil
- shell-command-switch
- cmd)))
- (unless (zerop res)
- (pop-to-buffer out-buffer))
- res))))
+ (let ((default-directory dir) res)
+ (with-connection-local-variables
+ (setq res (process-file
+ shell-file-name
+ nil
+ t
+ nil
+ shell-command-switch
+ cmd))
+ (dired-uncache dir)
+ (unless (zerop res)
+ (pop-to-buffer out-buffer))
+ res)))))
;;; Commands that delete or redisplay part of the dired buffer
@@ -1064,45 +1096,46 @@ With a prefix argument, kill that many lines starting with the current line.
(dired-move-to-filename)))
;;;###autoload
-(defun dired-do-kill-lines (&optional arg fmt)
- "Kill all marked lines (not the files).
-With a prefix argument, kill that many lines starting with the current line.
-\(A negative argument kills backward.)
+(defun dired-do-kill-lines (&optional arg fmt init-count)
+ "Remove all marked lines, or the next ARG lines.
+The files or directories on those lines are _not_ deleted. Only the
+Dired listing is affected. To restore the removals, use `\\[revert-buffer]'.
-If you use this command with a prefix argument to kill the line
-for a file that is a directory, which you have inserted in the
-Dired buffer as a subdirectory, then it deletes that subdirectory
-from the buffer as well.
+With a numeric prefix arg, remove that many lines going forward,
+starting with the current line. (A negative prefix arg removes lines
+going backward.)
-To kill an entire subdirectory \(without killing its line in the
-parent directory), go to its directory header line and use this
-command with a prefix argument (the value does not matter).
+If you use a prefix arg to remove the line for a subdir whose listing
+you have inserted into the Dired buffer, then that subdir listing is
+also removed.
-To undo the killing, the undo command can be used as normally.
+To remove a subdir listing _without_ removing the subdir's line in its
+parent listing, go to the header line of the subdir listing and use
+this command with any prefix arg.
-This function returns the number of killed lines.
+When called from Lisp, non-nil INIT-COUNT is added to the number of
+lines removed by this invocation, for the reporting message.
-FMT is a format string used for messaging the user about the
-killed lines, and defaults to \"Killed %d line%s.\" if not
-present. A FMT of \"\" will suppress the messaging."
+A FMT of \"\" will suppress the messaging."
+ ;; Returns count of killed lines.
(interactive "P")
(if arg
(if (dired-get-subdir)
- (dired-kill-subdir)
- (dired-kill-line arg))
+ (dired-kill-subdir)
+ (dired-kill-line arg))
(save-excursion
(goto-char (point-min))
- (let (buffer-read-only
- (count 0)
- (regexp (dired-marker-regexp)))
- (while (and (not (eobp))
- (re-search-forward regexp nil t))
- (setq count (1+ count))
- (delete-region (line-beginning-position)
- (progn (forward-line 1) (point))))
- (or (equal "" fmt)
- (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
- count))))
+ (let ((count (or init-count 0))
+ (regexp (dired-marker-regexp))
+ (inhibit-read-only t))
+ (while (and (not (eobp))
+ (re-search-forward regexp nil t))
+ (setq count (1+ count))
+ (delete-region (line-beginning-position)
+ (progn (forward-line 1) (point))))
+ (unless (equal "" fmt)
+ (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
+ count))))
;;; Compression
@@ -1283,9 +1316,9 @@ Return nil if no change in files."
(prog1 (setq newname (file-name-as-directory newname))
(dired-shell-command
(replace-regexp-in-string
- "%o" (shell-quote-argument newname)
+ "%o" (shell-quote-argument (file-local-name newname))
(replace-regexp-in-string
- "%i" (shell-quote-argument file)
+ "%i" (shell-quote-argument (file-local-name file))
command
nil t)
nil t)))
@@ -1296,10 +1329,10 @@ Return nil if no change in files."
(dired-check-process msg
(substring command 0 match)
(substring command (1+ match))
- file)
+ (file-local-name file))
(dired-check-process msg
command
- file))
+ (file-local-name file)))
newname))))
(t
;; We don't recognize the file as compressed, so compress it.
@@ -1317,7 +1350,8 @@ Return nil if no change in files."
(default-directory (file-name-directory file)))
(dired-shell-command
(replace-regexp-in-string
- "%o" (shell-quote-argument out-name)
+ "%o" (shell-quote-argument
+ (file-local-name out-name))
(replace-regexp-in-string
"%i" (shell-quote-argument
(file-name-nondirectory file))
@@ -1347,9 +1381,10 @@ see `dired-compress-file-alist' for the supported suffixes list"
out-name)))
(dired-shell-command
(replace-regexp-in-string
- "%o" (shell-quote-argument out-name)
+ "%o" (shell-quote-argument
+ (file-local-name out-name))
(replace-regexp-in-string
- "%i" (shell-quote-argument file)
+ "%i" (shell-quote-argument (file-local-name file))
(cdr rule)
nil t)
nil t))
@@ -1364,7 +1399,8 @@ see `dired-compress-file-alist' for the supported suffixes list"
out-name)))))
(file-error
(if (not (dired-check-process (concat "Compressing " file)
- "compress" "-f" file))
+ "compress" "-f"
+ (file-local-name file)))
;; Don't use NEWNAME with `compress'.
(concat file ".Z"))))))))
@@ -1785,13 +1821,46 @@ Special value `always' suppresses confirmation."
"Whether Dired should create destination dirs when copying/removing files.
If nil, don't create them.
If `always', create them without asking.
-If `ask', ask for user confirmation."
+If `ask', ask for user confirmation.
+
+Also see `dired-create-destination-dirs-on-trailing-dirsep'."
:type '(choice (const :tag "Never create non-existent dirs" nil)
(const :tag "Always create non-existent dirs" always)
(const :tag "Ask for user confirmation" ask))
:group 'dired
:version "27.1")
+(defcustom dired-create-destination-dirs-on-trailing-dirsep nil
+ "If non-nil, treat a trailing slash at queried destination dir specially.
+
+If this variable is non-nil and a single destination filename is
+queried which ends in a directory separator (/), it will be
+treated as a non-existent directory and acted on according to
+`dired-create-destination-dirs'.
+
+This option is only relevant if `dired-create-destination-dirs'
+is non-nil, too.
+
+For example, if both `dired-create-destination-dirs' and this
+option are non-nil, renaming a directory named `old_name' to
+`new_name/' (note the trailing directory separator) where
+`new_name' does not exists already, it will be created and
+`old_name' be moved into it. If only `new_name' (without the
+trailing /) is given or this option or
+`dired-create-destination-dirs' is `nil', `old_name' will be
+renamed to `new_name'."
+ :type '(choice
+ (const :tag
+ (concat "Do not treat destination dirs with a "
+ "trailing directory separator specially")
+ nil)
+ (const :tag
+ (concat "Treat destination dirs with trailing "
+ "directory separator specially")
+ t))
+ :group 'dired
+ :version "29.1")
+
(defun dired-maybe-create-dirs (dir)
"Create DIR if doesn't exist according to `dired-create-destination-dirs'."
(when (and dired-create-destination-dirs (not (file-exists-p dir)))
@@ -1988,11 +2057,12 @@ or with the current marker character if MARKER-CHAR is t."
(let* ((overwrite (file-exists-p to))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
- (let ((help-form (format-message "\
-Type SPC or `y' to overwrite file `%s',
-DEL or `n' to skip to next,
-ESC or `q' to not overwrite any of the remaining files,
-`!' to overwrite all remaining files with no more questions." to)))
+ (let ((help-form (format-message
+ (substitute-command-keys "\
+Type \\`SPC' or \\`y' to overwrite file `%s',
+\\`DEL' or \\`n' to skip to next,
+\\`ESC' or \\`q' to not overwrite any of the remaining files,
+\\`!' to overwrite all remaining files with no more questions.") to)))
(dired-query 'overwrite-query
"Overwrite `%s'?" to))))
;; must determine if FROM is marked before file-creator
@@ -2108,18 +2178,23 @@ Prompt user for a target directory in which to create the new
one file is marked. The initial suggestion for target is the
Dired buffer's current directory (or, if `dired-dwim-target' is
non-nil, the current directory of a neighboring Dired window).
+
OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
will determine whether pop-ups are appropriate for this OP-SYMBOL.
+
FILE-CREATOR and OPERATION as in `dired-create-files'.
+
ARG as in `dired-get-marked-files'.
+
Optional arg MARKER-CHAR as in `dired-create-files'.
+
Optional arg OP1 is an alternate form for OPERATION if there is
only one file.
+
Optional arg HOW-TO determines how to treat the target.
If HOW-TO is nil, use `file-directory-p' to determine if the
target is a directory. If so, the marked file(s) are created
- inside that directory. Otherwise, the target is a plain file;
- an error is raised unless there is exactly one marked file.
+ inside that directory.
If HOW-TO is t, target is always treated as a plain file.
Otherwise, HOW-TO should be a function of one argument, TARGET.
If its return value is nil, TARGET is regarded as a plain file.
@@ -2132,6 +2207,11 @@ Optional arg HOW-TO determines how to treat the target.
target - the name of the target itself.
The rest of elements of the list returned by HOW-TO are optional
arguments for the function that is the first element of the list.
+
+ This can be useful because by default, copying a single file
+ would replace the tar file. But this could be overridden to
+ add or replace entries in the tar file.
+
For any other return value, TARGET is treated as a directory."
(or op1 (setq op1 operation))
(let* ((fn-list (dired-get-marked-files nil arg nil nil t))
@@ -2161,7 +2241,12 @@ Optional arg HOW-TO determines how to treat the target.
target-dir op-symbol arg rfn-list default))))
(into-dir
(progn
- (unless dired-one-file (dired-maybe-create-dirs target))
+ (when
+ (or
+ (not dired-one-file)
+ (and dired-create-destination-dirs-on-trailing-dirsep
+ (directory-name-p target)))
+ (dired-maybe-create-dirs target))
(cond ((null how-to)
;; Allow users to change the letter case of
;; a directory on a case-insensitive
@@ -2375,7 +2460,7 @@ If FILE already exists, signal an error."
(defvar dired-copy-how-to-fn nil
"Either nil or a function used by `dired-do-copy' to determine target.
-See HOW-TO argument for `dired-do-create-files'.")
+See HOW-TO argument for `dired-do-create-files' for an explanation.")
;;;###autoload
(defun dired-do-copy (&optional arg)
@@ -2396,6 +2481,10 @@ If `dired-copy-preserve-time' is non-nil, this command preserves
the modification time of each old file in the copy, similar to
the \"-p\" option for the \"cp\" shell command.
+The `dired-keep-marker-copy' user option controls how this
+command handles file marking. The default is to mark all new
+copies of files with a \"C\" mark.
+
This command copies symbolic links by creating new ones,
similar to the \"-d\" option for the \"cp\" shell command.
But if `dired-copy-dereference' is non-nil, the symbolic
@@ -2433,6 +2522,73 @@ Also see `dired-do-revert-buffer'."
"Symlink" arg dired-keep-marker-symlink))
;;;###autoload
+(defun dired-do-relsymlink (&optional arg)
+ "Relative symlink all marked (or next ARG) files into a directory.
+Otherwise make a relative symbolic link to the current file.
+This creates relative symbolic links like
+
+ foo -> ../bar/foo
+
+not absolute ones like
+
+ foo -> /ugly/file/name/that/may/change/any/day/bar/foo
+
+For absolute symlinks, use \\[dired-do-symlink]."
+ (interactive "P")
+ (dired-do-create-files 'relsymlink #'dired-make-relative-symlink
+ "RelSymLink" arg dired-keep-marker-relsymlink))
+
+(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists)
+ "Make a symbolic link (pointing to FILE1) in FILE2.
+The link is relative (if possible), for example
+
+ \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"
+
+results in
+
+ \"../../tex/bin/foo\" \"/vol/local/bin/foo\""
+ (interactive "FRelSymLink: \nFRelSymLink %s: \np")
+ (let (name1 name2 len1 len2 (index 0) sub)
+ (setq file1 (expand-file-name file1)
+ file2 (expand-file-name file2)
+ len1 (length file1)
+ len2 (length file2))
+ ;; Find common initial file name components:
+ (let (next)
+ (while (and (setq next (string-search "/" file1 index))
+ (< (setq next (1+ next)) (min len1 len2))
+ ;; For the comparison, both substrings must end in
+ ;; `/', so NEXT is *one plus* the result of the
+ ;; string-search.
+ ;; E.g., consider the case of linking "/tmp/a/abc"
+ ;; to "/tmp/abc" erroneously giving "/tmp/a" instead
+ ;; of "/tmp/" as common initial component
+ (string-equal (substring file1 0 next)
+ (substring file2 0 next)))
+ (setq index next))
+ (setq name2 file2
+ sub (substring file1 0 index)
+ name1 (substring file1 index)))
+ (if (string-equal sub "/")
+ ;; No common initial file name found
+ (setq name1 file1)
+ ;; Else they have a common parent directory
+ (let ((tem (substring file2 index))
+ (start 0)
+ (count 0))
+ ;; Count number of slashes we must compensate for ...
+ (while (setq start (string-search "/" tem start))
+ (setq count (1+ count)
+ start (1+ start)))
+ ;; ... and prepend a "../" for each slash found:
+ (dotimes (_ count)
+ (setq name1 (concat "../" name1)))))
+ (make-symbolic-link
+ (directory-file-name name1) ; must not link to foo/
+ ; (trailing slash!)
+ name2 ok-if-already-exists)))
+
+;;;###autoload
(defun dired-do-hardlink (&optional arg)
"Add names (hard links) current file or all marked (or next ARG) files.
When operating on just the current file, you specify the new name.
@@ -2485,11 +2641,12 @@ Also see `dired-do-revert-buffer'."
;; Optional arg MARKER-CHAR as in dired-create-files.
(let* ((fn-list (dired-get-marked-files nil arg))
(operation-prompt (concat operation " `%s' to `%s'?"))
- (rename-regexp-help-form (format-message "\
-Type SPC or `y' to %s one match, DEL or `n' to skip to next,
-`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation)))
+ (rename-regexp-help-form (format-message
+ (substitute-command-keys "\
+Type \\`SPC' or \\`y' to %s one match, \\`DEL' or \\`n' to skip to next,
+\\`!' to %s all remaining matches with no more questions.")
+ (downcase operation)
+ (downcase operation)))
(regexp-name-constructor
;; Function to construct new filename using REGEXP and NEWNAME:
(if whole-name ; easy (but rare) case
@@ -2591,6 +2748,16 @@ See function `dired-do-rename-regexp' for more info."
#'make-symbolic-link
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
+;;;###autoload
+(defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name)
+ "RelSymlink all marked files containing REGEXP to NEWNAME.
+See functions `dired-do-rename-regexp' and `dired-do-relsymlink'
+for more info."
+ (interactive (dired-mark-read-regexp "RelSymLink"))
+ (dired-do-create-files-regexp
+ #'dired-make-relative-symlink
+ "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink))
+
;;; Change case of file names
@@ -2610,11 +2777,12 @@ See function `dired-do-rename-regexp' for more info."
(let ((to (concat (file-name-directory from)
(funcall basename-constructor
(file-name-nondirectory from)))))
- (and (let ((help-form (format-message "\
-Type SPC or `y' to %s one file, DEL or `n' to skip to next,
-`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation))))
+ (and (let ((help-form (format-message
+ (substitute-command-keys "\
+Type \\`SPC' or \\`y' to %s one file, \\`DEL' or \\`n' to skip to next,
+\\`!' to %s all remaining matches with no more questions.")
+ (downcase operation)
+ (downcase operation))))
(dired-query 'rename-non-directory-query
(concat operation " `%s' to `%s'")
(dired-make-relative from)
@@ -2864,8 +3032,8 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
;; if dired-actual-switches contained t.
(setq dir1 (file-name-as-directory dir1)
dir2 (file-name-as-directory dir2))
- (let ((components-1 (dired-split "/" dir1))
- (components-2 (dired-split "/" dir2)))
+ (let ((components-1 (split-string dir1 "/"))
+ (components-2 (split-string dir2 "/")))
(while (and components-1
components-2
(equal (car components-1) (car components-2)))
@@ -2884,7 +3052,6 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
nil)
(t (error "This can't happen"))))))
-;; There should be a builtin split function - inverse to mapconcat.
(defun dired-split (pat str &optional limit)
"Splitting on regexp PAT, turn string STR into a list of substrings.
Optional third arg LIMIT (>= 1) is a limit to the length of the
@@ -2894,6 +3061,7 @@ Thus, if SEP is a regexp that only matches itself,
(mapconcat #'identity (dired-split SEP STRING) SEP)
is always equal to STRING."
+ (declare (obsolete split-string "29.1"))
(let* ((start (string-match pat str))
(result (list (substring str 0 start)))
(count 1)
@@ -2932,18 +3100,20 @@ When called interactively and not on a subdir line, go to this subdir's line."
;;;###autoload
(defun dired-goto-subdir (dir)
- "Go to end of header line of DIR in this dired buffer.
+ "Go to end of header line of inserted directory DIR in this Dired buffer.
+When called interactively, prompt for the inserted subdirectory
+to go to.
+
Return value of point on success, otherwise return nil.
The next char is \\n."
(interactive
(prog1 ; let push-mark display its message
(list (expand-file-name
- (completing-read "Goto in situ directory: " ; prompt
- dired-subdir-alist ; table
- nil ; predicate
- t ; require-match
- (dired-current-directory))))
- (push-mark)))
+ (completing-read "Goto inserted directory: "
+ dired-subdir-alist nil t
+ (dired-current-directory))))
+ (push-mark))
+ dired-mode)
(setq dir (file-name-as-directory dir))
(let ((elt (assoc dir dired-subdir-alist)))
(and elt
@@ -3081,16 +3251,16 @@ a file name. Otherwise, it searches the whole buffer without restrictions."
(define-minor-mode dired-isearch-filenames-mode
"Toggle file names searching on or off.
-When on, Isearch skips matches outside file names using the predicate
-`dired-isearch-filter-filenames' that matches only at file names.
-When off, it uses the original predicate."
+When on, Isearch skips matches outside file names using the search function
+`dired-isearch-search-filenames' that matches only at file names.
+When off, it uses the default search function."
:lighter nil
(if dired-isearch-filenames-mode
- (add-function :before-while (local 'isearch-filter-predicate)
- #'dired-isearch-filter-filenames
+ (add-function :around (local 'isearch-search-fun-function)
+ #'dired-isearch-search-filenames
'((isearch-message-prefix . "filename ")))
- (remove-function (local 'isearch-filter-predicate)
- #'dired-isearch-filter-filenames))
+ (remove-function (local 'isearch-search-fun-function)
+ #'dired-isearch-search-filenames))
(when isearch-mode
(setq isearch-success t isearch-adjusted t)
(isearch-update)))
@@ -3114,12 +3284,12 @@ Intended to be added to `isearch-mode-hook'."
(unless isearch-suspended
(kill-local-variable 'dired-isearch-filenames)))
-(defun dired-isearch-filter-filenames (beg end)
- "Test whether some part of the current search match is inside a file name.
-This function returns non-nil if some part of the text between BEG and END
-is part of a file name (i.e., has the text property `dired-filename')."
- (text-property-not-all (min beg end) (max beg end)
- 'dired-filename nil))
+(defun dired-isearch-search-filenames (orig-fun)
+ "Return the function that searches inside file names.
+The returned function narrows the search to match the search string
+only as part of a file name enclosed by the text property `dired-filename'.
+It's intended to override the default search function."
+ (isearch-search-fun-in-text-property (funcall orig-fun) 'dired-filename))
;;;###autoload
(defun dired-isearch-filenames ()
@@ -3196,7 +3366,6 @@ resume the query replace with the command \\[fileloop-continue]."
delimited)
(fileloop-continue))
-(declare-function xref--show-xrefs "xref")
(declare-function xref-query-replace-in-results "xref")
(declare-function project--files-in-directory "project")
@@ -3232,7 +3401,7 @@ REGEXP should use constructs supported by your local `grep' command."
(project--files-in-directory mark ignores "*")
files))
(push mark files)))
- (nreverse marks))
+ (reverse marks))
(message "Searching...")
(setq xrefs
(xref-matches-in-files regexp files))
@@ -3240,7 +3409,7 @@ REGEXP should use constructs supported by your local `grep' command."
(user-error "No matches for: %s" regexp))
(message "Searching...done")
xrefs))))
- (xref--show-xrefs fetcher nil)))
+ (xref-show-xrefs fetcher nil)))
;;;###autoload
(defun dired-do-find-regexp-and-replace (from to)
@@ -3258,7 +3427,10 @@ recursively. However, files matching `grep-find-ignored-files'
and subdirectories matching `grep-find-ignored-directories' are skipped
in the marked directories.
-REGEXP should use constructs supported by your local `grep' command."
+REGEXP should use constructs supported by your local `grep' command.
+
+Also see `query-replace' for user options that affect how this
+function works."
(interactive
(let ((common
(query-replace-read-args
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 998cd46c7d6..9edf8374815 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1,7 +1,6 @@
;;; dired-x.el --- extra Dired functionality -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 1997, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1993-2022 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Lawrence R. Dodd <dodd@roebling.poly.edu>
@@ -51,11 +50,6 @@
"Extended directory editing (dired-x)."
:group 'dired)
-(defgroup dired-keys nil
- "Dired keys customizations."
- :prefix "dired-"
- :group 'dired-x)
-
(defcustom dired-bind-vm nil
"Non-nil means \"V\" runs `dired-vm', otherwise \"V\" runs `dired-rmail'.
RMAIL files in the old Babyl format (used before Emacs 23.1)
@@ -63,34 +57,16 @@ contain \"-*- rmail -*-\" at the top, so `dired-find-file'
will run `rmail' on these files. New RMAIL files use the standard
mbox format, and so cannot be distinguished in this way."
:type 'boolean
- :group 'dired-keys)
+ :group 'dired-x)
(defvar dired-bind-jump t)
(make-obsolete-variable 'dired-bind-jump "not used." "28.1")
-(defcustom dired-bind-man t
- "Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not.
-Setting this variable directly after dired-x is loaded has no effect -
-use \\[customize]."
- :type 'boolean
- :set (lambda (sym val)
- (if (set sym val)
- (define-key dired-mode-map "N" 'dired-man)
- (if (eq 'dired-man (lookup-key dired-mode-map "N"))
- (define-key dired-mode-map "N" nil))))
- :group 'dired-keys)
-
-(defcustom dired-bind-info t
- "Non-nil means bind `dired-info' to \"I\" in Dired, otherwise do not.
-Setting this variable directly after dired-x is loaded has no effect -
-use \\[customize]."
- :type 'boolean
- :set (lambda (sym val)
- (if (set sym val)
- (define-key dired-mode-map "I" 'dired-info)
- (if (eq 'dired-info (lookup-key dired-mode-map "I"))
- (define-key dired-mode-map "I" nil))))
- :group 'dired-keys)
+(defvar dired-bind-man t)
+(make-obsolete-variable 'dired-bind-man "not used." "29.1")
+
+(defvar dired-bind-info t)
+(make-obsolete-variable 'dired-bind-info "not used." "29.1")
(defcustom dired-vm-read-only-folders nil
"If non-nil, \\[dired-vm] will visit all folders read-only.
@@ -101,11 +77,12 @@ files not writable by you are visited read-only."
(other :tag "non-writable only" if-file-read-only))
:group 'dired-x)
-(defcustom dired-omit-size-limit 30000
+(defcustom dired-omit-size-limit 100000
"Maximum size for the \"omitting\" feature.
If nil, there is no maximum size."
:type '(choice (const :tag "no maximum" nil) integer)
- :group 'dired-x)
+ :group 'dired-x
+ :version "29.1")
(defcustom dired-omit-case-fold 'filesystem
"Determine whether \"omitting\" patterns are case-sensitive.
@@ -125,14 +102,49 @@ folding to be used on case-insensitive filesystems only."
(file-name-case-insensitive-p dir)
dired-omit-case-fold))
+(defcustom dired-omit-lines nil
+ "Regexp matching lines to be omitted by `dired-omit-mode'.
+The value can also be a variable whose value is such a regexp.
+The value can also be nil, which means do no line matching.
+
+Some predefined regexp variables for Dired, which you can use as the
+option value:
+
+* `dired-re-inode-size'
+* `dired-re-mark'
+* `dired-re-maybe-mark'
+* `dired-re-dir'
+* `dired-re-sym'
+* `dired-re-exe'
+* `dired-re-perms'
+* `dired-re-dot'
+* `dired-re-no-dot'"
+ :type `(choice
+ (const :tag "Do not match lines to omit" nil)
+ (regexp
+ :tag "Regexp to match lines to omit (default omits executables)"
+ :value ,dired-re-exe)
+ (restricted-sexp
+ :tag "Variable with regexp value (default: `dired-re-exe')"
+ :match-alternatives
+ ((lambda (obj) (and (symbolp obj) (boundp obj))))
+ :value dired-re-exe))
+ :group 'dired-x)
+
;;;###autoload
(define-minor-mode dired-omit-mode
"Toggle omission of uninteresting files in Dired (Dired-Omit mode).
+With prefix argument ARG, enable Dired-Omit mode if ARG is positive,
+and disable it otherwise.
+
+If called from Lisp, enable the mode if ARG is omitted or nil.
+
+Dired-Omit mode is a buffer-local minor mode.
-Dired-Omit mode is a buffer-local minor mode. When enabled in a
-Dired buffer, Dired does not list files whose filenames match
-regexp `dired-omit-files', nor files ending with extensions in
-`dired-omit-extensions'.
+When enabled in a Dired buffer, Dired does not list files whose
+filenames match regexp `dired-omit-files', files ending with
+extensions in `dired-omit-extensions', or files listed on lines
+matching `dired-omit-lines'.
To enable omitting in every Dired buffer, you can put this in
your init file:
@@ -141,10 +153,16 @@ your init file:
See Info node `(dired-x) Omitting Variables' for more information."
:group 'dired-x
- (if dired-omit-mode
- ;; This will mention how many lines were omitted:
- (let ((dired-omit-size-limit nil)) (dired-omit-expunge))
- (revert-buffer)))
+ (if (not dired-omit-mode)
+ (revert-buffer)
+ (let ((dired-omit-size-limit nil)
+ (file-count 0))
+ ;; Omit by file-name match, then omit by line match.
+ ;; Use count of file-name match as INIT-COUNT for line match.
+ ;; Return total count. (Return value is not used anywhere, so far).
+ (setq file-count (dired-omit-expunge))
+ (when dired-omit-lines
+ (dired-omit-expunge dired-omit-lines 'LINEP file-count)))))
(put 'dired-omit-mode 'safe-local-variable 'booleanp)
@@ -207,17 +225,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
(string :tag "Switches"))
:group 'dired-x)
-(defcustom dired-clean-up-buffers-too t
- "Non-nil means offer to kill buffers visiting files and dirs deleted in Dired."
- :type 'boolean
- :group 'dired-x)
-
-(defcustom dired-clean-confirm-killing-deleted-buffers t
- "If nil, don't ask whether to kill buffers visiting deleted files."
- :version "26.1"
- :type 'boolean
- :group 'dired-x)
-
;;; Key bindings
@@ -226,15 +233,10 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
(define-key dired-mode-map "*O" 'dired-mark-omitted)
(define-key dired-mode-map "*." 'dired-mark-extension))
-(when (keymapp (lookup-key dired-mode-map "%"))
- (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp))
-
(define-key dired-mode-map "\C-x\M-o" 'dired-omit-mode)
(define-key dired-mode-map "\M-(" 'dired-mark-sexp)
(define-key dired-mode-map "\M-!" 'dired-smart-shell-command)
-(define-key dired-mode-map "\M-G" 'dired-goto-subdir)
(define-key dired-mode-map "F" 'dired-do-find-marked-files)
-(define-key dired-mode-map "Y" 'dired-do-relsymlink)
(define-key dired-mode-map "V" 'dired-do-run-mail)
@@ -245,12 +247,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
["Find Files" dired-do-find-marked-files
:help "Find current or marked files"]
"Shell Command...")
- (easy-menu-add-item menu '("Operate")
- ["Relative Symlink to..." dired-do-relsymlink
- :visible (fboundp 'make-symbolic-link)
- :help "Make relative symbolic links for current or \
-marked files"]
- "Hardlink to...")
(easy-menu-add-item menu '("Mark")
["Flag Extension..." dired-flag-extension
:help "Flag files with a certain extension for deletion"]
@@ -264,12 +260,6 @@ marked files"]
:help "Mark files matching `dired-omit-files' \
and `dired-omit-extensions'"]
"Unmark All")
- (easy-menu-add-item menu '("Regexp")
- ["Relative Symlink..." dired-do-relsymlink-regexp
- :visible (fboundp 'make-symbolic-link)
- :help "Make relative symbolic links for files \
-matching regexp"]
- "Hardlink...")
(easy-menu-add-item menu '("Immediate")
["Omit Mode" dired-omit-mode
:style toggle :selected dired-omit-mode
@@ -287,8 +277,6 @@ files"]
"Automatically put on `dired-mode-hook' to get extra Dired features:
\\<dired-mode-map>
\\[dired-do-run-mail]\t-- run mail on folder (see `dired-bind-vm')
- \\[dired-info]\t-- run info on file
- \\[dired-man]\t-- run man on file
\\[dired-do-find-marked-files]\t-- visit all marked files simultaneously
\\[dired-omit-mode]\t-- toggle omitting of files
\\[dired-mark-sexp]\t-- mark by Lisp expression
@@ -297,10 +285,8 @@ To see the options you can set, use \\[customize-group] RET dired-x RET.
See also the functions:
`dired-flag-extension'
`dired-virtual'
- `dired-man'
`dired-vm'
`dired-rmail'
- `dired-info'
`dired-do-find-marked-files'"
(interactive)
;; These must be done in each new dired buffer.
@@ -486,45 +472,61 @@ variables `dired-omit-mode' and `dired-omit-files'."
:type '(repeat string)
:group 'dired-x)
-(defun dired-omit-expunge (&optional regexp)
- "Erases all unmarked files matching REGEXP.
-Does nothing if global variable `dired-omit-mode' is nil, or if called
- non-interactively and buffer is bigger than `dired-omit-size-limit'.
-If REGEXP is nil or not specified, uses `dired-omit-files', and also omits
- filenames ending in `dired-omit-extensions'.
-If REGEXP is the empty string, this function is a no-op.
-
-This functions works by temporarily binding `dired-marker-char' to
-`dired-omit-marker-char' and calling `dired-do-kill-lines'."
- (interactive "sOmit files (regexp): ")
+(defun dired-omit-expunge (&optional regexp linep init-count)
+ "Erase all unmarked files whose names match REGEXP.
+With a prefix arg (non-nil LINEP when called from Lisp), match REGEXP
+against the whole line. Otherwise, match it against the file name.
+
+If REGEXP is nil, use `dired-omit-files', and also omit file names
+ending in `dired-omit-extensions'.
+
+Do nothing if REGEXP is the empty string, `dired-omit-mode' is nil, or
+if called from Lisp and buffer is bigger than `dired-omit-size-limit'.
+
+Optional arg INIT-COUNT is an initial count tha'is added to the number
+of lines omitted by this invocation of `dired-omit-expunge', in the
+status message."
+ (interactive "sOmit files (regexp): \nP")
+ ;; Bind `dired-marker-char' to `dired-omit-marker-char',
+ ;; then call `dired-do-kill-lines'.
(if (and dired-omit-mode
(or (called-interactively-p 'interactive)
(not dired-omit-size-limit)
(< (buffer-size) dired-omit-size-limit)
- (progn
- (when dired-omit-verbose
- (message "Not omitting: directory larger than %d characters."
- dired-omit-size-limit))
- (setq dired-omit-mode nil)
- nil)))
+ (progn
+ (when dired-omit-verbose
+ (message "Not omitting: directory larger than %d characters."
+ dired-omit-size-limit))
+ (setq dired-omit-mode nil)
+ nil)))
(let ((omit-re (or regexp (dired-omit-regexp)))
(old-modified-p (buffer-modified-p))
- count)
- (or (string= omit-re "")
- (let ((dired-marker-char dired-omit-marker-char))
- (when dired-omit-verbose (message "Omitting..."))
- (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp
- (dired-omit-case-fold-p (if (stringp dired-directory)
- dired-directory
- (car dired-directory))))
- (progn
- (setq count (dired-do-kill-lines
- nil
- (if dired-omit-verbose "Omitted %d line%s." "")))
- (force-mode-line-update))
- (when dired-omit-verbose (message "(Nothing to omit)")))))
- ;; Try to preserve modified state of buffer. So `%*' doesn't appear
- ;; in mode-line of omitted buffers.
+ (count (or init-count 0)))
+ (unless (string= omit-re "")
+ (let ((dired-marker-char dired-omit-marker-char))
+ (when dired-omit-verbose (message "Omitting..."))
+ (if (not (if linep
+ (dired-mark-if
+ (and (= (following-char) ?\s) ; Not already marked
+ (string-match-p
+ omit-re (buffer-substring
+ (line-beginning-position)
+ (line-end-position))))
+ nil)
+ (dired-mark-unmarked-files
+ omit-re nil nil dired-omit-localp
+ (dired-omit-case-fold-p (if (stringp dired-directory)
+ dired-directory
+ (car dired-directory))))))
+ (when dired-omit-verbose (message "(Nothing to omit)"))
+ (setq count (+ count
+ (dired-do-kill-lines
+ nil
+ (if dired-omit-verbose "Omitted %d line%s" "")
+ init-count)))
+ (force-mode-line-update))))
+ ;; Try to preserve modified state, so `%*' doesn't appear in
+ ;; `mode-line'.
(set-buffer-modified-p (and old-modified-p
(save-excursion
(goto-char (point-min))
@@ -554,7 +556,7 @@ If the region is active in Transient Mark mode, operate only on
files in the active region if `dired-mark-region' is non-nil."
(interactive
(list (read-regexp
- "Mark unmarked files matching regexp (default all): "
+ (format-prompt "Mark unmarked files matching regexp" "all")
nil 'dired-regexp-history)
nil current-prefix-arg nil))
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
@@ -580,23 +582,24 @@ files in the active region if `dired-mark-region' is non-nil."
(defalias 'virtual-dired 'dired-virtual)
(defun dired-virtual (dirname &optional switches)
- "Put this Dired buffer into Virtual Dired mode.
+ "Treat the current buffer as a Dired buffer showing directory DIRNAME.
+Interactively, prompt for DIRNAME.
-In Virtual Dired mode, all commands that do not actually consult the
-filesystem will work.
+This command is rarely useful, but may be convenient if you want
+to peruse and move around in the output you got from \"ls
+-lR\" (or something similar), without having access to the actual
+file system.
-This is useful if you want to peruse and move around in an ls -lR
-output file, for example one you got from an ftp server. With
-ange-ftp, you can even Dired a directory containing an ls-lR file,
-visit that file and turn on Virtual Dired mode. But don't try to save
-this file, as `dired-virtual' indents the listing and thus changes the
-buffer.
+Most Dired commands that don't consult the file system will work
+as advertised, but commands that try to alter the file system
+will usually fail. (However, if the output is from the current
+system, most of those commands will work fine.)
If you have saved a Dired buffer in a file you can use \\[dired-virtual] to
resume it in a later session.
Type \\<dired-mode-map>\\[revert-buffer] \
-in the Virtual Dired buffer and answer `y' to convert
+in the Virtual Dired buffer and answer \\`y' to convert
the virtual to a real Dired buffer again. You don't have to do this, though:
you can relist single subdirs using \\[dired-do-redisplay]."
@@ -638,8 +641,8 @@ you can relist single subdirs using \\[dired-do-redisplay]."
":\n"))
(dired-mode dirname (or switches dired-listing-switches))
(setq mode-name "Virtual Dired"
- revert-buffer-function 'dired-virtual-revert)
- (setq-local dired-subdir-alist nil)
+ revert-buffer-function 'dired-virtual-revert
+ dired-subdir-alist nil)
(dired-build-subdir-alist)
(goto-char (point-min))
(dired-initial-position dirname))
@@ -1020,95 +1023,6 @@ See `dired-guess-shell-alist-user'."
(if (equal val "") default val))))
-;;; Relative symbolic links
-
-(declare-function make-symbolic-link "fileio.c")
-
-(defvar dired-keep-marker-relsymlink ?S
- "See variable `dired-keep-marker-move'.")
-
-(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists)
- "Make a symbolic link (pointing to FILE1) in FILE2.
-The link is relative (if possible), for example
-
- \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"
-
-results in
-
- \"../../tex/bin/foo\" \"/vol/local/bin/foo\""
- (interactive "FRelSymLink: \nFRelSymLink %s: \np")
- (let (name1 name2 len1 len2 (index 0) sub)
- (setq file1 (expand-file-name file1)
- file2 (expand-file-name file2)
- len1 (length file1)
- len2 (length file2))
- ;; Find common initial file name components:
- (let (next)
- (while (and (setq next (string-search "/" file1 index))
- (< (setq next (1+ next)) (min len1 len2))
- ;; For the comparison, both substrings must end in
- ;; `/', so NEXT is *one plus* the result of the
- ;; string-search.
- ;; E.g., consider the case of linking "/tmp/a/abc"
- ;; to "/tmp/abc" erroneously giving "/tmp/a" instead
- ;; of "/tmp/" as common initial component
- (string-equal (substring file1 0 next)
- (substring file2 0 next)))
- (setq index next))
- (setq name2 file2
- sub (substring file1 0 index)
- name1 (substring file1 index)))
- (if (string-equal sub "/")
- ;; No common initial file name found
- (setq name1 file1)
- ;; Else they have a common parent directory
- (let ((tem (substring file2 index))
- (start 0)
- (count 0))
- ;; Count number of slashes we must compensate for ...
- (while (setq start (string-search "/" tem start))
- (setq count (1+ count)
- start (1+ start)))
- ;; ... and prepend a "../" for each slash found:
- (dotimes (_ count)
- (setq name1 (concat "../" name1)))))
- (make-symbolic-link
- (directory-file-name name1) ; must not link to foo/
- ; (trailing slash!)
- name2 ok-if-already-exists)))
-
-(autoload 'dired-do-create-files "dired-aux")
-
-;;;###autoload
-(defun dired-do-relsymlink (&optional arg)
- "Relative symlink all marked (or next ARG) files into a directory.
-Otherwise make a relative symbolic link to the current file.
-This creates relative symbolic links like
-
- foo -> ../bar/foo
-
-not absolute ones like
-
- foo -> /ugly/file/name/that/may/change/any/day/bar/foo
-
-For absolute symlinks, use \\[dired-do-symlink]."
- (interactive "P")
- (dired-do-create-files 'relsymlink #'dired-make-relative-symlink
- "RelSymLink" arg dired-keep-marker-relsymlink))
-
-(autoload 'dired-mark-read-regexp "dired-aux")
-(autoload 'dired-do-create-files-regexp "dired-aux")
-
-(defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name)
- "RelSymlink all marked files containing REGEXP to NEWNAME.
-See functions `dired-do-rename-regexp' and `dired-do-relsymlink'
-for more info."
- (interactive (dired-mark-read-regexp "RelSymLink"))
- (dired-do-create-files-regexp
- #'dired-make-relative-symlink
- "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink))
-
-
;;; Visit all marked files simultaneously
;; Brief Description:
@@ -1180,31 +1094,6 @@ NOSELECT the files are merely found but not selected."
;;; Miscellaneous commands
-;; Run man on files.
-
-(declare-function Man-getpage-in-background "man" (topic))
-
-(defvar manual-program) ; from man.el
-
-(defun dired-man ()
- "Run `man' on this file."
- ;; Used also to say: "Display old buffer if buffer name matches filename."
- ;; but I have no idea what that means.
- (interactive)
- (require 'man)
- (let* ((file (dired-get-filename))
- (manual-program (string-replace "*" "%s"
- (dired-guess-shell-command
- "Man command: " (list file)))))
- (Man-getpage-in-background file)))
-
-;; Run Info on files.
-
-(defun dired-info ()
- "Run `info' on this file."
- (interactive)
- (info (dired-get-filename)))
-
;; Run mail on mail folders.
(declare-function vm-visit-folder "ext:vm" (folder &optional read-only))
@@ -1248,14 +1137,6 @@ otherwise."
;;; Miscellaneous internal functions
-;; This should be a builtin
-(defun dired-buffer-more-recently-used-p (buffer1 buffer2)
- "Return t if BUFFER1 is more recently used than BUFFER2.
-Considers buffers closer to the car of `buffer-list' to be more recent."
- (and (not (equal buffer1 buffer2))
- (memq buffer1 (buffer-list))
- (not (memq buffer1 (memq buffer2 (buffer-list))))))
-
;; Needed if ls -lh is supported and also for GNU ls -ls.
(defun dired-x--string-to-number (str)
"Like `string-to-number' but recognize a trailing unit prefix.
@@ -1264,13 +1145,21 @@ sure that a trailing letter in STR is one of BKkMGTPEZY."
(let* ((val (string-to-number str))
(u (unless (zerop val)
(aref str (1- (length str))))))
- (when (and u (> u ?9))
- (when (= u ?k)
- (setq u ?K))
- (let ((units '(?B ?K ?M ?G ?T ?P ?E ?Z ?Y)))
- (while (and units (/= (pop units) u))
- (setq val (* 1024.0 val)))))
- val))
+ ;; If we don't have a unit at the end, but we have some
+ ;; non-numeric strings in the string, then the string may be
+ ;; something like "4.134" or "4,134" meant to represent 4134
+ ;; (seen in some locales).
+ (if (and u
+ (<= ?0 u ?9)
+ (string-match-p "[^0-9]" str))
+ (string-to-number (replace-regexp-in-string "[^0-9]+" "" str))
+ (when (and u (> u ?9))
+ (when (= u ?k)
+ (setq u ?K))
+ (let ((units '(?B ?K ?M ?G ?T ?P ?E ?Z ?Y)))
+ (while (and units (/= (pop units) u))
+ (setq val (* 1024.0 val)))))
+ val)))
(defun dired-mark-sexp (predicate &optional unflag-p)
"Mark files for which PREDICATE returns non-nil.
@@ -1449,12 +1338,13 @@ Binding direction based on `dired-x-hands-off-my-keys'."
(interactive)
(if (called-interactively-p 'interactive)
(setq dired-x-hands-off-my-keys
- (not (y-or-n-p "Bind dired-x-find-file over find-file? "))))
+ (not (y-or-n-p (format-message
+ "Bind `dired-x-find-file' over `find-file'?")))))
(unless dired-x-hands-off-my-keys
- (define-key (current-global-map) [remap find-file]
- 'dired-x-find-file)
- (define-key (current-global-map) [remap find-file-other-window]
- 'dired-x-find-file-other-window)))
+ (keymap-set (current-global-map) "<remap> <find-file>"
+ #'dired-x-find-file)
+ (keymap-set (current-global-map) "<remap> <find-file-other-window>"
+ #'dired-x-find-file-other-window)))
;; Now call it so binding is correct. This could go in the :initialize
;; slot, but then dired-x-bind-find-file has to be defined before the
@@ -1478,12 +1368,12 @@ a prefix argument, when it offers the filename near point as a default."
;;; Internal functions
-;; Fixme: This should probably use `thing-at-point'. -- fx
(define-obsolete-function-alias 'dired-filename-at-point
#'dired-x-guess-file-name-at-point "28.1")
(defun dired-x-guess-file-name-at-point ()
"Return the filename closest to point, expanded.
Point should be in or after a filename."
+ (declare (obsolete "use (thing-at-point 'filename) instead." "29.1"))
(save-excursion
;; First see if just past a filename.
(or (eobp) ; why?
@@ -1515,20 +1405,15 @@ Point should be in or after a filename."
"Return filename prompting with PROMPT with completion.
If `current-prefix-arg' is non-nil, uses name at point as guess."
(if current-prefix-arg
- (let ((guess (dired-x-guess-file-name-at-point)))
+ (let ((guess (thing-at-point 'filename)))
(read-file-name prompt
(file-name-directory guess)
guess
nil (file-name-nondirectory guess)))
(read-file-name prompt default-directory)))
-(define-obsolete-function-alias 'read-filename-at-point
- 'dired-x-read-filename-at-point "24.1") ; is this even needed?
-
-
-;;; Epilog
-
-(define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1")
+(define-obsolete-function-alias 'dired-man #'dired-do-man "29.1")
+(define-obsolete-function-alias 'dired-info #'dired-do-info "29.1")
;; As Barry Warsaw would say: "This might be useful..."
diff --git a/lisp/dired.el b/lisp/dired.el
index f5ddd7aa39f..43563d969f1 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -35,11 +35,10 @@
;;; Code:
(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
;; When bootstrapping dired-loaddefs has not been generated.
(require 'dired-loaddefs nil t)
-
-(declare-function dired-buffer-more-recently-used-p
- "dired-x" (buffer1 buffer2))
+(require 'dnd)
;;; Customizable variables
@@ -104,10 +103,10 @@ If `dired-maybe-use-globstar' is non-nil, then `dired-insert-directory'
checks this alist to enable globstar in the shell subprocess.")
(defcustom dired-chown-program
- (purecopy (cond ((executable-find "chown") "chown")
- ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown")
- ((file-executable-p "/etc/chown") "/etc/chown")
- (t "chown")))
+ (cond ((executable-find "chown") "chown")
+ ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown")
+ ((file-executable-p "/etc/chown") "/etc/chown")
+ (t "chown"))
"Name of chown command (usually `chown')."
:group 'dired
:type 'file)
@@ -162,7 +161,7 @@ always set this variable to t."
:type 'boolean
:group 'dired-mark)
-(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`\\.?#")
+(defcustom dired-trivial-filenames "\\`\\.\\.?\\'\\|\\`\\.?#"
"Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file."
@@ -208,6 +207,23 @@ If a character, new links are unconditionally marked with that character."
(character :tag "Mark"))
:group 'dired-mark)
+(defvar dired-keep-marker-relsymlink ?S
+ "Controls marking of newly made relative symbolic links.
+If t, they are marked if and as the files linked to were marked.
+If a character, new links are unconditionally marked with that character.")
+
+(defcustom dired-free-space 'first
+ "Whether and how to display the amount of free disk space in Dired buffers.
+If nil, don't display.
+If `separate', display on a separate line (along with used count).
+If `first', display only the free disk space on the first line,
+following the directory name."
+ :type '(choice (const :tag "On a separate line" separate)
+ (const :tag "On the first line, after directory name" first)
+ (const :tag "Don't display" nil))
+ :version "29.1"
+ :group 'dired)
+
(defcustom dired-dwim-target nil
"If non-nil, Dired tries to guess a default target directory.
This means: if there is a Dired buffer displayed in some window,
@@ -235,6 +251,44 @@ The target is used in the prompt for file copy, rename etc."
(other :tag "Try to guess" t))
:group 'dired)
+
+(defcustom dired-mouse-drag-files nil
+ "If non-nil, allow the mouse to drag files from inside a Dired buffer.
+Dragging the mouse and then releasing it over the window of
+another program will result in that program opening or creating a
+copy of the file underneath the mouse pointer (or all marked
+files if it was marked). This feature is supported only on X
+Windows, Haiku, and Nextstep (macOS or GNUstep).
+
+If the value is `link', then a symbolic link will be created to
+the file instead by the other program (usually a file manager).
+
+If the value is `move', then the default action will be for the
+other program to move the file to a different location. For this
+to work optimally, `auto-revert-mode' should be enabled in the
+Dired buffer.
+
+If the Meta key is held down when the mouse button is pressed,
+then this will always be equivalent to `link'.
+
+If the Control key is held down when the mouse button is pressed,
+then dragging the file will always copy it to the new location.
+
+If the Shift key is held down when the mouse button is pressed,
+then this will always be equivalent to `move'."
+ :set (lambda (option value)
+ (set-default option value)
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (when (derived-mode-p 'dired-mode)
+ (revert-buffer nil t)))))
+ :type '(choice (const :tag "Don't allow dragging" nil)
+ (const :tag "Copy file to new location" t)
+ (const :tag "Move file to new location" t)
+ (const :tag "Create symbolic link to file" link))
+ :group 'dired
+ :version "29.1")
+
(defcustom dired-copy-preserve-time t
"If non-nil, Dired preserves the last-modified time in a file copy.
\(This works on only some systems.)"
@@ -281,6 +335,11 @@ with the buffer narrowed to the listing."
;; Note this can't simply be run inside function `dired-ls' as the hook
;; functions probably depend on the dired-subdir-alist to be OK.
+(defcustom dired-make-directory-clickable t
+ "When non-nil, make the directory at the start of the dired buffer clickable."
+ :version "29.1"
+ :type 'boolean)
+
(defcustom dired-initial-position-hook nil
"This hook is used to position the point.
It is run by the function `dired-initial-position'."
@@ -339,11 +398,11 @@ When `file', the region marking is based on the file name.
This means don't mark the file if the end of the region is
before the file name displayed on the Dired line, so the file name
is visually outside the region. This behavior is consistent with
-marking files without the region using the key `m' that advances
+marking files without the region using the key \\`m' that advances
point to the next line after marking the file. Thus the number
of keys used to mark files is the same as the number of keys
-used to select the region, e.g. `M-2 m' marks 2 files, and
-`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files.
+used to select the region, for example \\`M-2 m' marks 2 files, and
+\\`C-SPC M-2 n m' marks 2 files, and \\`M-2 S-<down> m' marks 2 files.
When `line', the region marking is based on Dired lines,
so include the file into marking if the end of the region
@@ -390,7 +449,7 @@ action argument symbol is `window-height' and its value is nil." "24.3")
(defvar dired-file-version-alist)
;;;###autoload
-(defvar dired-directory nil
+(defvar-local dired-directory nil
"The directory name or wildcard spec that this Dired directory lists.
Local to each Dired buffer. May be a list, in which case the car is the
directory name and the cdr is the list of files to mention.
@@ -437,7 +496,7 @@ The directory name must be absolute, but need not be fully expanded.")
(defvar dired-re-dot "^.* \\.\\.?/?$")
;; The subdirectory names in the next two lists are expanded.
-(defvar dired-subdir-alist nil
+(defvar-local dired-subdir-alist nil
"Alist of listed directories and their buffer positions.
Alist elements have the form (DIRNAME . STARTMARKER), where
DIRNAME is the absolute name of the directory and STARTMARKER is
@@ -768,6 +827,9 @@ that commands on the next ARG (instead of the marked) files can
be chained easily.
For any other non-nil value of ARG, use the current file.
+If ARG is `marked', don't return the current file if nothing else
+is marked.
+
If optional third arg SHOW-PROGRESS evaluates to non-nil,
redisplay the dired buffer after each file is processed.
@@ -789,7 +851,7 @@ marked file, return (t FILENAME) instead of (FILENAME)."
;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
`(prog1
(let ((inhibit-read-only t) case-fold-search found results)
- (if ,arg
+ (if (and ,arg (not (eq ,arg 'marked)))
(if (integerp ,arg)
(progn ;; no save-excursion, want to move point.
(dired-repeat-over-lines
@@ -800,8 +862,8 @@ marked file, return (t FILENAME) instead of (FILENAME)."
(if (< ,arg 0)
(nreverse results)
results))
- ;; non-nil, non-integer ARG means use current file:
- (list ,body))
+ ;; non-nil, non-integer, non-marked ARG means use current file:
+ (list ,body))
(let ((regexp (dired-marker-regexp)) next-position)
(save-excursion
(goto-char (point-min))
@@ -826,7 +888,8 @@ marked file, return (t FILENAME) instead of (FILENAME)."
(setq results (cons t results)))
(if found
results
- (list ,body)))))
+ (unless (eq ,arg 'marked)
+ (list ,body))))))
;; save-excursion loses, again
(dired-move-to-filename)))
@@ -1245,40 +1308,42 @@ The return value is the target column for the file names."
;; This differs from dired-buffers-for-dir in that it does not consider
;; subdirs of default-directory and searches for the first match only.
;; Also, the major mode must be MODE.
- (if (and (featurep 'dired-x)
- dired-find-subdir
- ;; Don't try to find a wildcard as a subdirectory.
- (string-equal dirname (file-name-directory dirname)))
- (let* ((cur-buf (current-buffer))
- (buffers (nreverse
- (dired-buffers-for-dir (expand-file-name dirname))))
- (cur-buf-matches (and (memq cur-buf buffers)
- ;; Wildcards must match, too:
- (equal dired-directory dirname))))
- ;; We don't want to switch to the same buffer---
- (setq buffers (delq cur-buf buffers))
- (or (car (sort buffers #'dired-buffer-more-recently-used-p))
- ;; ---unless it's the only possibility:
- (and cur-buf-matches cur-buf)))
- ;; No dired-x, or dired-find-subdir nil.
- (setq dirname (expand-file-name dirname))
- (let (found (blist dired-buffers)) ; was (buffer-list)
- (or mode (setq mode 'dired-mode))
- (while blist
- (if (null (buffer-name (cdr (car blist))))
- (setq blist (cdr blist))
- (with-current-buffer (cdr (car blist))
- (if (and (eq major-mode mode)
- dired-directory ;; nil during find-alternate-file
- (equal dirname
- (expand-file-name
- (if (consp dired-directory)
- (car dired-directory)
- dired-directory))))
- (setq found (cdr (car blist))
- blist nil)
- (setq blist (cdr blist))))))
- found)))
+ ;; We bind `non-essential' in order to avoid hangs in remote buffers
+ ;; with a blocked connection. (Bug#54542)
+ (let ((non-essential t))
+ (if (and (featurep 'dired-x)
+ dired-find-subdir
+ ;; Don't try to find a wildcard as a subdirectory.
+ (string-equal dirname (file-name-directory dirname)))
+ (let* ((cur-buf (current-buffer))
+ (buffers (nreverse (dired-buffers-for-dir dirname)))
+ (cur-buf-matches (and (memq cur-buf buffers)
+ ;; Wildcards must match, too:
+ (equal dired-directory dirname))))
+ ;; We don't want to switch to the same buffer---
+ (setq buffers (delq cur-buf buffers))
+ (or (car (sort buffers #'dired-buffer-more-recently-used-p))
+ ;; ---unless it's the only possibility:
+ (and cur-buf-matches cur-buf)))
+ ;; No dired-x, or dired-find-subdir nil.
+ (setq dirname (expand-file-name dirname))
+ (let (found (blist dired-buffers)) ; was (buffer-list)
+ (or mode (setq mode 'dired-mode))
+ (while blist
+ (if (null (buffer-name (cdr (car blist))))
+ (setq blist (cdr blist))
+ (with-current-buffer (cdr (car blist))
+ (if (and (eq major-mode mode)
+ dired-directory ;; nil during find-alternate-file
+ (equal dirname
+ (expand-file-name
+ (if (consp dired-directory)
+ (car dired-directory)
+ dired-directory))))
+ (setq found (cdr (car blist))
+ blist nil)
+ (setq blist (cdr blist))))))
+ found))))
;;; Read in a new dired buffer
@@ -1322,13 +1387,15 @@ wildcards, erases the buffer, and builds the subdir-alist anew
(goto-char (point-min))
;; Must first make alist buffer local and set it to nil because
;; dired-build-subdir-alist will call dired-clear-alist first
- (setq-local dired-subdir-alist nil)
+ (setq dired-subdir-alist nil)
(dired-build-subdir-alist))
(let ((attributes (file-attributes dirname)))
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
attributes))))
(set-buffer-modified-p nil)
+ (when dired-make-directory-clickable
+ (dired--make-directory-clickable))
;; No need to narrow since the whole buffer contains just
;; dired-readin's output, nothing else. The hook can
;; successfully use dired functions (e.g. dired-get-filename)
@@ -1609,15 +1676,134 @@ see `dired-use-ls-dired' for more details.")
;; by its expansion, so it does not matter whether what we insert
;; here is fully expanded, but it should be absolute.
(insert " " (or (car-safe (insert-directory-wildcard-in-dir-p dir))
- (directory-file-name (file-name-directory dir))) ":\n")
+ (directory-file-name (file-name-directory dir)))
+ ":\n")
(setq content-point (point)))
(when wildcard
;; Insert "wildcard" line where "total" line would be for a full dir.
(insert " wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir))
(file-name-nondirectory dir))
- "\n")))
+ "\n"))
+ (setq content-point (dired--insert-disk-space opoint dir)))
(dired-insert-set-properties content-point (point)))))
+(defun dired--insert-disk-space (beg file)
+ ;; Try to insert the amount of free space.
+ (save-excursion
+ (goto-char beg)
+ ;; First find the line to put it on.
+ (if (not (re-search-forward "^ *\\(total\\)" nil t))
+ beg
+ (if (or (not dired-free-space)
+ (eq dired-free-space 'first))
+ (delete-region (match-beginning 0) (line-beginning-position 2))
+ ;; Replace "total" with "total used in directory" to
+ ;; avoid confusion.
+ (replace-match "total used in directory" nil nil nil 1))
+ (if-let ((available (get-free-disk-space file)))
+ (cond
+ ((eq dired-free-space 'separate)
+ (end-of-line)
+ (insert " available " available)
+ (forward-line 1)
+ (point))
+ ((eq dired-free-space 'first)
+ (goto-char beg)
+ (when (and (looking-at
+ (if (memq system-type '(windows-nt ms-dos))
+ " *[A-Za-z]:/"
+ " */"))
+ (progn
+ (end-of-line)
+ (eq (char-after (1- (point))) ?:)))
+ (put-text-property (1- (point)) (point)
+ 'display
+ (concat ": (" available " available)")))
+ (forward-line 1)
+ (point))
+ (t
+ beg))
+ beg))))
+
+(declare-function x-begin-drag "xfns.c")
+
+(defun dired-mouse-drag (event)
+ "Begin a drag-and-drop operation for the file at EVENT.
+If there are marked files and that file is marked, drag every
+other marked file as well. Otherwise, unmark all files."
+ (interactive "e")
+ (when mark-active
+ (deactivate-mark))
+ (let* ((modifiers (event-modifiers event))
+ (action (cond ((memq 'control modifiers) 'copy)
+ ((memq 'shift modifiers) 'move)
+ ((memq 'meta modifiers) 'link)
+ (t (if (memq dired-mouse-drag-files
+ '(copy move link))
+ dired-mouse-drag-files
+ 'copy)))))
+ (save-excursion
+ (with-selected-window (posn-window (event-end event))
+ (goto-char (posn-point (event-end event))))
+ (track-mouse
+ (let ((beginning-position (mouse-pixel-position))
+ new-event)
+ (catch 'track-again
+ (setq new-event (read-event))
+ (if (not (eq (event-basic-type new-event) 'mouse-movement))
+ (when (eq (event-basic-type new-event) 'mouse-1)
+ (push new-event unread-command-events))
+ (let ((current-position (mouse-pixel-position)))
+ ;; If the mouse didn't move far enough, don't
+ ;; inadvertently trigger a drag.
+ (when (and (eq (car current-position) (car beginning-position))
+ (ignore-errors
+ (and (> 3 (abs (- (cadr beginning-position)
+ (cadr current-position))))
+ (> 3 (abs (- (caddr beginning-position)
+ (caddr current-position)))))))
+ (throw 'track-again nil)))
+ ;; We can get an error if there's by some chance no file
+ ;; name at point.
+ (condition-case error
+ (let ((filename (with-selected-window (posn-window
+ (event-end event))
+ (let ((marked-files (dired-map-over-marks (dired-get-filename
+ nil 'no-error-if-not-filep)
+ 'marked))
+ (file-name (dired-get-filename nil 'no-error-if-not-filep)))
+ (if (and marked-files
+ (member file-name marked-files))
+ marked-files
+ (when marked-files
+ (dired-map-over-marks (dired-unmark nil)
+ 'marked))
+ file-name)))))
+ (when filename
+ (if (and (consp filename)
+ (cdr filename))
+ (dnd-begin-drag-files filename nil action t)
+ (dnd-begin-file-drag (if (stringp filename)
+ filename
+ (car filename))
+ nil action t))))
+ (error (when (eq (event-basic-type new-event) 'mouse-1)
+ (push new-event unread-command-events))
+ ;; Errors from `dnd-begin-drag-files' should be
+ ;; treated as user errors, since they should
+ ;; only occur when the user performs an invalid
+ ;; action, such as trying to create a link to
+ ;; a remote file.
+ (user-error (cadr error)))))))))))
+
+(defvar dired-mouse-drag-files-map (let ((keymap (make-sparse-keymap)))
+ (define-key keymap [down-mouse-1] #'dired-mouse-drag)
+ (define-key keymap [C-down-mouse-1] #'dired-mouse-drag)
+ (define-key keymap [S-down-mouse-1] #'dired-mouse-drag)
+ (define-key keymap [M-down-mouse-1] #'dired-mouse-drag)
+ keymap)
+ "Keymap applied to file names when `dired-mouse-drag-files' is enabled.")
+
(defun dired-insert-set-properties (beg end)
"Add various text properties to the lines in the region, from BEG to END."
(save-excursion
@@ -1632,20 +1818,58 @@ see `dired-use-ls-dired' for more details.")
'invisible 'dired-hide-details-information))
(put-text-property (+ (line-beginning-position) 1) (1- (point))
'invisible 'dired-hide-details-detail)
+ (when (and dired-mouse-drag-files (fboundp 'x-begin-drag))
+ (put-text-property (point)
+ (save-excursion
+ (dired-move-to-end-of-filename)
+ (backward-char)
+ (point))
+ 'keymap
+ dired-mouse-drag-files-map))
(add-text-properties
(point)
(progn
(dired-move-to-end-of-filename)
(point))
- '(mouse-face
+ `(mouse-face
highlight
dired-filename t
- help-echo "mouse-2: visit this file in other window"))
+ help-echo ,(if (and dired-mouse-drag-files
+ (fboundp 'x-begin-drag))
+ "down-mouse-1: drag this file to another program
+mouse-2: visit this file in other window"
+ "mouse-2: visit this file in other window")))
(when (< (+ (point) 4) (line-end-position))
(put-text-property (+ (point) 4) (line-end-position)
'invisible 'dired-hide-details-link))))
(forward-line 1))))
+(defun dired--make-directory-clickable ()
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^ /" nil t 1)
+ (let ((bound (line-end-position))
+ (segment-start (point))
+ (inhibit-read-only t)
+ (dir "/"))
+ (while (search-forward "/" bound t 1)
+ (setq dir (concat dir (buffer-substring segment-start (point))))
+ (add-text-properties
+ segment-start (1- (point))
+ `( mouse-face highlight
+ help-echo "mouse-1: goto this directory"
+ keymap ,(let* ((current-dir dir)
+ (click (lambda ()
+ (interactive)
+ (if (assoc current-dir dired-subdir-alist)
+ (dired-goto-subdir current-dir)
+ (dired current-dir)))))
+ (define-keymap
+ "<mouse-2>" click
+ "<follow-link>" 'mouse-face
+ "RET" click))))
+ (setq segment-start (point)))))))
+
;;; Reverting a dired buffer
@@ -1838,160 +2062,157 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
;;; Dired mode key bindings and menus
-(defvar dired-mode-map
+(defvar-keymap dired-mode-map
+ :doc "Local keymap for Dired mode buffers."
+ :full t
+ :parent special-mode-map
;; This looks ugly when substitute-command-keys uses C-d instead d:
- ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
- (let ((map (make-keymap)))
- (set-keymap-parent map special-mode-map)
- (define-key map [mouse-2] 'dired-mouse-find-file-other-window)
- (define-key map [follow-link] 'mouse-face)
- ;; Commands to mark or flag certain categories of files
- (define-key map "#" 'dired-flag-auto-save-files)
- (define-key map "." 'dired-clean-directory)
- (define-key map "~" 'dired-flag-backup-files)
- ;; Upper case keys (except !) for operating on the marked files
- (define-key map "A" 'dired-do-find-regexp)
- (define-key map "C" 'dired-do-copy)
- (define-key map "B" 'dired-do-byte-compile)
- (define-key map "D" 'dired-do-delete)
- (define-key map "G" 'dired-do-chgrp)
- (define-key map "H" 'dired-do-hardlink)
- (define-key map "L" 'dired-do-load)
- (define-key map "M" 'dired-do-chmod)
- (define-key map "O" 'dired-do-chown)
- (define-key map "P" 'dired-do-print)
- (define-key map "Q" 'dired-do-find-regexp-and-replace)
- (define-key map "R" 'dired-do-rename)
- (define-key map "S" 'dired-do-symlink)
- (define-key map "T" 'dired-do-touch)
- (define-key map "X" 'dired-do-shell-command)
- (define-key map "Z" 'dired-do-compress)
- (define-key map "c" 'dired-do-compress-to)
- (define-key map "!" 'dired-do-shell-command)
- (define-key map "&" 'dired-do-async-shell-command)
- ;; Comparison commands
- (define-key map "=" 'dired-diff)
- ;; Tree Dired commands
- (define-key map "\M-\C-?" 'dired-unmark-all-files)
- (define-key map "\M-\C-d" 'dired-tree-down)
- (define-key map "\M-\C-u" 'dired-tree-up)
- (define-key map "\M-\C-n" 'dired-next-subdir)
- (define-key map "\M-\C-p" 'dired-prev-subdir)
- ;; move to marked files
- (define-key map "\M-{" 'dired-prev-marked-file)
- (define-key map "\M-}" 'dired-next-marked-file)
- ;; Make all regexp commands share a `%' prefix:
- ;; We used to get to the submap via a symbol dired-regexp-prefix,
- ;; but that seems to serve little purpose, and copy-keymap
- ;; does a better job without it.
- (define-key map "%" nil)
- (define-key map "%u" 'dired-upcase)
- (define-key map "%l" 'dired-downcase)
- (define-key map "%d" 'dired-flag-files-regexp)
- (define-key map "%g" 'dired-mark-files-containing-regexp)
- (define-key map "%m" 'dired-mark-files-regexp)
- (define-key map "%r" 'dired-do-rename-regexp)
- (define-key map "%C" 'dired-do-copy-regexp)
- (define-key map "%H" 'dired-do-hardlink-regexp)
- (define-key map "%R" 'dired-do-rename-regexp)
- (define-key map "%S" 'dired-do-symlink-regexp)
- (define-key map "%&" 'dired-flag-garbage-files)
- ;; Commands for marking and unmarking.
- (define-key map "*" nil)
- (define-key map "**" 'dired-mark-executables)
- (define-key map "*/" 'dired-mark-directories)
- (define-key map "*@" 'dired-mark-symlinks)
- (define-key map "*%" 'dired-mark-files-regexp)
- (define-key map "*N" 'dired-number-of-marked-files)
- (define-key map "*c" 'dired-change-marks)
- (define-key map "*s" 'dired-mark-subdir-files)
- (define-key map "*m" 'dired-mark)
- (define-key map "*u" 'dired-unmark)
- (define-key map "*?" 'dired-unmark-all-files)
- (define-key map "*!" 'dired-unmark-all-marks)
- (define-key map "U" 'dired-unmark-all-marks)
- (define-key map "*\177" 'dired-unmark-backward)
- (define-key map "*\C-n" 'dired-next-marked-file)
- (define-key map "*\C-p" 'dired-prev-marked-file)
- (define-key map "*t" 'dired-toggle-marks)
- ;; Lower keys for commands not operating on all the marked files
- (define-key map "a" 'dired-find-alternate-file)
- (define-key map "d" 'dired-flag-file-deletion)
- (define-key map "e" 'dired-find-file)
- (define-key map "f" 'dired-find-file)
- (define-key map "\C-m" 'dired-find-file)
- (put 'dired-find-file :advertised-binding "\C-m")
- (define-key map "g" 'revert-buffer)
- (define-key map "i" 'dired-maybe-insert-subdir)
- (define-key map "j" 'dired-goto-file)
- (define-key map "k" 'dired-do-kill-lines)
- (define-key map "l" 'dired-do-redisplay)
- (define-key map "m" 'dired-mark)
- (define-key map "n" 'dired-next-line)
- (define-key map "o" 'dired-find-file-other-window)
- (define-key map "\C-o" 'dired-display-file)
- (define-key map "p" 'dired-previous-line)
- (define-key map "s" 'dired-sort-toggle-or-edit)
- (define-key map "t" 'dired-toggle-marks)
- (define-key map "u" 'dired-unmark)
- (define-key map "v" 'dired-view-file)
- (define-key map "w" 'dired-copy-filename-as-kill)
- (define-key map "W" 'browse-url-of-dired-file)
- (define-key map "x" 'dired-do-flagged-delete)
- (define-key map "y" 'dired-show-file-type)
- (define-key map "+" 'dired-create-directory)
- ;; moving
- (define-key map "<" 'dired-prev-dirline)
- (define-key map ">" 'dired-next-dirline)
- (define-key map "^" 'dired-up-directory)
- (define-key map " " 'dired-next-line)
- (define-key map [?\S-\ ] 'dired-previous-line)
- (define-key map [remap next-line] 'dired-next-line)
- (define-key map [remap previous-line] 'dired-previous-line)
- ;; hiding
- (define-key map "$" 'dired-hide-subdir)
- (define-key map "\M-$" 'dired-hide-all)
- (define-key map "(" 'dired-hide-details-mode)
- ;; isearch
- (define-key map (kbd "M-s a C-s") 'dired-do-isearch)
- (define-key map (kbd "M-s a M-C-s") 'dired-do-isearch-regexp)
- (define-key map (kbd "M-s f C-s") 'dired-isearch-filenames)
- (define-key map (kbd "M-s f M-C-s") 'dired-isearch-filenames-regexp)
- ;; misc
- (define-key map [remap read-only-mode] 'dired-toggle-read-only)
- ;; `toggle-read-only' is an obsolete alias for `read-only-mode'
- (define-key map [remap toggle-read-only] 'dired-toggle-read-only)
- (define-key map "?" 'dired-summary)
- (define-key map "\177" 'dired-unmark-backward)
- (define-key map [remap undo] 'dired-undo)
- (define-key map [remap advertised-undo] 'dired-undo)
- (define-key map [remap vc-next-action] 'dired-vc-next-action)
- ;; thumbnail manipulation (image-dired)
- (define-key map "\C-td" 'image-dired-display-thumbs)
- (define-key map "\C-tt" 'image-dired-tag-files)
- (define-key map "\C-tr" 'image-dired-delete-tag)
- (define-key map "\C-tj" 'image-dired-jump-thumbnail-buffer)
- (define-key map "\C-ti" 'image-dired-dired-display-image)
- (define-key map "\C-tx" 'image-dired-dired-display-external)
- (define-key map "\C-ta" 'image-dired-display-thumbs-append)
- (define-key map "\C-t." 'image-dired-display-thumb)
- (define-key map "\C-tc" 'image-dired-dired-comment-files)
- (define-key map "\C-tf" 'image-dired-mark-tagged-files)
- (define-key map "\C-t\C-t" 'image-dired-dired-toggle-marked-thumbs)
- (define-key map "\C-te" 'image-dired-dired-edit-comment-and-tags)
- ;; encryption and decryption (epa-dired)
- (define-key map ":d" 'epa-dired-do-decrypt)
- (define-key map ":v" 'epa-dired-do-verify)
- (define-key map ":s" 'epa-dired-do-sign)
- (define-key map ":e" 'epa-dired-do-encrypt)
-
- ;; No need to do this, now that top-level items are fewer.
- ;;;;
- ;; Get rid of the Edit menu bar item to save space.
- ;;(define-key map [menu-bar edit] 'undefined)
-
- map)
- "Local keymap for Dired mode buffers.")
+ ;; "C-d" #'dired-flag-file-deletion
+ "<mouse-2>" #'dired-mouse-find-file-other-window
+ "<follow-link>" 'mouse-face
+ ;; Commands to mark or flag certain categories of files
+ "#" #'dired-flag-auto-save-files
+ "." #'dired-clean-directory
+ "~" #'dired-flag-backup-files
+ ;; Upper case keys (except !) for operating on the marked files
+ "A" #'dired-do-find-regexp
+ "C" #'dired-do-copy
+ "B" #'dired-do-byte-compile
+ "D" #'dired-do-delete
+ "G" #'dired-do-chgrp
+ "H" #'dired-do-hardlink
+ "I" #'dired-do-info
+ "L" #'dired-do-load
+ "M" #'dired-do-chmod
+ "N" #'dired-do-man
+ "O" #'dired-do-chown
+ "P" #'dired-do-print
+ "Q" #'dired-do-find-regexp-and-replace
+ "R" #'dired-do-rename
+ "S" #'dired-do-symlink
+ "T" #'dired-do-touch
+ "X" #'dired-do-shell-command
+ "Y" #'dired-do-relsymlink
+ "Z" #'dired-do-compress
+ "c" #'dired-do-compress-to
+ "!" #'dired-do-shell-command
+ "&" #'dired-do-async-shell-command
+ ;; Comparison commands
+ "=" #'dired-diff
+ ;; Tree Dired commands
+ "M-DEL" #'dired-unmark-all-files
+ "C-M-d" #'dired-tree-down
+ "C-M-u" #'dired-tree-up
+ "C-M-n" #'dired-next-subdir
+ "C-M-p" #'dired-prev-subdir
+ ;; move to marked files
+ "M-{" #'dired-prev-marked-file
+ "M-}" #'dired-next-marked-file
+ ;; Make all regexp commands share a `%' prefix:
+ ;; We used to get to the submap via a symbol dired-regexp-prefix,
+ ;; but that seems to serve little purpose, and copy-keymap
+ ;; does a better job without it.
+ "% u" #'dired-upcase
+ "% l" #'dired-downcase
+ "% d" #'dired-flag-files-regexp
+ "% g" #'dired-mark-files-containing-regexp
+ "% m" #'dired-mark-files-regexp
+ "% r" #'dired-do-rename-regexp
+ "% C" #'dired-do-copy-regexp
+ "% H" #'dired-do-hardlink-regexp
+ "% R" #'dired-do-rename-regexp
+ "% S" #'dired-do-symlink-regexp
+ "% Y" #'dired-do-relsymlink-regexp
+ "% &" #'dired-flag-garbage-files
+ ;; Commands for marking and unmarking.
+ "* *" #'dired-mark-executables
+ "* /" #'dired-mark-directories
+ "* @" #'dired-mark-symlinks
+ "* %" #'dired-mark-files-regexp
+ "* N" #'dired-number-of-marked-files
+ "* c" #'dired-change-marks
+ "* s" #'dired-mark-subdir-files
+ "* m" #'dired-mark
+ "* u" #'dired-unmark
+ "* ?" #'dired-unmark-all-files
+ "* !" #'dired-unmark-all-marks
+ "U" #'dired-unmark-all-marks
+ "* DEL" #'dired-unmark-backward
+ "* C-n" #'dired-next-marked-file
+ "* C-p" #'dired-prev-marked-file
+ "* t" #'dired-toggle-marks
+ ;; Lower keys for commands not operating on all the marked files
+ "a" #'dired-find-alternate-file
+ "d" #'dired-flag-file-deletion
+ "e" #'dired-find-file
+ "f" #'dired-find-file
+ "C-m" #'dired-find-file
+ "g" #'revert-buffer
+ "i" #'dired-maybe-insert-subdir
+ "j" #'dired-goto-file
+ "k" #'dired-do-kill-lines
+ "l" #'dired-do-redisplay
+ "m" #'dired-mark
+ "n" #'dired-next-line
+ "o" #'dired-find-file-other-window
+ "C-o" #'dired-display-file
+ "p" #'dired-previous-line
+ "s" #'dired-sort-toggle-or-edit
+ "t" #'dired-toggle-marks
+ "u" #'dired-unmark
+ "v" #'dired-view-file
+ "w" #'dired-copy-filename-as-kill
+ "W" #'browse-url-of-dired-file
+ "x" #'dired-do-flagged-delete
+ "y" #'dired-show-file-type
+ "+" #'dired-create-directory
+ ;; moving
+ "<" #'dired-prev-dirline
+ ">" #'dired-next-dirline
+ "^" #'dired-up-directory
+ "SPC" #'dired-next-line
+ "S-SPC" #'dired-previous-line
+ "<remap> <next-line>" #'dired-next-line
+ "<remap> <previous-line>" #'dired-previous-line
+ "M-G" #'dired-goto-subdir
+ ;; hiding
+ "$" #'dired-hide-subdir
+ "M-$" #'dired-hide-all
+ "(" #'dired-hide-details-mode
+ ;; isearch
+ "M-s a C-s" #'dired-do-isearch
+ "M-s a C-M-s" #'dired-do-isearch-regexp
+ "M-s f C-s" #'dired-isearch-filenames
+ "M-s f C-M-s" #'dired-isearch-filenames-regexp
+ ;; misc
+ "<remap> <read-only-mode>" #'dired-toggle-read-only
+ ;; `toggle-read-only' is an obsolete alias for `read-only-mode'
+ "<remap> <toggle-read-only>" #'dired-toggle-read-only
+ "?" #'dired-summary
+ "DEL" #'dired-unmark-backward
+ "<remap> <undo>" #'dired-undo
+ "<remap> <advertised-undo>" #'dired-undo
+ "<remap> <vc-next-action>" #'dired-vc-next-action
+ ;; thumbnail manipulation (image-dired)
+ "C-t d" #'image-dired-display-thumbs
+ "C-t t" #'image-dired-tag-files
+ "C-t r" #'image-dired-delete-tag
+ "C-t j" #'image-dired-jump-thumbnail-buffer
+ "C-t i" #'image-dired-dired-display-image
+ "C-t x" #'image-dired-dired-display-external
+ "C-t a" #'image-dired-display-thumbs-append
+ "C-t ." #'image-dired-display-thumb
+ "C-t c" #'image-dired-dired-comment-files
+ "C-t f" #'image-dired-mark-tagged-files
+ "C-t C-t" #'image-dired-dired-toggle-marked-thumbs
+ "C-t e" #'image-dired-dired-edit-comment-and-tags
+ ;; encryption and decryption (epa-dired)
+ ": d" #'epa-dired-do-decrypt
+ ": v" #'epa-dired-do-verify
+ ": s" #'epa-dired-do-sign
+ ": e" #'epa-dired-do-encrypt)
+
+(put 'dired-find-file :advertised-binding (kbd "RET"))
(easy-menu-define dired-mode-subdir-menu dired-mode-map
"Subdir menu for Dired mode."
@@ -2080,6 +2301,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
["Symlink..." dired-do-symlink-regexp
:visible (fboundp 'make-symbolic-link)
:help "Make symbolic links for files matching regexp"]
+ ["Relative Symlink..." dired-do-relsymlink-regexp
+ :visible (fboundp 'make-symbolic-link)
+ :help "Make relative symbolic links for files matching regexp"]
["Hardlink..." dired-do-hardlink-regexp
:help "Make hard links for files matching regexp"]
["Upcase" dired-upcase
@@ -2149,6 +2373,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
["Symlink to..." dired-do-symlink
:visible (fboundp 'make-symbolic-link)
:help "Make symbolic links for current or marked files"]
+ ["Relative Symlink to..." dired-do-relsymlink
+ :visible (fboundp 'make-symbolic-link)
+ :help "Make relative symbolic links for current or marked files"]
["Hardlink to..." dired-do-hardlink
:help "Make hard links for current or marked files"]
["Print..." dired-do-print
@@ -2253,7 +2480,7 @@ Type \\[dired-do-copy] to Copy files.
Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches.
Type \\[revert-buffer] to read all currently expanded directories aGain.
This retains all marks and hides subdirs again that were hidden before.
-Use `SPC' and `DEL' to move down and up by lines.
+Use \\`SPC' and \\`DEL' to move down and up by lines.
If Dired ever gets confused, you can either type \\[revert-buffer] \
to read the
@@ -2291,7 +2518,7 @@ Keybindings:
(setq-local buffer-stale-function #'dired-buffer-stale-p)
(setq-local buffer-auto-revert-by-notification t)
(setq-local page-delimiter "\n\n")
- (setq-local dired-directory (or dirname default-directory))
+ (setq dired-directory (or dirname default-directory))
;; list-buffers uses this to display the dir being edited in this buffer.
(setq list-buffers-directory
(expand-file-name (if (listp dired-directory)
@@ -2342,6 +2569,8 @@ If the current buffer can be edited with Wdired, (i.e. the major
mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
Otherwise, toggle `read-only-mode'."
(interactive)
+ (unless (file-exists-p default-directory)
+ (user-error "The current directory no longer exists"))
(when (and (not (file-writable-p default-directory))
(not (y-or-n-p
"Directory isn't writable; edit anyway? ")))
@@ -2418,7 +2647,9 @@ directory in another window."
file-name
(if (file-symlink-p file-name)
(error "File is a symlink to a nonexistent target")
- (error "File no longer exists; type `g' to update Dired buffer")))))
+ (error (substitute-command-keys
+ (concat "File no longer exists; type \\<dired-mode-map>"
+ "\\[revert-buffer] to update Dired buffer")))))))
;; Force C-m keybinding rather than `f' or `e' in the mode doc:
(define-obsolete-function-alias 'dired-advertised-find-file
@@ -2680,7 +2911,7 @@ permissions are hidden from view.
See options: `dired-hide-details-hide-symlink-targets' and
`dired-hide-details-hide-information-lines'."
:group 'dired
- (unless (derived-mode-p 'dired-mode)
+ (unless (derived-mode-p 'dired-mode 'wdired-mode)
(error "Not a Dired buffer"))
(dired-hide-details-update-invisibility-spec)
(if dired-hide-details-mode
@@ -2880,7 +3111,7 @@ matches FILE.
The list is in reverse order of buffer creation, most recent last.
As a side effect, killed dired buffers for DIR are removed from
`dired-buffers'."
- (setq dir (file-name-as-directory dir))
+ (setq dir (file-name-as-directory (expand-file-name dir)))
(let (result buf)
(dolist (elt dired-buffers)
(setq buf (cdr elt))
@@ -3272,6 +3503,14 @@ is the directory where the file on this line resides."
(point-max)
(point))))
+;; This should be a builtin
+(defun dired-buffer-more-recently-used-p (buffer1 buffer2)
+ "Return t if BUFFER1 is more recently used than BUFFER2.
+Considers buffers closer to the car of `buffer-list' to be more recent."
+ (and (not (equal buffer1 buffer2))
+ (memq buffer1 (buffer-list))
+ (not (memq buffer1 (memq buffer2 (buffer-list))))))
+
;;; Deleting files
@@ -3446,7 +3685,7 @@ If the buffer has a wildcard pattern, check that it matches FILE.
FILE may be nil, in which case ignore it.
Return list of buffers where FUN succeeded (i.e., returned non-nil)."
(let (success-list)
- (dolist (buf (dired-buffers-for-dir (expand-file-name directory) file))
+ (dolist (buf (dired-buffers-for-dir directory file))
(with-current-buffer buf
(when (apply fun args)
(push (buffer-name buf) success-list))))
@@ -3472,13 +3711,21 @@ See `dired-delete-file' in case you wish that."
(dired-remove-entry file)
(dired-clean-up-after-deletion file))
-(defvar dired-clean-up-buffers-too)
-(defvar dired-clean-confirm-killing-deleted-buffers)
+(defcustom dired-clean-up-buffers-too t
+ "Non-nil means offer to kill buffers visiting files and dirs deleted in Dired."
+ :type 'boolean
+ :group 'dired)
+
+(defcustom dired-clean-confirm-killing-deleted-buffers t
+ "If nil, don't ask whether to kill buffers visiting deleted files."
+ :type 'boolean
+ :group 'dired
+ :version "26.1")
(defun dired-clean-up-after-deletion (fn)
"Clean up after a deleted file or directory FN.
-Removes any expanded subdirectory of deleted directory. If
-`dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil,
+Removes any expanded subdirectory of deleted directory.
+If `dired-clean-up-buffers-too' is non-nil,
kill any buffers visiting those files, prompting for
confirmation. To disable the confirmation, see
`dired-clean-confirm-killing-deleted-buffers'."
@@ -3762,7 +4009,11 @@ this subdir."
(let ((inhibit-read-only t))
(dired-repeat-over-lines
(prefix-numeric-value arg)
- (lambda () (delete-char 1) (insert dired-marker-char)))))))
+ (lambda ()
+ (when (or (not (looking-at-p dired-re-dot))
+ (not (equal dired-marker-char dired-del-marker)))
+ (delete-char 1)
+ (insert dired-marker-char))))))))
(defun dired-unmark (arg &optional interactive)
"Unmark the file at point in the Dired buffer.
@@ -4083,9 +4334,9 @@ Type \\[help-command] at that time for help."
(inhibit-read-only t) case-fold-search
dired-unmark-all-files-query
(string (format "\n%c" mark))
- (help-form "\
-Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
-`!' to unmark all remaining files with no more questions."))
+ (help-form (substitute-command-keys "\
+Type \\`SPC' or \\`y' to unmark one file, \\`DEL' or \\`n' to skip to next,
+\\`!' to unmark all remaining files with no more questions.")))
(goto-char (point-min))
(while (if (eq mark ?\r)
(re-search-forward dired-re-mark nil t)
@@ -4573,6 +4824,42 @@ Interactively with prefix argument, read FILE-NAME."
(read-file-name "Jump to Dired file: "))))
(dired-jump t file-name))
+(defvar-keymap dired-jump-map
+ :doc "Keymap to repeat `dired-jump'. Used in `repeat-mode'."
+ "j" #'dired-jump
+ "C-j" #'dired-jump)
+(put 'dired-jump 'repeat-map 'dired-jump-map)
+
+
+;;; Miscellaneous commands
+
+(declare-function Man-getpage-in-background "man" (topic))
+(declare-function dired-guess-shell-command "dired-x" (prompt files))
+(defvar manual-program) ; from man.el
+
+(defun dired-do-man ()
+ "In Dired, run `man' on this file."
+ (interactive nil dired-mode)
+ (require 'man)
+ ;; FIXME: Move `dired-guess-shell-command' to dired.el to remove the
+ ;; need for requiring `dired-x'.
+ (require 'dired-x)
+ (let* ((file (dired-get-file-for-visit))
+ (manual-program (string-replace "*" "%s"
+ (dired-guess-shell-command
+ "Man command: " (list file)))))
+ (Man-getpage-in-background file)))
+
+(defun dired-do-info ()
+ "In Dired, run `info' on this file."
+ (interactive nil dired-mode)
+ (info (dired-get-file-for-visit)))
+
+(defun dired-do-eww ()
+ "In Dired, visit file in EWW."
+ (interactive nil dired-mode)
+ (eww-open-file (dired-get-file-for-visit)))
+
(provide 'dired)
(run-hooks 'dired-load-hook) ; for your customizations
diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el
index 860aa758bce..897a88398fd 100644
--- a/lisp/display-line-numbers.el
+++ b/lisp/display-line-numbers.el
@@ -108,6 +108,84 @@ the mode is on, set `display-line-numbers' directly."
(define-globalized-minor-mode global-display-line-numbers-mode
display-line-numbers-mode display-line-numbers--turn-on)
+
+
+;;;###autoload
+(defvar header-line-indent ""
+ "String to indent at the start if the header line.
+This is used in `header-line-indent-mode', and buffers that have
+this switched on should have a `header-line-format' that look like:
+
+ (\"\" header-line-indent THE-REST...)
+
+Also see `header-line-indent-width'.")
+
+;;;###autoload
+(defvar header-line-indent-width 0
+ "The width of the current line numbers displayed.
+This is updated when `header-line-indent-mode' is switched on.
+
+Also see `header-line-indent'.")
+
+(defun header-line-indent--line-number-width ()
+ "Return the width taken by `display-line-numbers' in the current buffer."
+ ;; line-number-display-width returns the value for the selected
+ ;; window, which might not be the window in which the current buffer
+ ;; is displayed.
+ (if (not display-line-numbers)
+ 0
+ (let ((cbuf-window (get-buffer-window (current-buffer) t)))
+ (if (window-live-p cbuf-window)
+ (with-selected-window cbuf-window
+ (truncate (line-number-display-width 'columns)))
+ 4))))
+
+(defun header-line-indent--watch-line-number-width (_window)
+ (let ((width (header-line-indent--line-number-width)))
+ (setq header-line-indent-width width)
+ (unless (= (length header-line-indent) width)
+ (setq header-line-indent (make-string width ?\s)))))
+
+(defun header-line-indent--window-scroll-function (window _start)
+ (let ((width (with-selected-window window
+ (truncate (line-number-display-width 'columns)))))
+ (setq header-line-indent-width width)
+ (unless (= (length header-line-indent) width)
+ (setq header-line-indent (make-string width ?\s)))))
+
+;;;###autoload
+(define-minor-mode header-line-indent-mode
+ "Mode to indent the header line in `display-line-numbers-mode' buffers.
+This means that the header line will be kept indented so that it
+has blank space that's as wide as the displayed line numbers in
+the buffer.
+
+Buffers that have this switched on should have a
+`header-line-format' that look like:
+
+ (\"\" header-line-indent THE-REST...)
+
+The `header-line-indent-width' variable is also kept updated, and
+has the width of `header-line-format'. This can be used, for
+instance, in `:align-to' specs, like:
+
+ (space :align-to (+ header-line-indent-width 10))"
+ :lighter nil
+ (if header-line-indent-mode
+ (progn
+ (setq-local header-line-indent ""
+ header-line-indent-width 0)
+ (add-hook 'pre-redisplay-functions
+ #'header-line-indent--watch-line-number-width nil t)
+ (add-hook 'window-scroll-functions
+ #'header-line-indent--window-scroll-function nil t))
+ (setq-local header-line-indent ""
+ header-line-indent-width 0)
+ (remove-hook 'pre-redisplay-functions
+ #'header-line-indent--watch-line-number-width t)
+ (remove-hook 'window-scroll-functions
+ #'header-line-indent--window-scroll-function t)))
+
(provide 'display-line-numbers)
;;; display-line-numbers.el ends here
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 97e81e9bf11..ade61917e96 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -33,6 +33,9 @@
;;; Customizable variables
+(eval-when-compile
+ (require 'cl-lib))
+
(defgroup dnd nil
"Handling data from drag and drop."
:group 'environment)
@@ -42,8 +45,7 @@
`((,(purecopy "^file:///") . dnd-open-local-file) ; XDND format.
(,(purecopy "^file://") . dnd-open-file) ; URL with host
(,(purecopy "^file:") . dnd-open-local-file) ; Old KDE, Motif, Sun
- (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)
- )
+ (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file))
"The functions to call for different protocols when a drop is made.
This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'.
@@ -57,7 +59,8 @@ If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
The function shall return the action done (move, copy, link or private)
if some action was made, or nil if the URL is ignored."
:version "22.1"
- :type '(repeat (cons (regexp) (function))))
+ :type '(repeat (cons (regexp) (function)))
+ :group 'dnd)
(defcustom dnd-open-remote-file-function
@@ -73,17 +76,82 @@ Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'.
is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode'
and is the default except for MS-Windows."
:version "22.1"
- :type 'function)
+ :type 'function
+ :group 'dnd)
(defcustom dnd-open-file-other-window nil
"If non-nil, always use `find-file-other-window' to open dropped files."
:version "22.1"
- :type 'boolean)
-
+ :type 'boolean
+ :group 'dnd)
+
+(defcustom dnd-scroll-margin nil
+ "The scroll margin inside a window underneath the cursor during drag-and-drop.
+If the mouse moves this many lines close to the top or bottom of
+a window while dragging text, then that window will be scrolled
+down and up respectively."
+ :type '(choice (const :tag "Don't scroll during mouse movement")
+ (integer :tag "This many lines from window top or bottom"))
+ :version "29.1"
+ :group 'dnd)
+
+(defcustom dnd-indicate-insertion-point nil
+ "Whether or not point should follow the position of the mouse.
+If non-nil, the point of the window underneath the mouse will be
+adjusted to reflect where any text will be inserted upon drop
+when the mouse moves while receiving a drop from another
+program."
+ :type 'boolean
+ :version "29.1"
+ :group 'dnd)
+
+(defcustom dnd-direct-save-remote-files 'x
+ "Whether or not to perform a direct save of remote files.
+This is compatible with less programs, but means dropped files
+will be saved with their actual file names, and not a temporary
+file name provided by TRAMP.
+
+This defaults to `x', which means only to drop that way on X
+Windows."
+ :type '(choice (const :tag "Only use direct save on X Windows" x)
+ (const :tag "Use direct save everywhere" t)
+ (const :tag "Don't use direct save")))
;; Functions
+(defun dnd-handle-movement (posn)
+ "Handle mouse movement to POSN when receiving a drop from another program."
+ (when (windowp (posn-window posn))
+ (with-selected-window (posn-window posn)
+ (when (and dnd-scroll-margin
+ ;; TODO: handle scroll bars reasonably.
+ (not (posn-area posn)))
+ (ignore-errors
+ (let* ((row (cdr (posn-col-row posn)))
+ (window (when (windowp (posn-window posn))
+ (posn-window posn)))
+ (text-height (window-text-height window))
+ ;; Make sure it's possible to scroll both up
+ ;; and down if the margin is too large for the
+ ;; window.
+ (margin (min (/ text-height 3) dnd-scroll-margin)))
+ ;; At 2 lines, the window becomes too small for any
+ ;; meaningful scrolling.
+ (unless (<= text-height 2)
+ (cond
+ ;; Inside the bottom scroll margin, scroll up.
+ ((> row (- text-height margin))
+ (with-selected-window window
+ (scroll-up 1)))
+ ;; Inside the top scroll margin, scroll down.
+ ((< row margin)
+ (with-selected-window window
+ (scroll-down 1))))))))
+ (when dnd-indicate-insertion-point
+ (ignore-errors
+ (goto-char (posn-point posn)))))))
+
(defun dnd-handle-one-url (window action url)
"Handle one dropped url by calling the appropriate handler.
The handler is first located by looking at `dnd-protocol-alist'.
@@ -227,6 +295,276 @@ TEXT is the text as a string, WINDOW is the window where the drop happened."
(insert text))
action)
+
+;;; Functions for dragging stuff to other programs. These build upon
+;;; the lower-level `x-begin-drag' interface, but take care of data
+;;; types and abstracting around the different return values.
+
+(defvar dnd-last-dragged-remote-file nil
+ "If non-nil, the name of a local copy of the last remote file that was dragged.
+This may also be a list of files, if multiple files were dragged.
+It can't be removed immediately after the drag-and-drop operation
+completes, since there is no way to determine when the drop
+target has finished opening it. So instead, this file is removed
+when Emacs exits or the user drags another file.")
+
+(defun dnd-remove-last-dragged-remote-file ()
+ "Remove the local copy of the last remote file to be dragged.
+If `dnd-last-dragged-remote-file' is a list, remove all the files
+in that list instead."
+ (when dnd-last-dragged-remote-file
+ (unwind-protect
+ (if (consp dnd-last-dragged-remote-file)
+ (mapc #'delete-file dnd-last-dragged-remote-file)
+ (delete-file dnd-last-dragged-remote-file))
+ (setq dnd-last-dragged-remote-file nil)))
+ (remove-hook 'kill-emacs-hook
+ #'dnd-remove-last-dragged-remote-file))
+
+(declare-function x-begin-drag "xfns.c")
+
+(defun dnd-begin-text-drag (text &optional frame action allow-same-frame)
+ "Begin dragging TEXT from FRAME.
+Initate a drag-and-drop operation allowing the user to drag text
+from Emacs to another program (the drop target), then block until
+the drop is completed or is cancelled.
+
+If the drop completed, return the action that the drop target
+actually performed, which can be one of the following symbols:
+
+ - `copy', which means TEXT was inserted by the drop target.
+
+ - `move', which means TEXT was inserted, and the caller should
+ additionally delete TEXT from its source (such as the buffer
+ where it originated).
+
+ - `private', which means the drop target chose to perform an
+ unspecified action.
+
+Return nil if the drop was cancelled.
+
+TEXT is a string containing text that will be inserted by the
+program where the drop happened. FRAME is the frame where the
+mouse is currently held down, or nil, which stands for the
+current frame. ACTION is one of the symbols `copy' or `move',
+where `copy' means that the text should be inserted by the drop
+target, and `move' means the same as `copy', but in addition
+the caller might have to delete TEXT from its source after this
+function returns. If ALLOW-SAME-FRAME is nil, ignore any drops
+on FRAME itself.
+
+This function might return immediately if no mouse buttons are
+currently being held down. It should only be called upon a
+`down-mouse-1' (or similar) event."
+ (unless (fboundp 'x-begin-drag)
+ (error "Dragging text from Emacs is not supported by this window system"))
+ (gui-set-selection 'XdndSelection text)
+ (unless action
+ (setq action 'copy))
+ (let ((return-value
+ (x-begin-drag '(;; Traditional X selection targets used by GTK, the
+ ;; Motif drag-and-drop protocols, and programs like
+ ;; Xterm. `STRING' is also used on NS and Haiku.
+ "STRING" "TEXT" "COMPOUND_TEXT" "UTF8_STRING"
+ ;; Used by Xdnd clients that strictly comply with
+ ;; the standard (i.e. Qt programs).
+ "text/plain" "text/plain;charset=utf-8")
+ (cl-ecase action
+ ('copy 'XdndActionCopy)
+ ('move 'XdndActionMove))
+ frame nil allow-same-frame)))
+ (cond
+ ((eq return-value 'XdndActionCopy) 'copy)
+ ((eq return-value 'XdndActionMove) 'move)
+ ((not return-value) nil)
+ (t 'private))))
+
+(defun dnd-begin-file-drag (file &optional frame action allow-same-frame)
+ "Begin dragging FILE from FRAME.
+Initate a drag-and-drop operation allowing the user to drag a file
+from Emacs to another program (the drop target), then block until
+the drop happens or is cancelled.
+
+Return the action that the drop target actually performed, which
+can be one of the following symbols:
+
+ - `copy', which means FILE was opened by the drop target.
+
+ - `move', which means FILE was moved to another location by the
+ drop target.
+
+ - `link', which means a symbolic link was created to FILE by
+ the drop target, usually a file manager.
+
+ - `private', which means the drop target chose to perform an
+ unspecified action.
+
+Return nil if the drop was cancelled.
+
+FILE is the file name that will be sent to the program where the
+drop happened. If it is a remote file, Emacs will make a
+temporary copy and pass that. FRAME is the frame where the mouse
+is currently held down, or nil (which means to use the current
+frame). ACTION is one of the symbols `copy', `move' or `link',
+where `copy' means that the file should be opened or copied by
+the drop target, `move' means the drop target should move the
+file to another location, and `link' means the drop target should
+create a symbolic link to FILE. It is an error to specify `link'
+as the action if FILE is a remote file. If ALLOW-SAME-FRAME is
+nil, any drops on FRAME itself will be ignored.
+
+This function might return immediately if no mouse buttons are
+currently being held down. It should only be called upon a
+`down-mouse-1' (or similar) event."
+ (unless (fboundp 'x-begin-drag)
+ (error "Dragging files from Emacs is not supported by this window system"))
+ (dnd-remove-last-dragged-remote-file)
+ (unless action
+ (setq action 'copy))
+ (if (and (or (and (eq dnd-direct-save-remote-files 'x)
+ (eq (framep (or frame
+ (selected-frame)))
+ 'x))
+ (and dnd-direct-save-remote-files
+ (not (eq dnd-direct-save-remote-files 'x))))
+ (eq action 'copy)
+ (file-remote-p file))
+ (dnd-direct-save file (file-name-nondirectory file)
+ frame allow-same-frame)
+ (let ((original-file file))
+ (when (file-remote-p file)
+ (if (eq action 'link)
+ (error "Cannot create symbolic link to remote file")
+ (setq file (file-local-copy file))
+ (setq dnd-last-dragged-remote-file file)
+ (add-hook 'kill-emacs-hook
+ #'dnd-remove-last-dragged-remote-file)))
+ (gui-set-selection 'XdndSelection
+ (propertize (expand-file-name file) 'text/uri-list
+ (concat "file://"
+ (expand-file-name file))))
+ (let ((return-value
+ (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
+ ;; modern programs that expect filenames to
+ ;; be supplied as URIs.
+ "text/uri-list" "text/x-xdnd-username"
+ ;; Traditional X selection targets used by
+ ;; programs supporting the Motif
+ ;; drag-and-drop protocols. Also used by NS
+ ;; and Haiku.
+ "FILE_NAME" "FILE" "HOST_NAME"
+ ;; ToolTalk filename. Mostly used by CDE
+ ;; programs.
+ "_DT_NETFILE")
+ (cl-ecase action
+ ('copy 'XdndActionCopy)
+ ('move 'XdndActionMove)
+ ('link 'XdndActionLink))
+ frame nil allow-same-frame)))
+ (cond
+ ((eq return-value 'XdndActionCopy) 'copy)
+ ((eq return-value 'XdndActionMove)
+ (prog1 'move
+ ;; If original-file is a remote file, delete it from the
+ ;; remote as well.
+ (when (file-remote-p original-file)
+ (ignore-errors
+ (delete-file original-file)))))
+ ((eq return-value 'XdndActionLink) 'link)
+ ((not return-value) nil)
+ (t 'private))))))
+
+(defun dnd-begin-drag-files (files &optional frame action allow-same-frame)
+ "Begin dragging FILES from FRAME.
+This is like `dnd-begin-file-drag', except with multiple files.
+FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in
+`dnd-begin-file-drag'.
+
+FILES is a list of files that will be dragged. If the drop
+target doesn't support dropping multiple files, the first file in
+FILES will be dragged."
+ (unless (fboundp 'x-begin-drag)
+ (error "Dragging files from Emacs is not supported by this window system"))
+ (dnd-remove-last-dragged-remote-file)
+ (let* ((new-files (copy-sequence files))
+ (tem new-files))
+ (while tem
+ (setcar tem (expand-file-name (car tem)))
+ (when (file-remote-p (car tem))
+ (when (eq action 'link)
+ (error "Cannot create symbolic link to remote file"))
+ (condition-case error
+ (progn (setcar tem (file-local-copy (car tem)))
+ (push (car tem) dnd-last-dragged-remote-file))
+ (error (message "Failed to download file: %s" error)
+ (setcar tem nil))))
+ (setq tem (cdr tem)))
+ (when dnd-last-dragged-remote-file
+ (add-hook 'kill-emacs-hook
+ #'dnd-remove-last-dragged-remote-file))
+ ;; Remove any files that failed to download from a remote host.
+ (setq new-files (delq nil new-files))
+ (unless new-files
+ (error "No files were specified or no remote file could be downloaded"))
+ (unless action
+ (setq action 'copy))
+ (gui-set-selection 'XdndSelection
+ (propertize (car new-files)
+ 'text/uri-list
+ (cl-loop for file in new-files
+ collect (concat "file://" file)
+ into targets finally return
+ (apply #'vector targets))
+ 'FILE_NAME (apply #'vector new-files)))
+ (let ((return-value
+ (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
+ ;; modern programs that expect filenames to
+ ;; be supplied as URIs.
+ "text/uri-list" "text/x-xdnd-username"
+ ;; Traditional X selection targets used by
+ ;; programs supporting the Motif
+ ;; drag-and-drop protocols. Also used by NS
+ ;; and Haiku.
+ "FILE_NAME" "HOST_NAME")
+ (cl-ecase action
+ ('copy 'XdndActionCopy)
+ ('move 'XdndActionMove)
+ ('link 'XdndActionLink))
+ frame nil allow-same-frame)))
+ (cond
+ ((eq return-value 'XdndActionCopy) 'copy)
+ ((eq return-value 'XdndActionMove)
+ (prog1 'move
+ ;; If original-file is a remote file, delete it from the
+ ;; remote as well.
+ (dolist (original-file files)
+ (when (file-remote-p original-file)
+ (ignore-errors
+ (delete-file original-file))))))
+ ((eq return-value 'XdndActionLink) 'link)
+ ((not return-value) nil)
+ (t 'private)))))
+
+(declare-function x-dnd-do-direct-save "x-dnd.el")
+
+(defun dnd-direct-save (file name &optional frame allow-same-frame)
+ "Drag FILE from FRAME, but do not treat it as an actual file.
+Instead, ask the target window to insert the file with NAME.
+File managers will create a file in the displayed directory with
+the contents of FILE and the name NAME, while text editors will
+insert the contents of FILE in a new document named
+NAME.
+
+ALLOW-SAME-FRAME means the same as in `dnd-begin-file-drag'.
+Return `copy' if the drop was successful, else nil."
+ (setq file (expand-file-name file))
+ (cond ((eq window-system 'x)
+ (when (x-dnd-do-direct-save file name frame
+ allow-same-frame)
+ 'copy))
+ ;; Avoid infinite recursion.
+ (t (let ((dnd-direct-save-remote-files nil))
+ (dnd-begin-file-drag file frame nil allow-same-frame)))))
(provide 'dnd)
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 836bfaf910f..0f659fb8b37 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2007-2022 Free Software Foundation, Inc.
;;
;; Author: Tassilo Horn <tsdh@gnu.org>
-;; Keywords: files, pdf, ps, dvi
+;; Keywords: files, pdf, ps, dvi, djvu, epub, cbz, fb2, xps, openxps
;; This file is part of GNU Emacs.
@@ -25,17 +25,19 @@
;; Viewing PS/PDF/DVI files requires Ghostscript, `dvipdf' (comes with
;; Ghostscript) or `dvipdfm' (comes with teTeX or TeXLive) and
;; `pdftotext', which comes with xpdf (https://www.foolabs.com/xpdf/)
-;; or poppler (https://poppler.freedesktop.org/).
-;; Djvu documents require `ddjvu' (from DjVuLibre).
-;; ODF files require `soffice' (from LibreOffice).
+;; or poppler (https://poppler.freedesktop.org/). EPUB, CBZ, FB2, XPS
+;; and OXPS documents require `mutool' which comes with mupdf
+;; (https://mupdf.com/index.html). Djvu documents require `ddjvu'
+;; (from DjVuLibre). ODF files require `soffice' (from LibreOffice).
;;; Commentary:
;; DocView is a document viewer for Emacs. It converts a number of
-;; document formats (including PDF, PS, DVI, Djvu and ODF files) to a
-;; set of PNG files, one PNG for each page, and displays the PNG
-;; images inside an Emacs buffer. This buffer uses `doc-view-mode'
-;; which provides convenient key bindings for browsing the document.
+;; document formats (including PDF, PS, DVI, Djvu, ODF, EPUB, CBZ,
+;; FB2, XPS and OXPS files) to a set of PNG (or TIFF for djvu) files,
+;; one image for each page, and displays the images inside an Emacs
+;; buffer. This buffer uses `doc-view-mode' which provides convenient
+;; key bindings for browsing the document.
;;
;; To use it simply open a document file with
;;
@@ -142,12 +144,16 @@
(require 'dired)
(require 'image-mode)
(require 'jka-compr)
+(require 'filenotify)
(eval-when-compile (require 'subr-x))
;;;; Customization Options
(defgroup doc-view nil
- "In-buffer viewer for PDF, PostScript, DVI, and DJVU files."
+ "In-buffer document viewer.
+The viewer handles PDF, PostScript, DVI, DJVU, ODF, EPUB, CBZ,
+FB2, XPS and OXPS files, if the appropriate converter programs
+are available (see Info node `(emacs)Document View')"
:link '(function-link doc-view)
:version "22.2"
:group 'applications
@@ -219,7 +225,68 @@
(defcustom doc-view-resolution 100
"Dots per inch resolution used to render the documents.
Higher values result in larger images."
- :type 'number)
+ :type 'natnum)
+
+(defvar doc-view-doc-type nil
+ "The type of document in the current buffer.
+Can be `dvi', `pdf', `ps', `djvu', `odf', `epub', `cbz', `fb2',
+`xps' or `oxps'.")
+
+(defvar doc-view--epub-stylesheet-watcher nil
+ "File watcher for `doc-view-epub-user-stylesheet'.")
+
+(defun doc-view--epub-reconvert (&optional _event)
+ "Reconvert all epub buffers.
+
+EVENT is unused, but neccesary to work with the filenotify API"
+ (dolist (x (buffer-list))
+ (with-current-buffer x
+ (when (eq doc-view-doc-type 'epub)
+ (doc-view-reconvert-doc)))))
+
+(defun doc-view-custom-set-epub-user-stylesheet (option-name new-value)
+ "Setter for `doc-view-epub-user-stylesheet'.
+
+Reconverts existing epub buffers when the file used as a user
+stylesheet is switched, or its contents modified."
+ (set-default option-name new-value)
+ (file-notify-rm-watch doc-view--epub-stylesheet-watcher)
+ (doc-view--epub-reconvert)
+ (setq doc-view--epub-stylesheet-watcher
+ (when new-value
+ (file-notify-add-watch new-value '(change) #'doc-view--epub-reconvert))))
+
+(defcustom doc-view-epub-user-stylesheet nil
+ "User stylesheet to use when converting EPUB documents to PDF."
+ :type '(choice (const nil)
+ (file :must-match t))
+ :version "29.1"
+ :set #'doc-view-custom-set-epub-user-stylesheet)
+
+(defvar-local doc-view--current-cache-dir nil
+ "Only used internally.")
+
+(defun doc-view-custom-set-epub-font-size (option-name new-value)
+ (set-default option-name new-value)
+ (doc-view--epub-reconvert))
+
+;; FIXME: The doc-view-current-* definitions below are macros because they
+;; map to accessors which we want to use via `setf' as well!
+(defmacro doc-view-current-page (&optional win)
+ `(image-mode-window-get 'page ,win))
+(defmacro doc-view-current-info () '(image-mode-window-get 'info))
+(defmacro doc-view-current-overlay () '(image-mode-window-get 'overlay))
+(defmacro doc-view-current-image () '(image-mode-window-get 'image))
+(defmacro doc-view-current-slice () '(image-mode-window-get 'slice))
+
+(defvar-local doc-view--current-cache-dir nil
+ "Only used internally.")
+
+(defcustom doc-view-epub-font-size nil
+ "Font size in points for EPUB layout."
+ :type '(choice (const nil) integer)
+ :set #'doc-view-custom-set-epub-font-size
+ :version "29.1")
(defcustom doc-view-scale-internally t
"Whether we should try to rescale images ourselves.
@@ -234,7 +301,7 @@ scaling."
Has only an effect if `doc-view-scale-internally' is non-nil and support for
scaling is compiled into Emacs."
:version "24.1"
- :type 'number)
+ :type 'natnum)
(defcustom doc-view-dvipdfm-program "dvipdfm"
"Program to convert DVI files to PDF.
@@ -256,9 +323,7 @@ If this and `doc-view-dvipdfm-program' are set,
`doc-view-dvipdf-program' will be preferred."
:type 'file)
-(define-obsolete-variable-alias 'doc-view-unoconv-program
- 'doc-view-odf->pdf-converter-program
- "24.4")
+(define-obsolete-variable-alias 'doc-view-unoconv-program 'doc-view-odf->pdf-converter-program "24.4")
(defcustom doc-view-odf->pdf-converter-program
(cond
@@ -313,7 +378,8 @@ After such a refresh newly converted pages will be available for
viewing. If set to nil there won't be any refreshes and the
pages won't be displayed before conversion of the whole document
has finished."
- :type 'integer)
+ :type '(choice natnum
+ (const :value nil :tag "No refreshes")))
(defcustom doc-view-continuous nil
"In Continuous mode reaching the page edge advances to next/previous page.
@@ -363,9 +429,6 @@ of the page moves to the previous page."
(defvar-local doc-view--current-timer nil
"Only used internally.")
-(defvar-local doc-view--current-cache-dir nil
- "Only used internally.")
-
(defvar-local doc-view--current-search-matches nil
"Only used internally.")
@@ -380,10 +443,6 @@ files inside an archive it is a temporary copy of
the (uncompressed, extracted) file residing in
`doc-view-cache-directory'.")
-(defvar doc-view-doc-type nil
- "The type of document in the current buffer.
-Can be `dvi', `pdf', `ps', `djvu' or `odf'.")
-
(defvar doc-view-single-page-converter-function nil
"Function to call to convert a single page of the document to a bitmap file.
May operate on the source document or on some intermediate (typically PDF)
@@ -464,17 +523,17 @@ Typically \"page-%s.png\".")
;; It's normal for this operation to result in a very large undo entry.
(setq-local undo-outer-limit (* 2 (buffer-size))))
(cl-labels ((revert ()
- (let ((revert-buffer-preserve-modes t))
- (apply orig-fun args)
- ;; Update the cached version of the pdf file,
- ;; too. This is the one that's used when
- ;; rendering (bug#26996).
- (unless (equal buffer-file-name
- doc-view--buffer-file-name)
- ;; FIXME: Lars says he needed to recreate
- ;; the dir, we should figure out why.
- (doc-view-make-safe-dir doc-view-cache-directory)
- (write-region nil nil doc-view--buffer-file-name)))))
+ (let ((revert-buffer-preserve-modes t))
+ (apply orig-fun args)
+ ;; Update the cached version of the pdf file,
+ ;; too. This is the one that's used when
+ ;; rendering (bug#26996).
+ (unless (equal buffer-file-name
+ doc-view--buffer-file-name)
+ ;; FIXME: Lars says he needed to recreate
+ ;; the dir, we should figure out why.
+ (doc-view-make-safe-dir doc-view-cache-directory)
+ (write-region nil nil doc-view--buffer-file-name)))))
(if (and (eq 'pdf doc-view-doc-type)
(executable-find "pdfinfo"))
;; We don't want to revert if the PDF file is corrupted which
@@ -493,24 +552,69 @@ Typically \"page-%s.png\".")
(easy-menu-define doc-view-menu doc-view-mode-map
"Menu for Doc View mode."
'("DocView"
- ["Toggle display" doc-view-toggle-display]
- ("Continuous"
+ ["Next page" doc-view-next-page
+ :help "Go to the next page"]
+ ["Previous page" doc-view-previous-page
+ :help "Go to the previous page"]
+ ("Other Navigation"
+ ["Go to page..." doc-view-goto-page
+ :help "Go to specific page"]
+ "---"
+ ["First page" doc-view-first-page
+ :help "View the first page"]
+ ["Last page" doc-view-last-page
+ :help "View the last page"]
+ "---"
+ ["Move forward" doc-view-scroll-up-or-next-page
+ :help "Scroll page up or go to next page"]
+ ["Move backward" doc-view-scroll-down-or-previous-page
+ :help "Scroll page down or go to previous page"])
+ ("Continuous Scrolling"
["Off" (setq doc-view-continuous nil)
- :style radio :selected (eq doc-view-continuous nil)]
+ :style radio :selected (eq doc-view-continuous nil)
+ :help "Scrolling stops at page beginning and end"]
["On" (setq doc-view-continuous t)
- :style radio :selected (eq doc-view-continuous t)]
+ :style radio :selected (eq doc-view-continuous t)
+ :help "Scrolling continues to next or previous page"]
"---"
- ["Save as Default"
- (customize-save-variable 'doc-view-continuous doc-view-continuous) t]
+ ["Save as Default" (customize-save-variable 'doc-view-continuous doc-view-continuous)
+ :help "Save current continuous scrolling option as default"]
)
"---"
- ["Set Slice" doc-view-set-slice-using-mouse]
- ["Set Slice (BoundingBox)" doc-view-set-slice-from-bounding-box]
- ["Set Slice (manual)" doc-view-set-slice]
- ["Reset Slice" doc-view-reset-slice]
+ ("Toggle edit/display"
+ ["Edit document" doc-view-toggle-display
+ :style radio :selected (eq major-mode 'doc-view--text-view-mode)]
+ ["Display document" (lambda ()) ; ignore but show no keybinding
+ :style radio :selected (eq major-mode 'doc-view-mode)])
+ ("Adjust Display"
+ ["Fit to window" doc-view-fit-page-to-window
+ :help "Fit the image to the window"]
+ ["Fit width" doc-view-fit-width-to-window
+ :help "Fit the image width to the window width"]
+ ["Fit height" doc-view-fit-height-to-window
+ :help "Fit the image height to the window height"]
+ "---"
+ ["Enlarge" doc-view-enlarge
+ :help "Enlarge the document"]
+ ["Shrink" doc-view-shrink
+ :help "Shrink the document"]
+ "---"
+ ["Set Slice" doc-view-set-slice-using-mouse
+ :help "Set the slice of the images that should be displayed"]
+ ["Set Slice (BoundingBox)" doc-view-set-slice-from-bounding-box
+ :help "Set the slice from the document's BoundingBox information"]
+ ["Set Slice (manual)" doc-view-set-slice
+ :help "Set the slice of the images that should be displayed"]
+ ["Reset Slice" doc-view-reset-slice
+ :help "Reset the current slice"
+ :enabled (image-mode-window-get 'slice)])
"---"
- ["Search" doc-view-search]
- ["Search Backwards" doc-view-search-backward]
+ ["New Search" (doc-view-search t)
+ :help "Initiate a new search"]
+ ["Search Forward" doc-view-search
+ :help "Jump to the next match or initiate a new search"]
+ ["Search Backward" doc-view-search-backward
+ :help "Jump to the previous match or initiate a new search"]
))
(defvar doc-view-minor-mode-map
@@ -520,16 +624,17 @@ Typically \"page-%s.png\".")
map)
"Keymap used by `doc-view-minor-mode'.")
-;;;; Navigation Commands
+(easy-menu-define doc-view-minor-mode-menu doc-view-minor-mode-map
+ "Menu for Doc View minor mode."
+ '("DocView (edit)"
+ ("Toggle edit/display"
+ ["Edit document" (lambda ()) ; ignore but show no keybinding
+ :style radio :selected (eq major-mode 'doc-view--text-view-mode)]
+ ["Display document" doc-view-toggle-display
+ :style radio :selected (eq major-mode 'doc-view-mode)])
+ ["Exit DocView Mode" doc-view-minor-mode]))
-;; FIXME: The doc-view-current-* definitions below are macros because they
-;; map to accessors which we want to use via `setf' as well!
-(defmacro doc-view-current-page (&optional win)
- `(image-mode-window-get 'page ,win))
-(defmacro doc-view-current-info () '(image-mode-window-get 'info))
-(defmacro doc-view-current-overlay () '(image-mode-window-get 'overlay))
-(defmacro doc-view-current-image () '(image-mode-window-get 'image))
-(defmacro doc-view-current-slice () '(image-mode-window-get 'slice))
+;;;; Navigation Commands
(defun doc-view-last-page-number ()
(length doc-view--current-files))
@@ -552,17 +657,16 @@ Typically \"page-%s.png\".")
(propertize
(format "Page %d of %d." page len) 'face 'bold)
;; Tell user if converting isn't finished yet
- (if doc-view--current-converter-processes
- " (still converting...)\n"
- "\n")
- ;; Display context infos if this page matches the last search
- (when (and doc-view--current-search-matches
- (assq page doc-view--current-search-matches))
- (concat (propertize "Search matches:\n" 'face 'bold)
+ (and doc-view--current-converter-processes
+ " (still converting...)")
+ ;; Display context infos if this page matches the last search
+ (when (and doc-view--current-search-matches
+ (assq page doc-view--current-search-matches))
+ (concat "\n" (propertize "Search matches:" 'face 'bold)
(let ((contexts ""))
(dolist (m (cdr (assq page
doc-view--current-search-matches)))
- (setq contexts (concat contexts " - \"" m "\"\n")))
+ (setq contexts (concat contexts "\n - \"" m "\"")))
contexts)))))
;; Update the buffer
;; We used to find the file name from doc-view--current-files but
@@ -683,7 +787,7 @@ at the top edge of the page moves to the previous page."
(interactive)
(while (consp doc-view--current-converter-processes)
(ignore-errors ;; Some entries might not be processes, and maybe
- ;; some are dead already?
+ ; some are dead already?
(kill-process (pop doc-view--current-converter-processes))))
(when doc-view--current-timer
(cancel-timer doc-view--current-timer)
@@ -744,8 +848,8 @@ It's a subdirectory of `doc-view-cache-directory'."
;;;###autoload
(defun doc-view-mode-p (type)
"Return non-nil if document type TYPE is available for `doc-view'.
-Document types are symbols like `dvi', `ps', `pdf', or `odf' (any
-OpenDocument format)."
+Document types are symbols like `dvi', `ps', `pdf', `epub',
+`cbz', `fb2', `xps', `oxps', or`odf' (any OpenDocument format)."
(and (display-graphic-p)
(image-type-available-p 'png)
(cond
@@ -756,15 +860,22 @@ OpenDocument format)."
(and doc-view-dvipdfm-program
(executable-find doc-view-dvipdfm-program)))))
((memq type '(postscript ps eps pdf))
- ;; FIXME: allow mupdf here
- (and doc-view-ghostscript-program
- (executable-find doc-view-ghostscript-program)))
+ (or (and doc-view-ghostscript-program
+ (executable-find doc-view-ghostscript-program))
+ ;; for pdf also check for `doc-view-pdfdraw-program'
+ (when (eq type 'pdf)
+ (and doc-view-pdfdraw-program
+ (executable-find doc-view-pdfdraw-program)))))
((eq type 'odf)
(and doc-view-odf->pdf-converter-program
(executable-find doc-view-odf->pdf-converter-program)
(doc-view-mode-p 'pdf)))
((eq type 'djvu)
(executable-find "ddjvu"))
+ ((memq type '(epub cbz fb2 xps oxps))
+ ;; first check if `doc-view-pdfdraw-program' is set to mutool
+ (and (string= doc-view-pdfdraw-program "mutool")
+ (executable-find "mutool")))
(t ;; unknown image type
nil))))
@@ -997,7 +1108,7 @@ Should be invoked when the cached images aren't up-to-date."
;; some file-name-handler-managed dir, for example).
(let* ((default-directory (or (unhandled-file-name-directory
default-directory)
- (expand-file-name "~/")))
+ (expand-file-name "~/")))
(proc (apply #'start-process name doc-view-conversion-buffer
program args)))
(push proc doc-view--current-converter-processes)
@@ -1083,14 +1194,25 @@ The test is performed using `doc-view-pdfdraw-program'."
(search-forward "error: cannot authenticate password" nil t)))
(defun doc-view-pdf->png-converter-mupdf (pdf png page callback)
- (let ((pdf-passwd (if (doc-view-pdf-password-protected-pdfdraw-p pdf)
- (read-passwd "Enter password for PDF file: "))))
+ (let* ((pdf-passwd (if (doc-view-pdf-password-protected-pdfdraw-p pdf)
+ (read-passwd "Enter password for PDF file: ")))
+ (options `(,(concat "-o" png)
+ ,(format "-r%d" (round doc-view-resolution))
+ ,@(if pdf-passwd `("-p" ,pdf-passwd)))))
+ (when (eq doc-view-doc-type 'epub)
+ (when doc-view-epub-font-size
+ (setq options (append options
+ (list (format "-S%s" doc-view-epub-font-size)))))
+ (when doc-view-epub-user-stylesheet
+ (setq options
+ (append options
+ (list (format "-U%s"
+ (expand-file-name
+ doc-view-epub-user-stylesheet)))))))
(doc-view-start-process
"pdf->png" doc-view-pdfdraw-program
`(,@(doc-view-pdfdraw-program-subcommand)
- ,(concat "-o" png)
- ,(format "-r%d" (round doc-view-resolution))
- ,@(if pdf-passwd `("-p" ,pdf-passwd))
+ ,@options
,pdf
,@(if page `(,(format "%d" page))))
callback)))
@@ -1133,7 +1255,8 @@ is named like ODF with the extension turned to pdf."
"Convert PDF-PS to PNG asynchronously."
(funcall
(pcase doc-view-doc-type
- ('pdf doc-view-pdf->png-converter-function)
+ ((or 'pdf 'odf 'epub 'cbz 'fb2 'xps 'oxps)
+ doc-view-pdf->png-converter-function)
('djvu #'doc-view-djvu->tiff-converter-ddjvu)
(_ #'doc-view-ps->png-converter-ghostscript))
pdf-ps png nil
@@ -1171,20 +1294,20 @@ Start by converting PAGES, and then the rest."
(let ((rest (cdr pages)))
(funcall doc-view-single-page-converter-function
pdf (format png (car pages)) (car pages)
- (lambda ()
- (if rest
- (doc-view-document->bitmap pdf png rest)
- ;; Yippie, the important pages are done, update the display.
- (clear-image-cache)
- ;; For the windows that have a message (like "Welcome to
- ;; DocView") display property, clearing the image cache is
- ;; not sufficient.
- (dolist (win (get-buffer-window-list (current-buffer) nil 'visible))
- (with-selected-window win
- (when (stringp (overlay-get (doc-view-current-overlay) 'display))
- (doc-view-goto-page (doc-view-current-page)))))
- ;; Convert the rest of the pages.
- (doc-view-pdf/ps->png pdf png)))))))
+ (lambda ()
+ (if rest
+ (doc-view-document->bitmap pdf png rest)
+ ;; Yippie, the important pages are done, update the display.
+ (clear-image-cache)
+ ;; For the windows that have a message (like "Welcome to
+ ;; DocView") display property, clearing the image cache is
+ ;; not sufficient.
+ (dolist (win (get-buffer-window-list (current-buffer) nil 'visible))
+ (with-selected-window win
+ (when (stringp (overlay-get (doc-view-current-overlay) 'display))
+ (doc-view-goto-page (doc-view-current-page)))))
+ ;; Convert the rest of the pages.
+ (doc-view-pdf/ps->png pdf png)))))))
(defun doc-view-pdf->txt (pdf txt callback)
"Convert PDF to TXT asynchronously and call CALLBACK when finished."
@@ -1281,7 +1404,9 @@ Those files are saved in the directory given by the function
;; Rename to doc.pdf
(rename-file opdf pdf)
(doc-view-pdf/ps->png pdf png-file)))))
- ((or 'pdf 'djvu)
+ ;; The doc-view-mode-p check ensures that epub, cbz, fb2 and
+ ;; (o)xps are handled with mutool
+ ((or 'pdf 'djvu 'epub 'cbz 'fb2 'xps 'oxps)
(let ((pages (doc-view-active-pages)))
;; Convert doc to bitmap images starting with the active pages.
(doc-view-document->bitmap doc-view--buffer-file-name png-file pages)))
@@ -1376,7 +1501,7 @@ dragging it to its bottom-right corner. See also
(defun doc-view-guess-paper-size (iw ih)
"Guess the paper size according to the aspect ratio."
(cl-labels ((div (x y)
- (round (/ (* 100.0 x) y))))
+ (round (/ (* 100.0 x) y))))
(let ((ar (div iw ih))
(al (mapcar (lambda (l)
(list (div (nth 1 l) (nth 2 l)) (car l)))
@@ -1530,18 +1655,19 @@ have the page we want to view."
(overlay-put (doc-view-current-overlay) 'display
(concat (propertize "Welcome to DocView!" 'face 'bold)
"\n"
- "
+ (substitute-command-keys "
If you see this buffer it means that the document you want to view is being
converted to PNG and the conversion of the first page hasn't finished yet or
`doc-view-conversion-refresh-interval' is set to nil.
For now these keys are useful:
+\\<doc-view-mode-map>
+\\[quit-window] : Bury this buffer. Conversion will go on in background.
+\\[image-kill-buffer] : Kill the conversion process and this buffer.
+\\[doc-view-kill-proc] : Kill the conversion process.\n")))))
-`q' : Bury this buffer. Conversion will go on in background.
-`k' : Kill the conversion process and this buffer.
-`K' : Kill the conversion process.\n"))))
-
-(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
+(declare-function tooltip-show "tooltip" (text &optional use-echo-area
+ text-face default-face))
(defun doc-view-show-tooltip ()
(interactive)
@@ -1813,6 +1939,8 @@ If BACKWARD is non-nil, jump to the previous match."
("dvi" dvi)
;; PDF
("pdf" pdf) ("epdf" pdf)
+ ;; EPUB
+ ("epub" epub)
;; PostScript
("ps" ps) ("eps" ps)
;; DjVu
@@ -1824,7 +1952,13 @@ If BACKWARD is non-nil, jump to the previous match."
;; Microsoft Office formats (also handled by the odf
;; conversion chain).
("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf)
- ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf))
+ ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf)
+ ;; CBZ
+ ("cbz" cbz)
+ ;; FB2
+ ("fb2" fb2)
+ ;; (Open)XPS
+ ("xps" xps) ("oxps" oxps))
t))))
(content-types
(save-excursion
@@ -1833,7 +1967,12 @@ If BACKWARD is non-nil, jump to the previous match."
((looking-at "%!") '(ps))
((looking-at "%PDF") '(pdf))
((looking-at "\367\002") '(dvi))
- ((looking-at "AT&TFORM") '(djvu))))))
+ ((looking-at "AT&TFORM") '(djvu))
+ ;; The following pattern actually is for recognizing
+ ;; zip-archives, so that this same association is used for
+ ;; cbz files. This is fine, as cbz files should be handled
+ ;; like epub anyway.
+ ((looking-at "PK") '(epub odf))))))
(setq-local
doc-view-doc-type
(car (or (nreverse (seq-intersection name-types content-types #'eq))
@@ -2146,6 +2285,8 @@ See the command `doc-view-mode' for more information on this mode."
(add-hook 'bookmark-after-jump-hook show-fn-sym)
(bookmark-default-handler bmk)))
+(put 'doc-view-bookmark-jump 'bookmark-handler-type "DocView")
+
;; Obsolete.
(defun doc-view-intersection (l1 l2)
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index ea54eea6036..edbe9e494f1 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -231,9 +231,6 @@ returned unaltered."
(add-hook 'before-init-hook 'dos-reevaluate-defcustoms)
-(define-obsolete-variable-alias
- 'register-name-alist 'dos-register-name-alist "24.1")
-
(defvar dos-register-name-alist
'((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5)
(cflag . 6) (flags . 7)
@@ -243,8 +240,6 @@ returned unaltered."
(defun dos-make-register ()
(make-vector 8 0))
-(define-obsolete-function-alias 'make-register 'dos-make-register "24.1")
-
(defun dos-register-value (regs name)
(let ((where (cdr (assoc name dos-register-name-alist))))
(cond ((consp where)
@@ -256,8 +251,6 @@ returned unaltered."
(aref regs where))
(t nil))))
-(define-obsolete-function-alias 'register-value 'dos-register-value "24.1")
-
(defun dos-set-register-value (regs name value)
(and (numberp value)
(>= value 0)
@@ -274,9 +267,6 @@ returned unaltered."
(aset regs where (logand value 65535))))))
regs)
-(define-obsolete-function-alias
- 'set-register-value 'dos-set-register-value "24.1")
-
(defsubst dos-intdos (regs)
"Issue the DOS Int 21h with registers REGS.
@@ -284,8 +274,6 @@ REGS should be a vector produced by `dos-make-register'
and `dos-set-register-value', which see."
(int86 33 regs))
-(define-obsolete-function-alias 'intdos 'dos-intdos "24.1")
-
;; Backward compatibility for obsolescent functions which
;; set screen size.
@@ -294,8 +282,6 @@ and `dos-set-register-value', which see."
(interactive)
(set-frame-size (selected-frame) 80 25))
-(define-obsolete-function-alias 'mode25 'dos-mode25 "24.1")
-
(defun dos-mode4350 ()
"Change the number of rows to 43 or 50.
Emacs always tries to set the screen height to 50 rows first.
@@ -307,8 +293,6 @@ that your video hardware might not support 50-line mode."
nil ; the original built-in function returned nil
(set-frame-size (selected-frame) 80 43)))
-(define-obsolete-function-alias 'mode4350 'dos-mode4350 "24.1")
-
(provide 'dos-fns)
;;; dos-fns.el ends here
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index 0c3d4af569d..2b1fc916d9f 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -48,6 +48,7 @@
(define-key map "\C-m" #'Electric-buffer-menu-select)
(define-key map "\C-l" #'recenter)
(define-key map "s" #'Buffer-menu-save)
+ (define-key map "S" #'tabulated-list-sort)
(define-key map "d" #'Buffer-menu-delete)
(define-key map "k" #'Buffer-menu-delete)
(define-key map "\C-d" #'Buffer-menu-delete-backwards)
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index 260657e0f7a..d5f3fc77560 100644
--- a/lisp/ecomplete.el
+++ b/lisp/ecomplete.el
@@ -65,10 +65,11 @@
:type 'file)
(defcustom ecomplete-database-file-coding-system 'iso-2022-7bit
+ ;; FIXME: We should transition to `utf-8-emacs-unix' somehow!
"Coding system used for writing the ecomplete database file."
:type '(symbol :tag "Coding system"))
-(defcustom ecomplete-sort-predicate 'ecomplete-decay
+(defcustom ecomplete-sort-predicate #'ecomplete-decay
"Predicate to use when sorting matched.
The predicate is called with two parameters that represent the
completion. Each parameter is a list where the first element is
@@ -95,13 +96,18 @@ string that was matched."
(defun ecomplete-add-item (type key text)
"Add item TEXT of TYPE to the database, using KEY as the identifier."
+ (unless ecomplete-database (ecomplete-setup))
(let ((elems (assq type ecomplete-database))
(now (time-convert nil 'integer))
entry)
(unless elems
(push (setq elems (list type)) ecomplete-database))
(if (setq entry (assoc key (cdr elems)))
- (setcdr entry (list (1+ (cadr entry)) now text))
+ (pcase-let ((`(,_key ,count ,_time ,oldtext) entry))
+ (setcdr entry (list (1+ count) now
+ ;; Preserve the "more complete" text.
+ (if (>= (length text) (length oldtext))
+ text oldtext))))
(nconc elems (list (list key 1 now text))))))
(defun ecomplete-get-item (type key)
@@ -110,19 +116,23 @@ string that was matched."
(defun ecomplete-save ()
"Write the .ecompleterc file."
- (with-temp-buffer
- (let ((coding-system-for-write ecomplete-database-file-coding-system))
- (insert "(")
- (cl-loop for (type . elems) in ecomplete-database
- do
- (insert (format "(%s\n" type))
- (dolist (entry elems)
- (prin1 entry (current-buffer))
- (insert "\n"))
- (insert ")\n"))
- (insert ")")
- (write-region (point-min) (point-max)
- ecomplete-database-file nil 'silent))))
+ ;; If the database is empty, it might be because we haven't called
+ ;; `ecomplete-setup', so better not save at all, lest we lose the real
+ ;; database!
+ (when ecomplete-database
+ (with-temp-buffer
+ (let ((coding-system-for-write ecomplete-database-file-coding-system))
+ (insert "(")
+ (cl-loop for (type . elems) in ecomplete-database
+ do
+ (insert (format "(%s\n" type))
+ (dolist (entry elems)
+ (prin1 entry (current-buffer))
+ (insert "\n"))
+ (insert ")\n"))
+ (insert ")")
+ (write-region (point-min) (point-max)
+ ecomplete-database-file nil 'silent)))))
(defun ecomplete-get-matches (type match)
(let* ((elems (cdr (assq type ecomplete-database)))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 11d5541203a..bdc50c5885a 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -62,6 +62,7 @@
;;; Code:
(require 'cl-lib)
+(require 'seq)
(require 'kmacro)
;;; The user-level commands for editing macros.
@@ -72,11 +73,35 @@ Default nil means to write characters above \\177 in octal notation."
:type 'boolean
:group 'kmacro)
-(defvar edmacro-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" #'edmacro-finish-edit)
- (define-key map "\C-c\C-q" #'edmacro-insert-key)
- map))
+(defvar-keymap edmacro-mode-map
+ "C-c C-c" #'edmacro-finish-edit
+ "C-c C-q" #'edmacro-insert-key)
+
+(defface edmacro-label
+ '((default :inherit bold)
+ (((class color) (background dark)) :foreground "light blue")
+ (((min-colors 88) (class color) (background light)) :foreground "DarkBlue")
+ (((class color) (background light)) :foreground "blue")
+ (t :inherit bold))
+ "Face used for labels in `edit-kbd-macro'."
+ :version "29.1"
+ :group 'kmacro)
+
+(defvar edmacro-mode-font-lock-keywords
+ `((,(rx bol (group (or "Command" "Key" "Macro") ":")) 0 'edmacro-label)
+ (,(rx bol
+ (group ";; Keyboard Macro Editor. Press ")
+ (group (*? any))
+ (group " to finish; press "))
+ (1 'font-lock-comment-face)
+ (2 'help-key-binding)
+ (3 'font-lock-comment-face)
+ (,(rx (group (*? any))
+ (group " to cancel" (* any)))
+ nil nil
+ (1 'help-key-binding)
+ (2 'font-lock-comment-face)))
+ (,(rx (one-or-more ";") (zero-or-more any)) 0 'font-lock-comment-face)))
(defvar edmacro-store-hook)
(defvar edmacro-finish-hook)
@@ -86,7 +111,7 @@ Default nil means to write characters above \\177 in octal notation."
(defun edit-kbd-macro (keys &optional prefix finish-hook store-hook)
"Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `\\[kmacro-end-and-call-macro]' or RET to edit the last
+Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last
keyboard macro, `\\[view-lossage]' to edit the last 300
keystrokes as a keyboard macro, or `\\[execute-extended-command]'
to edit a macro by its command name.
@@ -99,8 +124,7 @@ With a prefix argument, format the macro in a more concise way."
(when keys
(let ((cmd (if (arrayp keys) (key-binding keys) keys))
(cmd-noremap (when (arrayp keys) (key-binding keys nil t)))
- (mac nil) (mac-counter nil) (mac-format nil)
- kmacro)
+ (mac nil) (mac-counter nil) (mac-format nil))
(cond (store-hook
(setq mac keys)
(setq cmd nil))
@@ -131,10 +155,10 @@ With a prefix argument, format the macro in a more concise way."
(t
(setq mac cmd)
(setq cmd nil)))
- (when (setq kmacro (kmacro-extract-lambda mac))
- (setq mac (car kmacro)
- mac-counter (nth 1 kmacro)
- mac-format (nth 2 kmacro)))
+ (when (kmacro-p mac)
+ (setq mac (kmacro--keys mac)
+ mac-counter (kmacro--counter mac)
+ mac-format (kmacro--format mac)))
(unless (arrayp mac)
(error "Key sequence %s is not a keyboard macro"
(key-description keys)))
@@ -154,9 +178,18 @@ With a prefix argument, format the macro in a more concise way."
(setq-local edmacro-original-buffer oldbuf)
(setq-local edmacro-finish-hook finish-hook)
(setq-local edmacro-store-hook store-hook)
+ (setq-local font-lock-defaults
+ '(edmacro-mode-font-lock-keywords nil nil nil nil))
+ (setq font-lock-multiline nil)
(erase-buffer)
- (insert ";; Keyboard Macro Editor. Press C-c C-c to finish; "
- "press C-x k RET to cancel.\n")
+ (insert (substitute-command-keys
+ (concat
+ ;; When editing this, make sure to update
+ ;; `edmacro-mode-font-lock-keywords' to match.
+ ";; Keyboard Macro Editor. Press \\[edmacro-finish-edit] "
+ "to finish; press \\[kill-buffer] \\`RET' to cancel.\n")
+ ;; Use 'no-face argument to not conflict with font-lock.
+ 'no-face))
(insert ";; Original keys: " fmt "\n")
(unless store-hook
(insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n")
@@ -222,7 +255,7 @@ or nil, use a compact 80-column format."
;;; Commands for *Edit Macro* buffer.
(defun edmacro-finish-edit ()
- (interactive)
+ (interactive nil edmacro-mode)
(unless (eq major-mode 'edmacro-mode)
(error
"This command is valid only in buffers created by `edit-kbd-macro'"))
@@ -252,15 +285,14 @@ or nil, use a compact 80-column format."
((looking-at "Key:\\(.*\\)$")
(when edmacro-store-hook
(error "\"Key\" line not allowed in this context"))
- (let ((key (edmacro-parse-keys
- (match-string 1))))
+ (let ((key (kbd (match-string 1))))
(unless (equal key "")
(if (equal key "none")
(setq no-keys t)
(push key keys)
(let ((b (key-binding key)))
(and b (commandp b) (not (arrayp b))
- (not (kmacro-extract-lambda b))
+ (not (kmacro-p b))
(or (not (fboundp b))
(not (or (arrayp (symbol-function b))
(get b 'kmacro))))
@@ -313,10 +345,7 @@ or nil, use a compact 80-column format."
(when cmd
(if (= (length mac) 0)
(fmakunbound cmd)
- (fset cmd
- (if (and mac-counter mac-format)
- (kmacro-lambda-form mac mac-counter mac-format)
- mac))))
+ (fset cmd (kmacro mac mac-counter mac-format))))
(if no-keys
(when cmd
(cl-loop for key in (where-is-internal cmd '(keymap)) do
@@ -327,10 +356,8 @@ or nil, use a compact 80-column format."
(cl-loop for key in keys do
(global-set-key key
(or cmd
- (if (and mac-counter mac-format)
- (kmacro-lambda-form
- mac mac-counter mac-format)
- mac))))))))))
+ (kmacro mac mac-counter
+ mac-format))))))))))
(kill-buffer buf)
(when (buffer-name obuf)
(switch-to-buffer obuf))
@@ -339,7 +366,7 @@ or nil, use a compact 80-column format."
(defun edmacro-insert-key (key)
"Insert the written name of a KEY in the buffer."
- (interactive "kKey to insert: ")
+ (interactive "kKey to insert: " edmacro-mode)
(if (bolp)
(insert (edmacro-format-keys key t) "\n")
(insert (edmacro-format-keys key) " ")))
@@ -347,7 +374,7 @@ or nil, use a compact 80-column format."
(defun edmacro-mode ()
"\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \
\\[edmacro-finish-edit] to save and exit.
-To abort the edit, just kill this buffer with \\[kill-buffer] RET.
+To abort the edit, just kill this buffer with \\[kill-buffer] \\`RET'.
Press \\[edmacro-insert-key] to insert the name of any key by typing the key.
@@ -537,8 +564,8 @@ doubt, use whitespace."
((integerp ch)
(concat
(cl-loop for pf across "ACHMsS"
- for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
- ?\M-\^@ ?\s-\^@ ?\S-\^@)
+ for bit in '( ?\A-\0 ?\C-\0 ?\H-\0
+ ?\M-\0 ?\s-\0 ?\S-\0)
when (/= (logand ch bit) 0)
concat (format "%c-" pf))
(let ((ch2 (logand ch (1- (ash 1 18)))))
@@ -610,6 +637,12 @@ This function assumes that the events can be stored in a string."
(defun edmacro-fix-menu-commands (macro &optional noerror)
(if (vectorp macro)
(let (result)
+ ;; Not preloaded in without-x builds.
+ (require 'mwheel)
+ (defvar mouse-wheel-down-event)
+ (defvar mouse-wheel-left-event)
+ (defvar mouse-wheel-right-event)
+ (defvar mouse-wheel-up-event)
;; Make a list of the elements.
(setq macro (append macro nil))
(dolist (ev macro)
@@ -639,102 +672,11 @@ This function assumes that the events can be stored in a string."
;;; Parsing a human-readable keyboard macro.
-(defun edmacro-parse-keys (string &optional need-vector)
- (let ((case-fold-search nil)
- (len (length string)) ; We won't alter string in the loop below.
- (pos 0)
- (res []))
- (while (and (< pos len)
- (string-match "[^ \t\n\f]+" string pos))
- (let* ((word-beg (match-beginning 0))
- (word-end (match-end 0))
- (word (substring string word-beg len))
- (times 1)
- key)
- ;; Try to catch events of the form "<as df>".
- (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
- (setq word (match-string 0 word)
- pos (+ word-beg (match-end 0)))
- (setq word (substring string word-beg word-end)
- pos word-end))
- (when (string-match "\\([0-9]+\\)\\*." word)
- (setq times (string-to-number (substring word 0 (match-end 1))))
- (setq word (substring word (1+ (match-end 1)))))
- (cond ((string-match "^<<.+>>$" word)
- (setq key (vconcat (if (eq (key-binding [?\M-x])
- 'execute-extended-command)
- [?\M-x]
- (or (car (where-is-internal
- 'execute-extended-command))
- [?\M-x]))
- (substring word 2 -2) "\r")))
- ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
- (progn
- (setq word (concat (match-string 1 word)
- (match-string 3 word)))
- (not (string-match
- "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
- word))))
- (setq key (list (intern word))))
- ((or (equal word "REM") (string-match "^;;" word))
- (setq pos (string-match "$" string pos)))
- (t
- (let ((orig-word word) (prefix 0) (bits 0))
- (while (string-match "^[ACHMsS]-." word)
- (cl-incf bits (cdr (assq (aref word 0)
- '((?A . ?\A-\^@) (?C . ?\C-\^@)
- (?H . ?\H-\^@) (?M . ?\M-\^@)
- (?s . ?\s-\^@) (?S . ?\S-\^@)))))
- (cl-incf prefix 2)
- (cl-callf substring word 2))
- (when (string-match "^\\^.$" word)
- (cl-incf bits ?\C-\^@)
- (cl-incf prefix)
- (cl-callf substring word 1))
- (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
- ("LFD" . "\n") ("TAB" . "\t")
- ("ESC" . "\e") ("SPC" . " ")
- ("DEL" . "\177")))))
- (when found (setq word (cdr found))))
- (when (string-match "^\\\\[0-7]+$" word)
- (cl-loop for ch across word
- for n = 0 then (+ (* n 8) ch -48)
- finally do (setq word (vector n))))
- (cond ((= bits 0)
- (setq key word))
- ((and (= bits ?\M-\^@) (stringp word)
- (string-match "^-?[0-9]+$" word))
- (setq key (cl-loop for x across word
- collect (+ x bits))))
- ((/= (length word) 1)
- (error "%s must prefix a single character, not %s"
- (substring orig-word 0 prefix) word))
- ((and (/= (logand bits ?\C-\^@) 0) (stringp word)
- ;; We used to accept . and ? here,
- ;; but . is simply wrong,
- ;; and C-? is not used (we use DEL instead).
- (string-match "[@-_a-z]" word))
- (setq key (list (+ bits (- ?\C-\^@)
- (logand (aref word 0) 31)))))
- (t
- (setq key (list (+ bits (aref word 0)))))))))
- (when key
- (cl-loop repeat times do (cl-callf vconcat res key)))))
- (when (and (>= (length res) 4)
- (eq (aref res 0) ?\C-x)
- (eq (aref res 1) ?\()
- (eq (aref res (- (length res) 2)) ?\C-x)
- (eq (aref res (- (length res) 1)) ?\)))
- (setq res (cl-subseq res 2 -2)))
- (if (and (not need-vector)
- (cl-loop for ch across res
- always (and (characterp ch)
- (let ((ch2 (logand ch (lognot ?\M-\^@))))
- (and (>= ch2 0) (<= ch2 127))))))
- (concat (cl-loop for ch across res
- collect (if (= (logand ch ?\M-\^@) 0)
- ch (+ ch 128))))
- res)))
+(defun edmacro-parse-keys (string &optional _need-vector)
+ (let ((result (kbd string)))
+ (if (stringp result)
+ (seq-into result 'vector)
+ result)))
(provide 'edmacro)
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index 8c1555249ca..0c2f02639fc 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -76,7 +76,10 @@
(define-key map [?\C-7] 'electric-help-undefined)
(define-key map [?\C-8] 'electric-help-undefined)
(define-key map [?\C-9] 'electric-help-undefined)
- (define-key map (char-to-string help-char) 'electric-help-help)
+ (define-key map (if (characterp help-char)
+ (char-to-string help-char)
+ (vector help-char))
+ 'electric-help-help)
(define-key map "?" 'electric-help-help)
(define-key map " " 'scroll-up)
(define-key map [?\S-\ ] 'scroll-down)
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index bbed955a393..4b901071cd9 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -188,6 +188,30 @@ be considered.")
;; I also find it often preferable not to pair next to a word.
(eq (char-syntax (following-char)) ?w)))
+(defmacro electric-pair--with-syntax (string-or-comment &rest body)
+ "Run BODY with appropriate syntax table active.
+STRING-OR-COMMENT is the start position of the string/comment
+in which we are, if applicable.
+Uses the text-mode syntax table if within a string or a comment."
+ (declare (debug t) (indent 1))
+ `(electric-pair--with-syntax-1 ,string-or-comment (lambda () ,@body)))
+
+(defun electric-pair--with-syntax-1 (string-or-comment body-fun)
+ (if (not string-or-comment)
+ (funcall body-fun)
+ ;; Here we assume that the `syntax-ppss' cache has already been filled
+ ;; past `string-or-comment' with data corresponding to the "normal" syntax
+ ;; (this should be the case because STRING-OR-COMMENT was returned
+ ;; in the `nth 8' of `syntax-ppss').
+ ;; Maybe we should narrow-to-region so that `syntax-ppss' uses the narrow
+ ;; cache?
+ (syntax-ppss-flush-cache string-or-comment)
+ (let ((syntax-propertize-function nil))
+ (unwind-protect
+ (with-syntax-table electric-pair-text-syntax-table
+ (funcall body-fun))
+ (syntax-ppss-flush-cache string-or-comment)))))
+
(defun electric-pair-syntax-info (command-event)
"Calculate a list (SYNTAX PAIR UNCONDITIONAL STRING-OR-COMMENT-START).
@@ -202,13 +226,11 @@ inside a comment or string."
(post-string-or-comment (nth 8 (syntax-ppss (point))))
(string-or-comment (and post-string-or-comment
pre-string-or-comment))
- (table (if string-or-comment
- electric-pair-text-syntax-table
- (syntax-table)))
- (table-syntax-and-pair (with-syntax-table table
- (list (char-syntax command-event)
- (or (matching-paren command-event)
- command-event))))
+ (table-syntax-and-pair
+ (electric-pair--with-syntax string-or-comment
+ (list (char-syntax command-event)
+ (or (matching-paren command-event)
+ command-event))))
(fallback (if string-or-comment
(append electric-pair-text-pairs
electric-pair-pairs)
@@ -237,26 +259,10 @@ inside a comment or string."
(electric-layout-allow-duplicate-newlines t))
(self-insert-command 1)))
-(cl-defmacro electric-pair--with-uncached-syntax ((table &optional start) &rest body)
- "Like `with-syntax-table', but flush the `syntax-ppss' cache afterwards.
-Use this instead of (with-syntax-table TABLE BODY) when BODY
-contains code which may update the `syntax-ppss' cache. This
-includes calling `parse-partial-sexp' and any sexp-based movement
-functions when `parse-sexp-lookup-properties' is non-nil. The
-cache is flushed from position START, defaulting to point."
- (declare (debug ((form &optional form) body)) (indent 1))
- (let ((start-var (make-symbol "start")))
- `(let ((syntax-propertize-function #'ignore)
- (,start-var ,(or start '(point))))
- (unwind-protect
- (with-syntax-table ,table
- ,@body)
- (syntax-ppss-flush-cache ,start-var)))))
-
(defun electric-pair--syntax-ppss (&optional pos where)
"Like `syntax-ppss', but sometimes fallback to `parse-partial-sexp'.
-WHERE is a list defaulting to '(string comment) and indicates
+WHERE is a list defaulting to \\='(string comment) and indicates
when to fallback to `parse-partial-sexp'."
(let* ((pos (or pos (point)))
(where (or where '(string comment)))
@@ -271,8 +277,7 @@ when to fallback to `parse-partial-sexp'."
(skip-syntax-forward " >!")
(point)))))
(if s-or-c-start
- (electric-pair--with-uncached-syntax (electric-pair-text-syntax-table
- s-or-c-start)
+ (electric-pair--with-syntax s-or-c-start
(parse-partial-sexp s-or-c-start pos))
;; HACK! cc-mode apparently has some `syntax-ppss' bugs
(if (memq major-mode '(c-mode c++ mode))
@@ -290,7 +295,8 @@ when to fallback to `parse-partial-sexp'."
(defun electric-pair--balance-info (direction string-or-comment)
"Examine lists forward or backward according to DIRECTION's sign.
-STRING-OR-COMMENT is info suitable for running `parse-partial-sexp'.
+STRING-OR-COMMENT is the position of the start of the comment/string
+in which we are, if applicable.
Return a cons of two descriptions (MATCHED-P . PAIR) for the
innermost and outermost lists that enclose point. The outermost
@@ -301,62 +307,60 @@ If the outermost list is matched, don't rely on its PAIR.
If point is not enclosed by any lists, return ((t) . (t))."
(let* (innermost
outermost
- (table (if string-or-comment
- electric-pair-text-syntax-table
- (syntax-table)))
(at-top-level-or-equivalent-fn
;; called when `scan-sexps' ran perfectly, when it found
;; a parenthesis pointing in the direction of travel.
;; Also when travel started inside a comment and exited it.
- #'(lambda ()
- (setq outermost (list t))
- (unless innermost
- (setq innermost (list t)))))
+ (lambda ()
+ (setq outermost (list t))
+ (unless innermost
+ (setq innermost (list t)))))
(ended-prematurely-fn
;; called when `scan-sexps' crashed against a parenthesis
;; pointing opposite the direction of travel. After
;; traversing that character, the idea is to travel one sexp
;; in the opposite direction looking for a matching
;; delimiter.
- #'(lambda ()
- (let* ((pos (point))
- (matched
- (save-excursion
- (cond ((< direction 0)
- (condition-case nil
- (eq (char-after pos)
- (electric-pair--with-uncached-syntax
- (table)
- (matching-paren
- (char-before
- (scan-sexps (point) 1)))))
- (scan-error nil)))
- (t
- ;; In this case, no need to use
- ;; `scan-sexps', we can use some
- ;; `electric-pair--syntax-ppss' in this
- ;; case (which uses the quicker
- ;; `syntax-ppss' in some cases)
- (let* ((ppss (electric-pair--syntax-ppss
- (1- (point))))
- (start (car (last (nth 9 ppss))))
- (opener (char-after start)))
- (and start
- (eq (char-before pos)
- (or (with-syntax-table table
- (matching-paren opener))
- opener))))))))
- (actual-pair (if (> direction 0)
- (char-before (point))
- (char-after (point)))))
- (unless innermost
- (setq innermost (cons matched actual-pair)))
- (unless matched
- (setq outermost (cons matched actual-pair)))))))
+ (lambda ()
+ (let* ((pos (point))
+ (matched
+ (save-excursion
+ (cond ((< direction 0)
+ (condition-case nil
+ (eq (char-after pos)
+ (electric-pair--with-syntax
+ string-or-comment
+ (matching-paren
+ (char-before
+ (scan-sexps (point) 1)))))
+ (scan-error nil)))
+ (t
+ ;; In this case, no need to use
+ ;; `scan-sexps', we can use some
+ ;; `electric-pair--syntax-ppss' in this
+ ;; case (which uses the quicker
+ ;; `syntax-ppss' in some cases)
+ (let* ((ppss (electric-pair--syntax-ppss
+ (1- (point))))
+ (start (car (last (nth 9 ppss))))
+ (opener (char-after start)))
+ (and start
+ (eq (char-before pos)
+ (or (electric-pair--with-syntax
+ string-or-comment
+ (matching-paren opener))
+ opener))))))))
+ (actual-pair (if (> direction 0)
+ (char-before (point))
+ (char-after (point)))))
+ (unless innermost
+ (setq innermost (cons matched actual-pair)))
+ (unless matched
+ (setq outermost (cons matched actual-pair)))))))
(save-excursion
(while (not outermost)
(condition-case err
- (electric-pair--with-uncached-syntax (table)
+ (electric-pair--with-syntax string-or-comment
(scan-sexps (point) (if (> direction 0)
(point-max)
(- (point-max))))
@@ -503,8 +507,8 @@ The decision is taken by order of preference:
* According to C's syntax and the syntactic state of the buffer
(both as defined by the major mode's syntax table). This is
- done by looking up up the variables
- `electric-pair-inhibit-predicate', `electric-pair-skip-self'
+ done by looking up the variables
+ `electric-pair-inhibit-predicate', `electric-pair-skip-self'
and `electric-pair-skip-whitespace' (which see)."
(let* ((pos (and electric-pair-mode (electric--after-char-pos)))
(skip-whitespace-info))
diff --git a/lisp/electric.el b/lisp/electric.el
index 57cdff38ed4..0cf3a299cfa 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -512,11 +512,11 @@ This list's members correspond to left single quote, right single
quote, left double quote, and right double quote, respectively."
:version "26.1"
:type '(list character character character character)
- :safe #'(lambda (x)
- (pcase x
- (`(,(pred characterp) ,(pred characterp)
- ,(pred characterp) ,(pred characterp))
- t)))
+ :safe (lambda (x)
+ (pcase x
+ (`(,(pred characterp) ,(pred characterp)
+ ,(pred characterp) ,(pred characterp))
+ t)))
:group 'electricity)
(defcustom electric-quote-paragraph t
@@ -620,7 +620,7 @@ This requotes when a quoting key is typed."
(define-minor-mode electric-quote-mode
"Toggle on-the-fly requoting (Electric Quote mode).
-When enabled, as you type this replaces \\=` with ‘, \\=' with ’,
+When enabled, as you type this replaces \\=` with \\=‘, \\=' with \\=’,
\\=`\\=` with “, and \\='\\=' with ”. This occurs only in comments, strings,
and text paragraphs, and these are selectively controlled with
`electric-quote-comment', `electric-quote-string', and
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index d2e3ac6a996..90bf1fe35b5 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -26,12 +26,12 @@
;; notices) in file headers to avoid clutter when you know what it
;; says.
;;
-;; `elide-head-headers-to-hide' controls what is elided by the command
-;; `elide-head'. A buffer-local invisible overlay manages the
-;; elision.
+;; `elide-head-headers-to-hide' controls what is elided by the minor
+;; mode `elide-head-mode'. A buffer-local invisible overlay manages
+;; the elision.
-;; You might add `elide-head' to appropriate major mode hooks or to
-;; `find-file-hook'. Please do not do this in site init files. If
+;; You might add `elide-head-mode' to appropriate major mode hooks or
+;; to `find-file-hook'. Please do not do this in site init files. If
;; you do, information may be hidden from users who don't know it
;; already.
@@ -50,24 +50,99 @@
:group 'tools)
(defcustom elide-head-headers-to-hide
- '(("is free software[:;] you can redistribute it" . ; GNU boilerplate
- "\\(Boston, MA 0211\\(1-1307\\|0-1301\\), USA\\|\
-If not, see <https?://www\\.gnu\\.org/licenses/>\\)\\.")
- ("The Regents of the University of California\\. All rights reserved\\." .
- "SUCH DAMAGE\\.") ; BSD
- ("Permission is hereby granted, free of charge" . ; X11
- "authorization from the X Consortium\\."))
+ `(;; GNU GPL
+ ("is free software[:;] you can redistribute it" .
+ ,(rx (or (seq "If not, see " (? "<")
+ "http" (? "s") "://www.gnu.org/licenses/"
+ (? ">") (? " "))
+ (seq "Boston, MA " (? " ")
+ "0211" (or "1-1307" "0-1301")
+ (or " " ", ") "USA")
+ "675 Mass Ave, Cambridge, MA 02139, USA")
+ (? ".")))
+ ;; FreeBSD license / Modified BSD license (3-clause)
+ (,(rx (or "The Regents of the University of California. All rights reserved."
+ "Redistribution and use in source and binary"))
+ . "POSSIBILITY OF SUCH DAMAGE\\.")
+ ;; X11 and Expat
+ ("Permission is hereby granted, free of charge" .
+ ,(rx (or "authorization from the X Consortium." ; X11
+ "THE USE OR OTHER DEALINGS IN THE SOFTWARE.")))) ; Expat
"Alist of regexps defining start and end of text to elide.
The cars of elements of the list are searched for in order. Text is
elided with an invisible overlay from the end of the line where the
first match is found to the end of the match for the corresponding
-cdr."
+cdr.
+
+This affects `elide-head-mode'."
:type '(alist :key-type (regexp :tag "Start regexp")
- :value-type (regexp :tag "End regexp")))
+ :value-type (regexp :tag "End regexp"))
+ :version "29.1")
(defvar-local elide-head-overlay nil)
+(defun elide-head--delete-overlay ()
+ "Delete the overlay in `elide-head-overlay'."
+ (when (overlayp elide-head-overlay)
+ (delete-overlay elide-head-overlay)))
+
+(defun elide-head--hide ()
+ "Hide elided (hidden) headers."
+ (save-excursion
+ (save-restriction
+ (let ((rest elide-head-headers-to-hide)
+ beg end)
+ (widen)
+ (goto-char (point-min))
+ (while rest
+ (save-excursion
+ (when (re-search-forward (caar rest) nil t)
+ (setq beg (point))
+ (when (re-search-forward (cdar rest) nil t)
+ (setq end (point-marker)
+ rest nil))))
+ (if rest (setq rest (cdr rest))))
+ (if (not (and beg end))
+ (if (called-interactively-p 'interactive)
+ (message "No header found"))
+ (goto-char beg)
+ (end-of-line)
+ (if (overlayp elide-head-overlay)
+ (move-overlay elide-head-overlay (point-marker) end)
+ (setq elide-head-overlay (make-overlay (point-marker) end)))
+ (overlay-put elide-head-overlay 'invisible t)
+ (overlay-put elide-head-overlay 'evaporate t)
+ (overlay-put elide-head-overlay 'after-string "..."))))))
+
+(defun elide-head--show ()
+ "Show elided (hidden) headers."
+ (if (and (overlayp elide-head-overlay)
+ (overlay-buffer elide-head-overlay))
+ (elide-head--delete-overlay)
+ (if (called-interactively-p 'interactive)
+ (message "No header hidden"))))
+
+;;;###autoload
+(define-minor-mode elide-head-mode
+ "Toggle eliding (hiding) header material in the current buffer.
+
+When Elide Header mode is enabled, headers are hidden according
+to `elide-head-headers-to-hide'.
+
+This is suitable as an entry on `find-file-hook' or appropriate
+mode hooks."
+ :group 'elide-head
+ (if elide-head-mode
+ (progn
+ (elide-head--hide)
+ (add-hook 'change-major-mode-hook 'elide-head--delete-overlay nil 'local))
+ (elide-head--show)
+ (remove-hook 'change-major-mode-hook 'elide-head--delete-overlay 'local)))
+
+
+;;; Obsolete
+
;;;###autoload
(defun elide-head (&optional arg)
"Hide header material in buffer according to `elide-head-headers-to-hide'.
@@ -76,43 +151,17 @@ The header is made invisible with an overlay. With a prefix arg, show
an elided material again.
This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
+ (declare (obsolete elide-head-mode "29.1"))
(interactive "P")
(if arg
- (elide-head-show)
- (save-excursion
- (save-restriction
- (let ((rest elide-head-headers-to-hide)
- beg end)
- (widen)
- (goto-char (point-min))
- (while rest
- (save-excursion
- (when (re-search-forward (caar rest) nil t)
- (setq beg (point))
- (when (re-search-forward (cdar rest) nil t)
- (setq end (point-marker)
- rest nil))))
- (if rest (setq rest (cdr rest))))
- (if (not (and beg end))
- (if (called-interactively-p 'interactive)
- (message "No header found"))
- (goto-char beg)
- (end-of-line)
- (if (overlayp elide-head-overlay)
- (move-overlay elide-head-overlay (point-marker) end)
- (setq elide-head-overlay (make-overlay (point-marker) end)))
- (overlay-put elide-head-overlay 'invisible t)
- (overlay-put elide-head-overlay 'evaporate t)
- (overlay-put elide-head-overlay 'after-string "...")))))))
+ (elide-head-mode -1)
+ (elide-head-mode 1)))
(defun elide-head-show ()
"Show a header in the current buffer elided by \\[elide-head]."
+ (declare (obsolete elide-head-mode "29.1"))
(interactive)
- (if (and (overlayp elide-head-overlay)
- (overlay-buffer elide-head-overlay))
- (delete-overlay elide-head-overlay)
- (if (called-interactively-p 'interactive)
- (message "No header hidden"))))
+ (elide-head-mode -1))
(provide 'elide-head)
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 8e43ae68072..86a42b208e7 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1814,8 +1814,7 @@ Redefining advices affect the construction of an advised definition."
(if (symbolp function)
(setq function (if (fboundp function)
(advice--strip-macro (symbol-function function)))))
- (while (advice--p function) (setq function (advice--cdr function)))
- function)
+ (advice--cd*r function))
(defun ad-clear-advicefunname-definition (function)
(let ((advicefunname (ad-get-advice-info-field function 'advicefunname)))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 756cac6d0b7..eed88b6faf4 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -28,36 +28,15 @@
;; Lisp source files in various useful ways. To learn more, read the
;; source; if you're going to use this, you'd better be able to.
+;; The functions in this file have been largely superseded by
+;; loaddefs-gen.el.
+
;;; Code:
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'lisp-mnt)
-(eval-when-compile (require 'cl-lib))
-
-(defvar generated-autoload-file nil
- "File into which to write autoload definitions.
-A Lisp file can set this in its local variables section to make
-its autoloads go somewhere else.
-
-If this is a relative file name, the directory is determined as
-follows:
- - If a Lisp file defined `generated-autoload-file' as a
- file-local variable, use its containing directory.
- - Otherwise use the \"lisp\" subdirectory of `source-directory'.
-
-The autoload file is assumed to contain a trailer starting with a
-FormFeed character.")
-;;;###autoload
-(put 'generated-autoload-file 'safe-local-variable 'stringp)
-
-(defvar generated-autoload-load-name nil
- "Load name for `autoload' statements generated from autoload cookies.
-If nil, this defaults to the file name, sans extension.
-Typically, you need to set this when the directory containing the file
-is not in `load-path'.
-This also affects the generated cus-load.el file.")
-;;;###autoload
-(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
+(require 'cl-lib)
+(require 'loaddefs-gen)
;; This feels like it should be a defconst, but MH-E sets it to
;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
@@ -112,165 +91,7 @@ then we use the timestamp of the output file instead. As a result:
(defvar autoload-modified-buffers) ;Dynamically scoped var.
-(defun make-autoload (form file &optional expansion)
- "Turn FORM into an autoload or defvar for source file FILE.
-Returns nil if FORM is not a special autoload form (i.e. a function definition
-or macro definition or a defcustom).
-If EXPANSION is non-nil, we're processing the macro expansion of an
-expression, in which case we want to handle forms differently."
- (let ((car (car-safe form)) expand)
- (cond
- ((and expansion (eq car 'defalias))
- (pcase-let*
- ((`(,_ ,_ ,arg . ,rest) form)
- ;; `type' is non-nil if it defines a macro.
- ;; `fun' is the function part of `arg' (defaults to `arg').
- ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
- (and (let fun arg) (let type nil)))
- arg)
- ;; `lam' is the lambda expression in `fun' (or nil if not
- ;; recognized).
- (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
- ;; `args' is the list of arguments (or t if not recognized).
- ;; `body' is the body of `lam' (or t if not recognized).
- ((or `(lambda ,args . ,body)
- (and (let args t) (let body t)))
- lam)
- ;; Get the `doc' from `body' or `rest'.
- (doc (cond ((stringp (car-safe body)) (car body))
- ((stringp (car-safe rest)) (car rest))))
- ;; Look for an interactive spec.
- (interactive (pcase body
- ((or `((interactive . ,iargs) . ,_)
- `(,_ (interactive . ,iargs) . ,_))
- ;; List of modes or just t.
- (if (nthcdr 1 iargs)
- (list 'quote (nthcdr 1 iargs))
- t)))))
- ;; Add the usage form at the end where describe-function-1
- ;; can recover it.
- (when (consp args) (setq doc (help-add-fundoc-usage doc args)))
- ;; (message "autoload of %S" (nth 1 form))
- `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
-
- ((and expansion (memq car '(progn prog1)))
- (let ((end (memq :autoload-end form)))
- (when end ;Cut-off anything after the :autoload-end marker.
- (setq form (copy-sequence form))
- (setcdr (memq :autoload-end form) nil))
- (let ((exps (delq nil (mapcar (lambda (form)
- (make-autoload form file expansion))
- (cdr form)))))
- (when exps (cons 'progn exps)))))
-
- ;; For complex cases, try again on the macro-expansion.
- ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
- define-globalized-minor-mode defun defmacro
- easy-mmode-define-minor-mode define-minor-mode
- define-inline cl-defun cl-defmacro cl-defgeneric
- cl-defstruct pcase-defmacro))
- (macrop car)
- (setq expand (let ((load-true-file-name file)
- (load-file-name file))
- (macroexpand form)))
- (memq (car expand) '(progn prog1 defalias)))
- (make-autoload expand file 'expansion)) ;Recurse on the expansion.
-
- ;; For special function-like operators, use the `autoload' function.
- ((memq car '(define-skeleton define-derived-mode
- define-compilation-mode define-generic-mode
- easy-mmode-define-global-mode define-global-minor-mode
- define-globalized-minor-mode
- easy-mmode-define-minor-mode define-minor-mode
- cl-defun defun* cl-defmacro defmacro*
- define-overloadable-function))
- (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
- (name (nth 1 form))
- (args (pcase car
- ((or 'defun 'defmacro
- 'defun* 'defmacro* 'cl-defun 'cl-defmacro
- 'define-overloadable-function)
- (nth 2 form))
- ('define-skeleton '(&optional str arg))
- ((or 'define-generic-mode 'define-derived-mode
- 'define-compilation-mode)
- nil)
- (_ t)))
- (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
- (doc (if (stringp (car body)) (pop body))))
- ;; Add the usage form at the end where describe-function-1
- ;; can recover it.
- (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
- ;; `define-generic-mode' quotes the name, so take care of that
- `(autoload ,(if (listp name) name (list 'quote name))
- ,file ,doc
- ,(or (and (memq car '(define-skeleton define-derived-mode
- define-generic-mode
- easy-mmode-define-global-mode
- define-global-minor-mode
- define-globalized-minor-mode
- easy-mmode-define-minor-mode
- define-minor-mode))
- t)
- (and (eq (car-safe (car body)) 'interactive)
- ;; List of modes or just t.
- (or (if (nthcdr 1 (car body))
- (list 'quote (nthcdr 1 (car body)))
- t))))
- ,(if macrop ''macro nil))))
-
- ;; For defclass forms, use `eieio-defclass-autoload'.
- ((eq car 'defclass)
- (let ((name (nth 1 form))
- (superclasses (nth 2 form))
- (doc (nth 4 form)))
- (list 'eieio-defclass-autoload (list 'quote name)
- (list 'quote superclasses) file doc)))
-
- ;; Convert defcustom to less space-consuming data.
- ((eq car 'defcustom)
- (let* ((varname (car-safe (cdr-safe form)))
- (props (nthcdr 4 form))
- (initializer (plist-get props :initialize))
- (init (car-safe (cdr-safe (cdr-safe form))))
- (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
- ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
- )
- `(progn
- ,(if (not (member initializer '(nil 'custom-initialize-default
- #'custom-initialize-default
- 'custom-initialize-reset
- #'custom-initialize-reset)))
- form
- `(defvar ,varname ,init ,doc))
- ;; When we include the complete `form', this `custom-autoload'
- ;; is not indispensable, but it still helps in case the `defcustom'
- ;; doesn't specify its group explicitly, and probably in a few other
- ;; corner cases.
- (custom-autoload ',varname ,file
- ,(condition-case nil
- (null (plist-get props :set))
- (error nil)))
- ;; Propagate the :safe property to the loaddefs file.
- ,@(when-let ((safe (plist-get props :safe)))
- `((put ',varname 'safe-local-variable ,safe))))))
-
- ((eq car 'defgroup)
- ;; In Emacs this is normally handled separately by cus-dep.el, but for
- ;; third party packages, it can be convenient to explicitly autoload
- ;; a group.
- (let ((groupname (nth 1 form)))
- `(let ((loads (get ',groupname 'custom-loads)))
- (if (member ',file loads) nil
- (put ',groupname 'custom-loads (cons ',file loads))))))
-
- ;; When processing a macro expansion, any expression
- ;; before a :autoload-end should be included. These are typically (put
- ;; 'fun 'prop val) and things like that.
- ((and expansion (consp form)) form)
-
- ;; nil here indicates that this is not a special autoload form.
- (t nil))))
+(defalias 'make-autoload #'loaddefs-generate--make-autoload)
;; Forms which have doc-strings which should be printed specially.
;; A doc-string-elt property of ELT says that (nth ELT FORM) is
@@ -340,7 +161,7 @@ put the output in."
(t
(let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
(outbuf autoload-print-form-outbuf))
- (if (and doc-string-elt (stringp (nth doc-string-elt form)))
+ (if (and (numberp doc-string-elt) (stringp (nth doc-string-elt form)))
;; We need to hack the printing because the
;; doc-string must be printed specially for
;; make-docfile (sigh).
@@ -379,39 +200,7 @@ put the output in."
(print-escape-nonascii t))
(print form outbuf)))))))
-(defun autoload-rubric (file &optional type feature)
- "Return a string giving the appropriate autoload rubric for FILE.
-TYPE (default \"autoloads\") is a string stating the type of
-information contained in FILE. TYPE \"package\" acts like the default,
-but adds an extra line to the output to modify `load-path'.
-
-If FEATURE is non-nil, FILE will provide a feature. FEATURE may
-be a string naming the feature, otherwise it will be based on
-FILE's name."
- (let ((basename (file-name-nondirectory file))
- (lp (if (equal type "package") (setq type "autoloads"))))
- (concat ";;; " basename
- " --- automatically extracted " (or type "autoloads")
- " -*- lexical-binding: t -*-\n"
- ";;\n"
- ";;; Code:\n\n"
- (if lp
- "(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))\n\n")
- " \n"
- ;; This is used outside of autoload.el, eg cus-dep, finder.
- (if feature
- (format "(provide '%s)\n"
- (if (stringp feature) feature
- (file-name-sans-extension basename))))
- ";; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-byte-compile: t\n" ;; #$ is byte-compiled into nil.
- ";; no-update-autoloads: t\n"
- ";; coding: utf-8\n"
- ";; End:\n"
- ";;; " basename
- " ends here\n")))
+(defalias 'autoload-rubric #'loaddefs-generate--rubric)
(defvar autoload-ensure-writable nil
"Non-nil means `autoload-find-generated-file' makes existing file writable.")
@@ -478,35 +267,13 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
(hack-local-variables))
(current-buffer)))
+(defalias 'autoload-insert-section-header
+ #'loaddefs-generate--insert-section-header)
+
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
-(defun autoload-file-load-name (file outfile)
- "Compute the name that will be used to load FILE.
-OUTFILE should be the name of the global loaddefs.el file, which
-is expected to be at the root directory of the files we are
-scanning for autoloads and will be in the `load-path'."
- (let* ((name (file-relative-name file (file-name-directory outfile)))
- (names '())
- (dir (file-name-directory outfile)))
- ;; If `name' has directory components, only keep the
- ;; last few that are really needed.
- (while name
- (setq name (directory-file-name name))
- (push (file-name-nondirectory name) names)
- (setq name (file-name-directory name)))
- (while (not name)
- (cond
- ((null (cdr names)) (setq name (car names)))
- ((file-exists-p (expand-file-name "subdirs.el" dir))
- ;; FIXME: here we only check the existence of subdirs.el,
- ;; without checking its content. This makes it generate wrong load
- ;; names for cases like lisp/term which is not added to load-path.
- (setq dir (expand-file-name (pop names) dir)))
- (t (setq name (mapconcat #'identity names "/")))))
- (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
- (substring name 0 (match-beginning 0))
- name)))
+(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name)
(defun generate-file-autoloads (file)
"Insert at point a loaddefs autoload section for FILE.
@@ -520,13 +287,6 @@ Return non-nil in the case where no autoloads were added at point."
(autoload-generate-file-autoloads file (current-buffer) buffer-file-name)
autoload-modified-buffers))
-(defvar autoload-compute-prefixes t
- "If non-nil, autoload will add code to register the prefixes used in a file.
-Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
-variables or functions that use \"foo-\" as prefix, that will not be registered.
-But all other prefixes will be included.")
-(put 'autoload-compute-prefixes 'safe #'booleanp)
-
(defconst autoload-def-prefixes-max-entries 5
"Target length of the list of definition prefixes per file.
If set too small, the prefixes will be too generic (i.e. they'll use little
@@ -538,102 +298,7 @@ cost more memory use).")
"Target size of definition prefixes.
Don't try to split prefixes that are already longer than that.")
-(require 'radix-tree)
-
-(defun autoload--make-defs-autoload (defs file)
-
- ;; Remove the defs that obey the rule that file foo.el (or
- ;; foo-mode.el) uses "foo-" as prefix.
- ;; FIXME: help--symbol-completion-table still doesn't know how to use
- ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix.
- ;;(let ((prefix
- ;; (concat (substring file 0 (string-match "-mode\\'" file)) "-")))
- ;; (dolist (def (prog1 defs (setq defs nil)))
- ;; (unless (string-prefix-p prefix def)
- ;; (push def defs))))
-
- ;; Then compute a small set of prefixes that cover all the
- ;; remaining definitions.
- (let* ((tree (let ((tree radix-tree-empty))
- (dolist (def defs)
- (setq tree (radix-tree-insert tree def t)))
- tree))
- (prefixes nil))
- ;; Get the root prefixes, that we should include in any case.
- (radix-tree-iter-subtrees
- tree (lambda (prefix subtree)
- (push (cons prefix subtree) prefixes)))
- ;; In some cases, the root prefixes are too short, e.g. if you define
- ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
- (dolist (pair (prog1 prefixes (setq prefixes nil)))
- (let ((s (car pair)))
- (if (or (and (> (length s) 2) ; Long enough!
- ;; But don't use "def" from deffoo-pkg-thing.
- (not (string= "def" s)))
- (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
- (radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
- (push pair prefixes) ;Keep it as is.
- (radix-tree-iter-subtrees
- (cdr pair) (lambda (prefix subtree)
- (push (cons (concat s prefix) subtree) prefixes))))))
- ;; FIXME: The expansions done below are mostly pointless, such as
- ;; for `yenc', where we replace "yenc-" with an exhaustive list (5
- ;; elements).
- ;; (while
- ;; (let ((newprefixes nil)
- ;; (changes nil))
- ;; (dolist (pair prefixes)
- ;; (let ((prefix (car pair)))
- ;; (if (or (> (length prefix) autoload-def-prefixes-max-length)
- ;; (radix-tree-lookup (cdr pair) ""))
- ;; ;; No point splitting it any further.
- ;; (push pair newprefixes)
- ;; (setq changes t)
- ;; (radix-tree-iter-subtrees
- ;; (cdr pair) (lambda (sprefix subtree)
- ;; (push (cons (concat prefix sprefix) subtree)
- ;; newprefixes))))))
- ;; (and changes
- ;; (<= (length newprefixes)
- ;; autoload-def-prefixes-max-entries)
- ;; (let ((new nil)
- ;; (old nil))
- ;; (dolist (pair prefixes)
- ;; (unless (memq pair newprefixes) ;Not old
- ;; (push pair old)))
- ;; (dolist (pair newprefixes)
- ;; (unless (memq pair prefixes) ;Not new
- ;; (push pair new)))
- ;; (cl-assert new)
- ;; (message "Expanding %S to %S"
- ;; (mapcar #'car old) (mapcar #'car new))
- ;; t)
- ;; (setq prefixes newprefixes)
- ;; (< (length prefixes) autoload-def-prefixes-max-entries))))
-
- ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
- (when prefixes
- (let ((strings
- (mapcar
- (lambda (x)
- (let ((prefix (car x)))
- (if (or (> (length prefix) 2) ;Long enough!
- (and (eq (length prefix) 2)
- (string-match "[[:punct:]]" prefix)))
- prefix
- ;; Some packages really don't follow the rules.
- ;; Drop the most egregious cases such as the
- ;; one-letter prefixes.
- (let ((dropped ()))
- (radix-tree-iter-mappings
- (cdr x) (lambda (s _)
- (push (concat prefix s) dropped)))
- (message "%s:0: Warning: Not registering prefix \"%s\". Affects: %S"
- file prefix dropped)
- nil))))
- prefixes)))
- `(register-definition-prefixes ,file ',(sort (delq nil strings)
- 'string<))))))
+(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes)
(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file)
(let ((outbuf
@@ -685,21 +350,6 @@ Don't try to split prefixes that are already longer than that.")
(defvar autoload-builtin-package-versions nil)
-(defvar autoload-ignored-definitions
- '("define-obsolete-function-alias"
- "define-obsolete-variable-alias"
- "define-category" "define-key"
- "defgroup" "defface" "defadvice"
- "def-edebug-spec"
- ;; Hmm... this is getting ugly:
- "define-widget"
- "define-erc-module"
- "define-erc-response-handler"
- "defun-rcirc-command")
- "List of strings naming definitions to ignore for prefixes.
-More specifically those definitions will not be considered for the
-`register-definition-prefixes' call.")
-
(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
"Insert an autoload section for FILE in the appropriate buffer.
Autoloads are generated for defuns and defmacros in FILE
@@ -1106,6 +756,9 @@ directory or directories specified."
;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings.
(no-autoloads nil)
+ ;; Ensure that we don't do odd things when putting the doc
+ ;; strings into the autoloads file.
+ (left-margin 0)
(autoload-modified-buffers nil)
(output-time
(and (file-exists-p output-file)
@@ -1194,9 +847,17 @@ directory or directories specified."
(goto-char (point-max))
(search-backward "\f" nil t)
(autoload-insert-section-header
- (current-buffer) nil nil no-autoloads (if autoload-timestamps
- no-autoloads-time
- autoload--non-timestamp))
+ (current-buffer) nil nil
+ ;; Filter out the other loaddefs files, because it makes
+ ;; the list unstable (and leads to spurious changes in
+ ;; ldefs-boot.el) since the loaddef files can be created in
+ ;; any order.
+ (seq-filter (lambda (file)
+ (not (string-match-p "[/-]loaddefs.el" file)))
+ no-autoloads)
+ (if autoload-timestamps
+ no-autoloads-time
+ autoload--non-timestamp))
(insert generate-autoload-section-trailer)))
;; Don't modify the file if its content has not been changed, so `make'
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 7b320cd9e02..4f98bf3f4f5 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -55,10 +55,11 @@ order to debug the code that does fontification."
(defcustom backtrace-line-length 5000
"Target length for lines in Backtrace buffers.
Backtrace mode will attempt to abbreviate printing of backtrace
-frames to make them shorter than this, but success is not
-guaranteed. If set to nil or zero, Backtrace mode will not
-abbreviate the forms it prints."
- :type 'integer
+frames by setting `print-level' and `print-length' to make them
+shorter than this, but success is not guaranteed. If set to nil
+or zero, backtrace mode will not abbreviate the forms it prints."
+ :type '(choice natnum
+ (const :value nil :tag "Don't abbreviate"))
:group 'backtrace
:version "27.1")
@@ -199,63 +200,63 @@ functions returns non-nil. When adding a function to this hook,
you should also set the :source-available flag for the backtrace
frames where the source code location is known.")
-(defvar backtrace-mode-map
- (let ((map (copy-keymap special-mode-map)))
- (set-keymap-parent map button-buffer-map)
- (define-key map "n" 'backtrace-forward-frame)
- (define-key map "p" 'backtrace-backward-frame)
- (define-key map "v" 'backtrace-toggle-locals)
- (define-key map "#" 'backtrace-toggle-print-circle)
- (define-key map ":" 'backtrace-toggle-print-gensym)
- (define-key map "s" 'backtrace-goto-source)
- (define-key map "\C-m" 'backtrace-help-follow-symbol)
- (define-key map "+" 'backtrace-multi-line)
- (define-key map "-" 'backtrace-single-line)
- (define-key map "." 'backtrace-expand-ellipses)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'mouse-select-window)
- (easy-menu-define nil map ""
- '("Backtrace"
- ["Next Frame" backtrace-forward-frame
- :help "Move cursor forwards to the start of a backtrace frame"]
- ["Previous Frame" backtrace-backward-frame
- :help "Move cursor backwards to the start of a backtrace frame"]
- "--"
- ["Show Variables" backtrace-toggle-locals
- :style toggle
- :active (backtrace-get-index)
- :selected (plist-get (backtrace-get-view) :show-locals)
- :help "Show or hide the local variables for the frame at point"]
- ["Show Circular Structures" backtrace-toggle-print-circle
- :style toggle
- :active (backtrace-get-index)
- :selected (plist-get (backtrace-get-view) :print-circle)
- :help
- "Condense or expand shared or circular structures in the frame at point"]
- ["Show Uninterned Symbols" backtrace-toggle-print-gensym
- :style toggle
- :active (backtrace-get-index)
- :selected (plist-get (backtrace-get-view) :print-gensym)
- :help
- "Toggle unique printing of uninterned symbols in the frame at point"]
- ["Expand \"...\"s" backtrace-expand-ellipses
- :help "Expand all the abbreviated forms in the current frame"]
- ["Show on Multiple Lines" backtrace-multi-line
- :help "Use line breaks and indentation to make a form more readable"]
- ["Show on Single Line" backtrace-single-line]
- "--"
- ["Go to Source" backtrace-goto-source
- :active (and (backtrace-get-index)
- (plist-get (backtrace-frame-flags
- (nth (backtrace-get-index) backtrace-frames))
- :source-available))
- :help "Show the source code for the current frame"]
- ["Help for Symbol" backtrace-help-follow-symbol
- :help "Show help for symbol at point"]
- ["Describe Backtrace Mode" describe-mode
- :help "Display documentation for backtrace-mode"]))
- map)
- "Local keymap for `backtrace-mode' buffers.")
+(defvar-keymap backtrace-mode-map
+ :doc "Local keymap for `backtrace-mode' buffers."
+ :parent (make-composed-keymap special-mode-map
+ button-buffer-map)
+ "n" #'backtrace-forward-frame
+ "p" #'backtrace-backward-frame
+ "v" #'backtrace-toggle-locals
+ "#" #'backtrace-toggle-print-circle
+ ":" #'backtrace-toggle-print-gensym
+ "s" #'backtrace-goto-source
+ "RET" #'backtrace-help-follow-symbol
+ "+" #'backtrace-multi-line
+ "-" #'backtrace-single-line
+ "." #'backtrace-expand-ellipses
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'mouse-select-window
+
+ :menu
+ '("Backtrace"
+ ["Next Frame" backtrace-forward-frame
+ :help "Move cursor forwards to the start of a backtrace frame"]
+ ["Previous Frame" backtrace-backward-frame
+ :help "Move cursor backwards to the start of a backtrace frame"]
+ "--"
+ ["Show Variables" backtrace-toggle-locals
+ :style toggle
+ :active (backtrace-get-index)
+ :selected (plist-get (backtrace-get-view) :show-locals)
+ :help "Show or hide the local variables for the frame at point"]
+ ["Show Circular Structures" backtrace-toggle-print-circle
+ :style toggle
+ :active (backtrace-get-index)
+ :selected (plist-get (backtrace-get-view) :print-circle)
+ :help
+ "Condense or expand shared or circular structures in the frame at point"]
+ ["Show Uninterned Symbols" backtrace-toggle-print-gensym
+ :style toggle
+ :active (backtrace-get-index)
+ :selected (plist-get (backtrace-get-view) :print-gensym)
+ :help
+ "Toggle unique printing of uninterned symbols in the frame at point"]
+ ["Expand \"...\"s" backtrace-expand-ellipses
+ :help "Expand all the abbreviated forms in the current frame"]
+ ["Show on Multiple Lines" backtrace-multi-line
+ :help "Use line breaks and indentation to make a form more readable"]
+ ["Show on Single Line" backtrace-single-line]
+ "--"
+ ["Go to Source" backtrace-goto-source
+ :active (and (backtrace-get-index)
+ (plist-get (backtrace-frame-flags
+ (nth (backtrace-get-index) backtrace-frames))
+ :source-available))
+ :help "Show the source code for the current frame"]
+ ["Help for Symbol" backtrace-help-follow-symbol
+ :help "Show help for symbol at point"]
+ ["Describe Backtrace Mode" describe-mode
+ :help "Display documentation for backtrace-mode"]))
(defconst backtrace--flags-width 2
"Width in characters of the flags for a backtrace frame.")
@@ -751,6 +752,13 @@ property for use by navigation."
(insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
(put-text-property beg (point) 'backtrace-section 'func)))
+(defun backtrace--line-length-or-nil ()
+ "Return `backtrace-line-length' if valid, nil else."
+ ;; mirror the logic in `cl-print-to-string-with-limits'
+ (and (natnump backtrace-line-length)
+ (not (zerop backtrace-line-length))
+ backtrace-line-length))
+
(defun backtrace--print-func-and-args (frame _view)
"Print the function, arguments and buffer position of a backtrace FRAME.
Format it according to VIEW."
@@ -769,11 +777,16 @@ Format it according to VIEW."
(if (atom fun)
(funcall backtrace-print-function fun)
(insert
- (backtrace--print-to-string fun (when args (/ backtrace-line-length 2)))))
+ (backtrace--print-to-string
+ fun
+ (when (and args (backtrace--line-length-or-nil))
+ (/ backtrace-line-length 2)))))
(if args
(insert (backtrace--print-to-string
- args (max (truncate (/ backtrace-line-length 5))
- (- backtrace-line-length (- (point) beg)))))
+ args
+ (if (backtrace--line-length-or-nil)
+ (max (truncate (/ backtrace-line-length 5))
+ (- backtrace-line-length (- (point) beg))))))
;; The backtrace-form property is so that backtrace-multi-line
;; will find it. backtrace-multi-line doesn't do anything
;; useful with it, just being consistent.
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index c5f621c6c86..882b1d68c48 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -121,7 +121,11 @@ result. The overhead of the `lambda's is accounted for."
(unless (or (natnump repetitions) (and repetitions (symbolp repetitions)))
(setq forms (cons repetitions forms)
repetitions 1))
- `(benchmark-call (byte-compile '(lambda () ,@forms)) ,repetitions))
+ `(benchmark-call (,(if (native-comp-available-p)
+ 'native-compile
+ 'byte-compile)
+ '(lambda () ,@forms))
+ ,repetitions))
;;;###autoload
(defun benchmark (repetitions form)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index c6d64975eca..0ecac3d52aa 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -77,7 +77,7 @@
;; (bindat-type
;; (type u8)
;; (opcode u8)
-;; (length uintr 32) ;; little endian order
+;; (length uint 32 t) ;; little endian order
;; (id strz 8)
;; (data vec length)
;; (_ align 4)))
@@ -165,12 +165,12 @@
(if (stringp s) s
(apply #'unibyte-string s))))
-(defun bindat--unpack-strz (len)
+(defun bindat--unpack-strz (&optional len)
(let ((i 0) s)
(while (and (if len (< i len) t) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(setq i (1+ i)))
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
- (setq bindat-idx (+ bindat-idx len))
+ (setq bindat-idx (+ bindat-idx (or len (1+ i))))
(if (stringp s) s
(apply #'unibyte-string s))))
@@ -320,72 +320,72 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(defun bindat--length-group (struct spec)
(if (cl-typep spec 'bindat--type)
(funcall (bindat--type-le spec) struct)
- (with-suppressed-warnings ((lexical struct last))
- (defvar struct) (defvar last))
- (let ((struct struct) last)
- (dolist (item spec)
- (let* ((field (car item))
- (type (nth 1 item))
- (len (nth 2 item))
- (vectype (and (eq type 'vec) (nth 3 item)))
- (tail 3))
- (if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)) t)))
- (if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)) t)))
- (if (memq field '(eval fill align struct union))
- (setq tail 2
- len type
- type field
- field nil))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
- (if (and (consp len) (not (eq type 'eval)))
- (setq len (apply #'bindat-get-field struct len)))
- (if (not len)
- (setq len 1))
- (while (eq type 'vec)
- (if (consp vectype)
- (setq len (* len (nth 1 vectype))
- type (nth 2 vectype))
- (setq type (or vectype 'u8)
- vectype nil)))
- (pcase type
- ('eval
- (if field
- (setq struct (cons (cons field (eval len t)) struct))
- (eval len t)))
- ('fill
- (setq bindat-idx (+ bindat-idx len)))
- ('align
- (setq bindat-idx (bindat--align bindat-idx len)))
- ('struct
- (bindat--length-group
- (if field (bindat-get-field struct field) struct) (eval len t)))
- ('repeat
- (dotimes (index len)
- (bindat--length-group
- (nth index (bindat-get-field struct field))
- (nthcdr tail item))))
- ('union
- (with-suppressed-warnings ((lexical tag))
- (defvar tag))
- (let ((tag len) (cases (nthcdr tail item)) case cc)
- (while cases
- (setq case (car cases)
- cases (cdr cases)
- cc (car case))
- (if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc t)))
- (progn
- (bindat--length-group struct (cdr case))
- (setq cases nil))))))
- (_
- (if (setq type (assq type bindat--fixed-length-alist))
- (setq len (* len (cdr type))))
- (if field
- (setq last (bindat-get-field struct field)))
- (setq bindat-idx (+ bindat-idx len)))))))))
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
+ (let ((struct struct) last)
+ (dolist (item spec)
+ (let* ((field (car item))
+ (type (nth 1 item))
+ (len (nth 2 item))
+ (vectype (and (eq type 'vec) (nth 3 item)))
+ (tail 3))
+ (if (and type (consp type) (eq (car type) 'eval))
+ (setq type (eval (car (cdr type)) t)))
+ (if (and len (consp len) (eq (car len) 'eval))
+ (setq len (eval (car (cdr len)) t)))
+ (if (memq field '(eval fill align struct union))
+ (setq tail 2
+ len type
+ type field
+ field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
+ (if (and (consp len) (not (eq type 'eval)))
+ (setq len (apply #'bindat-get-field struct len)))
+ (if (not len)
+ (setq len 1))
+ (while (eq type 'vec)
+ (if (consp vectype)
+ (setq len (* len (nth 1 vectype))
+ type (nth 2 vectype))
+ (setq type (or vectype 'u8)
+ vectype nil)))
+ (pcase type
+ ('eval
+ (if field
+ (setq struct (cons (cons field (eval len t)) struct))
+ (eval len t)))
+ ('fill
+ (setq bindat-idx (+ bindat-idx len)))
+ ('align
+ (setq bindat-idx (bindat--align bindat-idx len)))
+ ('struct
+ (bindat--length-group
+ (if field (bindat-get-field struct field) struct) (eval len t)))
+ ('repeat
+ (dotimes (index len)
+ (bindat--length-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))))
+ ('union
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
+ (let ((tag len) (cases (nthcdr tail item)) case cc)
+ (while cases
+ (setq case (car cases)
+ cases (cdr cases)
+ cc (car case))
+ (if (or (equal cc tag) (equal cc t)
+ (and (consp cc) (eval cc t)))
+ (progn
+ (bindat--length-group struct (cdr case))
+ (setq cases nil))))))
+ (_
+ (if (setq type (assq type bindat--fixed-length-alist))
+ (setq len (* len (cdr type))))
+ (if field
+ (setq last (bindat-get-field struct field)))
+ (setq bindat-idx (+ bindat-idx len)))))))))
(defun bindat-length (spec struct)
"Calculate `bindat-raw' length for STRUCT according to bindat SPEC."
@@ -435,15 +435,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-u32r (ash v -32)))
(defun bindat--pack-str (len v)
- (dotimes (i (min len (length v)))
- (aset bindat-raw (+ bindat-idx i) (aref v i)))
- (setq bindat-idx (+ bindat-idx len)))
-
-(defun bindat--pack-strz (v)
- (let ((len (length v)))
- (dotimes (i len)
+ (let ((v (string-to-unibyte v)))
+ (dotimes (i (min len (length v)))
(aset bindat-raw (+ bindat-idx i) (aref v i)))
- (setq bindat-idx (+ bindat-idx len 1))))
+ (setq bindat-idx (+ bindat-idx len))))
+
+(defun bindat--pack-strz (len v)
+ (let* ((v (string-to-unibyte v))
+ (vlen (length v)))
+ ;; Explicitly write a null terminator (if there's room) in case
+ ;; the user provided a pre-allocated string to `bindat-pack' that
+ ;; wasn't already zeroed.
+ (when (or (null len) (< vlen len))
+ (aset bindat-raw (+ bindat-idx vlen) 0))
+ (if len
+ ;; When len is specified, behave the same as the str type
+ ;; (except for the null terminator possibly written above).
+ (bindat--pack-str len v)
+ (dotimes (i vlen)
+ (when (= (aref v i) 0)
+ ;; Alternatively we could pretend that this was the end of
+ ;; the string and stop packing, but then bindat-length would
+ ;; need to scan the input string looking for a null byte.
+ (error "Null byte encountered in input strz string"))
+ (aset bindat-raw (+ bindat-idx i) (aref v i)))
+ (setq bindat-idx (+ bindat-idx vlen 1)))))
(defun bindat--pack-bits (len v)
(let ((bnum (1- (* 8 len))) j m)
@@ -472,7 +488,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
('u24r (bindat--pack-u24r v))
('u32r (bindat--pack-u32r v))
('bits (bindat--pack-bits len v))
- ((or 'str 'strz) (bindat--pack-str len v))
+ ('str (bindat--pack-str len v))
+ ('strz (bindat--pack-strz len v))
('vec
(let ((l (length v)) (vlen 1))
(if (consp vectype)
@@ -663,19 +680,15 @@ is the name of a variable that will hold the value we need to pack.")
(`(length . ,_) `(cl-incf bindat-idx 1))
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
-(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uint)) n &optional le)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
- ('unpack `(bindat--unpack-uint ,n))
- (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
- (`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
-
-(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
- (if (eq n 8) (bindat--type op 'byte)
- (bindat--pcase op
- ('unpack `(bindat--unpack-uintr ,n))
+ ('unpack
+ `(if ,le (bindat--unpack-uintr ,n) (bindat--unpack-uint ,n)))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
- (`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
+ (`(pack . ,args)
+ `(if ,le (bindat--pack-uintr ,n . ,args)
+ (bindat--pack-uint ,n . ,args))))))
(cl-defmethod bindat--type (op (_ (eql 'str)) len)
(bindat--pcase op
@@ -688,18 +701,12 @@ is the name of a variable that will hold the value we need to pack.")
('unpack `(bindat--unpack-strz ,len))
(`(length ,val)
`(cl-incf bindat-idx ,(cond
- ((null len) `(length ,val))
+ ;; Optimizations if len is a literal number or nil.
+ ((null len) `(1+ (length ,val)))
((numberp len) len)
- (t `(or ,len (length ,val))))))
- (`(pack . ,args)
- (macroexp-let2 nil len len
- `(if ,len
- ;; Same as non-zero terminated strings since we don't actually add
- ;; the terminating zero anyway (because we rely on the fact that
- ;; `bindat-raw' was presumably initialized with all-zeroes before
- ;; we started).
- (bindat--pack-str ,len . ,args)
- (bindat--pack-strz . ,args))))))
+ ;; General expression support.
+ (t `(or ,len (1+ (length ,val)))))))
+ (`(pack . ,args) `(bindat--pack-strz ,len . ,args))))
(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
(bindat--pcase op
@@ -824,7 +831,7 @@ is the name of a variable that will hold the value we need to pack.")
&optional ":unpack-val" def-form))
(def-edebug-elem-spec 'bindat-type
- '(&or ["uint" def-form]
+ '(&or ["uint" def-form &optional def-form]
["uintr" def-form]
["str" def-form]
["strz" &optional def-form]
@@ -844,8 +851,7 @@ is the name of a variable that will hold the value we need to pack.")
"Return the Bindat type value to pack&unpack TYPE.
TYPE is a Bindat type expression. It can take the following forms:
- uint BITLEN - Big-endian unsigned integer
- uintr BITLEN - Little-endian unsigned integer
+ uint BITLEN [LE] - unsigned integer (big-endian if LE is nil)
str LEN - Byte string
strz [LEN] - Zero-terminated byte-string
bits LEN - Bit vector (LEN is counted in bytes)
@@ -872,7 +878,7 @@ controlled in the following way:
- If the list of fields is preceded with `:pack-var VAR' then the object to
be packed is bound to VAR when evaluating the EXPs of `:pack-val'.
-All the above BITLEN, LEN, COUNT, and EXP are ELisp expressions evaluated
+All the above BITLEN, LEN, LE, COUNT, and EXP are ELisp expressions evaluated
in the current lexical context extended with the previous fields.
TYPE can additionally be one of the Bindat type macros defined with
@@ -886,7 +892,7 @@ a bindat type expression."
:pe ,(bindat--toplevel 'pack type))))
(eval-and-compile
- (defconst bindat--primitives '(byte uint uintr str strz bits fill align
+ (defconst bindat--primitives '(byte uint str strz bits fill align
struct type vec unit)))
(eval-and-compile
@@ -930,9 +936,9 @@ a bindat type expression."
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
(bindat-defmacro u8 () "Unsigned 8bit integer." '(byte))
-(bindat-defmacro sint (bitlen r)
+(bindat-defmacro sint (bitlen le)
"Signed integer of size BITLEN.
-Bigendian if R is nil and little endian if not."
+Big-endian if LE is nil and little-endian if not."
(let ((bl (make-symbol "bitlen"))
(max (make-symbol "max"))
(wrap (make-symbol "wrap")))
@@ -940,10 +946,14 @@ Bigendian if R is nil and little endian if not."
(,max (ash 1 (1- ,bl)))
(,wrap (+ ,max ,max)))
(struct :pack-var v
- (n if ,r (uintr ,bl) (uint ,bl)
+ (n uint ,bl ,le
:pack-val (if (< v 0) (+ v ,wrap) v))
:unpack-val (if (>= n ,max) (- n ,wrap) n)))))
+(bindat-defmacro uintr (bitlen)
+ "(deprecated since Emacs-29) Little-endian unsigned integer."
+ `(uint ,bitlen t))
+
(bindat-defmacro repeat (count &rest type)
"Like `vec', but unpacks to a list rather than a vector."
`(:pack-var v
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 5f83a217061..b7147a7f50f 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -34,128 +34,13 @@
;; still not going to make it go faster than 70 mph, but it might be easier
;; to get it there.
;;
-
;; TO DO:
;;
-;; (apply (lambda (x &rest y) ...) 1 (foo))
-;;
-;; maintain a list of functions known not to access any global variables
-;; (actually, give them a 'dynamically-safe property) and then
-;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==>
-;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
-;; by recursing on this, we might be able to eliminate the entire let.
-;; However certain variables should never have their bindings optimized
-;; away, because they affect everything.
-;; (put 'debug-on-error 'binding-is-magic t)
-;; (put 'debug-on-abort 'binding-is-magic t)
-;; (put 'debug-on-next-call 'binding-is-magic t)
-;; (put 'inhibit-quit 'binding-is-magic t)
-;; (put 'quit-flag 'binding-is-magic t)
-;; (put 't 'binding-is-magic t)
-;; (put 'nil 'binding-is-magic t)
-;; possibly also
-;; (put 'gc-cons-threshold 'binding-is-magic t)
-;; (put 'track-mouse 'binding-is-magic t)
-;; others?
-;;
-;; Simple defsubsts often produce forms like
-;; (let ((v1 (f1)) (v2 (f2)) ...)
-;; (FN v1 v2 ...))
-;; It would be nice if we could optimize this to
-;; (FN (f1) (f2) ...)
-;; but we can't unless FN is dynamically-safe (it might be dynamically
-;; referring to the bindings that the lambda arglist established.)
-;; One of the uncountable lossages introduced by dynamic scope...
-;;
-;; Maybe there should be a control-structure that says "turn on
-;; fast-and-loose type-assumptive optimizations here." Then when
-;; we see a form like (car foo) we can from then on assume that
-;; the variable foo is of type cons, and optimize based on that.
-;; But, this won't win much because of (you guessed it) dynamic
-;; scope. Anything down the stack could change the value.
-;; (Another reason it doesn't work is that it is perfectly valid
-;; to call car with a null argument.) A better approach might
-;; be to allow type-specification of the form
-;; (put 'foo 'arg-types '(float (list integer) dynamic))
-;; (put 'foo 'result-type 'bool)
-;; It should be possible to have these types checked to a certain
-;; degree.
-;;
-;; collapse common subexpressions
-;;
-;; It would be nice if redundant sequences could be factored out as well,
-;; when they are known to have no side-effects:
-;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2
-;; but beware of traps like
-;; (cons (list x y) (list x y))
-;;
-;; Tail-recursion elimination is not really possible in Emacs Lisp.
-;; Tail-recursion elimination is almost always impossible when all variables
-;; have dynamic scope, but given that the "return" byteop requires the
-;; binding stack to be empty (rather than emptying it itself), there can be
-;; no truly tail-recursive Emacs Lisp functions that take any arguments or
-;; make any bindings.
-;;
-;; Here is an example of an Emacs Lisp function which could safely be
-;; byte-compiled tail-recursively:
-;;
-;; (defun tail-map (fn list)
-;; (cond (list
-;; (funcall fn (car list))
-;; (tail-map fn (cdr list)))))
-;;
-;; However, if there was even a single let-binding around the COND,
-;; it could not be byte-compiled, because there would be an "unbind"
-;; byte-op between the final "call" and "return." Adding a
-;; Bunbind_all byteop would fix this.
-;;
-;; (defun foo (x y z) ... (foo a b c))
-;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
-;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
-;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
-;;
-;; this also can be considered tail recursion:
-;;
-;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
-;; could generalize this by doing the optimization
-;; (goto X) ... X: (return) --> (return)
-;;
-;; But this doesn't solve all of the problems: although by doing tail-
-;; recursion elimination in this way, the call-stack does not grow, the
-;; binding-stack would grow with each recursive step, and would eventually
-;; overflow. I don't believe there is any way around this without lexical
-;; scope.
-;;
-;; Wouldn't it be nice if Emacs Lisp had lexical scope.
-;;
-;; Idea: the form (lexical-scope) in a file means that the file may be
-;; compiled lexically. This proclamation is file-local. Then, within
-;; that file, "let" would establish lexical bindings, and "let-dynamic"
-;; would do things the old way. (Or we could use CL "declare" forms.)
-;; We'd have to notice defvars and defconsts, since those variables should
-;; always be dynamic, and attempting to do a lexical binding of them
-;; should simply do a dynamic binding instead.
-;; But! We need to know about variables that were not necessarily defvared
-;; in the file being compiled (doing a boundp check isn't good enough.)
-;; Fdefvar() would have to be modified to add something to the plist.
-;;
-;; A major disadvantage of this scheme is that the interpreter and compiler
-;; would have different semantics for files compiled with (dynamic-scope).
-;; Since this would be a file-local optimization, there would be no way to
-;; modify the interpreter to obey this (unless the loader was hacked
-;; in some grody way, but that's a really bad idea.)
-
-;; Other things to consider:
-
-;; ;; Associative math should recognize subcalls to identical function:
-;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
-;; ;; This should generate the same as (1+ x) and (1- x)
-
-;; (disassemble (lambda (x) (cons (+ x 1) (- x 1))))
;; ;; An awful lot of functions always return a non-nil value. If they're
;; ;; error free also they may act as true-constants.
-
+;;
;; (disassemble (lambda (x) (and (point) (foo))))
+
;; ;; When
;; ;; - all but one arguments to a function are constant
;; ;; - the non-constant argument is an if-expression (cond-expression?)
@@ -188,10 +73,6 @@
(eval-when-compile (require 'subr-x))
(defun byte-compile-log-lap-1 (format &rest args)
- ;; Newer byte codes for stack-ref make the slot 0 non-nil again.
- ;; But the "old disassembler" is *really* ancient by now.
- ;; (if (aref byte-code-vector 0)
- ;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well"))
(byte-compile-log-1
(apply #'format-message format
(let (c a)
@@ -264,8 +145,9 @@ Earlier variables shadow later ones with the same name.")
(cdr (assq name byte-compile-function-environment)))))
(pcase fn
('nil
- (byte-compile-warn "attempt to inline `%s' before it was defined"
- name)
+ (byte-compile-warn-x name
+ "attempt to inline `%s' before it was defined"
+ name)
form)
(`(autoload . ,_)
(error "File `%s' didn't define `%s'" (nth 1 fn) name))
@@ -342,8 +224,12 @@ for speeding up processing.")
(numberp expr)
(stringp expr)
(and (consp expr)
- (memq (car expr) '(quote function))
- (symbolp (cadr expr)))
+ (or (and (memq (car expr) '(quote function))
+ (symbolp (cadr expr)))
+ ;; (internal-get-closed-var N) can be considered constant for
+ ;; const-prop purposes.
+ (and (eq (car expr) 'internal-get-closed-var)
+ (integerp (cadr expr)))))
(keywordp expr)))
(defmacro byte-optimize--pcase (exp &rest cases)
@@ -417,8 +303,8 @@ for speeding up processing.")
(t form)))
(`(quote . ,v)
(if (or (not v) (cdr v))
- (byte-compile-warn "malformed quote form: `%s'"
- (prin1-to-string form)))
+ (byte-compile-warn-x form "malformed quote form: `%s'"
+ form))
;; Map (quote nil) to nil to simplify optimizer logic.
;; Map quoted constants to nil if for-effect (just because).
(and (car v)
@@ -436,8 +322,9 @@ for speeding up processing.")
(cons
(byte-optimize-form (car clause) nil)
(byte-optimize-body (cdr clause) for-effect))
- (byte-compile-warn "malformed cond form: `%s'"
- (prin1-to-string clause))
+ (byte-compile-warn-x
+ clause "malformed cond form: `%s'"
+ clause)
clause))
clauses)))
(`(progn . ,exps)
@@ -451,7 +338,7 @@ for speeding up processing.")
(let ((exps-opt (byte-optimize-body exps t)))
(if (macroexp-const-p exp-opt)
`(progn ,@exps-opt ,exp-opt)
- `(prog1 ,exp-opt ,@exps-opt)))
+ `(,fn ,exp-opt ,@exps-opt)))
exp-opt)))
(`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
@@ -471,7 +358,7 @@ for speeding up processing.")
(then-opt (and test-opt (byte-optimize-form then for-effect)))
(else-opt (and (not (and test-opt const))
(byte-optimize-body else for-effect))))
- `(if ,test-opt ,then-opt . ,else-opt)))
+ `(,fn ,test-opt ,then-opt . ,else-opt)))
(`(,(or 'and 'or) . ,exps)
;; FIXME: We have to traverse the expressions in left-to-right
@@ -510,20 +397,19 @@ for speeding up processing.")
;; as mutated variables have been marked as non-substitutable.
(condition (byte-optimize-form (car condition-body) nil))
(body (byte-optimize-body (cdr condition-body) t)))
- `(while ,condition . ,body)))
+ `(,fn ,condition . ,body)))
(`(interactive . ,_)
- (byte-compile-warn "misplaced interactive spec: `%s'"
- (prin1-to-string form))
+ (byte-compile-warn-x form "misplaced interactive spec: `%s'" form)
nil)
(`(function . ,_)
;; This forms is compiled as constant or by breaking out
;; all the subexpressions and compiling them separately.
- form)
+ (and (not for-effect) form))
(`(condition-case ,var ,exp . ,clauses)
- `(condition-case ,var ;Not evaluated.
+ `(,fn ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
(let ((byte-optimize--lexvars
@@ -536,35 +422,29 @@ for speeding up processing.")
(byte-optimize-body (cdr clause) for-effect))))
clauses)))
- (`(unwind-protect ,exp . ,exps)
- ;; The unwinding part of an unwind-protect is compiled (and thus
- ;; optimized) as a top-level form, but run the optimizer for it here
- ;; anyway for lexical variable usage and substitution. But the
- ;; protected part has the same for-effect status as the
- ;; unwind-protect itself. (The unwinding part is always for effect,
- ;; but that isn't handled properly yet.)
- (let ((bodyform (byte-optimize-form exp for-effect)))
- (pcase exps
- (`(:fun-body ,f)
- `(unwind-protect ,bodyform
- :fun-body ,(byte-optimize-form f nil)))
- (_
- `(unwind-protect ,bodyform
- . ,(byte-optimize-body exps t))))))
+ ;; `unwind-protect' is a special form which here takes the shape
+ ;; (unwind-protect EXPR :fun-body UNWIND-FUN).
+ ;; We can treat it as if it were a plain function at this point,
+ ;; although there are specific optimisations possible.
+ ;; In particular, the return value of UNWIND-FUN is never used
+ ;; so its body should really be compiled for-effect, but we
+ ;; don't do that right now.
(`(catch ,tag . ,exps)
- `(catch ,(byte-optimize-form tag nil)
+ `(,fn ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect)))
;; Needed as long as we run byte-optimize-form after cconv.
(`(internal-make-closure . ,_)
- ;; Look up free vars and mark them to be kept, so that they
- ;; won't be optimised away.
- (dolist (var (caddr form))
- (let ((lexvar (assq var byte-optimize--lexvars)))
- (when lexvar
- (setcar (cdr lexvar) t))))
- form)
+ (and (not for-effect)
+ (progn
+ ;; Look up free vars and mark them to be kept, so that they
+ ;; won't be optimised away.
+ (dolist (var (caddr form))
+ (let ((lexvar (assq var byte-optimize--lexvars)))
+ (when lexvar
+ (setcar (cdr lexvar) t))))
+ form)))
(`((lambda . ,_) . ,_)
(let ((newform (macroexp--unfold-lambda form)))
@@ -577,46 +457,34 @@ for speeding up processing.")
;; is a *value* and shouldn't appear in the car.
(`((closure . ,_) . ,_) form)
- (`(setq . ,args)
- (let ((var-expr-list nil))
- (while args
- (unless (and (consp args)
- (symbolp (car args)) (consp (cdr args)))
- (byte-compile-warn "malformed setq form: %S" form))
- (let* ((var (car args))
- (expr (cadr args))
- (lexvar (assq var byte-optimize--lexvars))
- (value (byte-optimize-form expr nil)))
- (when lexvar
- (setcar (cdr lexvar) t) ; Mark variable to be kept.
- (setcdr (cdr lexvar) nil) ; Inhibit further substitution.
-
- (when (memq var byte-optimize--aliased-vars)
- ;; Cancel aliasing of variables aliased to this one.
- (dolist (v byte-optimize--lexvars)
- (when (eq (nth 2 v) var)
- ;; V is bound to VAR but VAR is now mutated:
- ;; cancel aliasing.
- (setcdr (cdr v) nil)))))
-
- (push var var-expr-list)
- (push value var-expr-list))
- (setq args (cddr args)))
- (cons fn (nreverse var-expr-list))))
+ (`(setq ,var ,expr)
+ (let ((lexvar (assq var byte-optimize--lexvars))
+ (value (byte-optimize-form expr nil)))
+ (when lexvar
+ (setcar (cdr lexvar) t) ; Mark variable to be kept.
+ (setcdr (cdr lexvar) nil) ; Inhibit further substitution.
+
+ (when (memq var byte-optimize--aliased-vars)
+ ;; Cancel aliasing of variables aliased to this one.
+ (dolist (v byte-optimize--lexvars)
+ (when (eq (nth 2 v) var)
+ ;; V is bound to VAR but VAR is now mutated:
+ ;; cancel aliasing.
+ (setcdr (cdr v) nil)))))
+ `(,fn ,var ,value)))
(`(defvar ,(and (pred symbolp) name) . ,rest)
(let ((optimized-rest (and rest
(cons (byte-optimize-form (car rest) nil)
(cdr rest)))))
(push name byte-optimize--dynamic-vars)
- `(defvar ,name . ,optimized-rest)))
+ `(,fn ,name . ,optimized-rest)))
(`(,(pred byte-code-function-p) . ,exps)
(cons fn (mapcar #'byte-optimize-form exps)))
(`(,(pred (not symbolp)) . ,_)
- (byte-compile-warn "`%s' is a malformed function"
- (prin1-to-string fn))
+ (byte-compile-warn-x fn "`%s' is a malformed function" fn)
form)
((guard (when for-effect
@@ -624,8 +492,10 @@ for speeding up processing.")
(or byte-compile-delete-errors
(eq tmp 'error-free)
(progn
- (byte-compile-warn "value returned from %s is unused"
- (prin1-to-string form))
+ (byte-compile-warn-x
+ form
+ "value returned from %s is unused"
+ form)
nil)))))
(byte-compile-log " %s called for effect; deleted" fn)
;; appending a nil here might not be necessary, but it can't hurt.
@@ -674,49 +544,50 @@ for speeding up processing.")
(defun byte-optimize--rename-var (var new-var form)
"Replace VAR with NEW-VAR in FORM."
- (pcase form
- ((pred symbolp) (if (eq form var) new-var form))
- (`(setq . ,args)
- (let ((new-args nil))
- (while args
- (push (byte-optimize--rename-var var new-var (car args)) new-args)
- (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
- (setq args (cddr args)))
- `(setq . ,(nreverse new-args))))
- ;; In binding constructs like `let', `let*' and `condition-case' we
- ;; rename everything for simplicity, even new bindings named VAR.
- (`(,(and head (or 'let 'let*)) ,bindings . ,body)
- `(,head
- ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
- bindings)
- ,@(byte-optimize--rename-var-body var new-var body)))
- (`(condition-case ,res-var ,protected-form . ,handlers)
- `(condition-case ,(byte-optimize--rename-var var new-var res-var)
- ,(byte-optimize--rename-var var new-var protected-form)
- ,@(mapcar (lambda (h)
- (cons (car h)
- (byte-optimize--rename-var-body var new-var (cdr h))))
- handlers)))
- (`(internal-make-closure ,vars ,env . ,rest)
- `(internal-make-closure
- ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
- (`(defvar ,name . ,rest)
- ;; NAME is not renamed here; we only care about lexical variables.
- `(defvar ,name . ,(byte-optimize--rename-var-body var new-var rest)))
-
- (`(cond . ,clauses)
- `(cond ,@(mapcar (lambda (c)
- (byte-optimize--rename-var-body var new-var c))
- clauses)))
-
- (`(function . ,_) form)
- (`(quote . ,_) form)
- (`(lambda . ,_) form)
-
- ;; Function calls and special forms not handled above.
- (`(,head . ,args)
- `(,head . ,(byte-optimize--rename-var-body var new-var args)))
- (_ form)))
+ (let ((fn (car-safe form)))
+ (pcase form
+ ((pred symbolp) (if (eq form var) new-var form))
+ (`(setq . ,args)
+ (let ((new-args nil))
+ (while args
+ (push (byte-optimize--rename-var var new-var (car args)) new-args)
+ (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
+ (setq args (cddr args)))
+ `(,fn . ,(nreverse new-args))))
+ ;; In binding constructs like `let', `let*' and `condition-case' we
+ ;; rename everything for simplicity, even new bindings named VAR.
+ (`(,(and head (or 'let 'let*)) ,bindings . ,body)
+ `(,head
+ ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
+ bindings)
+ ,@(byte-optimize--rename-var-body var new-var body)))
+ (`(condition-case ,res-var ,protected-form . ,handlers)
+ `(,fn ,(byte-optimize--rename-var var new-var res-var)
+ ,(byte-optimize--rename-var var new-var protected-form)
+ ,@(mapcar (lambda (h)
+ (cons (car h)
+ (byte-optimize--rename-var-body var new-var (cdr h))))
+ handlers)))
+ (`(internal-make-closure ,vars ,env . ,rest)
+ `(,fn
+ ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
+ (`(defvar ,name . ,rest)
+ ;; NAME is not renamed here; we only care about lexical variables.
+ `(,fn ,name . ,(byte-optimize--rename-var-body var new-var rest)))
+
+ (`(cond . ,clauses)
+ `(,fn ,@(mapcar (lambda (c)
+ (byte-optimize--rename-var-body var new-var c))
+ clauses)))
+
+ (`(function . ,_) form)
+ (`(quote . ,_) form)
+ (`(lambda . ,_) form)
+
+ ;; Function calls and special forms not handled above.
+ (`(,head . ,args)
+ `(,head . ,(byte-optimize--rename-var-body var new-var args)))
+ (_ form))))
(defun byte-optimize-let-form (head form for-effect)
;; Recursively enter the optimizer for the bindings and body
@@ -818,12 +689,8 @@ for speeding up processing.")
(let ((byte-optimize--lexvars nil))
(cons
(mapcar (lambda (binding)
- (if (symbolp binding)
- binding
- (when (or (atom binding) (cddr binding))
- (byte-compile-warn "malformed let binding: `%S'" binding))
- (list (car binding)
- (byte-optimize-form (nth 1 binding) nil))))
+ (list (car binding)
+ (byte-optimize-form (nth 1 binding) nil)))
(car form))
(byte-optimize-body (cdr form) for-effect)))))
@@ -1161,6 +1028,14 @@ See Info node `(elisp) Integer Basics'."
form ; No improvement.
(cons 'concat (nreverse newargs)))))
+(defun byte-optimize-string-greaterp (form)
+ ;; Rewrite in terms of `string-lessp' which has its own bytecode.
+ (pcase (cdr form)
+ (`(,a ,b) (let ((arg1 (make-symbol "arg1")))
+ `(let ((,arg1 ,a))
+ (string-lessp ,b ,arg1))))
+ (_ form)))
+
(put 'identity 'byte-optimizer #'byte-optimize-identity)
(put 'memq 'byte-optimizer #'byte-optimize-memq)
(put 'memql 'byte-optimizer #'byte-optimize-member)
@@ -1184,6 +1059,9 @@ See Info node `(elisp) Integer Basics'."
(put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
(put 'string-equal 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'string-greaterp 'byte-optimizer #'byte-optimize-string-greaterp)
+(put 'string> 'byte-optimizer #'byte-optimize-string-greaterp)
+
(put 'concat 'byte-optimizer #'byte-optimize-concat)
;; I'm not convinced that this is necessary. Doesn't the optimizer loop
@@ -1261,7 +1139,7 @@ See Info node `(elisp) Integer Basics'."
(list 'or (car (car clauses))
(byte-optimize-cond
(cons (car form) (cdr (cdr form)))))
- form))
+ (and clauses form)))
form))
(defun byte-optimize-if (form)
@@ -1275,21 +1153,21 @@ See Info node `(elisp) Integer Basics'."
(proper-list-p clause))
(if (null (cddr clause))
;; A trivial `progn'.
- (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form)))
+ (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 form)))
(nconc (butlast clause)
(list
(byte-optimize-if
- `(if ,(car (last clause)) ,@(nthcdr 2 form)))))))
+ `(,(car form) ,(car (last clause)) ,@(nthcdr 2 form)))))))
((byte-compile-trueconstp clause)
`(progn ,clause ,(nth 2 form)))
((byte-compile-nilconstp clause)
`(progn ,clause ,@(nthcdr 3 form)))
((nth 2 form)
(if (equal '(nil) (nthcdr 3 form))
- (list 'if clause (nth 2 form))
+ (list (car form) clause (nth 2 form))
form))
((or (nth 3 form) (nthcdr 4 form))
- (list 'if
+ (list (car form)
;; Don't make a double negative;
;; instead, take away the one that is there.
(if (and (consp clause) (memq (car clause) '(not null))
@@ -1304,7 +1182,7 @@ See Info node `(elisp) Integer Basics'."
(defun byte-optimize-while (form)
(when (< (length form) 2)
- (byte-compile-warn "too few arguments for `while'"))
+ (byte-compile-warn-x form "too few arguments for `while'"))
(if (nth 1 form)
form))
@@ -1342,9 +1220,10 @@ See Info node `(elisp) Integer Basics'."
(let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
(nconc (list 'funcall fn) butlast
(mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
- (byte-compile-warn
+ (byte-compile-warn-x
+ last
"last arg to apply can't be a literal atom: `%s'"
- (prin1-to-string last))
+ last)
nil))
form))))
@@ -1363,28 +1242,17 @@ See Info node `(elisp) Integer Basics'."
;; Body is empty or just contains a constant.
(`(,head ,bindings . ,(or '() `(,(and const (pred macroexp-const-p)))))
(if (eq head 'let)
- `(progn ,@(mapcar (lambda (binding)
- (and (consp binding) (cadr binding)))
- bindings)
- ,const)
- `(let* ,(butlast bindings)
- ,@(and (consp (car (last bindings)))
- (cdar (last bindings)))
- ,const)))
+ `(progn ,@(mapcar #'cadr bindings) ,const)
+ `(,head ,(butlast bindings) ,(cadar (last bindings)) ,const)))
;; Body is last variable.
(`(,head ,(and bindings
- (let last-var (let ((last (car (last bindings))))
- (if (consp last) (car last) last))))
+ (let last-var (caar (last bindings))))
,(and last-var ; non-linear pattern
(pred symbolp) (pred (not keywordp)) (pred (not booleanp))))
(if (eq head 'let)
- `(progn ,@(mapcar (lambda (binding)
- (and (consp binding) (cadr binding)))
- bindings))
- `(let* ,(butlast bindings)
- ,@(and (consp (car (last bindings)))
- (cdar (last bindings))))))
+ `(progn ,@(mapcar #'cadr bindings))
+ `(,head ,(butlast bindings) ,(cadar (last bindings)))))
(_ form)))
@@ -1420,8 +1288,6 @@ See Info node `(elisp) Integer Basics'."
form))
;; Fixme: delete-char -> delete-region (byte-coded)
-;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
-;; string-make-multibyte for constant args.
(put 'set 'byte-optimizer #'byte-optimize-set)
(defun byte-optimize-set (form)
@@ -1460,13 +1326,14 @@ See Info node `(elisp) Integer Basics'."
(let ((side-effect-free-fns
'(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
assq
+ base64-decode-string base64-encode-string base64url-encode-string
bool-vector-count-consecutive bool-vector-count-population
bool-vector-subsetp
boundp buffer-file-name buffer-local-variables buffer-modified-p
buffer-substring byte-code-function-p
capitalize car-less-than-car car cdr ceiling char-after char-before
char-equal char-to-string char-width compare-strings
- compare-window-configurations concat coordinates-in-window-p
+ window-configuration-equal-p concat coordinates-in-window-p
copy-alist copy-sequence copy-marker copysign cos count-lines
current-time-string current-time-zone
decode-char
@@ -1492,7 +1359,7 @@ See Info node `(elisp) Integer Basics'."
match-beginning match-end
member memq memql min minibuffer-selected-window minibuffer-window
mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
- parse-colon-path plist-get plist-member
+ parse-colon-path
prefix-numeric-value previous-window prin1-to-string propertize
degrees-to-radians
radians-to-degrees rassq rassoc read-from-string regexp-opt
@@ -1614,8 +1481,9 @@ See Info node `(elisp) Integer Basics'."
;; `assoc' and `assoc-default' are excluded since they are
;; impure if the test function is (consider `string-match').
assq rassq rassoc
- plist-get lax-plist-get plist-member
+ lax-plist-get
aref elt
+ base64-decode-string base64-encode-string base64url-encode-string
bool-vector-subsetp
bool-vector-count-population bool-vector-count-consecutive
)))
@@ -2190,9 +2058,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
((and (memq (car lap0) byte-goto-ops)
(memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
'(byte-goto byte-return)))
- (cond ((and (not (eq tmp lap0))
- (or (eq (car lap0) 'byte-goto)
- (eq (car tmp) 'byte-goto)))
+ (cond ((and (or (eq (car lap0) 'byte-goto)
+ (eq (car tmp) 'byte-goto))
+ (not (eq (cdr tmp) (cdr lap0))))
(byte-compile-log-lap " %s [%s]\t-->\t%s"
(car lap0) tmp tmp)
(if (eq (car tmp) 'byte-return)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 77e077f0442..dd90bcf4d82 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -30,6 +30,76 @@
;;; Code:
+(defvar byte-run--ssp-seen nil
+ "Which conses/vectors/records have been processed in strip-symbol-positions?
+The value is a hash table, the keys being the elements and the values being t.
+
+The purpose of this is to detect circular structures.")
+
+(defalias 'byte-run--strip-list
+ #'(lambda (arg)
+ "Strip the positions from symbols with position in the list ARG.
+This is done by destructively modifying ARG. Return ARG."
+ (let ((a arg))
+ (while
+ (and
+ (not (gethash a byte-run--ssp-seen))
+ (progn
+ (puthash a t byte-run--ssp-seen)
+ (cond
+ ((symbol-with-pos-p (car a))
+ (setcar a (bare-symbol (car a))))
+ ((consp (car a))
+ (byte-run--strip-list (car a)))
+ ((or (vectorp (car a)) (recordp (car a)))
+ (byte-run--strip-vector/record (car a))))
+ (consp (cdr a))))
+ (setq a (cdr a)))
+ (cond
+ ((symbol-with-pos-p (cdr a))
+ (setcdr a (bare-symbol (cdr a))))
+ ((or (vectorp (cdr a)) (recordp (cdr a)))
+ (byte-run--strip-vector/record (cdr a))))
+ arg)))
+
+(defalias 'byte-run--strip-vector/record
+ #'(lambda (arg)
+ "Strip the positions from symbols with position in the vector/record ARG.
+This is done by destructively modifying ARG. Return ARG."
+ (unless (gethash arg byte-run--ssp-seen)
+ (let ((len (length arg))
+ (i 0)
+ elt)
+ (puthash arg t byte-run--ssp-seen)
+ (while (< i len)
+ (setq elt (aref arg i))
+ (cond
+ ((symbol-with-pos-p elt)
+ (aset arg i elt))
+ ((consp elt)
+ (byte-run--strip-list elt))
+ ((or (vectorp elt) (recordp elt))
+ (byte-run--strip-vector/record elt)))
+ (setq i (1+ i)))))
+ arg))
+
+(defalias 'byte-run-strip-symbol-positions
+ #'(lambda (arg)
+ "Strip all positions from symbols in ARG.
+This modifies destructively then returns ARG.
+
+ARG is any Lisp object, but is usually a list or a vector or a
+record, containing symbols with position."
+ (setq byte-run--ssp-seen (make-hash-table :test 'eq))
+ (cond
+ ((symbol-with-pos-p arg)
+ (bare-symbol arg))
+ ((consp arg)
+ (byte-run--strip-list arg))
+ ((or (vectorp arg) (recordp arg))
+ (byte-run--strip-vector/record arg))
+ (t arg))))
+
(defalias 'function-put
;; We don't want people to just use `put' because we can't conveniently
;; hook into `put' to remap old properties to new ones. But for now, there's
@@ -38,7 +108,7 @@
"Set FUNCTION's property PROP to VALUE.
The namespace for PROP is shared with symbols.
So far, FUNCTION can only be a symbol, not a lambda expression."
- (put function prop value)))
+ (put (bare-symbol function) prop value)))
(function-put 'defmacro 'doc-string-elt 3)
(function-put 'defmacro 'lisp-indent-function 2)
@@ -96,7 +166,7 @@ The return value of this function is not used."
(defalias 'byte-run--set-obsolete
#'(lambda (f _args new-name when)
(list 'make-obsolete
- (list 'quote f) (list 'quote new-name) (list 'quote when))))
+ (list 'quote f) (list 'quote new-name) when)))
(defalias 'byte-run--set-interactive-only
#'(lambda (f _args instead)
@@ -134,17 +204,22 @@ The return value of this function is not used."
:autoload-end
(eval-and-compile
(defun ,cfname (,@(car data) ,@args)
+ (ignore ,@(delq '&rest (delq '&optional (copy-sequence args))))
,@(cdr data))))))))
(defalias 'byte-run--set-doc-string
#'(lambda (f _args pos)
(list 'function-put (list 'quote f)
- ''doc-string-elt (list 'quote pos))))
+ ''doc-string-elt (if (numberp pos)
+ pos
+ (list 'quote pos)))))
(defalias 'byte-run--set-indent
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
- ''lisp-indent-function (list 'quote val))))
+ ''lisp-indent-function (if (numberp val)
+ val
+ (list 'quote val)))))
(defalias 'byte-run--set-speed
#'(lambda (f _args val)
@@ -201,6 +276,75 @@ This is used by `declare'.")
(list 'function-put (list 'quote name)
''no-font-lock-keyword (list 'quote val))))
+(defalias 'byte-run--parse-body
+ #'(lambda (body allow-interactive)
+ "Decompose BODY into (DOCSTRING DECLARE INTERACTIVE BODY-REST WARNINGS)."
+ (let* ((top body)
+ (docstring nil)
+ (declare-form nil)
+ (interactive-form nil)
+ (warnings nil)
+ (warn #'(lambda (msg form)
+ (push (macroexp-warn-and-return msg nil nil t form)
+ warnings))))
+ (while
+ (and body
+ (let* ((form (car body))
+ (head (car-safe form)))
+ (cond
+ ((or (and (stringp form) (cdr body))
+ (eq head :documentation))
+ (cond
+ (docstring (funcall warn "More than one doc string" top))
+ (declare-form
+ (funcall warn "Doc string after `declare'" declare-form))
+ (interactive-form
+ (funcall warn "Doc string after `interactive'"
+ interactive-form))
+ (t (setq docstring form)))
+ t)
+ ((eq head 'declare)
+ (cond
+ (declare-form
+ (funcall warn "More than one `declare' form" form))
+ (interactive-form
+ (funcall warn "`declare' after `interactive'" form))
+ (t (setq declare-form form)))
+ t)
+ ((eq head 'interactive)
+ (cond
+ ((not allow-interactive)
+ (funcall warn "No `interactive' form allowed here" form))
+ (interactive-form
+ (funcall warn "More than one `interactive' form" form))
+ (t (setq interactive-form form)))
+ t))))
+ (setq body (cdr body)))
+ (list docstring declare-form interactive-form body warnings))))
+
+(defalias 'byte-run--parse-declarations
+ #'(lambda (name arglist clauses construct declarations-alist)
+ (let* ((cl-decls nil)
+ (actions
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) declarations-alist))))
+ (cond
+ (f (apply (car f) name arglist (cdr x)))
+ ;; Yuck!!
+ ((and (featurep 'cl)
+ (memq (car x) ;C.f. cl--do-proclaim.
+ '(special inline notinline optimize warn)))
+ (push (list 'declare x) cl-decls)
+ nil)
+ (t
+ (macroexp-warn-and-return
+ (format-message "Unknown %s property `%S'"
+ construct (car x))
+ nil nil nil (car x))))))
+ clauses)))
+ (cons actions cl-decls))))
+
(defvar macro-declarations-alist
(cons
(list 'debug #'byte-run--set-debug)
@@ -218,7 +362,7 @@ This is used by `declare'.")
(defalias 'defmacro
(cons
'macro
- #'(lambda (name arglist &optional docstring &rest body)
+ #'(lambda (name arglist &rest body)
"Define NAME as a macro.
When the macro is called, as in (NAME ARGS...),
the function (lambda ARGLIST BODY...) is applied to
@@ -229,116 +373,73 @@ DECLS is a list of elements of the form (PROP . VALUES). These are
interpreted according to `macro-declarations-alist'.
The return value is undefined.
-\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
- ;; We can't just have `decl' as an &optional argument, because we need
- ;; to distinguish
- ;; (defmacro foo (arg) (bar) nil)
- ;; from
- ;; (defmacro foo (arg) (bar)).
- (let ((decls (cond
- ((eq (car-safe docstring) 'declare)
- (prog1 (cdr docstring) (setq docstring nil)))
- ((and (stringp docstring)
- (eq (car-safe (car body)) 'declare))
- (prog1 (cdr (car body)) (setq body (cdr body)))))))
- (if docstring (setq body (cons docstring body))
- (if (null body) (setq body '(nil))))
- ;; Can't use backquote because it's not defined yet!
- (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
- (def (list 'defalias
- (list 'quote name)
- (list 'cons ''macro fun)))
- (declarations
- (mapcar
- #'(lambda (x)
- (let ((f (cdr (assq (car x) macro-declarations-alist))))
- (if f (apply (car f) name arglist (cdr x))
- (macroexp-warn-and-return
- (format-message
- "Unknown macro property %S in %S"
- (car x) name)
- nil))))
- decls)))
- ;; Refresh font-lock if this is a new macro, or it is an
- ;; existing macro whose 'no-font-lock-keyword declaration
- ;; has changed.
- (if (and
- ;; If lisp-mode hasn't been loaded, there's no reason
- ;; to flush.
- (fboundp 'lisp--el-font-lock-flush-elisp-buffers)
- (or (not (fboundp name)) ;; new macro
- (and (fboundp name) ;; existing macro
- (member `(function-put ',name 'no-font-lock-keyword
- ',(get name 'no-font-lock-keyword))
- declarations))))
- (lisp--el-font-lock-flush-elisp-buffers))
- (if declarations
- (cons 'prog1 (cons def declarations))
+\(fn NAME ARGLIST [DOCSTRING] [DECL] BODY...)"
+ (let* ((parse (byte-run--parse-body body nil))
+ (docstring (nth 0 parse))
+ (declare-form (nth 1 parse))
+ (body (nth 3 parse))
+ (warnings (nth 4 parse))
+ (declarations
+ (and declare-form (byte-run--parse-declarations
+ name arglist (cdr declare-form) 'macro
+ macro-declarations-alist))))
+ (setq body (nconc warnings body))
+ (setq body (nconc (cdr declarations) body))
+ (if docstring
+ (setq body (cons docstring body)))
+ (if (null body)
+ (setq body '(nil)))
+ (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
+ (def (list 'defalias
+ (list 'quote name)
+ (list 'cons ''macro fun))))
+ (if declarations
+ (cons 'prog1 (cons def (car declarations)))
def))))))
;; Now that we defined defmacro we can use it!
-(defmacro defun (name arglist &optional docstring &rest body)
+(defmacro defun (name arglist &rest body)
"Define NAME as a function.
-The definition is (lambda ARGLIST [DOCSTRING] BODY...).
-See also the function `interactive'.
+The definition is (lambda ARGLIST [DOCSTRING] [INTERACTIVE] BODY...).
DECL is a declaration, optional, of the form (declare DECLS...) where
DECLS is a list of elements of the form (PROP . VALUES). These are
interpreted according to `defun-declarations-alist'.
+INTERACTIVE is an optional `interactive' specification.
The return value is undefined.
-\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
- ;; We can't just have `decl' as an &optional argument, because we need
- ;; to distinguish
- ;; (defun foo (arg) (toto) nil)
- ;; from
- ;; (defun foo (arg) (toto)).
+\(fn NAME ARGLIST [DOCSTRING] [DECL] [INTERACTIVE] BODY...)"
(declare (doc-string 3) (indent 2))
(or name (error "Cannot define '%s' as a function" name))
(if (null
(and (listp arglist)
(null (delq t (mapcar #'symbolp arglist)))))
(error "Malformed arglist: %s" arglist))
- (let ((decls (cond
- ((eq (car-safe docstring) 'declare)
- (prog1 (cdr docstring) (setq docstring nil)))
- ((and (stringp docstring)
- (eq (car-safe (car body)) 'declare))
- (prog1 (cdr (car body)) (setq body (cdr body)))))))
- (if docstring (setq body (cons docstring body))
- (if (null body) (setq body '(nil))))
- (let ((declarations
- (mapcar
- #'(lambda (x)
- (let ((f (cdr (assq (car x) defun-declarations-alist))))
- (cond
- (f (apply (car f) name arglist (cdr x)))
- ;; Yuck!!
- ((and (featurep 'cl)
- (memq (car x) ;C.f. cl-do-proclaim.
- '(special inline notinline optimize warn)))
- (push (list 'declare x)
- (if (stringp docstring)
- (if (eq (car-safe (cadr body)) 'interactive)
- (cddr body)
- (cdr body))
- (if (eq (car-safe (car body)) 'interactive)
- (cdr body)
- body)))
- nil)
- (t
- (macroexp-warn-and-return
- (format-message "Unknown defun property `%S' in %S"
- (car x) name)
- nil)))))
- decls))
- (def (list 'defalias
+ (let* ((parse (byte-run--parse-body body t))
+ (docstring (nth 0 parse))
+ (declare-form (nth 1 parse))
+ (interactive-form (nth 2 parse))
+ (body (nth 3 parse))
+ (warnings (nth 4 parse))
+ (declarations
+ (and declare-form (byte-run--parse-declarations
+ name arglist (cdr declare-form) 'defun
+ defun-declarations-alist))))
+ (setq body (nconc warnings body))
+ (setq body (nconc (cdr declarations) body))
+ (if interactive-form
+ (setq body (cons interactive-form body)))
+ (if docstring
+ (setq body (cons docstring body)))
+ (if (null body)
+ (setq body '(nil)))
+ (let ((def (list 'defalias
(list 'quote name)
(list 'function
(cons 'lambda
(cons arglist body))))))
(if declarations
- (cons 'prog1 (cons def declarations))
- def))))
+ (cons 'prog1 (cons def (car declarations)))
+ def))))
;; Redefined in byte-opt.el.
@@ -380,7 +481,7 @@ You don't need this. (See bytecomp.el commentary for more details.)
"Define an inline function. The syntax is just like that of `defun'.
\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
- (declare (debug defun) (doc-string 3))
+ (declare (debug defun) (doc-string 3) (indent 2))
(or (memq (get name 'byte-optimizer)
'(nil byte-compile-inline-expand))
(error "`%s' is a primitive" name))
@@ -434,7 +535,7 @@ WHEN should be a string indicating when the function was first
made obsolete, for example a date or a release number.
See the docstrings of `defalias' and `make-obsolete' for more details."
- (declare (doc-string 4))
+ (declare (doc-string 4) (indent defun))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
@@ -463,7 +564,7 @@ made obsolete, for example a date or a release number.
This macro evaluates all its parameters, and both OBSOLETE-NAME
and CURRENT-NAME should be symbols, so a typical usage would look like:
- (define-obsolete-variable-alias 'foo-thing 'bar-thing \"28.1\")
+ (define-obsolete-variable-alias \\='foo-thing \\='bar-thing \"28.1\")
This macro uses `defvaralias' and `make-obsolete-variable' (which see).
See the Info node `(elisp)Variable Aliases' for more details.
@@ -483,7 +584,7 @@ For the benefit of Customize, if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
`saved-value', `saved-variable-comment'."
- (declare (doc-string 4))
+ (declare (doc-string 4) (indent defun))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.
@@ -574,7 +675,7 @@ For the `mapcar' case, only the `mapcar' function can be used in
the symbol list. For `suspicious', only `set-buffer' can be used."
;; Note: during compilation, this definition is overridden by the one in
;; byte-compile-initial-macro-environment.
- (declare (debug (sexp &optional body)) (indent 1))
+ (declare (debug (sexp body)) (indent 1))
(if (not (and (featurep 'macroexp)
(boundp 'byte-compile--suppressed-warnings)))
;; If `macroexp' is not yet loaded, we're in the middle of
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 7629e190401..8df4133b6b0 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -244,11 +244,6 @@ the functions you loaded will not be able to run.")
(make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1")
;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
-(defvar byte-compile-disable-print-circle nil
- "If non-nil, disable `print-circle' on printing a byte-compiled code.")
-(make-obsolete-variable 'byte-compile-disable-print-circle nil "24.1")
-;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
-
(defcustom byte-compile-dynamic-docstrings t
"If non-nil, compile doc strings for lazy access.
We bury the doc strings of functions and variables inside comments in
@@ -299,10 +294,10 @@ The information is logged to `byte-compile-log-buffer'."
'(redefine callargs free-vars unresolved
obsolete noruntime interactive-only
make-local mapcar constants suspicious lexical lexical-dynamic
- docstrings)
+ docstrings docstrings-non-ascii-quotes not-unused)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
- "List of warnings that the byte-compiler should issue (t for all).
+ "List of warnings that the byte-compiler should issue (t for almost all).
Elements of the list may be:
@@ -321,19 +316,34 @@ Elements of the list may be:
lexically bound variable declared dynamic elsewhere
make-local calls to `make-variable-buffer-local' that may be incorrect.
mapcar mapcar called for effect.
+ not-unused warning about using variables with symbol names starting with _.
constants let-binding of, or assignment to, constants/nonvariables.
docstrings docstrings that are too wide (longer than
`byte-compile-docstring-max-column' or
- `fill-column' characters, whichever is bigger).
+ `fill-column' characters, whichever is bigger) or
+ have other stylistic issues.
+ docstrings-non-ascii-quotes docstrings that have non-ASCII quotes.
+ This depends on the `docstrings' warning type.
suspicious constructs that usually don't do what the coder wanted.
If the list begins with `not', then the remaining elements specify warnings to
-suppress. For example, (not mapcar) will suppress warnings about mapcar."
+suppress. For example, (not mapcar) will suppress warnings about mapcar.
+
+The t value means \"all non experimental warning types\", and
+excludes the types in `byte-compile--emacs-build-warning-types'.
+A value of `all' really means all."
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
,@(mapcar (lambda (x) `(const ,x))
byte-compile-warning-types))))
+(defconst byte-compile--emacs-build-warning-types
+ '(docstrings-non-ascii-quotes)
+ "List of warning types that are only enabled during Emacs builds.
+This is typically either warning types that are being phased in
+(but shouldn't be enabled for packages yet), or that are only relevant
+for the Emacs build itself.")
+
(defvar byte-compile--suppressed-warnings nil
"Dynamically bound by `with-suppressed-warnings' to suppress warnings.")
@@ -343,6 +353,7 @@ suppress. For example, (not mapcar) will suppress warnings about mapcar."
(or (symbolp v)
(null (delq nil (mapcar (lambda (x) (not (symbolp x))) v))))))
+;;;###autoload
(defun byte-compile-warning-enabled-p (warning &optional symbol)
"Return non-nil if WARNING is enabled, according to `byte-compile-warnings'."
(let ((suppress nil))
@@ -351,10 +362,15 @@ suppress. For example, (not mapcar) will suppress warnings about mapcar."
(memq symbol (cdr elem)))
(setq suppress t)))
(and (not suppress)
- (or (eq byte-compile-warnings t)
- (if (eq (car byte-compile-warnings) 'not)
- (not (memq warning byte-compile-warnings))
- (memq warning byte-compile-warnings))))))
+ ;; During an Emacs build, we want all warnings.
+ (or (eq byte-compile-warnings 'all)
+ ;; If t, we want almost all the warnings, but not the
+ ;; ones that are Emacs build specific.
+ (and (not (memq warning byte-compile--emacs-build-warning-types))
+ (or (eq byte-compile-warnings t)
+ (if (eq (car byte-compile-warnings) 'not)
+ (not (memq warning byte-compile-warnings))
+ (memq warning byte-compile-warnings))))))))
;;;###autoload
(defun byte-compile-disable-warning (warning)
@@ -466,9 +482,10 @@ Return the compile-time value of FORM."
;; 3.2.3.1, "Processing of Top Level Forms". The semantics are very
;; subtle: see test/lisp/emacs-lisp/bytecomp-tests.el for interesting
;; cases.
- (setf form (macroexp-macroexpand form byte-compile-macro-environment))
+ (let ((print-symbols-bare t)) ; Possibly redundant binding.
+ (setf form (macroexp-macroexpand form byte-compile-macro-environment)))
(if (eq (car-safe form) 'progn)
- (cons 'progn
+ (cons (car form)
(mapcar (lambda (subform)
(byte-compile-recurse-toplevel
subform non-toplevel-case))
@@ -497,8 +514,9 @@ Return the compile-time value of FORM."
byte-compile-new-defuns))
(setf result
(byte-compile-eval
- (byte-compile-top-level
- (byte-compile-preprocess form)))))))
+ (byte-run-strip-symbol-positions
+ (byte-compile-top-level
+ (byte-compile-preprocess form))))))))
(list 'quote result))))
(eval-and-compile . ,(lambda (&rest body)
(byte-compile-recurse-toplevel
@@ -507,10 +525,12 @@ Return the compile-time value of FORM."
;; Don't compile here, since we don't know
;; whether to compile as byte-compile-form
;; or byte-compile-file-form.
- (let ((expanded
- (macroexpand-all
- form
- macroexpand-all-environment)))
+ (let* ((print-symbols-bare t) ; Possibly redundant binding.
+ (expanded
+ (byte-run-strip-symbol-positions
+ (macroexpand--all-toplevel
+ form
+ macroexpand-all-environment))))
(eval expanded lexical-binding)
expanded)))))
(with-suppressed-warnings
@@ -613,8 +633,8 @@ Each element is (INDEX . VALUE)")
"Hash byte-code -> byte-to-native-lambda.")
(defvar byte-to-native-top-level-forms nil
"List of top level forms.")
-(defvar byte-to-native-output-file nil
- "Temporary file containing the byte-compilation output.")
+(defvar byte-to-native-output-buffer-file nil
+ "Pair holding byte-compilation output buffer, elc filename.")
(defvar byte-to-native-plist-environment nil
"To spill `overriding-plist-environment'.")
@@ -656,10 +676,13 @@ Each element is (INDEX . VALUE)")
(put 'byte-stack+-info 'tmp-compile-time-value nil)))
-;; These opcodes are special in that they pack their argument into the
-;; opcode word.
-;;
+;; The following opcodes (1-47) use the 3 lowest bits for an immediate
+;; argument.
+
(byte-defop 0 1 byte-stack-ref "for stack reference")
+;; Code 0 is actually unused but reserved as invalid code for detecting
+;; corrupted bytecode. Codes 1-7 are stack-ref.
+
(byte-defop 8 1 byte-varref "for variable reference")
(byte-defop 16 -1 byte-varset "for setting a variable")
(byte-defop 24 -1 byte-varbind "for binding a variable")
@@ -667,11 +690,9 @@ Each element is (INDEX . VALUE)")
(byte-defop 40 0 byte-unbind "for unbinding special bindings")
;; codes 8-47 are consumed by the preceding opcodes
-;; New (in Emacs-24.4) bytecodes for more efficient handling of non-local exits
-;; (especially useful in lexical-binding code).
(byte-defop 48 0 byte-pophandler)
-(byte-defop 50 -1 byte-pushcatch)
(byte-defop 49 -1 byte-pushconditioncase)
+(byte-defop 50 -1 byte-pushcatch)
;; unused: 51-55
@@ -694,9 +715,9 @@ Each element is (INDEX . VALUE)")
(byte-defop 72 -1 byte-aref)
(byte-defop 73 -2 byte-aset)
(byte-defop 74 0 byte-symbol-value)
-(byte-defop 75 0 byte-symbol-function) ; this was commented out
+(byte-defop 75 0 byte-symbol-function)
(byte-defop 76 -1 byte-set)
-(byte-defop 77 -1 byte-fset) ; this was commented out
+(byte-defop 77 -1 byte-fset)
(byte-defop 78 -1 byte-get)
(byte-defop 79 -2 byte-substring)
(byte-defop 80 -1 byte-concat2)
@@ -714,8 +735,9 @@ Each element is (INDEX . VALUE)")
(byte-defop 92 -1 byte-plus)
(byte-defop 93 -1 byte-max)
(byte-defop 94 -1 byte-min)
-(byte-defop 95 -1 byte-mult) ; v19 only
+(byte-defop 95 -1 byte-mult)
(byte-defop 96 1 byte-point)
+(byte-defop 97 0 byte-save-current-buffer-OBSOLETE) ; unused since v20
(byte-defop 98 0 byte-goto-char)
(byte-defop 99 0 byte-insert)
(byte-defop 100 1 byte-point-max)
@@ -737,7 +759,6 @@ Each element is (INDEX . VALUE)")
(byte-defop 115 0 byte-set-mark-OBSOLETE)
(byte-defop 116 1 byte-interactive-p-OBSOLETE)
-;; These ops are new to v19
(byte-defop 117 0 byte-forward-char)
(byte-defop 118 0 byte-forward-word)
(byte-defop 119 -1 byte-skip-chars-forward)
@@ -792,13 +813,8 @@ the unwind-action")
(byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE)
(byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE)
-;; these ops are new to v19
+;; unused: 146
-;; To unbind back to the beginning of this frame.
-;; Not used yet, but will be needed for tail-recursion elimination.
-(byte-defop 146 0 byte-unbind-all)
-
-;; these ops are new to v19
(byte-defop 147 -2 byte-set-marker)
(byte-defop 148 0 byte-match-beginning)
(byte-defop 149 0 byte-match-end)
@@ -845,10 +861,11 @@ the unwind-action")
"to take a hash table and a value from the stack, and jump to
the address the value maps to, if any.")
-;; unused: 182-191
+;; unused: 184-191
(byte-defop 192 1 byte-constant "for reference to a constant")
-;; codes 193-255 are consumed by byte-constant.
+;; Codes 193-255 are consumed by `byte-constant', which uses the 6
+;; lowest bits for an immediate argument.
(defconst byte-constant-limit 64
"Exclusive maximum index usable in the `byte-constant' opcode.")
@@ -1007,13 +1024,22 @@ CONST2 may be evaluated multiple times."
;; Similarly, replace TAGs in all jump tables with the correct PC index.
(dolist (hash-table byte-compile-jump-tables)
- (maphash #'(lambda (value tag)
- (setq pc (cadr tag))
- ;; We don't need to split PC here, as it is stored as a lisp
- ;; object in the hash table (whereas other goto-* ops store
- ;; it within 2 bytes in the byte string).
- (puthash value pc hash-table))
- hash-table))
+ (let (alist)
+ (maphash #'(lambda (value tag)
+ (setq pc (cadr tag))
+ ;; We don't need to split PC here, as it is stored as a
+ ;; lisp object in the hash table (whereas other goto-*
+ ;; ops store it within 2 bytes in the byte string).
+ ;; De-position any symbols with position in `value'.
+ ;; Since this may change the hash table key, we remove
+ ;; the entry from the table and reinsert it outside the
+ ;; scope of the `maphash'.
+ (setq value (byte-run-strip-symbol-positions value))
+ (push (cons value pc) alist)
+ (remhash value hash-table))
+ hash-table)
+ (dolist (elt alist)
+ (puthash (car elt) (cdr elt) hash-table))))
(let ((bytecode (apply 'unibyte-string (nreverse bytes))))
(when byte-native-compiling
;; Spill LAP for the native compiler here.
@@ -1031,30 +1057,29 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(hist-nil-orig current-load-list))
(prog1 (eval form lexical-binding)
(when (byte-compile-warning-enabled-p 'noruntime)
- (let ((hist-new load-history)
- (hist-nil-new current-load-list))
+ (let* ((hist-new
+ ;; Get new `current-load-list' for the locally defined funs.
+ (cons (butlast current-load-list
+ (length hist-nil-orig))
+ load-history)))
;; Go through load-history, look for newly loaded files
;; and mark all the functions defined therein.
(while (and hist-new (not (eq hist-new hist-orig)))
- (let ((xs (pop hist-new))
- old-autoloads)
+ (let ((xs (pop hist-new)))
;; Make sure the file was not already loaded before.
(unless (assoc (car xs) hist-orig)
(dolist (s xs)
- (cond
- ((and (consp s) (eq t (car s)))
- (push (cdr s) old-autoloads))
- ((and (consp s) (memq (car s) '(autoload defun)))
- (unless (memq (cdr s) old-autoloads)
- (push (cdr s) byte-compile-noruntime-functions))))))))
- ;; Go through current-load-list for the locally defined funs.
- (let (old-autoloads)
- (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
- (let ((s (pop hist-nil-new)))
- (when (and (symbolp s) (not (memq s old-autoloads)))
- (push s byte-compile-noruntime-functions))
- (when (and (consp s) (eq t (car s)))
- (push (cdr s) old-autoloads))))))))))
+ (pcase s
+ (`(defun . ,f)
+ ;; If `f' has a history, it's presumably because
+ ;; it was already defined beforehand (typically
+ ;; as an autoload). It could also be because it
+ ;; was defined twice during `form', in which case
+ ;; we arguably should add it to b-c-noruntime-functions,
+ ;; but it's not clear it's worth the trouble
+ ;; trying to recognize that case.
+ (unless (get f 'function-history)
+ (push f byte-compile-noruntime-functions)))))))))))))
(defun byte-compile-eval-before-compile (form)
"Evaluate FORM for `eval-and-compile'."
@@ -1093,10 +1118,8 @@ message buffer `default-directory'."
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
-(defvar emacs-lisp-compilation-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "g" 'emacs-lisp-compilation-recompile)
- map))
+(defvar-keymap emacs-lisp-compilation-mode-map
+ "g" #'emacs-lisp-compilation-recompile)
(defvar emacs-lisp-compilation--current-file nil)
@@ -1145,60 +1168,6 @@ message buffer `default-directory'."
(t
(insert (format "%s\n" string)))))))
-(defvar byte-compile-read-position nil
- "Character position we began the last `read' from.")
-(defvar byte-compile-last-position nil
- "Last known character position in the input.")
-
-;; copied from gnus-util.el
-(defsubst byte-compile-delete-first (elt list)
- (if (eq (car list) elt)
- (cdr list)
- (let ((total list))
- (while (and (cdr list)
- (not (eq (cadr list) elt)))
- (setq list (cdr list)))
- (when (cdr list)
- (setcdr list (cddr list)))
- total)))
-
-;; The purpose of `byte-compile-set-symbol-position' is to attempt to
-;; set `byte-compile-last-position' to the "current position" in the
-;; raw source code. This is used for warning and error messages.
-;;
-;; The function should be called for most occurrences of symbols in
-;; the forms being compiled, strictly in the order they occur in the
-;; source code. It should never be called twice for any single
-;; occurrence, and should not be called for symbols generated by the
-;; byte compiler itself.
-;;
-;; The function works by scanning the elements in the alist
-;; `read-symbol-positions-list' for the next match for the symbol
-;; after the current value of `byte-compile-last-position', setting
-;; that variable to the match's character position, then deleting the
-;; matching element from the list. Thus the new value for
-;; `byte-compile-last-position' is later than the old value unless,
-;; perhaps, ALLOW-PREVIOUS is non-nil.
-;;
-;; So your're probably asking yourself: Isn't this function a gross
-;; hack? And the answer, of course, would be yes.
-(defun byte-compile-set-symbol-position (sym &optional allow-previous)
- (when byte-compile-read-position
- (let ((last byte-compile-last-position)
- entry)
- (while (progn
- (setq entry (assq sym read-symbol-positions-list))
- (when entry
- (setq byte-compile-last-position
- (+ byte-compile-read-position (cdr entry))
- read-symbol-positions-list
- (byte-compile-delete-first
- entry read-symbol-positions-list)))
- (and entry
- (or (and allow-previous
- (not (= last byte-compile-last-position)))
- (> last byte-compile-last-position))))))))
-
(defvar byte-compile-last-warned-form nil)
(defvar byte-compile-last-logged-file nil)
(defvar byte-compile-root-dir nil
@@ -1211,6 +1180,36 @@ message buffer `default-directory'."
(f2 (file-relative-name file dir)))
(if (< (length f2) (length f1)) f2 f1)))
+(defun byte-compile--first-symbol-with-pos (form)
+ "Return the first symbol with position in form, or nil if none.
+Order is by depth-first search."
+ (cond
+ ((symbol-with-pos-p form) form)
+ ((consp form)
+ (or (byte-compile--first-symbol-with-pos (car form))
+ (let ((sym nil))
+ (setq form (cdr form))
+ (while (and (consp form)
+ (not (setq sym (byte-compile--first-symbol-with-pos
+ (car form)))))
+ (setq form (cdr form)))
+ (or sym
+ (and form (byte-compile--first-symbol-with-pos form))))))
+ ((or (vectorp form) (recordp form))
+ (let ((len (length form))
+ (i 0)
+ (sym nil))
+ (while (and (< i len)
+ (not (setq sym (byte-compile--first-symbol-with-pos
+ (aref form i)))))
+ (setq i (1+ i)))
+ sym))))
+
+(defun byte-compile--warning-source-offset ()
+ "Return a source offset from `byte-compile-form-stack' or nil if none."
+ (let ((sym (byte-compile--first-symbol-with-pos byte-compile-form-stack)))
+ (and sym (symbol-with-pos-pos sym))))
+
;; This is used as warning-prefix for the compiler.
;; It is always called with the warnings buffer current.
(defun byte-compile-warning-prefix (level entry)
@@ -1228,16 +1227,15 @@ message buffer `default-directory'."
(format "%s:" (byte-compile-abbreviate-file
load-file-name dir)))
(t "")))
- (pos (if (and byte-compile-current-file
- (integerp byte-compile-read-position))
+ (offset (byte-compile--warning-source-offset))
+ (pos (if (and byte-compile-current-file offset)
(with-current-buffer byte-compile-current-buffer
- (format "%d:%d:"
- (save-excursion
- (goto-char byte-compile-last-position)
- (1+ (count-lines (point-min) (point-at-bol))))
- (save-excursion
- (goto-char byte-compile-last-position)
- (1+ (current-column)))))
+ (let (new-l new-c)
+ (save-excursion
+ (goto-char offset)
+ (setq new-l (1+ (count-lines (point-min) (point-at-bol)))
+ new-c (1+ (current-column)))
+ (format "%d:%d:" new-l new-c))))
""))
(form (if (eq byte-compile-current-form :end) "end of data"
(or byte-compile-current-form "toplevel form"))))
@@ -1312,20 +1310,21 @@ Called with arguments (STRING POSITION FILL LEVEL). STRING is a
message describing the problem. POSITION is a buffer position
where the problem was detected. FILL is a prefix as in
`warning-fill-prefix'. LEVEL is the level of the
-problem (`:warning' or `:error'). POSITION, FILL and LEVEL may be
-nil.")
+problem (`:warning' or `:error'). FILL and LEVEL may be nil.")
(defun byte-compile-log-warning (string &optional fill level)
"Log a byte-compilation warning.
STRING, FILL and LEVEL are as described in
`byte-compile-log-warning-function', which see."
(funcall byte-compile-log-warning-function
- string byte-compile-last-position
+ string
+ (or (byte-compile--warning-source-offset)
+ (point))
fill
level))
-(defun byte-compile--log-warning-for-byte-compile (string &optional
- _position
+(defun byte-compile--log-warning-for-byte-compile (string _position
+ &optional
fill
level)
"Log a message STRING in `byte-compile-log-buffer'.
@@ -1346,6 +1345,14 @@ function directly; use `byte-compile-warn' or
(error "%s" format) ; byte-compile-file catches and logs it
(byte-compile-log-warning format t :warning)))
+(defun byte-compile-warn-x (arg format &rest args)
+ "Issue a byte compiler warning.
+ARG is the source element (likely a symbol with position) central to
+ the warning, intended to supply source position information.
+FORMAT and ARGS are as in `byte-compile-warn'."
+ (let ((byte-compile-form-stack (cons arg byte-compile-form-stack)))
+ (apply #'byte-compile-warn format args)))
+
(defun byte-compile-warn-obsolete (symbol)
"Warn that SYMBOL (a variable or function) is obsolete."
(when (byte-compile-warning-enabled-p 'obsolete symbol)
@@ -1355,7 +1362,7 @@ function directly; use `byte-compile-warn' or
(or funcp (get symbol 'byte-obsolete-variable))
(if funcp "function" "variable"))))
(unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
- (byte-compile-warn "%s" msg)))))
+ (byte-compile-warn-x symbol "%s" msg)))))
(defun byte-compile-report-error (error-info &optional fill)
"Report Lisp error in compilation.
@@ -1433,7 +1440,7 @@ when printing the error message."
(and (eq 'macro (car-safe f)) (setq f (cdr f)))
;; Advice wrappers have "catch all" args, so fetch the actual underlying
;; function to find the real arguments.
- (while (advice--p f) (setq f (advice--cdr f)))
+ (setq f (advice--cd*r f))
(if (eq (car-safe f) 'declared)
(byte-compile-arglist-signature (nth 1 f))
(condition-case nil
@@ -1458,7 +1465,6 @@ when printing the error message."
(t (format "%d-%d" (car signature) (cdr signature)))))
(defun byte-compile-function-warn (f nargs def)
- (byte-compile-set-symbol-position f)
(when (and (get f 'byte-obsolete-info)
(byte-compile-warning-enabled-p 'obsolete f))
(byte-compile-warn-obsolete f))
@@ -1475,19 +1481,24 @@ when printing the error message."
(if cons
(or (memq nargs (cddr cons))
(push nargs (cddr cons)))
- (push (list f byte-compile-last-position nargs)
+ (push (list f
+ (if (symbol-with-pos-p f)
+ (symbol-with-pos-pos f)
+ 1) ; Should never happen.
+ nargs)
byte-compile-unresolved-functions)))))
(defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
- (byte-compile-set-symbol-position name)
- (byte-compile-warn
- "%s called with %d argument%s, but %s %s"
- name actual-args
- (if (= 1 actual-args) "" "s")
- (if (< actual-args min-args)
- "requires"
- "accepts only")
- (byte-compile-arglist-signature-string (cons min-args max-args))))
+ (when (byte-compile-warning-enabled-p 'callargs name)
+ (byte-compile-warn-x
+ name
+ "`%s' called with %d argument%s, but %s %s"
+ name actual-args
+ (if (= 1 actual-args) "" "s")
+ (if (< actual-args min-args)
+ "requires"
+ "accepts only")
+ (byte-compile-arglist-signature-string (cons min-args max-args)))))
(defun byte-compile--check-arity-bytecode (form bytecode)
"Check that the call in FORM matches that allowed by BYTECODE."
@@ -1546,22 +1557,46 @@ extra args."
n)))
(nargs (- (length form) 2)))
(unless (= nargs nfields)
- (byte-compile-warn
+ (byte-compile-warn-x (car form)
"`%s' called with %d args to fill %d format field(s)" (car form)
nargs nfields)))))
(dolist (elt '(format message error))
(put elt 'byte-compile-format-like t))
+(defun byte-compile--suspicious-defcustom-choice (type)
+ "Say whether defcustom TYPE looks odd."
+ ;; Check whether there's anything like (choice (const :tag "foo" ;; 'bar)).
+ ;; We don't actually follow the syntax for defcustom types, but this
+ ;; should be good enough.
+ (catch 'found
+ (if (and (consp type)
+ (proper-list-p type))
+ (if (memq (car type) '(const other))
+ (when (assq 'quote type)
+ (throw 'found t))
+ (when (memq t (mapcar #'byte-compile--suspicious-defcustom-choice
+ type))
+ (throw 'found t)))
+ nil)))
+
;; Warn if a custom definition fails to specify :group, or :type.
(defun byte-compile-nogroup-warn (form)
(let ((keyword-args (cdr (cdr (cdr (cdr form)))))
(name (cadr form)))
(when (eq (car-safe name) 'quote)
- (or (not (eq (car form) 'custom-declare-variable))
- (plist-get keyword-args :type)
- (byte-compile-warn
- "defcustom for `%s' fails to specify type" (cadr name)))
+ (when (eq (car form) 'custom-declare-variable)
+ (let ((type (plist-get keyword-args :type)))
+ (cond
+ ((not type)
+ (byte-compile-warn-x (cadr name)
+ "defcustom for `%s' fails to specify type"
+ (cadr name)))
+ ((byte-compile--suspicious-defcustom-choice type)
+ (byte-compile-warn-x
+ (cadr name)
+ "defcustom for `%s' has syntactically odd type `%s'"
+ (cadr name) type)))))
(if (and (memq (car form) '(custom-declare-face custom-declare-variable))
byte-compile-current-group)
;; The group will be provided implicitly.
@@ -1569,7 +1604,7 @@ extra args."
(or (and (eq (car form) 'custom-declare-group)
(equal name ''emacs))
(plist-get keyword-args :group)
- (byte-compile-warn
+ (byte-compile-warn-x (cadr name)
"%s for `%s' fails to specify containing group"
(cdr (assq (car form)
'((custom-declare-group . defgroup)
@@ -1585,32 +1620,31 @@ extra args."
;; number of arguments.
(defun byte-compile-arglist-warn (name arglist macrop)
;; This is the first definition. See if previous calls are compatible.
- (let ((calls (assq name byte-compile-unresolved-functions))
- nums sig min max)
- (when (and calls macrop)
- (byte-compile-warn "macro `%s' defined too late" name))
- (setq byte-compile-unresolved-functions
- (delq calls byte-compile-unresolved-functions))
- (setq calls (delq t calls)) ;Ignore higher-order uses of the function.
- (when (cddr calls)
- (when (and (symbolp name)
- (eq (function-get name 'byte-optimizer)
- 'byte-compile-inline-expand))
- (byte-compile-warn "defsubst `%s' was used before it was defined"
- name))
- (setq sig (byte-compile-arglist-signature arglist)
- nums (sort (copy-sequence (cddr calls)) (function <))
- min (car nums)
- max (car (nreverse nums)))
- (when (or (< min (car sig))
- (and (cdr sig) (> max (cdr sig))))
- (byte-compile-set-symbol-position name)
- (byte-compile-warn
- "%s being defined to take %s%s, but was previously called with %s"
- name
- (byte-compile-arglist-signature-string sig)
- (if (equal sig '(1 . 1)) " arg" " args")
- (byte-compile-arglist-signature-string (cons min max))))))
+ (let ((calls (assq name byte-compile-unresolved-functions)))
+ (when calls
+ (when macrop
+ (byte-compile-warn-x name "macro `%s' defined too late" name))
+ (setq byte-compile-unresolved-functions
+ (delq calls byte-compile-unresolved-functions))
+ (let ((nums (delq t (cddr calls)))) ; Ignore higher-order uses.
+ (when nums
+ (when (and (symbolp name)
+ (eq (function-get name 'byte-optimizer)
+ 'byte-compile-inline-expand))
+ (byte-compile-warn-x
+ name "defsubst `%s' was used before it was defined" name))
+ (let ((sig (byte-compile-arglist-signature arglist))
+ (min (apply #'min nums))
+ (max (apply #'max nums)))
+ (when (or (< min (car sig))
+ (and (cdr sig) (> max (cdr sig))))
+ (byte-compile-warn-x
+ name
+ "%s being defined to take %s%s, but was previously called with %s"
+ name
+ (byte-compile-arglist-signature-string sig)
+ (if (equal sig '(1 . 1)) " arg" " args")
+ (byte-compile-arglist-signature-string (cons min max)))))))))
(let* ((old (byte-compile-fdefinition name macrop))
(initial (and macrop
(cdr (assq name
@@ -1623,8 +1657,8 @@ extra args."
(let ((sig1 (byte-compile--function-signature old))
(sig2 (byte-compile-arglist-signature arglist)))
(unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
- (byte-compile-set-symbol-position name)
- (byte-compile-warn
+ (byte-compile-warn-x
+ name
"%s %s used to take %s %s, now takes %s"
(if macrop "macro" "function")
name
@@ -1671,9 +1705,14 @@ URLs."
;; known at compile time. So instead, we assume that these
;; substitutions are of some length N.
(replace-regexp-in-string
- (rx "\\" (or (seq "[" (* (not "]")) "]")))
+ (rx "\\[" (* (not "]")) "]")
(make-string byte-compile--wide-docstring-substitution-len ?x)
- docstring))))
+ ;; For literal key sequence substitutions (e.g. "\\`C-h'"), just
+ ;; remove the markup as `substitute-command-keys' would.
+ (replace-regexp-in-string
+ (rx "\\`" (group (* (not "'"))) "'")
+ "\\1"
+ docstring)))))
(defcustom byte-compile-docstring-max-column 80
"Recommended maximum width of doc string lines.
@@ -1681,12 +1720,16 @@ The byte-compiler will emit a warning for documentation strings
containing lines wider than this. If `fill-column' has a larger
value, it will override this variable."
:group 'bytecomp
- :type 'integer
- :safe #'integerp
+ :type 'natnum
+ :safe #'natnump
:version "28.1")
-(defun byte-compile-docstring-length-warn (form)
- "Warn if documentation string of FORM is too wide.
+(define-obsolete-function-alias 'byte-compile-docstring-length-warn
+ 'byte-compile-docstring-style-warn "29.1")
+
+(defun byte-compile-docstring-style-warn (form)
+ "Warn if there are stylistic problems with the docstring in FORM.
+Warn if documentation string of FORM is too wide.
It is too wide if it has any lines longer than the largest of
`fill-column' and `byte-compile-docstring-max-column'."
(when (byte-compile-warning-enabled-p 'docstrings)
@@ -1695,7 +1738,8 @@ It is too wide if it has any lines longer than the largest of
(pcase (car form)
((or 'autoload 'custom-declare-variable 'defalias
'defconst 'define-abbrev-table
- 'defvar 'defvaralias)
+ 'defvar 'defvaralias
+ 'custom-declare-face)
(setq kind (nth 0 form))
(setq name (nth 1 form))
(setq docs (nth 3 form)))
@@ -1705,11 +1749,26 @@ It is too wide if it has any lines longer than the largest of
(nth 2 form)))))
(when (and (consp name) (eq (car name) 'quote))
(setq name (cadr name)))
- (setq name (if name (format " `%s'" name) ""))
- (when (and kind docs (stringp docs)
- (byte-compile--wide-docstring-p docs col))
- (byte-compile-warn "%s%s docstring wider than %s characters"
- kind name col))))
+ (setq name (if name (format " `%s' " name) ""))
+ (when (and kind docs (stringp docs))
+ (when (byte-compile--wide-docstring-p docs col)
+ (byte-compile-warn-x
+ name
+ "%s%sdocstring wider than %s characters"
+ kind name col))
+ ;; There's a "naked" ' character before a symbol/list, so it
+ ;; should probably be quoted with \=.
+ (when (string-match-p "\\( \"\\|[ \t]\\|^\\)'[a-z(]" docs)
+ (byte-compile-warn-x
+ name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)"
+ kind name))
+ ;; There's a "Unicode quote" in the string -- it should probably
+ ;; be an ASCII one instead.
+ (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes)
+ (when (string-match-p "\\( \"\\|[ \t]\\|^\\)[‘’]" docs)
+ (byte-compile-warn-x
+ name "%s%sdocstring has wrong usage of \"fancy\" single quotation marks"
+ kind name))))))
form)
;; If we have compiled any calls to functions which are not known to be
@@ -1723,10 +1782,10 @@ It is too wide if it has any lines longer than the largest of
(dolist (urf byte-compile-unresolved-functions)
(let ((f (car urf)))
(when (not (memq f byte-compile-new-defuns))
- (let ((byte-compile-last-position (cadr urf)))
- (byte-compile-warn
- (if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.")
- (car urf))))))))
+ (byte-compile-warn-x
+ f
+ (if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.")
+ (car urf)))))))
nil)
@@ -1782,7 +1841,8 @@ It is too wide if it has any lines longer than the largest of
(warning-series-started
(and (markerp warning-series)
(eq (marker-buffer warning-series)
- (get-buffer byte-compile-log-buffer)))))
+ (get-buffer byte-compile-log-buffer))))
+ (byte-compile-form-stack byte-compile-form-stack))
(if (or (eq warning-series 'byte-compile-warning-series)
warning-series-started)
;; warning-series does come from compilation,
@@ -1969,12 +2029,51 @@ If compilation is needed, this functions returns the result of
(defvar byte-compile-level 0 ; bug#13787
"Depth of a recursive byte compilation.")
+(defun byte-write-target-file (buffer target-file)
+ "Write BUFFER into TARGET-FILE."
+ (with-current-buffer buffer
+ ;; We must disable any code conversion here.
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile
+ (make-temp-file (when (file-writable-p target-file)
+ (expand-file-name target-file))))
+ (default-modes (default-file-modes))
+ (temp-modes (logand default-modes #o600))
+ (desired-modes (logand default-modes #o666))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors
+ (delete-file tempfile)))
+ kill-emacs-hook)))
+ (unless (= temp-modes desired-modes)
+ (set-file-modes tempfile desired-modes 'nofollow))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (if byte-native-compiling
+ ;; Defer elc final renaming.
+ (setf byte-to-native-output-buffer-file
+ (cons tempfile target-file))
+ (rename-file tempfile target-file t)))))
+
;;;###autoload
(defun byte-compile-file (filename &optional load)
"Compile a file of Lisp code named FILENAME into a file of byte code.
The output file's name is generated by passing FILENAME to the
function `byte-compile-dest-file' (which see).
The value is non-nil if there were no errors, nil if errors.
+If the file sets the file variable `no-byte-compile', it is not
+compiled, any existing output file is removed, and the return
+value is `no-byte-compile'.
See also `emacs-lisp-byte-compile-and-load'."
(declare (advertised-calling-convention (filename) "28.1"))
@@ -2100,38 +2199,11 @@ See also `emacs-lisp-byte-compile-and-load'."
;; Need to expand in case TARGET-FILE doesn't
;; include a directory (Bug#45287).
(expand-file-name target-file))))
- ;; We must disable any code conversion here.
- (let* ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile
- (make-temp-file (when (file-writable-p target-file)
- (expand-file-name target-file))))
- (default-modes (default-file-modes))
- (temp-modes (logand default-modes #o600))
- (desired-modes (logand default-modes #o666))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors
- (delete-file tempfile)))
- kill-emacs-hook)))
- (unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes 'nofollow))
- (write-region (point-min) (point-max) tempfile nil 1)
- ;; This has the intentional side effect that any
- ;; hard-links to target-file continue to
- ;; point to the old file (this makes it possible
- ;; for installed files to share disk space with
- ;; the build tree, without causing problems when
- ;; emacs-lisp files in the build tree are
- ;; recompiled). Previously this was accomplished by
- ;; deleting target-file before writing it.
- (if byte-native-compiling
- ;; Defer elc final renaming.
- (setf byte-to-native-output-file
- (cons tempfile target-file))
- (rename-file tempfile target-file t)))
+ (if byte-native-compiling
+ ;; Defer elc production.
+ (setf byte-to-native-output-buffer-file
+ (cons (current-buffer) target-file))
+ (byte-write-target-file (current-buffer) target-file))
(or noninteractive
byte-native-compiling
(message "Wrote %s" target-file)))
@@ -2152,7 +2224,8 @@ See also `emacs-lisp-byte-compile-and-load'."
"Cannot overwrite file"
"Directory not writable or nonexistent")
target-file))))))
- (kill-buffer (current-buffer)))
+ (unless byte-native-compiling
+ (kill-buffer (current-buffer))))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
(y-or-n-p (format "Report call tree for %s? "
@@ -2182,19 +2255,20 @@ With argument ARG, insert value in current buffer after the form."
(save-excursion
(end-of-defun)
(beginning-of-defun)
- (let* ((byte-compile-current-file (current-buffer))
+ (let* ((print-symbols-bare t) ; For the final `message'.
+ (byte-compile-current-file (current-buffer))
(byte-compile-current-buffer (current-buffer))
- (byte-compile-read-position (point))
- (byte-compile-last-position byte-compile-read-position)
+ (start-read-position (point))
(byte-compile-last-warned-form 'nothing)
+ (symbols-with-pos-enabled t)
(value (eval
- (let ((read-with-symbol-positions (current-buffer))
- (read-symbol-positions-list nil))
- (displaying-byte-compile-warnings
- (byte-compile-sexp
+ (displaying-byte-compile-warnings
+ (byte-compile-sexp
+ (let ((form (read-positioning-symbols (current-buffer))))
+ (push form byte-compile-form-stack)
(eval-sexp-add-defvars
- (read (current-buffer))
- byte-compile-read-position))))
+ form
+ start-read-position))))
lexical-binding)))
(cond (arg
(message "Compiling from buffer... done.")
@@ -2204,13 +2278,12 @@ With argument ARG, insert value in current buffer after the form."
(defun byte-compile-from-buffer (inbuffer)
(let ((byte-compile-current-buffer inbuffer)
- (byte-compile-read-position nil)
- (byte-compile-last-position nil)
;; Prevent truncation of flonums and lists as we read and print them
(float-output-format nil)
(case-fold-search nil)
(print-length nil)
(print-level nil)
+ (print-symbols-bare t)
;; Prevent edebug from interfering when we compile
;; and put the output into a file.
;; (edebug-all-defs nil)
@@ -2223,13 +2296,9 @@ With argument ARG, insert value in current buffer after the form."
(byte-compile-depth 0)
(byte-compile-maxdepth 0)
(byte-compile-output nil)
- ;; This allows us to get the positions of symbols read; it's
- ;; new in Emacs 22.1.
- (read-with-symbol-positions inbuffer)
- (read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
;; (byte-compile-warnings byte-compile-warnings)
- )
+ (symbols-with-pos-enabled t))
(byte-compile-close-variables
(with-current-buffer
(setq byte-compile--outbuffer
@@ -2275,18 +2344,17 @@ With argument ARG, insert value in current buffer after the form."
(= (following-char) ?\;))
(forward-line 1))
(not (eobp)))
- (setq byte-compile-read-position (point)
- byte-compile-last-position byte-compile-read-position)
(let* ((lread--unescaped-character-literals nil)
- (form (read inbuffer))
+ ;; Don't bind `load-read-function' to
+ ;; `read-positioning-symbols' here. Calls to `read'
+ ;; at a lower level must not get symbols with
+ ;; position.
+ (form (read-positioning-symbols inbuffer))
(warning (byte-run--unescaped-character-literals-warning)))
- (when warning (byte-compile-warn "%s" warning))
+ (when warning (byte-compile-warn-x form "%s" warning))
(byte-compile-toplevel-file-form form)))
;; Compile pending forms at end of file.
(byte-compile-flush-pending)
- ;; Make warnings about unresolved functions
- ;; give the end of the file as their position.
- (setq byte-compile-last-position (point-max))
(byte-compile-warn-about-unresolved-functions)))
byte-compile--outbuffer)))
@@ -2344,13 +2412,13 @@ Call from the source buffer."
;; Spill output for the native compiler here
(push (make-byte-to-native-top-level :form form :lexical lexical-binding)
byte-to-native-top-level-forms))
- (let ((print-escape-newlines t)
+ (let ((print-symbols-bare t) ; Possibly redundant binding.
+ (print-escape-newlines t)
(print-length nil)
(print-level nil)
(print-quoted t)
(print-gensym t)
- (print-circle ; Handle circular data structures.
- (not byte-compile-disable-print-circle)))
+ (print-circle t)) ; Handle circular data structures.
(if (and (memq (car-safe form) '(defvar defvaralias defconst
autoload custom-declare-variable))
(stringp (nth 3 form)))
@@ -2379,8 +2447,8 @@ list that represents a doc string reference.
;; in the input buffer (now current), not in the output buffer.
(let ((dynamic-docstrings byte-compile-dynamic-docstrings))
(with-current-buffer byte-compile--outbuffer
- (let (position)
-
+ (let (position
+ (print-symbols-bare t)) ; Possibly redundant binding.
;; Insert the doc string, and make it a comment with #@LENGTH.
(and (>= (nth 1 info) 0)
dynamic-docstrings
@@ -2408,8 +2476,7 @@ list that represents a doc string reference.
(print-level nil)
(print-quoted t)
(print-gensym t)
- (print-circle ; Handle circular data structures.
- (not byte-compile-disable-print-circle)))
+ (print-circle t)) ; Handle circular data structures.
(if preface
(progn
;; FIXME: We don't handle uninterned names correctly.
@@ -2462,13 +2529,12 @@ list that represents a doc string reference.
(defun byte-compile-keep-pending (form &optional handler)
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-one-form form t)))
+ ;; To avoid consing up monstrously large forms at load time, we split
+ ;; the output regularly.
+ (when (nthcdr 300 byte-compile-output)
+ (byte-compile-flush-pending))
(if handler
(let ((byte-compile--for-effect t))
- ;; To avoid consing up monstrously large forms at load time, we split
- ;; the output regularly.
- (and (memq (car-safe form) '(fset defalias))
- (nthcdr 300 byte-compile-output)
- (byte-compile-flush-pending))
(funcall handler form)
(if byte-compile--for-effect
(byte-compile-discard)))
@@ -2490,24 +2556,28 @@ list that represents a doc string reference.
byte-compile-jump-tables nil))))
(defun byte-compile-preprocess (form &optional _for-effect)
- (setq form (macroexpand-all form byte-compile-macro-environment))
+ (let ((print-symbols-bare t)) ; Possibly redundant binding.
+ (setq form (macroexpand-all form byte-compile-macro-environment)))
;; FIXME: We should run byte-optimize-form here, but it currently does not
;; recurse through all the code, so we'd have to fix this first.
;; Maybe a good fix would be to merge byte-optimize-form into
;; macroexpand-all.
;; (if (memq byte-optimize '(t source))
;; (setq form (byte-optimize-form form for-effect)))
- (cond
- (lexical-binding (cconv-closure-convert form))
- (t form)))
+ (cconv-closure-convert form))
;; byte-hunk-handlers cannot call this!
(defun byte-compile-toplevel-file-form (top-level-form)
- (byte-compile-recurse-toplevel
- top-level-form
- (lambda (form)
- (let ((byte-compile-current-form nil)) ; close over this for warnings.
- (byte-compile-file-form (byte-compile-preprocess form t))))))
+ ;; (let ((byte-compile-form-stack
+ ;; (cons top-level-form byte-compile-form-stack)))
+ (push top-level-form byte-compile-form-stack)
+ (prog1
+ (byte-compile-recurse-toplevel
+ top-level-form
+ (lambda (form)
+ (let ((byte-compile-current-form nil)) ; close over this for warnings.
+ (byte-compile-file-form (byte-compile-preprocess form t)))))
+ (pop byte-compile-form-stack)))
;; byte-hunk-handlers can call this.
(defun byte-compile-file-form (form)
@@ -2556,8 +2626,9 @@ list that represents a doc string reference.
(delq (assq funsym byte-compile-unresolved-functions)
byte-compile-unresolved-functions)))))
(if (stringp (nth 3 form))
- (prog1 form
- (byte-compile-docstring-length-warn form))
+ (prog1
+ form
+ (byte-compile-docstring-style-warn form))
;; No doc string, so we can compile this as a normal form.
(byte-compile-keep-pending form 'byte-compile-normal-call)))
@@ -2568,7 +2639,8 @@ list that represents a doc string reference.
(when (and (symbolp sym)
(not (string-match "[-*/:$]" (symbol-name sym)))
(byte-compile-warning-enabled-p 'lexical sym))
- (byte-compile-warn "global/dynamic var `%s' lacks a prefix" sym)))
+ (byte-compile-warn-x
+ sym "global/dynamic var `%s' lacks a prefix" sym)))
(defun byte-compile--declare-var (sym)
(byte-compile--check-prefixed-var sym)
@@ -2576,7 +2648,7 @@ list that represents a doc string reference.
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
(when (byte-compile-warning-enabled-p 'lexical sym)
- (byte-compile-warn "Variable `%S' declared after its first use" sym)))
+ (byte-compile-warn-x sym "Variable `%S' declared after its first use" sym)))
(push sym byte-compile-bound-variables)
(push sym byte-compile--seen-defvars))
@@ -2588,11 +2660,11 @@ list that represents a doc string reference.
(if (and (null (cddr form)) ;No `value' provided.
(eq (car form) 'defvar)) ;Just a declaration.
nil
- (byte-compile-docstring-length-warn form)
- (cond ((consp (nth 2 form))
- (setq form (copy-sequence form))
- (setcar (cdr (cdr form))
- (byte-compile-top-level (nth 2 form) nil 'file))))
+ (byte-compile-docstring-style-warn form)
+ (setq form (copy-sequence form))
+ (when (consp (nth 2 form))
+ (setcar (cdr (cdr form))
+ (byte-compile-top-level (nth 2 form) nil 'file)))
form))
(put 'define-abbrev-table 'byte-hunk-handler
@@ -2610,22 +2682,25 @@ list that represents a doc string reference.
(`(defvaralias ,_ ',newname . ,_)
(when (memq newname byte-compile-bound-variables)
(if (byte-compile-warning-enabled-p 'suspicious)
- (byte-compile-warn
+ (byte-compile-warn-x
+ newname
"Alias for `%S' should be declared before its referent" newname)))))
- (byte-compile-docstring-length-warn form)
+ (byte-compile-docstring-style-warn form)
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
- 'byte-compile-file-form-custom-declare-variable)
-(defun byte-compile-file-form-custom-declare-variable (form)
- (when (byte-compile-warning-enabled-p 'callargs)
- (byte-compile-nogroup-warn form))
- (byte-compile-file-form-defvar-function form))
+ 'byte-compile-file-form-defvar-function)
+
+(put 'custom-declare-face 'byte-hunk-handler
+ 'byte-compile-docstring-style-warn)
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
- (let ((args (mapcar 'eval (cdr form)))
- hist-new prov-cons)
+ (let* ((args (mapcar 'eval (cdr form)))
+ ;; The following is for the byte-compile-warn in
+ ;; `do-after-load-evaluation' (in subr.el).
+ (byte-compile-form-stack (cons (car args) byte-compile-form-stack))
+ hist-new prov-cons)
(apply 'require args)
;; Record the functions defined by the require in `byte-compile-new-defuns'.
@@ -2669,16 +2744,8 @@ list that represents a doc string reference.
(put 'make-obsolete 'byte-hunk-handler 'byte-compile-file-form-make-obsolete)
(defun byte-compile-file-form-make-obsolete (form)
(prog1 (byte-compile-keep-pending form)
- (apply 'make-obsolete (mapcar 'eval (cdr form)))))
-
-;; This handler is not necessary, but it makes the output from dont-compile
-;; and similar macros cleaner.
-(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
-(defun byte-compile-file-form-eval (form)
- (if (and (eq (car-safe (nth 1 form)) 'quote)
- (equal (nth 2 form) lexical-binding))
- (nth 1 (nth 1 form))
- (byte-compile-keep-pending form)))
+ (apply 'make-obsolete
+ (mapcar 'eval (cdr form)))))
(defun byte-compile-file-form-defmumble (name macro arglist body rest)
"Process a `defalias' for NAME.
@@ -2693,23 +2760,23 @@ not to take responsibility for the actual compilation of the code."
'byte-compile-macro-environment))
(this-one (assq name (symbol-value this-kind)))
(that-one (assq name (symbol-value that-kind)))
+ (bare-name (bare-symbol name))
(byte-compile-current-form name)) ; For warnings.
- (byte-compile-set-symbol-position name)
- (push name byte-compile-new-defuns)
+ (push bare-name byte-compile-new-defuns)
;; When a function or macro is defined, add it to the call tree so that
;; we can tell when functions are not used.
(if byte-compile-generate-call-tree
- (or (assq name byte-compile-call-tree)
+ (or (assq bare-name byte-compile-call-tree)
(setq byte-compile-call-tree
- (cons (list name nil nil) byte-compile-call-tree))))
+ (cons (list bare-name nil nil) byte-compile-call-tree))))
(if (byte-compile-warning-enabled-p 'redefine name)
(byte-compile-arglist-warn name arglist macro))
(if byte-compile-verbose
(message "Compiling %s... (%s)"
- (or byte-compile-current-file "") name))
+ (or byte-compile-current-file "") bare-name))
(cond ((not (or macro (listp body)))
;; We do not know positively if the definition is a macro
;; or a function, so we shouldn't emit warnings.
@@ -2718,29 +2785,34 @@ not to take responsibility for the actual compilation of the code."
(that-one
(if (and (byte-compile-warning-enabled-p 'redefine name)
;; Don't warn when compiling the stubs in byte-run...
- (not (assq name byte-compile-initial-macro-environment)))
- (byte-compile-warn
+ (not (assq bare-name byte-compile-initial-macro-environment)))
+ (byte-compile-warn-x
+ name
"`%s' defined multiple times, as both function and macro"
- name))
+ bare-name))
(setcdr that-one nil))
(this-one
(when (and (byte-compile-warning-enabled-p 'redefine name)
;; Hack: Don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
- (not (assq name byte-compile-initial-macro-environment)))
- (byte-compile-warn "%s `%s' defined multiple times in this file"
- (if macro "macro" "function")
- name)))
- ((eq (car-safe (symbol-function name))
+ (not (assq bare-name byte-compile-initial-macro-environment)))
+ (byte-compile-warn-x
+ name
+ "%s `%s' defined multiple times in this file"
+ (if macro "macro" "function")
+ bare-name)))
+ ((eq (car-safe (symbol-function bare-name))
(if macro 'lambda 'macro))
- (when (byte-compile-warning-enabled-p 'redefine name)
- (byte-compile-warn "%s `%s' being redefined as a %s"
- (if macro "function" "macro")
- name
- (if macro "macro" "function")))
+ (when (byte-compile-warning-enabled-p 'redefine bare-name)
+ (byte-compile-warn-x
+ name
+ "%s `%s' being redefined as a %s"
+ (if macro "function" "macro")
+ bare-name
+ (if macro "macro" "function")))
;; Shadow existing definition.
(set this-kind
- (cons (cons name nil)
+ (cons (cons bare-name nil)
(symbol-value this-kind))))
)
@@ -2749,10 +2821,8 @@ not to take responsibility for the actual compilation of the code."
(symbolp (car-safe (cdr-safe body)))
(car-safe (cdr-safe body))
(stringp (car-safe (cdr-safe (cdr-safe body)))))
- ;; FIXME: We've done that already just above, so this looks wrong!
- ;;(byte-compile-set-symbol-position name)
- (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
- name))
+ (byte-compile-warn-x
+ name "probable `\"' without `\\' in doc string of %s" bare-name))
(if (not (listp body))
;; The precise definition requires evaluation to find out, so it
@@ -2760,7 +2830,7 @@ not to take responsibility for the actual compilation of the code."
;; For a macro, that means we can't use that macro in the same file.
(progn
(unless macro
- (push (cons name (if (listp arglist) `(declared ,arglist) t))
+ (push (cons bare-name (if (listp arglist) `(declared ,arglist) t))
byte-compile-function-environment))
;; Tell the caller that we didn't compile it yet.
nil)
@@ -2770,10 +2840,10 @@ not to take responsibility for the actual compilation of the code."
;; A definition in b-c-initial-m-e should always take precedence
;; during compilation, so don't let it be redefined. (Bug#8647)
(or (and macro
- (assq name byte-compile-initial-macro-environment))
+ (assq bare-name byte-compile-initial-macro-environment))
(setcdr this-one code))
(set this-kind
- (cons (cons name code)
+ (cons (cons bare-name code)
(symbol-value this-kind))))
(if rest
@@ -2789,18 +2859,19 @@ not to take responsibility for the actual compilation of the code."
(if (not (stringp (documentation code t))) -1 4)))
(when byte-native-compiling
;; Spill output for the native compiler here.
- (push (if macro
- (make-byte-to-native-top-level
- :form `(defalias ',name '(macro . ,code) nil)
- :lexical lexical-binding)
- (make-byte-to-native-func-def :name name
- :byte-func code))
- byte-to-native-top-level-forms))
+ (push
+ (if macro
+ (make-byte-to-native-top-level
+ :form `(defalias ',name '(macro . ,code) nil)
+ :lexical lexical-binding)
+ (make-byte-to-native-func-def :name name
+ :byte-func code))
+ byte-to-native-top-level-forms))
;; Output the form by hand, that's much simpler than having
;; b-c-output-file-form analyze the defalias.
(byte-compile-output-docform
"\n(defalias '"
- name
+ bare-name
(if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
(append code nil) ; Turn byte-code-function-p into list.
(and (atom code) byte-compile-dynamic
@@ -2859,6 +2930,7 @@ FUN should be either a `lambda' value or a `closure' value."
(push (pop body) preamble))
(when (eq (car-safe (car body)) 'interactive)
(push (pop body) preamble))
+ (setq preamble (nreverse preamble))
;; Turn the function's closed vars (if any) into local let bindings.
(dolist (binding env)
(cond
@@ -2883,37 +2955,38 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(macro (eq (car-safe fun) 'macro)))
(if macro
(setq fun (cdr fun)))
- (cond
- ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to
- ;; compile something invalid. So let's tune down the complaint from an
- ;; error to a simple message for the known case where signaling an error
- ;; causes problems.
- ((byte-code-function-p fun)
- (message "Function %s is already compiled"
- (if (symbolp form) form "provided"))
- fun)
- (t
- (let (final-eval)
- (when (or (symbolp form) (eq (car-safe fun) 'closure))
- ;; `fun' is a function *value*, so try to recover its corresponding
- ;; source code.
- (setq lexical-binding (eq (car fun) 'closure))
- (setq fun (byte-compile--reify-function fun))
- (setq final-eval t))
- ;; Expand macros.
- (setq fun (byte-compile-preprocess fun))
- (setq fun (byte-compile-top-level fun nil 'eval))
- (if (symbolp form)
- ;; byte-compile-top-level returns an *expression* equivalent to the
- ;; `fun' expression, so we need to evaluate it, tho normally
- ;; this is not needed because the expression is just a constant
- ;; byte-code object, which is self-evaluating.
- (setq fun (eval fun t)))
- (if final-eval
- (setq fun (eval fun t)))
- (if macro (push 'macro fun))
- (if (symbolp form) (fset form fun))
- fun)))))))
+ (prog1
+ (cond
+ ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to
+ ;; compile something invalid. So let's tune down the complaint from an
+ ;; error to a simple message for the known case where signaling an error
+ ;; causes problems.
+ ((byte-code-function-p fun)
+ (message "Function %s is already compiled"
+ (if (symbolp form) form "provided"))
+ fun)
+ (t
+ (let (final-eval)
+ (when (or (symbolp form) (eq (car-safe fun) 'closure))
+ ;; `fun' is a function *value*, so try to recover its corresponding
+ ;; source code.
+ (setq lexical-binding (eq (car fun) 'closure))
+ (setq fun (byte-compile--reify-function fun))
+ (setq final-eval t))
+ ;; Expand macros.
+ (setq fun (byte-compile-preprocess fun))
+ (setq fun (byte-compile-top-level fun nil 'eval))
+ (if (symbolp form)
+ ;; byte-compile-top-level returns an *expression* equivalent to the
+ ;; `fun' expression, so we need to evaluate it, tho normally
+ ;; this is not needed because the expression is just a constant
+ ;; byte-code object, which is self-evaluating.
+ (setq fun (eval fun t)))
+ (if final-eval
+ (setq fun (eval fun t)))
+ (if macro (push 'macro fun))
+ (if (symbolp form) (fset form fun))
+ fun))))))))
(defun byte-compile-sexp (sexp)
"Compile and return SEXP."
@@ -2926,8 +2999,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(let (vars)
(while list
(let ((arg (car list)))
- (when (symbolp arg)
- (byte-compile-set-symbol-position arg))
(cond ((or (not (symbolp arg))
(macroexp--const-symbol-p arg t))
(error "Invalid lambda variable %s" arg))
@@ -2944,7 +3015,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
((and (memq arg vars)
;; Allow repetitions for unused args.
(not (string-match "\\`_" (symbol-name arg))))
- (byte-compile-warn "repeated variable %s in lambda-list" arg))
+ (byte-compile-warn-x
+ arg "repeated variable %s in lambda-list" arg))
(t
(push arg vars))))
(setq list (cdr list)))))
@@ -2987,7 +3059,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(defun byte-compile--warn-lexical-dynamic (var context)
(when (byte-compile-warning-enabled-p 'lexical-dynamic var)
- (byte-compile-warn
+ (byte-compile-warn-x
+ var
"`%s' lexically bound in %s here but declared dynamic in: %s"
var context
(mapconcat #'identity
@@ -2999,20 +3072,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
"Byte-compile a lambda-expression and return a valid function.
The value is usually a compiled function but may be the original
-lambda-expression.
-When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
-of the list FUN and `byte-compile-set-symbol-position' is not called.
-Use this feature to avoid calling `byte-compile-set-symbol-position'
-for symbols generated by the byte compiler itself."
+lambda-expression."
(if add-lambda
(setq fun (cons 'lambda fun))
(unless (eq 'lambda (car-safe fun))
- (error "Not a lambda list: %S" fun))
- (byte-compile-set-symbol-position 'lambda))
- (byte-compile-docstring-length-warn fun)
+ (error "Not a lambda list: %S" fun)))
+ (byte-compile-docstring-style-warn fun)
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
- (arglistvars (byte-compile-arglist-vars arglist))
+ (arglistvars (byte-run-strip-symbol-positions
+ (byte-compile-arglist-vars arglist)))
(byte-compile-bound-variables
(append (if (not lexical-binding) arglistvars)
byte-compile-bound-variables))
@@ -3031,7 +3100,6 @@ for symbols generated by the byte compiler itself."
(byte-compile--warn-lexical-dynamic var 'lambda))))
;; Process the interactive spec.
(when int
- (byte-compile-set-symbol-position 'interactive)
;; Skip (interactive) if it is in front (the most usual location).
(if (eq int (car body))
(setq body (cdr body)))
@@ -3039,8 +3107,8 @@ for symbols generated by the byte compiler itself."
;; Check that the bit after the `interactive' spec is
;; just a list of symbols (i.e., modes).
(unless (seq-every-p #'symbolp (cdr (cdr int)))
- (byte-compile-warn "malformed interactive specc: %s"
- (prin1-to-string int)))
+ (byte-compile-warn-x int "malformed interactive specc: %s"
+ int))
(setq command-modes (cdr (cdr int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
@@ -3052,16 +3120,17 @@ for symbols generated by the byte compiler itself."
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
- (when (or (not (eq (car-safe form) 'list))
- ;; For code using lexical-binding, form is not
- ;; valid lisp, but rather an intermediate form
- ;; which may include "calls" to
- ;; internal-make-closure (Bug#29988).
- lexical-binding)
- (setq int `(interactive ,newform)))))
+ (if (or (not (eq (car-safe form) 'list))
+ ;; For code using lexical-binding, form is not
+ ;; valid lisp, but rather an intermediate form
+ ;; which may include "calls" to
+ ;; internal-make-closure (Bug#29988).
+ lexical-binding)
+ (setq int `(,(car int) ,newform))
+ (setq int (byte-run-strip-symbol-positions int))))) ; for compile-defun.
((cdr int) ; Invalid (interactive . something).
- (byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))))
+ (byte-compile-warn-x int "malformed interactive spec: %s"
+ int))))
;; Process the body.
(let ((compiled
(byte-compile-top-level (cons 'progn body) nil 'lambda
@@ -3072,14 +3141,15 @@ for symbols generated by the byte compiler itself."
(and lexical-binding
(byte-compile-make-lambda-lexenv
arglistvars))
- reserved-csts)))
+ reserved-csts))
+ (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun.
;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled)))
(let ((out
(apply #'make-byte-code
(if lexical-binding
(byte-compile-make-args-desc arglist)
- arglist)
+ bare-arglist)
(append
;; byte-string, constants-vector, stack depth
(cdr compiled)
@@ -3087,7 +3157,7 @@ for symbols generated by the byte compiler itself."
(cond ((and lexical-binding arglist)
;; byte-compile-make-args-desc lost the args's names,
;; so preserve them in the docstring.
- (list (help-add-fundoc-usage doc arglist)))
+ (list (help-add-fundoc-usage doc bare-arglist)))
((or doc int)
(list doc)))
;; optionally, the interactive spec (and the modes the
@@ -3292,7 +3362,8 @@ for symbols generated by the byte compiler itself."
(setq byte-compile-noruntime-functions
(delq fn byte-compile-noruntime-functions))
;; Delegate the rest to the normal macro definition.
- (macroexpand `(declare-function ,fn ,file ,@args)))
+ (let ((print-symbols-bare t)) ; Possibly redundant binding.
+ (macroexpand `(declare-function ,fn ,file ,@args))))
;; This is the recursive entry point for compiling each subform of an
@@ -3310,18 +3381,14 @@ for symbols generated by the byte compiler itself."
;;
(defun byte-compile-form (form &optional for-effect)
(let ((byte-compile--for-effect for-effect))
+ (push form byte-compile-form-stack)
(cond
((not (consp form))
(cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
- (when (symbolp form)
- (byte-compile-set-symbol-position form))
(byte-compile-constant form))
((and byte-compile--for-effect byte-compile-delete-errors)
- (when (symbolp form)
- (byte-compile-set-symbol-position form))
(setq byte-compile--for-effect nil))
- (t
- (byte-compile-variable-ref form))))
+ (t (byte-compile-variable-ref form))))
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile))
@@ -3344,20 +3411,20 @@ for symbols generated by the byte compiler itself."
(byte-compile-check-variable (cadr hook) nil))))
(when (and (byte-compile-warning-enabled-p 'suspicious)
(macroexp--const-symbol-p fn))
- (byte-compile-warn "`%s' called as a function" fn))
+ (byte-compile-warn-x fn "`%s' called as a function" fn))
(when (and (byte-compile-warning-enabled-p 'interactive-only fn)
interactive-only)
- (byte-compile-warn "`%s' is for interactive use only%s"
- fn
- (cond ((stringp interactive-only)
- (format "; %s"
- (substitute-command-keys
- interactive-only)))
- ((and (symbolp 'interactive-only)
- (not (eq interactive-only t)))
- (format-message "; use `%s' instead."
- interactive-only))
- (t "."))))
+ (byte-compile-warn-x fn "`%s' is for interactive use only%s"
+ fn
+ (cond ((stringp interactive-only)
+ (format "; %s"
+ (substitute-command-keys
+ interactive-only)))
+ ((and (symbolp 'interactive-only)
+ (not (eq interactive-only t)))
+ (format-message "; use `%s' instead."
+ interactive-only))
+ (t "."))))
(if (eq (car-safe (symbol-function (car form))) 'macro)
(byte-compile-report-error
(format "`%s' defined after use in %S (missing `require' of a library file?)"
@@ -3382,7 +3449,8 @@ for symbols generated by the byte compiler itself."
(setq byte-compile--for-effect nil))
((byte-compile-normal-call form)))
(if byte-compile--for-effect
- (byte-compile-discard))))
+ (byte-compile-discard))
+ (pop byte-compile-form-stack)))
(defun byte-compile-normal-call (form)
(when (and (symbolp (car form))
@@ -3396,8 +3464,8 @@ for symbols generated by the byte compiler itself."
(byte-compile-annotate-call-tree form))
(when (and byte-compile--for-effect (eq (car form) 'mapcar)
(byte-compile-warning-enabled-p 'mapcar 'mapcar))
- (byte-compile-set-symbol-position 'mapcar)
- (byte-compile-warn
+ (byte-compile-warn-x
+ (car form)
"`mapcar' called for effect; use `mapc' or `dolist' instead"))
(byte-compile-push-constant (car form))
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
@@ -3528,16 +3596,16 @@ for symbols generated by the byte compiler itself."
(defun byte-compile-check-variable (var access-type)
"Do various error checks before a use of the variable VAR."
- (when (symbolp var)
- (byte-compile-set-symbol-position var))
(cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
(when (byte-compile-warning-enabled-p 'constants
(and (symbolp var) var))
- (byte-compile-warn (if (eq access-type 'let-bind)
- "attempt to let-bind %s `%s'"
- "variable reference to %s `%s'")
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var))))
+ (byte-compile-warn-x
+ var
+ (if (eq access-type 'let-bind)
+ "attempt to let-bind %s `%s'"
+ "variable reference to %s `%s'")
+ (if (symbolp var) "constant" "nonvariable")
+ var)))
((let ((od (get var 'byte-obsolete-variable)))
(and od
(not (memq var byte-compile-not-obsolete-vars))
@@ -3562,9 +3630,10 @@ for symbols generated by the byte compiler itself."
(push var byte-compile-bound-variables)
(byte-compile-dynamic-variable-op 'byte-varbind var))
-(defun byte-compile-free-vars-warn (var &optional assignment)
+(defun byte-compile-free-vars-warn (arg var &optional assignment)
"Warn if symbol VAR refers to a free variable.
VAR must not be lexically bound.
+ARG is a position argument, used by byte-compile-warn-x.
If optional argument ASSIGNMENT is non-nil, this is treated as an
assignment (i.e. `setq')."
(unless (or (not (byte-compile-warning-enabled-p 'free-vars var))
@@ -3576,9 +3645,9 @@ assignment (i.e. `setq')."
(let* ((varname (prin1-to-string var))
(desc (if assignment "assignment" "reference"))
(suggestions (help-uni-confusable-suggestions varname)))
- (byte-compile-warn "%s to free variable `%s'%s"
- desc varname
- (if suggestions (concat "\n " suggestions) "")))
+ (byte-compile-warn-x arg "%s to free variable `%s'%s"
+ desc var
+ (if suggestions (concat "\n " suggestions) "")))
(push var (if assignment
byte-compile-free-assignments
byte-compile-free-references))))
@@ -3591,7 +3660,7 @@ assignment (i.e. `setq')."
;; VAR is lexically bound
(byte-compile-stack-ref (cdr lex-binding))
;; VAR is dynamically bound
- (byte-compile-free-vars-warn var)
+ (byte-compile-free-vars-warn var var)
(byte-compile-dynamic-variable-op 'byte-varref var))))
(defun byte-compile-variable-set (var)
@@ -3602,7 +3671,7 @@ assignment (i.e. `setq')."
;; VAR is lexically bound.
(byte-compile-stack-set (cdr lex-binding))
;; VAR is dynamically bound.
- (byte-compile-free-vars-warn var t)
+ (byte-compile-free-vars-warn var var t)
(byte-compile-dynamic-variable-op 'byte-varset var))))
(defmacro byte-compile-get-constant (const)
@@ -3627,9 +3696,9 @@ assignment (i.e. `setq')."
;; Use this for a constant that is not the value of its containing form.
;; This ignores byte-compile--for-effect.
(defun byte-compile-push-constant (const)
- (when (symbolp const)
- (byte-compile-set-symbol-position const))
- (byte-compile-out 'byte-constant (byte-compile-get-constant const)))
+ (byte-compile-out
+ 'byte-constant
+ (byte-compile-get-constant const)))
;; Compile those primitive ordinary functions
;; which have special byte codes just for speed.
@@ -3781,12 +3850,13 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(defun byte-compile-subr-wrong-args (form n)
- (byte-compile-set-symbol-position (car form))
- (byte-compile-warn "`%s' called with %d arg%s, but requires %s"
- (car form) (length (cdr form))
- (if (= 1 (length (cdr form))) "" "s") n)
- ;; Get run-time wrong-number-of-args error.
- (byte-compile-normal-call form))
+ (when (byte-compile-warning-enabled-p 'callargs (car form))
+ (byte-compile-warn-x (car form)
+ "`%s' called with %d arg%s, but requires %s"
+ (car form) (length (cdr form))
+ (if (= 1 (length (cdr form))) "" "s") n)
+ ;; Get run-time wrong-number-of-args error.
+ (byte-compile-normal-call form)))
(defun byte-compile-no-args (form)
(if (not (= (length form) 1))
@@ -3895,7 +3965,9 @@ discarding."
(byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var)
(defun byte-compile-make-closure (form)
- "Byte-compile the special `internal-make-closure' form."
+ "Byte-compile the special `internal-make-closure' form.
+
+This function is never called when `lexical-binding' is nil."
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(let* ((vars (nth 1 form))
(env (nth 2 form))
@@ -3907,7 +3979,7 @@ discarding."
docstring-exp)) ;Otherwise, we don't need a closure.
(cl-assert (byte-code-function-p fun))
(byte-compile-form
- (if (or (not docstring-exp) (stringp docstring-exp))
+ (if (macroexp-const-p docstring-exp)
;; Use symbols V0, V1 ... as placeholders for closure variables:
;; they should be short (to save space in the .elc file), yet
;; distinct when disassembled.
@@ -3917,24 +3989,33 @@ discarding."
(number-sequence 4 (1- (length fun)))))
(proto-fun
(apply #'make-byte-code
- (aref fun 0) (aref fun 1)
+ (aref fun 0) ; The arglist is always the 15-bit
+ ; form, never the list of symbols.
+ (aref fun 1) ; The byte-code.
;; Prepend dummy cells to the constant vector,
;; to get the indices right when disassembling.
(vconcat dummy-vars (aref fun 2))
- (aref fun 3)
+ (aref fun 3) ; Stack depth of function
(if docstring-exp
- (cons docstring-exp (cdr opt-args))
+ (cons
+ (eval (byte-run-strip-symbol-positions
+ docstring-exp)
+ t)
+ (cdr opt-args)) ; The interactive spec will
+ ; have been stripped in
+ ; `byte-compile-lambda'.
opt-args))))
`(make-closure ,proto-fun ,@env))
;; Nontrivial doc string expression: create a bytecode object
;; from small pieces at run time.
`(make-byte-code
- ',(aref fun 0) ',(aref fun 1)
- (vconcat (vector . ,env) ',(aref fun 2))
+ ',(aref fun 0) ; 15-bit form of arglist descriptor.
+ ',(aref fun 1) ; The byte-code.
+ (vconcat (vector . ,env) ',(aref fun 2)) ; constant vector.
,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
(if docstring-exp
`(,(car rest)
- ,docstring-exp
+ ,(byte-run-strip-symbol-positions docstring-exp)
,@(cddr rest))
rest))))
))))
@@ -4093,7 +4174,8 @@ discarding."
(if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
(if (and (consp (car body))
(not (eq 'byte-code (car (car body)))))
- (byte-compile-warn
+ (byte-compile-warn-x
+ (nth 2 form)
"A quoted lambda form is the second argument of `fset'. This is probably
not what you want, as that lambda cannot be compiled. Consider using
the syntax #'(lambda (...) ...) instead.")))))
@@ -4147,25 +4229,13 @@ discarding."
(byte-defop-compiler-1 quote)
(defun byte-compile-setq (form)
- (let* ((args (cdr form))
- (len (length args)))
- (if (= (logand len 1) 1)
- (progn
- (byte-compile-report-error
- (format-message
- "missing value for `%S' at end of setq" (car (last args))))
- (byte-compile-form
- `(signal 'wrong-number-of-arguments '(setq ,len))
- byte-compile--for-effect))
- (if args
- (while args
- (byte-compile-form (car (cdr args)))
- (or byte-compile--for-effect (cdr (cdr args))
- (byte-compile-out 'byte-dup 0))
- (byte-compile-variable-set (car args))
- (setq args (cdr (cdr args))))
- ;; (setq), with no arguments.
- (byte-compile-form nil byte-compile--for-effect)))
+ (cl-assert (= (length form) 3)) ; normalised in macroexp
+ (let ((var (nth 1 form))
+ (expr (nth 2 form)))
+ (byte-compile-form expr)
+ (unless byte-compile--for-effect
+ (byte-compile-out 'byte-dup 0))
+ (byte-compile-variable-set var)
(setq byte-compile--for-effect nil)))
(byte-defop-compiler-1 set-default)
@@ -4178,10 +4248,11 @@ discarding."
(macroexp--const-symbol-p var t))
(byte-compile-warning-enabled-p 'constants
(and (symbolp var) var))
- (byte-compile-warn
+ (byte-compile-warn-x
+ var
"variable assignment to %s `%s'"
(if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var)))))
+ var))))
(byte-compile-normal-call form)))
(defun byte-compile-quote (form)
@@ -4714,7 +4785,6 @@ binding slots have been popped."
;; Even when optimization is off, /= is optimized to (not (= ...)).
(defun byte-compile-negation-optimizer (form)
;; an optimizer for forms where <form1> is less efficient than (not <form2>)
- (byte-compile-set-symbol-position (car form))
(list 'not
(cons (or (get (car form) 'byte-compile-negated-op)
(error
@@ -4742,11 +4812,8 @@ binding slots have been popped."
(byte-compile-out-tag endtag)))
(defun byte-compile-unwind-protect (form)
- (pcase (cddr form)
- (`(:fun-body ,f)
- (byte-compile-form f))
- (handlers
- (byte-compile-form `#'(lambda () ,@handlers))))
+ (cl-assert (eq (caddr form) :fun-body))
+ (byte-compile-form (nth 3 form))
(byte-compile-out 'byte-unwind-protect 0)
(byte-compile-form-do-effect (car (cdr form)))
(byte-compile-out 'byte-unbind 1))
@@ -4764,18 +4831,17 @@ binding slots have been popped."
(cons (byte-compile-make-tag) clause))
failure-handlers))
(endtag (byte-compile-make-tag)))
- (byte-compile-set-symbol-position 'condition-case)
(unless (symbolp var)
- (byte-compile-warn
- "`%s' is not a variable-name or nil (in condition-case)" var))
+ (byte-compile-warn-x
+ var "`%s' is not a variable-name or nil (in condition-case)" var))
(dolist (clause (reverse clauses))
(let ((condition (nth 1 clause)))
(unless (consp condition) (setq condition (list condition)))
(dolist (c condition)
(unless (and c (symbolp c))
- (byte-compile-warn
- "`%S' is not a condition name (in condition-case)" c))
+ (byte-compile-warn-x
+ c "`%S' is not a condition name (in condition-case)" c))
;; In reality, the `error-conditions' property is only required
;; for the argument to `signal', not to `condition-case'.
;;(unless (consp (get c 'error-conditions))
@@ -4826,7 +4892,8 @@ binding slots have been popped."
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
(byte-compile-warning-enabled-p 'suspicious 'set-buffer))
- (byte-compile-warn
+ (byte-compile-warn-x
+ form
"Use `with-current-buffer' rather than save-excursion+set-buffer"))
(byte-compile-out 'byte-save-excursion 0)
(byte-compile-body-do-effect (cdr form))
@@ -4860,25 +4927,25 @@ binding slots have been popped."
(push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars))
(byte-compile-normal-call form))
-(defconst byte-compile-tmp-var (make-symbol "def-tmp-var"))
-
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts.
(when (and (symbolp (nth 1 form))
(not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
(byte-compile-warning-enabled-p 'lexical (nth 1 form)))
- (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
- (nth 1 form)))
- (byte-compile-docstring-length-warn form)
+ (byte-compile-warn-x
+ (nth 1 form)
+ "global/dynamic var `%s' lacks a prefix"
+ (nth 1 form)))
+ (byte-compile-docstring-style-warn form)
(let ((fun (nth 0 form))
(var (nth 1 form))
(value (nth 2 form))
(string (nth 3 form)))
- (byte-compile-set-symbol-position fun)
(when (or (> (length form) 4)
(and (eq fun 'defconst) (null (cddr form))))
(let ((ncall (length (cdr form))))
- (byte-compile-warn
+ (byte-compile-warn-x
+ fun
"`%s' called with %d argument%s, but %s %s"
fun ncall
(if (= 1 ncall) "" "s")
@@ -4888,28 +4955,29 @@ binding slots have been popped."
(if (eq fun 'defconst)
(push var byte-compile-const-variables))
(when (and string (not (stringp string)))
- (byte-compile-warn "third arg to `%s %s' is not a string: %s"
- fun var string))
+ (byte-compile-warn-x
+ string
+ "third arg to `%s %s' is not a string: %s"
+ fun var string))
+ ;; Delegate the actual work to the function version of the
+ ;; special form, named with a "-1" suffix.
(byte-compile-form-do-effect
- (if (cddr form) ; `value' provided
- ;; Quote with `quote' to prevent byte-compiling the body,
- ;; which would lead to an inf-loop.
- `(funcall '(lambda (,byte-compile-tmp-var)
- (,fun ,var ,byte-compile-tmp-var ,@(nthcdr 3 form)))
- ,value)
- (if (eq fun 'defconst)
- ;; This will signal an appropriate error at runtime.
- `(eval ',form)
- ;; A simple (defvar foo) just returns foo.
- `',var)))))
+ (cond
+ ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form)))
+ ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo.
+ (t `(defvar-1 ',var
+ ;; Don't eval `value' if `defvar' wouldn't eval it either.
+ ,(if (macroexp-const-p value) value
+ `(if (boundp ',var) nil ,value))
+ ,@(nthcdr 3 form)))))))
(defun byte-compile-autoload (form)
- (byte-compile-set-symbol-position 'autoload)
(and (macroexp-const-p (nth 1 form))
(macroexp-const-p (nth 5 form))
(memq (eval (nth 5 form)) '(t macro)) ; macro-p
(not (fboundp (eval (nth 1 form))))
- (byte-compile-warn
+ (byte-compile-warn-x
+ form
"The compiler ignores `autoload' except at top level. You should
probably put the autoload of the macro `%s' at top-level."
(eval (nth 1 form))))
@@ -4918,7 +4986,6 @@ binding slots have been popped."
;; Lambdas in valid places are handled as special cases by various code.
;; The ones that remain are errors.
(defun byte-compile-lambda-form (_form)
- (byte-compile-set-symbol-position 'lambda)
(error "`lambda' used as function name is invalid"))
;; Compile normally, but deal with warnings for the function being defined.
@@ -4929,13 +4996,13 @@ binding slots have been popped."
;; if it weren't for the fact that we need to figure out when a defalias
;; defines a macro, so as to add it to byte-compile-macro-environment.
;;
- ;; FIXME: we also use this hunk-handler to implement the function's dynamic
- ;; docstring feature. We could actually implement it more elegantly in
- ;; byte-compile-lambda so it applies to all lambdas, but the problem is that
- ;; the resulting .elc format will not be recognized by make-docfile, so
- ;; either we stop using DOC for the docstrings of preloaded elc files (at the
- ;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to
- ;; build DOC in a more clever way (e.g. handle anonymous elements).
+ ;; FIXME: we also use this hunk-handler to implement the function's
+ ;; dynamic docstring feature (via byte-compile-file-form-defmumble).
+ ;; We should actually implement it (more elegantly) in
+ ;; byte-compile-lambda so it applies to all lambdas. We did it here
+ ;; so the resulting .elc format was recognizable by make-docfile,
+ ;; but since then we stopped using DOC for the docstrings of
+ ;; preloaded elc files so that obstacle is gone.
(let ((byte-compile-free-references nil)
(byte-compile-free-assignments nil))
(pcase form
@@ -4944,7 +5011,7 @@ binding slots have been popped."
;; - `arg' is the expression to which it is defined.
;; - `rest' is the rest of the arguments.
(`(,_ ',name ,arg . ,rest)
- (byte-compile-docstring-length-warn form)
+ (byte-compile-docstring-style-warn form)
(pcase-let*
;; `macro' is non-nil if it defines a macro.
;; `fun' is the function part of `arg' (defaults to `arg').
@@ -4998,7 +5065,8 @@ binding slots have been popped."
(defun byte-compile-make-variable-buffer-local (form)
(if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote)
(byte-compile-warning-enabled-p 'make-local))
- (byte-compile-warn
+ (byte-compile-warn-x
+ form
"`make-variable-buffer-local' not called at toplevel"))
(byte-compile-normal-call form))
(put 'make-variable-buffer-local
@@ -5042,6 +5110,8 @@ binding slots have been popped."
nil))
(_ (byte-compile-keep-pending form))))
+
+
;;; tags
@@ -5076,7 +5146,7 @@ binding slots have been popped."
OP and OPERAND are as passed to `byte-compile-out'."
(if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos))
;; For calls, OPERAND is the number of args, so we pop OPERAND + 1
- ;; elements, and the push the result, for a total of -OPERAND.
+ ;; elements, and then push the result, for a total of -OPERAND.
;; For discardN*, of course, we just pop OPERAND elements.
(- operand)
(or (aref byte-stack+-info (symbol-value op))
@@ -5086,6 +5156,11 @@ OP and OPERAND are as passed to `byte-compile-out'."
(- 1 operand))))
(defun byte-compile-out (op &optional operand)
+ "Push the operation onto `byte-compile-output'.
+OP is an opcode, a symbol. OPERAND is either nil or a number or
+a one-element list of a lisp form."
+ (when (and (consp operand) (null (cdr operand)))
+ (setq operand (byte-run-strip-symbol-positions operand)))
(push (cons op operand) byte-compile-output)
(if (eq op 'byte-return)
;; This is actually an unnecessary case, because there should be no
@@ -5100,24 +5175,26 @@ OP and OPERAND are as passed to `byte-compile-out'."
;;; call tree stuff
(defun byte-compile-annotate-call-tree (form)
- (let (entry)
+ (let ((current-form (byte-run-strip-symbol-positions
+ byte-compile-current-form))
+ (bare-car-form (byte-run-strip-symbol-positions (car form)))
+ entry)
;; annotate the current call
- (if (setq entry (assq (car form) byte-compile-call-tree))
- (or (memq byte-compile-current-form (nth 1 entry)) ;callers
+ (if (setq entry (assq bare-car-form byte-compile-call-tree))
+ (or (memq current-form (nth 1 entry)) ;callers
(setcar (cdr entry)
- (cons byte-compile-current-form (nth 1 entry))))
+ (cons current-form (nth 1 entry))))
(setq byte-compile-call-tree
- (cons (list (car form) (list byte-compile-current-form) nil)
+ (cons (list bare-car-form (list current-form) nil)
byte-compile-call-tree)))
;; annotate the current function
- (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
- (or (memq (car form) (nth 2 entry)) ;called
+ (if (setq entry (assq current-form byte-compile-call-tree))
+ (or (memq bare-car-form (nth 2 entry)) ;called
(setcar (cdr (cdr entry))
- (cons (car form) (nth 2 entry))))
+ (cons bare-car-form (nth 2 entry))))
(setq byte-compile-call-tree
- (cons (list byte-compile-current-form nil (list (car form)))
- byte-compile-call-tree)))
- ))
+ (cons (list current-form nil (list bare-car-form))
+ byte-compile-call-tree)))))
;; Renamed from byte-compile-report-call-tree
;; to avoid interfering with completion of byte-compile-file.
@@ -5142,14 +5219,15 @@ invoked interactively."
(set-buffer "*Call-Tree*")
(erase-buffer)
(message "Generating call tree... (sorting on %s)"
- byte-compile-call-tree-sort)
+ (remove-pos-from-symbol byte-compile-call-tree-sort))
(insert "Call tree for "
(cond ((null byte-compile-current-file) (or filename "???"))
((stringp byte-compile-current-file)
byte-compile-current-file)
(t (buffer-name byte-compile-current-file)))
" sorted on "
- (prin1-to-string byte-compile-call-tree-sort)
+ (prin1-to-string (remove-pos-from-symbol
+ byte-compile-call-tree-sort))
":\n\n")
(if byte-compile-call-tree-sort
(setq byte-compile-call-tree
@@ -5169,7 +5247,8 @@ invoked interactively."
('name
(lambda (x y) (string< (car x) (car y))))
(_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
- byte-compile-call-tree-sort))))))
+ (remove-pos-from-symbol
+ byte-compile-call-tree-sort)))))))
(message "Generating call tree...")
(let ((rest byte-compile-call-tree)
(b (current-buffer))
@@ -5316,7 +5395,7 @@ already up-to-date."
(or (not (file-exists-p dest))
(file-newer-than-file-p source dest))))
(if (null (batch-byte-compile-file (car command-line-args-left)))
- (setq error t))))
+ (setq error t))))
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs (if error 1 0))))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index ccb96d169d5..7f95fa94fa1 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -25,21 +25,20 @@
;;; Commentary:
;; This takes a piece of Elisp code, and eliminates all free variables from
-;; lambda expressions. The user entry points are cconv-closure-convert and
-;; cconv-closure-convert-toplevel (for toplevel forms).
+;; lambda expressions. The user entry point is `cconv-closure-convert'.
;; All macros should be expanded beforehand.
;;
;; Here is a brief explanation how this code works.
-;; Firstly, we analyze the tree by calling cconv-analyze-form.
+;; Firstly, we analyze the tree by calling `cconv-analyze-form'.
;; This function finds all mutated variables, all functions that are suitable
;; for lambda lifting and all variables captured by closure. It passes the tree
;; once, returning a list of three lists.
;;
;; Then we calculate the intersection of the first and third lists returned by
-;; cconv-analyze form to find all mutated variables that are captured by
+;; `cconv-analyze-form' to find all mutated variables that are captured by
;; closure.
-;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the
+;; Armed with this data, we call `cconv-convert', that rewrites the
;; tree recursively, lifting lambdas where possible, building closures where it
;; is needed and eliminating mutable variables used in closure.
;;
@@ -141,11 +140,9 @@ is less than this number.")
;;;###autoload
(defun cconv-closure-convert (form)
"Main entry point for closure conversion.
--- FORM is a piece of Elisp code after macroexpansion.
--- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST
+FORM is a piece of Elisp code after macroexpansion.
Returns a form where all lambdas don't have any free variables."
- ;; (message "Entering cconv-closure-convert...")
(let ((cconv-freevars-alist '())
(cconv-var-classification '()))
;; Analyze form - fill these variables with new information.
@@ -201,7 +198,10 @@ Returns a form where all lambdas don't have any free variables."
(i 0)
(new-env ()))
;; Build the "formal and actual envs" for the closure-converted function.
- (dolist (fv fvs)
+ ;; Hack for OClosure: `nreverse' here intends to put the captured vars
+ ;; in the closure such that the first one is the one that is bound
+ ;; most closely.
+ (dolist (fv (nreverse fvs))
(let ((exp (or (cdr (assq fv env)) fv)))
(pcase exp
;; If `fv' is a variable that's wrapped in a cons-cell,
@@ -240,7 +240,7 @@ Returns a form where all lambdas don't have any free variables."
;; this case better, we'd need to traverse the tree one more time to
;; collect this data, and I think that it's not worth it.
(mapcar (lambda (mapping)
- (if (not (eq (cadr mapping) 'apply-partially))
+ (if (not (eq (cadr mapping) #'apply-partially))
mapping
(cl-assert (eq (car mapping) (nth 2 mapping)))
`(,(car mapping)
@@ -258,17 +258,16 @@ Returns a form where all lambdas don't have any free variables."
;; unused vars.
(not (intern-soft var))
(eq ?_ (aref (symbol-name var) 0))
- ;; As a special exception, ignore "ignore".
+ ;; As a special exception, ignore "ignored".
(eq var 'ignored))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
- varkind var
+ varkind (bare-symbol var)
(if suggestions (concat "\n " suggestions) "")))))
(define-inline cconv--var-classification (binder form)
(inline-quote
- (alist-get (cons ,binder ,form) cconv-var-classification
- nil nil #'equal)))
+ (cdr (assoc (cons ,binder ,form) cconv-var-classification))))
(defun cconv--convert-funcbody (funargs funcbody env parentform)
"Run `cconv-convert' on FUNCBODY, the forms of a lambda expression.
@@ -286,24 +285,38 @@ of converted forms."
(let (and (pred stringp) msg)
(cconv--warn-unused-msg arg "argument")))
(if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed?
- (push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers))
+ (push (lambda (body) (macroexp--warn-wrap arg msg body 'lexical)) wrappers))
(_
(if (assq arg env) (push `(,arg . nil) env)))))
(setq funcbody (mapcar (lambda (form)
(cconv-convert form env nil))
funcbody))
(if wrappers
- (let ((special-forms '()))
- ;; Keep special forms at the beginning of the body.
- (while (or (and (cdr funcbody) (stringp (car funcbody))) ;docstring.
- (memq (car-safe (car funcbody))
- '(interactive declare :documentation)))
- (push (pop funcbody) special-forms))
- (let ((body (macroexp-progn funcbody)))
+ (pcase-let ((`(,decls . ,body) (macroexp-parse-body funcbody)))
+ (let ((body (macroexp-progn body)))
(dolist (wrapper wrappers) (setq body (funcall wrapper body)))
- `(,@(nreverse special-forms) ,@(macroexp-unprogn body))))
+ `(,@decls ,@(macroexp-unprogn body))))
funcbody)))
+(defun cconv--lifted-arg (var env)
+ "The argument to use for VAR in λ-lifted calls according to ENV.
+This is used when VAR is being shadowed; we may still need its value for
+such calls."
+ (let ((mapping (cdr (assq var env))))
+ (pcase-exhaustive mapping
+ (`(internal-get-closed-var . ,_)
+ ;; The variable is captured.
+ mapping)
+ (`(car-safe ,exp)
+ ;; The variable is mutably captured; skip
+ ;; the indirection step because the variable is
+ ;; passed "by reference" to the λ-lifted function.
+ exp)
+ (_
+ ;; The variable is not captured; use the (shadowed) variable value.
+ ;; (If the mapping is `(car-safe SYMBOL)', SYMBOL is always VAR.
+ var))))
+
(defun cconv-convert (form env extend)
;; This function actually rewrites the tree.
"Return FORM with all its lambdas changed so they are closed.
@@ -353,7 +366,8 @@ places where they originally did not directly appear."
(var (if (not (consp binder))
(prog1 binder (setq binder (list binder)))
(when (cddr binder)
- (byte-compile-warn
+ (byte-compile-warn-x
+ binder
"Malformed `%S' binding: %S"
letsym binder))
(setq value (cadr binder))
@@ -361,9 +375,9 @@ places where they originally did not directly appear."
(cond
;; Ignore bindings without a valid name.
((not (symbolp var))
- (byte-compile-warn "attempt to let-bind nonvariable `%S'" var))
+ (byte-compile-warn-x var "attempt to let-bind nonvariable `%S'" var))
((or (booleanp var) (keywordp var))
- (byte-compile-warn "attempt to let-bind constant `%S'" var))
+ (byte-compile-warn-x var "attempt to let-bind constant `%S'" var))
(t
(let ((new-val
(pcase (cconv--var-classification binder form)
@@ -413,11 +427,14 @@ places where they originally did not directly appear."
;; Declared variable is unused.
(if (assq var new-env)
(push `(,var) new-env)) ;FIXME:Needed?
- (let ((newval
- `(ignore ,(cconv-convert value env extend)))
- (msg (cconv--warn-unused-msg var "variable")))
+ (let* ((Ignore (if (symbol-with-pos-p var)
+ (position-symbol 'ignore var)
+ 'ignore))
+ (newval `(,Ignore
+ ,(cconv-convert value env extend)))
+ (msg (cconv--warn-unused-msg var "variable")))
(if (null msg) newval
- (macroexp--warn-wrap msg newval 'lexical))))
+ (macroexp--warn-wrap var msg newval 'lexical))))
;; Normal default case.
(_
@@ -428,10 +445,14 @@ places where they originally did not directly appear."
;; One of the lambda-lifted vars is shadowed, so add
;; a reference to the outside binding and arrange to use
;; that reference.
- (let ((closedsym (make-symbol (format "closed-%s" var))))
+ (let ((var-def (cconv--lifted-arg var env))
+ (closedsym (make-symbol (format "closed-%s" var))))
(setq new-env (cconv--remap-llv new-env var closedsym))
+ ;; FIXME: `closedsym' doesn't need to be added to `extend'
+ ;; but adding it makes it easier to write the assertion at
+ ;; the beginning of this function.
(setq new-extend (cons closedsym (remq var new-extend)))
- (push `(,closedsym ,var) binders-new)))
+ (push `(,closedsym ,var-def) binders-new)))
;; We push the element after redefined free variables are
;; processed. This is important to avoid the bug when free
@@ -449,14 +470,13 @@ places where they originally did not directly appear."
;; before we know that the var will be in `new-extend' (bug#24171).
(dolist (binder binders-new)
(when (memq (car-safe binder) new-extend)
- ;; One of the lambda-lifted vars is shadowed, so add
- ;; a reference to the outside binding and arrange to use
- ;; that reference.
+ ;; One of the lambda-lifted vars is shadowed.
(let* ((var (car-safe binder))
+ (var-def (cconv--lifted-arg var env))
(closedsym (make-symbol (format "closed-%s" var))))
(setq new-env (cconv--remap-llv new-env var closedsym))
(setq new-extend (cons closedsym (remq var new-extend)))
- (push `(,closedsym ,var) binders-new)))))
+ (push `(,closedsym ,var-def) binders-new)))))
`(,letsym ,(nreverse binders-new)
. ,(mapcar (lambda (form)
@@ -476,11 +496,11 @@ places where they originally did not directly appear."
args)))
(`(cond . ,cond-forms) ; cond special form
- `(cond . ,(mapcar (lambda (branch)
- (mapcar (lambda (form)
- (cconv-convert form env extend))
- branch))
- cond-forms)))
+ `(,(car form) . ,(mapcar (lambda (branch)
+ (mapcar (lambda (form)
+ (cconv-convert form env extend))
+ branch))
+ cond-forms)))
(`(function (lambda ,args . ,body) . ,_)
(let ((docstring (if (eq :documentation (car-safe (car body)))
@@ -514,9 +534,9 @@ places where they originally did not directly appear."
(msg (when (eq class :unused)
(cconv--warn-unused-msg var "variable")))
(newprotform (cconv-convert protected-form env extend)))
- `(condition-case ,var
+ `(,(car form) ,var
,(if msg
- (macroexp--warn-wrap msg newprotform 'lexical)
+ (macroexp--warn-wrap var msg newprotform 'lexical)
newprotform)
,@(mapcar
(lambda (handler)
@@ -530,33 +550,23 @@ places where they originally did not directly appear."
`((let ((,var (list ,var))) ,@body))))))
handlers))))
- (`(unwind-protect ,form . ,body)
- `(unwind-protect ,(cconv-convert form env extend)
- :fun-body ,(cconv--convert-function () body env form)))
-
- (`(setq . ,forms) ; setq special form
- (if (= (logand (length forms) 1) 1)
- ;; With an odd number of args, let bytecomp.el handle the error.
- form
- (let ((prognlist ()))
- (while forms
- (let* ((sym (pop forms))
- (sym-new (or (cdr (assq sym env)) sym))
- (value (cconv-convert (pop forms) env extend)))
- (push (pcase sym-new
- ((pred symbolp) `(setq ,sym-new ,value))
- (`(car-safe ,iexp) `(setcar ,iexp ,value))
- ;; This "should never happen", but for variables which are
- ;; mutated+captured+unused, we may end up trying to `setq'
- ;; on a closed-over variable, so just drop the setq.
- (_ ;; (byte-compile-report-error
- ;; (format "Internal error in cconv of (setq %s ..)"
- ;; sym-new))
- value))
- prognlist)))
- (if (cdr prognlist)
- `(progn . ,(nreverse prognlist))
- (car prognlist)))))
+ (`(unwind-protect ,form1 . ,body)
+ `(,(car form) ,(cconv-convert form1 env extend)
+ :fun-body ,(cconv--convert-function () body env form1)))
+
+ (`(setq ,var ,expr)
+ (let ((var-new (or (cdr (assq var env)) var))
+ (value (cconv-convert expr env extend)))
+ (pcase var-new
+ ((pred symbolp) `(,(car form) ,var-new ,value))
+ (`(car-safe ,iexp) `(setcar ,iexp ,value))
+ ;; This "should never happen", but for variables which are
+ ;; mutated+captured+unused, we may end up trying to `setq'
+ ;; on a closed-over variable, so just drop the setq.
+ (_ ;; (byte-compile-report-error
+ ;; (format "Internal error in cconv of (setq %s ..)"
+ ;; sym-new))
+ value))))
(`(,(and (or 'funcall 'apply) callsym) ,fun . ,args)
;; These are not special forms but we treat them separately for the needs
@@ -580,12 +590,20 @@ places where they originally did not directly appear."
(cons fun args)))))))
(`(interactive . ,forms)
- `(interactive . ,(mapcar (lambda (form)
+ `(,(car form) . ,(mapcar (lambda (form)
(cconv-convert form nil nil))
forms)))
(`(declare . ,_) form) ;The args don't contain code.
+ (`(oclosure--fix-type (ignore . ,vars) ,exp)
+ (dolist (var vars)
+ (let ((x (assq var env)))
+ (pcase (cdr x)
+ (`(car-safe . ,_) (error "Slot %S should not be mutated" var))
+ (_ (cl-assert (null (cdr x)))))))
+ (cconv-convert exp env extend))
+
(`(,func . ,forms)
;; First element is function or whatever function-like forms are: or, and,
;; if, catch, progn, prog1, while, until
@@ -608,10 +626,10 @@ FORM is the parent form that binds this var."
(`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
- ;; so as to give better position information and obey
- ;; `byte-compile-warnings'.
- (byte-compile-warn
- "%s `%S' not left unused" varkind var))
+ ;; so as to give better position information.
+ (when (byte-compile-warning-enabled-p 'not-unused var)
+ (byte-compile-warn-x
+ var "%s `%S' not left unused" varkind var)))
((and (let (or 'let* 'let) (car form))
`((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
t nil ,_ ,_))
@@ -619,7 +637,7 @@ FORM is the parent form that binds this var."
;; so as to give better position information and obey
;; `byte-compile-warnings'.
(unless (not (intern-soft var))
- (byte-compile-warn "Variable `%S' left uninitialized" var))))
+ (byte-compile-warn-x var "Variable `%S' left uninitialized" var))))
(pcase vardata
(`(,binder nil ,_ ,_ nil)
(push (cons (cons binder form) :unused) cconv-var-classification))
@@ -645,17 +663,19 @@ FORM is the parent form that binds this var."
;; Push it before recursing, so cconv-freevars-alist contains entries in
;; the order they'll be used by closure-convert-rec.
(push freevars cconv-freevars-alist)
- (dolist (arg args)
- (cond
- ((byte-compile-not-lexical-var-p arg)
- (byte-compile-warn
- "Lexical argument shadows the dynamic variable %S"
- arg))
- ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
- (t (let ((varstruct (list arg nil nil nil nil)))
- (cl-pushnew arg byte-compile-lexical-variables)
- (push (cons (list arg) (cdr varstruct)) newvars)
- (push varstruct newenv)))))
+ (when lexical-binding
+ (dolist (arg args)
+ (cond
+ ((byte-compile-not-lexical-var-p arg)
+ (byte-compile-warn-x
+ arg
+ "Lexical argument shadows the dynamic variable %S"
+ arg))
+ ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
+ (t (let ((varstruct (list arg nil nil nil nil)))
+ (cl-pushnew arg byte-compile-lexical-variables)
+ (push (cons (list arg) (cdr varstruct)) newvars)
+ (push varstruct newenv))))))
(dolist (form body) ;Analyze body forms.
(cconv-analyze-form form newenv))
;; Summarize resulting data about arguments.
@@ -704,7 +724,7 @@ This function does not return anything but instead fills the
(cconv-analyze-form value (if (eq letsym 'let*) env orig-env)))
- (unless (byte-compile-not-lexical-var-p var)
+ (unless (or (byte-compile-not-lexical-var-p var) (not lexical-binding))
(cl-pushnew var byte-compile-lexical-variables)
(let ((varstruct (list var nil nil nil nil)))
(push (cons binder (cdr varstruct)) newvars)
@@ -721,17 +741,17 @@ This function does not return anything but instead fills the
(cconv-analyze-form (cadr (pop body-forms)) env))
(cconv--analyze-function vrs body-forms env form))
- (`(setq . ,forms)
+ (`(setq ,var ,expr)
;; If a local variable (member of env) is modified by setq then
;; it is a mutated variable.
- (while forms
- (let ((v (assq (car forms) env))) ; v = non nil if visible
- (when v (setf (nth 2 v) t)))
- (cconv-analyze-form (cadr forms) env)
- (setq forms (cddr forms))))
+ (let ((v (assq var env))) ; v = non nil if visible
+ (when v
+ (setf (nth 2 v) t)))
+ (cconv-analyze-form expr env))
(`((lambda . ,_) . ,_) ; First element is lambda expression.
- (byte-compile-warn
+ (byte-compile-warn-x
+ (nth 1 (car form))
"Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form)))
(dolist (exp `((function ,(car form)) . ,(cdr form)))
(cconv-analyze-form exp env)))
@@ -749,9 +769,11 @@ This function does not return anything but instead fills the
(`(condition-case ,var ,protected-form . ,handlers)
(cconv-analyze-form protected-form env)
+ (unless lexical-binding
+ (setq var nil))
(when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
- (byte-compile-warn
- "Lexical variable shadows the dynamic variable %S" var))
+ (byte-compile-warn-x
+ var "Lexical variable shadows the dynamic variable %S" var))
(let* ((varstruct (list var nil nil nil nil)))
(if var (push varstruct env))
(dolist (handler handlers)
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 4186a541f82..716b236d3ab 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -1,7 +1,6 @@
;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2022 Free
-;; Software Foundation, Inc.
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.2
@@ -64,7 +63,6 @@
(eval-when-compile (require 'cl-generic))
;;; Code:
-(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1")
(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
(defvar-local chart-local-object nil
@@ -76,8 +74,7 @@
Colors will be the background color.")
(defvar chart-face-pixmap-list
- (if (and (fboundp 'display-graphic-p)
- (display-graphic-p))
+ (if (display-graphic-p)
'("dimple1" "scales" "dot" "cross_weave" "boxes" "dimple3"))
"If pixmaps are allowed, display these background pixmaps.
Useful if new Emacs is used on B&W display.")
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index eeefb3de10c..83187acf71e 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -319,10 +319,7 @@ Returns non-nil if any false statements are found."
(setq root (directory-file-name (file-relative-name root)))
(or (file-directory-p root)
(error "Directory `%s' not found" root))
- (let ((files (process-lines find-program root
- "-name" "*.el"
- "-exec" grep-program
- "-l" "^[ \t]*(declare-function" "{}" "+")))
+ (let ((files (directory-files-recursively root "\\.el\\'")))
(when files
(apply #'check-declare-files files))))
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 660b7062d1e..611f32e23c6 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -165,8 +165,8 @@
(require 'cl-lib)
(require 'help-mode) ;; for help-xref-info-regexp
(require 'thingatpt) ;; for handy thing-at-point-looking-at
-(require 'lisp-mode) ;; for lisp-mode-symbol-regexp
-(require 'dired) ;; for dired-get-filename and dired-map-over-marks
+(require 'lisp-mode) ;; for lisp-mode-symbol regexp
+(eval-when-compile (require 'dired)) ;; for dired-map-over-marks
(require 'lisp-mnt)
(defvar compilation-error-regexp-alist)
@@ -327,7 +327,7 @@ This should be set in an Emacs Lisp file's local variables."
;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable #'checkdoc-list-of-strings-p)
(defcustom checkdoc-column-zero-backslash-before-paren t
- "Non-nil means to warn if there is no '\\' before '(' in column zero.
+ "Non-nil means to warn if there is no \"\\\" before \"(\" in column zero.
This backslash is no longer needed on Emacs 27.1 or later.
See Info node `(elisp) Documentation Tips' for background."
@@ -340,6 +340,7 @@ See Info node `(elisp) Documentation Tips' for background."
;; (setq checkdoc--argument-missing-flag nil) ; optional
;; (setq checkdoc--disambiguate-symbol-flag nil) ; optional
;; (setq checkdoc--interactive-docstring-flag nil) ; optional
+;; (setq checkdoc-verb-check-experimental-flag nil)
;; Then use `M-x find-dired' ("-name '*.el'") and `M-x checkdoc-dired'
(defvar checkdoc--argument-missing-flag t
@@ -494,6 +495,9 @@ be re-created.")
(defconst checkdoc--help-buffer "*Checkdoc Help*"
"Name of buffer used for Checkdoc Help.")
+(defvar checkdoc-commentary-header-string "\n;;; Commentary:\n;; \n\n"
+ "String inserted as commentary marker in `checkdoc-file-comments-engine'.")
+
;;; User level commands
;;
;;;###autoload
@@ -1113,18 +1117,27 @@ space at the end of each line."
";;; lisp/trampver.el. Generated from trampver.el.in by configure."))
"Regexp that when it matches tells `checkdoc-dired' to skip a file.")
+;;;###autoload
(defun checkdoc-dired (files)
"In Dired, run `checkdoc' on marked files.
Skip anything that doesn't have the Emacs Lisp library file
extension (\".el\").
When called from Lisp, FILES is a list of filenames."
(interactive
- (list
- (delq nil
- (mapcar
- ;; skip anything that doesn't look like an Emacs Lisp library
- (lambda (f) (if (equal (file-name-extension f) "el") f nil))
- (nreverse (dired-map-over-marks (dired-get-filename) nil)))))
+ (progn
+ ;; These Dired functions must be defined since we're in a Dired buffer.
+ (declare-function dired-get-filename "dired"
+ (&optional localp no-error-if-not-filep))
+ ;; These functions are used by the expansion of `dired-map-over-marks'.
+ (declare-function dired-move-to-filename "dired"
+ (&optional raise-error eol))
+ (declare-function dired-marker-regexp "dired" ())
+ (list
+ (delq nil
+ (mapcar
+ ;; skip anything that doesn't look like an Emacs Lisp library
+ (lambda (f) (if (equal (file-name-extension f) "el") f nil))
+ (nreverse (dired-map-over-marks (dired-get-filename) nil))))))
dired-mode)
(if (null files)
(error "No files to run checkdoc on")
@@ -1266,38 +1279,30 @@ TEXT, START, END and UNFIXABLE conform to
;;; Minor Mode specification
;;
-(defvar checkdoc-minor-mode-map
- (let ((map (make-sparse-keymap))
- (pmap (make-sparse-keymap)))
- ;; Override some bindings
- (define-key map "\C-\M-x" 'checkdoc-eval-defun)
- (define-key map "\C-x`" 'checkdoc-continue)
- (define-key map [menu-bar emacs-lisp eval-buffer]
- 'checkdoc-eval-current-buffer)
- ;; Add some new bindings under C-c ?
- (define-key pmap "x" 'checkdoc-defun)
- (define-key pmap "X" 'checkdoc-ispell-defun)
- (define-key pmap "`" 'checkdoc-continue)
- (define-key pmap "~" 'checkdoc-ispell-continue)
- (define-key pmap "s" 'checkdoc-start)
- (define-key pmap "S" 'checkdoc-ispell-start)
- (define-key pmap "d" 'checkdoc)
- (define-key pmap "D" 'checkdoc-ispell)
- (define-key pmap "b" 'checkdoc-current-buffer)
- (define-key pmap "B" 'checkdoc-ispell-current-buffer)
- (define-key pmap "e" 'checkdoc-eval-current-buffer)
- (define-key pmap "m" 'checkdoc-message-text)
- (define-key pmap "M" 'checkdoc-ispell-message-text)
- (define-key pmap "c" 'checkdoc-comments)
- (define-key pmap "C" 'checkdoc-ispell-comments)
- (define-key pmap " " 'checkdoc-rogue-spaces)
-
- ;; bind our submap into map
- (define-key map "\C-c?" pmap)
- map)
- "Keymap used to override evaluation key-bindings for documentation checking.")
-
-;; Add in a menubar with easy-menu
+(defvar-keymap checkdoc-minor-mode-map
+ :doc "Keymap used to override evaluation key-bindings for documentation checking."
+ ;; Override some bindings
+ "C-M-x" #'checkdoc-eval-defun
+ "C-x `" #'checkdoc-continue
+ "<menu-bar> <emacs-lisp> <eval-buffer>" #'checkdoc-eval-current-buffer
+
+ ;; Add some new bindings under C-c ?
+ "C-c ? x" #'checkdoc-defun
+ "C-c ? X" #'checkdoc-ispell-defun
+ "C-c ? `" #'checkdoc-continue
+ "C-c ? ~" #'checkdoc-ispell-continue
+ "C-c ? s" #'checkdoc-start
+ "C-c ? S" #'checkdoc-ispell-start
+ "C-c ? d" #'checkdoc
+ "C-c ? D" #'checkdoc-ispell
+ "C-c ? b" #'checkdoc-current-buffer
+ "C-c ? B" #'checkdoc-ispell-current-buffer
+ "C-c ? e" #'checkdoc-eval-current-buffer
+ "C-c ? m" #'checkdoc-message-text
+ "C-c ? M" #'checkdoc-ispell-message-text
+ "C-c ? c" #'checkdoc-comments
+ "C-c ? C" #'checkdoc-ispell-comments
+ "C-c ? SPC" #'checkdoc-rogue-spaces)
(easy-menu-define nil checkdoc-minor-mode-map
"Checkdoc Minor Mode Menu."
@@ -1994,6 +1999,7 @@ from the comment."
(let ((defun (looking-at
"(\\(?:cl-\\)?def\\(un\\|macro\\|subst\\|advice\\|generic\\|method\\)"))
(is-advice (looking-at "(defadvice"))
+ (defun-depth (ppss-depth (syntax-ppss)))
(lst nil)
(ret nil)
(oo (make-vector 3 0))) ;substitute obarray for `read'
@@ -2009,11 +2015,17 @@ from the comment."
(setq ret (cons nil ret))
;; Interactive
(save-excursion
- (setq ret (cons
- (re-search-forward "^\\s-*(interactive"
- (save-excursion (end-of-defun) (point))
- t)
- ret)))
+ (push (and (re-search-forward "^\\s-*(interactive"
+ (save-excursion
+ (end-of-defun)
+ (point))
+ t)
+ ;; Disregard `interactive' from other parts of
+ ;; the function.
+ (= (ppss-depth (syntax-ppss))
+ (+ defun-depth 2))
+ (point))
+ ret))
(skip-chars-forward " \t\n")
(let ((bss (buffer-substring (point) (save-excursion (forward-sexp 1)
(point))))
@@ -2126,13 +2138,11 @@ Examples of recognized abbreviations: \"e.g.\", \"i.e.\", \"cf.\"."
;; a part of a list.
(rx letter ".")
(rx (or
- ;; The abbreviations:
+ ;; The abbreviations (a trailing dot is added below).
(seq (any "cC") "f") ; cf.
(seq (any "eE") ".g") ; e.g.
(seq (any "iI") "." (any "eE")) ; i.e.
- "a.k.a" ; a.k.a.
- "etc" ; etc.
- "vs" ; vs.
+ "a.k.a" "etc" "vs" "N.B"
;; Some non-standard or less common ones that we
;; might as well accept.
"Inc" "Univ" "misc" "resp")
@@ -2223,7 +2233,7 @@ If the offending word is in a piece of quoted text, then it is skipped."
;;
(defvar ispell-process)
(declare-function ispell-buffer-local-words "ispell" ())
-(declare-function ispell-correct-p "ispell" ())
+(declare-function ispell-correct-p "ispell" (&optional following))
(declare-function ispell-set-spellchecker-params "ispell" ())
(declare-function ispell-accept-buffer-local-defs "ispell" ())
(declare-function ispell-error-checking-word "ispell" (word))
@@ -2411,7 +2421,7 @@ Code:, and others referenced in the style guide."
nil nil t)))
(if (checkdoc-y-or-n-p
"You should have a \";;; Commentary:\", add one?")
- (insert "\n;;; Commentary:\n;; \n\n")
+ (insert checkdoc-commentary-header-string)
(checkdoc-create-error
"You should have a section marked \";;; Commentary:\""
nil nil t)))
@@ -2453,11 +2463,9 @@ Code:, and others referenced in the style guide."
pos)
(goto-char (point-min))
;; match ";;;###autoload" cookie to keep it with the form
- (require 'autoload)
(while (and cont (re-search-forward
- (concat "^\\("
- (regexp-quote generate-autoload-cookie)
- "\n\\)?"
+ (concat "^\\(" lisp-mode-autoload-regexp
+ "\n\\)?"
"(")
nil t))
(setq pos (match-beginning 0)
@@ -2588,13 +2596,13 @@ The correct format is \"Foo\" or \"some-symbol: Foo\". See also
(unless (let ((case-fold-search nil))
(looking-at (rx (or upper-case "%s"))))
;; A defined Lisp symbol is always okay.
- (unless (and (looking-at (rx (group (regexp lisp-mode-symbol-regexp))))
+ (unless (and (looking-at (rx (group lisp-mode-symbol)))
(or (fboundp (intern (match-string 1)))
(boundp (intern (match-string 1)))))
;; Other Lisp symbols are sometimes okay.
(rx-let ((c (? "\\\n"))) ; `c' is for a continued line
(let ((case-fold-search nil)
- (some-symbol (rx (regexp lisp-mode-symbol-regexp)
+ (some-symbol (rx lisp-mode-symbol
c ":" c (+ (any " \t\n"))))
(lowercase-str (rx c (group (any "a-z") (+ wordchar)))))
(if (looking-at some-symbol)
@@ -2619,7 +2627,7 @@ a space as a style error."
(checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
(format-message
- "`y-or-n-p' argument should end with \"? \". Fix?")
+ "`y-or-n-p' argument should end with \"?\". Fix?")
"?\"" t))
nil
(checkdoc-create-error
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index add8e7fda0c..0560ddda268 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -86,6 +86,14 @@
;;; Code:
+;; We provide a mechanism to define new specializers.
+;; Related work can be found in:
+;; - http://www.p-cos.net/documents/filtered-dispatch.pdf
+;; - Generalizers: New metaobjects for generalized dispatch
+;; http://research.gold.ac.uk/9924/1/els-specializers.pdf
+;; This second one is closely related to what we do here (and that's
+;; the name "generalizer" comes from).
+
;; The autoloads.el mechanism which adds package--builtin-versions
;; maintenance to loaddefs.el doesn't work for preloaded packages (such
;; as this one), so we have to do it by hand!
@@ -100,6 +108,7 @@
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'cl-macs)) ;For cl--find-class.
(eval-when-compile (require 'pcase))
+(eval-when-compile (require 'subr-x))
(cl-defstruct (cl--generic-generalizer
(:constructor nil)
@@ -135,13 +144,20 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
(cl-defstruct (cl--generic-method
(:constructor nil)
(:constructor cl--generic-make-method
- (specializers qualifiers uses-cnm function))
+ (specializers qualifiers call-con function))
(:predicate nil))
(specializers nil :read-only t :type list)
(qualifiers nil :read-only t :type (list-of atom))
- ;; USES-CNM is a boolean indicating if FUNCTION expects an extra argument
- ;; holding the next-method.
- (uses-cnm nil :read-only t :type boolean)
+ ;; CALL-CON indicates the calling convention expected by FUNCTION:
+ ;; - nil: FUNCTION is just a normal function with no extra arguments for
+ ;; `call-next-method' or `next-method-p' (which it hence can't use).
+ ;; - `curried': FUNCTION is a curried function that first takes the
+ ;; "next combined method" and return the resulting combined method.
+ ;; It can distinguish `next-method-p' by checking if that next method
+ ;; is `cl--generic-isnot-nnm-p'.
+ ;; - t: FUNCTION takes the `call-next-method' function as its first (extra)
+ ;; argument.
+ (call-con nil :read-only t :type symbol)
(function nil :read-only t :type function))
(cl-defstruct (cl--generic
@@ -253,6 +269,16 @@ DEFAULT-BODY, if present, is used as the body of a default method.
(declarations nil)
(methods ())
(options ())
+ (warnings
+ (let ((nonsymargs
+ (delq nil (mapcar (lambda (arg) (unless (symbolp arg) arg))
+ args))))
+ (when nonsymargs
+ (list
+ (macroexp-warn-and-return
+ (format "Non-symbol arguments to cl-defgeneric: %s"
+ (mapconcat #'prin1-to-string nonsymargs ""))
+ nil nil nil nonsymargs)))))
next-head)
(while (progn (setq next-head (car-safe (car options-and-methods)))
(or (keywordp next-head)
@@ -275,12 +301,17 @@ DEFAULT-BODY, if present, is used as the body of a default method.
(setq name (gv-setter (cadr name))))
`(prog1
(progn
+ ,@warnings
(defalias ',name
(cl-generic-define ',name ',args ',(nreverse options))
- ,(help-add-fundoc-usage doc args))
+ ,(if (consp doc) ;An expression rather than a constant.
+ `(help-add-fundoc-usage ,doc ',args)
+ (help-add-fundoc-usage doc args)))
:autoload-end
- ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
- (nreverse methods)))
+ ,(when methods
+ `(with-suppressed-warnings ((obsolete ,name))
+ ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+ (nreverse methods)))))
,@(mapcar (lambda (declaration)
(let ((f (cdr (assq (car declaration)
defun-declarations-alist))))
@@ -370,14 +401,16 @@ the specializer used will be the one returned by BODY."
. ,(lambda () spec-args))
macroexpand-all-environment)))
(require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'.
- (when (interactive-form (cadr fun))
- (message "Interactive forms unsupported in generic functions: %S"
- (interactive-form (cadr fun))))
+ (when (assq 'interactive body)
+ (message "Interactive forms not supported in generic functions: %S"
+ (assq 'interactive body)))
;; First macroexpand away the cl-function stuff (e.g. &key and
;; destructuring args, `declare' and whatnot).
(pcase (macroexpand fun macroenv)
(`#'(lambda ,args . ,body)
(let* ((parsed-body (macroexp-parse-body body))
+ (nm (make-symbol "cl--nm"))
+ (arglist (make-symbol "cl--args"))
(cnm (make-symbol "cl--cnm"))
(nmp (make-symbol "cl--nmp"))
(nbody (macroexpand-all
@@ -390,15 +423,49 @@ the specializer used will be the one returned by BODY."
;; is used.
;; FIXME: Also, optimize the case where call-next-method is
;; only called with explicit arguments.
- (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
- (cons (not (not uses-cnm))
- `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
- ,@(car parsed-body)
- ,(if (not (assq nmp uses-cnm))
- nbody
- `(let ((,nmp (lambda ()
- (cl--generic-isnot-nnm-p ,cnm))))
- ,nbody))))))
+ (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody))
+ (λ-lift (mapcar #'car uses-cnm)))
+ (if (not uses-cnm)
+ (cons nil
+ `#'(lambda (,@args)
+ ,@(car parsed-body)
+ ,nbody))
+ (cons 'curried
+ `#'(lambda (,nm) ;Called when constructing the effective method.
+ (let ((,nmp (if (cl--generic-isnot-nnm-p ,nm)
+ #'always #'ignore)))
+ ;; This `(λ (&rest x) .. (apply (λ (args) ..) x))'
+ ;; dance is needed because we need to get the original
+ ;; args as a list when `cl-call-next-method' is
+ ;; called with no arguments. It's important to
+ ;; capture it as a list since it needs to distinguish
+ ;; the nil case from the absent case in optional
+ ;; arguments and it needs to properly remember the
+ ;; original value if `nbody' mutates some of its
+ ;; formal args.
+ ;; FIXME: This `(λ (&rest ,arglist)' could be skipped
+ ;; when we know `cnm' is always called with args, and
+ ;; it could be implemented more efficiently if `cnm'
+ ;; is always called directly and there are no
+ ;; `&optional' args.
+ (lambda (&rest ,arglist)
+ ,@(let* ((prebody (car parsed-body))
+ (ds (if (stringp (car prebody))
+ prebody
+ (setq prebody (cons nil prebody))))
+ (usage (help-split-fundoc (car ds) nil)))
+ (unless usage
+ (setcar ds (help-add-fundoc-usage (car ds)
+ args)))
+ prebody)
+ (let ((,cnm (lambda (&rest args)
+ (apply ,nm (or args ,arglist)))))
+ ;; This `apply+lambda' basically parses
+ ;; `arglist' according to `args'.
+ ;; A destructuring-bind would do the trick
+ ;; as well when/if it's more efficient.
+ (apply (lambda (,@λ-lift ,@args) ,nbody)
+ ,@λ-lift ,arglist)))))))))
(f (error "Unexpected macroexpansion result: %S" f))))))
(put 'cl-defmethod 'function-documentation
@@ -495,23 +562,18 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(require 'gv)
(declare-function gv-setter "gv" (name))
(setq name (gv-setter (cadr name))))
- (pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
+ (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body)))
`(progn
- ,(and (get name 'byte-obsolete-info)
- (or (not (fboundp 'byte-compile-warning-enabled-p))
- (byte-compile-warning-enabled-p 'obsolete name))
- (let* ((obsolete (get name 'byte-obsolete-info)))
- (macroexp-warn-and-return
- (macroexp--obsolete-warning name obsolete "generic function")
- nil)))
;; You could argue that `defmethod' modifies rather than defines the
;; function, so warnings like "not known to be defined" are fair game.
;; But in practice, it's common to use `cl-defmethod'
;; without a previous `cl-defgeneric'.
;; The ",'" is a no-op that pacifies check-declare.
(,'declare-function ,name "")
- (cl-generic-define-method ',name ',(nreverse qualifiers) ',args
- ,uses-cnm ,fun)))))
+ ;; We use #' to quote `name' so as to trigger an
+ ;; obsolescence warning when applicable.
+ (cl-generic-define-method #',name ',(nreverse qualifiers) ',args
+ ',call-con ,fun)))))
(defun cl--generic-member-method (specializers qualifiers methods)
(while
@@ -529,7 +591,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
`(,name ,qualifiers . ,specializers))
;;;###autoload
-(defun cl-generic-define-method (name qualifiers args uses-cnm function)
+(defun cl-generic-define-method (name qualifiers args call-con function)
(pcase-let*
((generic (cl-generic-ensure-function name))
(`(,spec-args . ,_) (cl--generic-split-args args))
@@ -538,7 +600,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
spec-arg (cdr spec-arg)))
spec-args))
(method (cl--generic-make-method
- specializers qualifiers uses-cnm function))
+ specializers qualifiers call-con function))
(mt (cl--generic-method-table generic))
(me (cl--generic-member-method specializers qualifiers mt))
(dispatches (cl--generic-dispatches generic))
@@ -589,22 +651,43 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
;; e.g. for tracing/debug-on-entry.
(defalias sym gfun)))))
-(defmacro cl--generic-with-memoization (place &rest code)
- (declare (indent 1) (debug t))
- (gv-letplace (getter setter) place
- `(or ,getter
- ,(macroexp-let2 nil val (macroexp-progn code)
- `(progn
- ,(funcall setter val)
- ,val)))))
-
(defvar cl--generic-dispatchers (make-hash-table :test #'equal))
+(defvar cl--generic-compiler
+ ;; Don't byte-compile the dispatchers if cl-generic itself is not
+ ;; compiled. Otherwise the byte-compiler and all the code on
+ ;; which it depends needs to be usable before cl-generic is loaded,
+ ;; which imposes a significant burden on the bootstrap.
+ (if (consp (lambda (x) (+ x 1)))
+ (lambda (exp) (eval exp t))
+ ;; But do byte-compile the dispatchers once bootstrap is passed:
+ ;; the performance difference is substantial (like a 5x speedup on
+ ;; the `eieio' elisp-benchmark)).
+ ;; To avoid loading the byte-compiler during the final preload,
+ ;; see `cl--generic-prefill-dispatchers'.
+ #'byte-compile))
+
(defun cl--generic-get-dispatcher (dispatch)
- (cl--generic-with-memoization
+ (with-memoization
;; We need `copy-sequence` here because this `dispatch' object might be
;; modified by side-effect in `cl-generic-define-method' (bug#46722).
(gethash (copy-sequence dispatch) cl--generic-dispatchers)
+
+ (when (and purify-flag ;FIXME: Is this a reliable test of the final dump?
+ (eq cl--generic-compiler #'byte-compile))
+ ;; We don't want to preload the byte-compiler!!
+ (error
+ "Missing cl-generic dispatcher in the prefilled cache!
+Missing for: %S
+You might need to add: %S"
+ (mapcar (lambda (x) (if (cl--generic-generalizer-p x)
+ (cl--generic-generalizer-name x)
+ x))
+ dispatch)
+ `(cl--generic-prefill-dispatchers
+ ,@(delq nil (mapcar #'cl--generic-prefill-generalizer-sample
+ dispatch)))))
+
;; (message "cl--generic-get-dispatcher (%S)" dispatch)
(let* ((dispatch-arg (car dispatch))
(generalizers (cdr dispatch))
@@ -644,12 +727,13 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
;; FIXME: For generic functions with a single method (or with 2 methods,
;; one of which always matches), using a tagcode + hash-table is
;; overkill: better just use a `cl-typep' test.
- (byte-compile
+ (funcall
+ cl--generic-compiler
`(lambda (generic dispatches-left methods)
(let ((method-cache (make-hash-table :test #'eql)))
(lambda (,@fixedargs &rest args)
(let ,bindings
- (apply (cl--generic-with-memoization
+ (apply (with-memoization
(gethash ,tag-exp method-cache)
(cl--generic-cache-miss
generic ',dispatch-arg dispatches-left methods
@@ -686,14 +770,14 @@ This is particularly useful when many different tags select the same set
of methods, since this table then allows us to share a single combined-method
for all those different tags in the method-cache.")
-(define-error 'cl--generic-cyclic-definition "Cyclic definition: %S")
+(define-error 'cl--generic-cyclic-definition "Cyclic definition")
(defun cl--generic-build-combined-method (generic methods)
(if (null methods)
;; Special case needed to fix a circularity during bootstrap.
(cl--generic-standard-method-combination generic methods)
(let ((f
- (cl--generic-with-memoization
+ (with-memoization
;; FIXME: Since the fields of `generic' are modified, this
;; hash-table won't work right, because the hashes will change!
;; It's not terribly serious, but reduces the effectiveness of
@@ -712,29 +796,38 @@ for all those different tags in the method-cache.")
(list (cl--generic-name generic)))
f))))
-(defun cl--generic-no-next-method-function (generic method)
- (lambda (&rest args)
- (apply #'cl-no-next-method generic method args)))
+(oclosure-define (cl--generic-nnm)
+ "Special type for `call-next-method's that just call `no-next-method'.")
(defun cl-generic-call-method (generic method &optional fun)
"Return a function that calls METHOD.
FUN is the function that should be called when METHOD calls
`call-next-method'."
- (if (not (cl--generic-method-uses-cnm method))
- (cl--generic-method-function method)
- (let ((met-fun (cl--generic-method-function method))
- (next (or fun (cl--generic-no-next-method-function
- generic method))))
- (lambda (&rest args)
- (apply met-fun
- ;; FIXME: This sucks: passing just `next' would
- ;; be a lot more efficient than the lambda+apply
- ;; quasi-η, but we need this to implement the
- ;; "if call-next-method is called with no
- ;; arguments, then use the previous arguments".
- (lambda (&rest cnm-args)
- (apply next (or cnm-args args)))
- args)))))
+ (let ((met-fun (cl--generic-method-function method)))
+ (pcase (cl--generic-method-call-con method)
+ ('nil met-fun)
+ ('curried
+ (funcall met-fun (or fun
+ (oclosure-lambda (cl--generic-nnm) (&rest args)
+ (apply #'cl-no-next-method generic method
+ args)))))
+ ;; FIXME: backward compatibility with old convention for `.elc' files
+ ;; compiled before the `curried' convention.
+ (_
+ (lambda (&rest args)
+ (apply met-fun
+ (if fun
+ ;; FIXME: This sucks: passing just `next' would
+ ;; be a lot more efficient than the lambda+apply
+ ;; quasi-η, but we need this to implement the
+ ;; "if call-next-method is called with no
+ ;; arguments, then use the previous arguments".
+ (lambda (&rest cnm-args)
+ (apply fun (or cnm-args args)))
+ (oclosure-lambda (cl--generic-nnm) (&rest cnm-args)
+ (apply #'cl-no-next-method generic method
+ (or cnm-args args))))
+ args))))))
;; Standard CLOS name.
(defalias 'cl-method-qualifiers #'cl--generic-method-qualifiers)
@@ -859,6 +952,20 @@ those methods.")
(if (eq specializer t) (list cl--generic-t-generalizer)
(error "Unknown specializer %S" specializer)))
+(defun cl--generic-prefill-generalizer-sample (x)
+ "Return an example specializer."
+ (if (not (cl--generic-generalizer-p x))
+ x
+ (pcase (cl--generic-generalizer-name x)
+ ('cl--generic-t-generalizer nil)
+ ('cl--generic-head-generalizer '(head 'x))
+ ('cl--generic-eql-generalizer '(eql 'x))
+ ('cl--generic-struct-generalizer 'cl--generic)
+ ('cl--generic-typeof-generalizer 'integer)
+ ('cl--generic-derived-generalizer '(derived-mode c-mode))
+ ('cl--generic-oclosure-generalizer 'oclosure)
+ (_ x))))
+
(eval-when-compile
;; This macro is brittle and only really important in order to be
;; able to preload cl-generic without also preloading the byte-compiler,
@@ -869,11 +976,20 @@ those methods.")
(setq arg-or-context `(&context . ,arg-or-context)))
(unless (fboundp 'cl--generic-get-dispatcher)
(require 'cl-generic))
- (let ((fun (cl--generic-get-dispatcher
- `(,arg-or-context
- ,@(apply #'append
- (mapcar #'cl-generic-generalizers specializers))
- ,cl--generic-t-generalizer))))
+ (let ((fun
+ ;; Let-bind cl--generic-dispatchers so we *re*compute the function
+ ;; from scratch, since the one in the cache may be non-compiled!
+ (let ((cl--generic-dispatchers (make-hash-table))
+ ;; When compiling `cl-generic' during bootstrap, make sure
+ ;; we prefill with compiled dispatchers even though the loaded
+ ;; `cl-generic' is still interpreted.
+ (cl--generic-compiler
+ (if (featurep 'bytecomp) #'byte-compile cl--generic-compiler)))
+ (cl--generic-get-dispatcher
+ `(,arg-or-context
+ ,@(apply #'append
+ (mapcar #'cl-generic-generalizers specializers))
+ ,cl--generic-t-generalizer)))))
;; Recompute dispatch at run-time, since the generalizers may be slightly
;; different (e.g. byte-compiled rather than interpreted).
;; FIXME: There is a risk that the run-time generalizer is not equivalent
@@ -891,36 +1007,9 @@ those methods.")
"Standard support for :after, :before, :around, and `:extra NAME' qualifiers."
(cl--generic-standard-method-combination generic methods))
-(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t))
-(defconst cl--generic-cnm-sample
- (funcall (cl--generic-build-combined-method
- nil (list (cl--generic-make-method () () t #'identity)))))
-
(defun cl--generic-isnot-nnm-p (cnm)
"Return non-nil if CNM is the function that calls `cl-no-next-method'."
- ;; ¡Big Gross Ugly Hack!
- ;; `next-method-p' just sucks, we should let it die. But EIEIO did support
- ;; it, and some packages use it, so we need to support it.
- (catch 'found
- (cl-assert (function-equal cnm cl--generic-cnm-sample))
- (if (byte-code-function-p cnm)
- (let ((cnm-constants (aref cnm 2))
- (sample-constants (aref cl--generic-cnm-sample 2)))
- (dotimes (i (length sample-constants))
- (when (function-equal (aref sample-constants i)
- cl--generic-nnm-sample)
- (throw 'found
- (not (function-equal (aref cnm-constants i)
- cl--generic-nnm-sample))))))
- (cl-assert (eq 'closure (car-safe cl--generic-cnm-sample)))
- (let ((cnm-env (cadr cnm)))
- (dolist (vb (cadr cl--generic-cnm-sample))
- (when (function-equal (cdr vb) cl--generic-nnm-sample)
- (throw 'found
- (not (function-equal (cdar cnm-env)
- cl--generic-nnm-sample))))
- (setq cnm-env (cdr cnm-env)))))
- (error "Haven't found no-next-method-sample in cnm-sample")))
+ (not (eq (oclosure-type cnm) 'cl--generic-nnm)))
;;; Define some pre-defined generic functions, used internally.
@@ -996,9 +1085,12 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
(defun cl--generic-method-info (method)
(let* ((specializers (cl--generic-method-specializers method))
(qualifiers (cl--generic-method-qualifiers method))
- (uses-cnm (cl--generic-method-uses-cnm method))
+ (call-con (cl--generic-method-call-con method))
(function (cl--generic-method-function method))
- (args (help-function-arglist function 'names))
+ (args (help-function-arglist (if (not (eq call-con 'curried))
+ function
+ (funcall function #'ignore))
+ 'names))
(docstring (documentation function))
(qual-string
(if (null qualifiers) ""
@@ -1009,7 +1101,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
(let ((split (help-split-fundoc docstring nil)))
(if split (cdr split) docstring))))
(combined-args ()))
- (if uses-cnm (setq args (cdr args)))
+ (if (eq t call-con) (setq args (cdr args)))
(dolist (specializer specializers)
(let ((arg (if (eq '&rest (car args))
(intern (format "arg%d" (length combined-args)))
@@ -1019,6 +1111,19 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
(setq combined-args (append (nreverse combined-args) args))
(list qual-string combined-args doconly)))
+(defun cl--generic-upcase-formal-args (args)
+ (mapcar (lambda (arg)
+ (cond
+ ((symbolp arg)
+ (let ((name (symbol-name arg)))
+ (if (eq ?& (aref name 0)) arg
+ (intern (upcase name)))))
+ ((consp arg)
+ (cons (intern (upcase (symbol-name (car arg))))
+ (cdr arg)))
+ (t arg)))
+ args))
+
(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
(defun cl--generic-describe (function)
;; Supposedly this is called from help-fns, so help-fns should be loaded at
@@ -1035,9 +1140,20 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
(insert (propertize "Implementations:\n\n" 'face 'bold))
;; Loop over fanciful generics
(dolist (method (cl--generic-method-table generic))
- (let* ((info (cl--generic-method-info method)))
+ (pcase-let*
+ ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)))
;; FIXME: Add hyperlinks for the types as well.
- (insert (format "%s%S" (nth 0 info) (nth 1 info)))
+ (let ((print-quoted nil)
+ (quals (if (length> qualifiers 0)
+ (concat (substring qualifiers
+ 0 (string-match " *\\'"
+ qualifiers))
+ "\n")
+ "")))
+ (insert (format "%s%S"
+ quals
+ (cons function
+ (cl--generic-upcase-formal-args args)))))
(let* ((met-name (cl--generic-load-hist-format
function
(cl--generic-method-qualifiers method)
@@ -1049,7 +1165,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
'help-function-def met-name file
'cl-defmethod)
(insert (substitute-command-keys "'.\n"))))
- (insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
+ (insert "\n" (or doc "Undocumented") "\n\n")))))))
(defun cl--generic-specializers-apply-to-type-p (specializers type)
"Return non-nil if a method with SPECIALIZERS applies to TYPE."
@@ -1065,7 +1181,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
(let ((sclass (cl--find-class specializer))
(tclass (cl--find-class type)))
(when (and sclass tclass)
- (member specializer (cl--generic-class-parents tclass))))))
+ (member specializer (cl--class-allparents tclass))))))
(setq applies t)))
applies))
@@ -1145,7 +1261,7 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
;; since we can't use the `head' specializer to implement itself.
(if (not (eq (car-safe specializer) 'head))
(cl-call-next-method)
- (cl--generic-with-memoization
+ (with-memoization
(gethash (cadr specializer) cl--generic-head-used)
specializer)
(list cl--generic-head-generalizer)))
@@ -1194,22 +1310,11 @@ These match if the argument is `eql' to VAL."
;; Use exactly the same code as for `typeof'.
`(if ,name (type-of ,name) 'null))
-(defun cl--generic-class-parents (class)
- (let ((parents ())
- (classes (list class)))
- ;; BFS precedence. FIXME: Use a topological sort.
- (while (let ((class (pop classes)))
- (cl-pushnew (cl--class-name class) parents)
- (setq classes
- (append classes
- (cl--class-parents class)))))
- (nreverse parents)))
-
(defun cl--generic-struct-specializers (tag &rest _)
(and (symbolp tag)
(let ((class (get tag 'cl--class)))
(when (cl-typep class 'cl-structure-class)
- (cl--generic-class-parents class)))))
+ (cl--class-allparents class)))))
(cl-generic-define-generalizer cl--generic-struct-generalizer
50 #'cl--generic-struct-tag
@@ -1258,6 +1363,7 @@ See the full list and their hierarchy in `cl--typeof-types'."
(cl-call-next-method)))
(cl--generic-prefill-dispatchers 0 integer)
+(cl--generic-prefill-dispatchers 1 integer)
(cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer)
;;; Dispatch on major mode.
@@ -1292,6 +1398,42 @@ Used internally for the (major-mode MODE) context specializers."
(progn (cl-assert (null modes)) mode)
`(derived-mode ,mode . ,modes))))
+;;; Dispatch on OClosure type
+
+;; It would make sense to put this into `oclosure.el' except that when
+;; `oclosure.el' is loaded `cl-defmethod' is not available yet.
+
+(defun cl--generic-oclosure-tag (name &rest _)
+ `(oclosure-type ,name))
+
+(defun cl-generic--oclosure-specializers (tag &rest _)
+ (and (symbolp tag)
+ (let ((class (cl--find-class tag)))
+ (when (cl-typep class 'oclosure--class)
+ (oclosure--class-allparents class)))))
+
+(cl-generic-define-generalizer cl--generic-oclosure-generalizer
+ ;; Give slightly higher priority than the struct specializer, so that
+ ;; for a generic function with methods dispatching structs and on OClosures,
+ ;; we first try `oclosure-type' before `type-of' since `type-of' will return
+ ;; non-nil for an OClosure as well.
+ 51 #'cl--generic-oclosure-tag
+ #'cl-generic--oclosure-specializers)
+
+(cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type)
+ "Support for dispatch on types defined by `oclosure-define'."
+ (or
+ (when (symbolp type)
+ ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
+ ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
+ ;; take place without requiring cl-lib.
+ (let ((class (cl--find-class type)))
+ (and (cl-typep class 'oclosure--class)
+ (list cl--generic-oclosure-generalizer))))
+ (cl-call-next-method)))
+
+(cl--generic-prefill-dispatchers 0 oclosure)
+
;;; Support for unloading.
(cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index 213eecf88d4..fe7e4506d7c 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -378,10 +378,9 @@ instead."
function)
(setq tentative-defun t))
((string-match
- (eval-when-compile
- (concat "\\`\\("
- (regexp-opt '("with" "without" "do"))
- "\\)-"))
+ (concat "\\`\\("
+ (regexp-opt '("with" "without" "do"))
+ "\\)-")
function)
(setq method '(&lambda &body))))))
;; backwards compatibility. Bletch.
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 8d63a3cccfa..3f40ab07605 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -114,7 +114,10 @@ a future Emacs interpreter will be able to use it.")
(defmacro cl-incf (place &optional x)
"Increment PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the incremented value of PLACE."
+The return value is the incremented value of PLACE.
+
+If X is specified, it should be an expression that should
+evaluate to a number."
(declare (debug (place &optional form)))
(if (symbolp place)
(list 'setq place (if x (list '+ place x) (list '1+ place)))
@@ -123,7 +126,10 @@ The return value is the incremented value of PLACE."
(defmacro cl-decf (place &optional x)
"Decrement PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the decremented value of PLACE."
+The return value is the decremented value of PLACE.
+
+If X is specified, it should be an expression that should
+evaluate to a number."
(declare (debug cl-incf))
(if (symbolp place)
(list 'setq place (if x (list '- place x) (list '1- place)))
@@ -560,4 +566,9 @@ of record objects."
(t
(advice-remove 'type-of #'cl--old-struct-type-of))))
+(defun cl-constantly (value)
+ "Return a function that takes any number of arguments, but returns VALUE."
+ (lambda (&rest _)
+ value))
+
;;; cl-lib.el ends here
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 85ebcaade71..6646167b92b 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -301,24 +301,31 @@ FORM is of the form (ARGS . BODY)."
(t ;; `simple-args' doesn't handle all the parsing that we need,
;; so we pass the rest to cl--do-arglist which will do
;; "manual" parsing.
- (let ((slen (length simple-args)))
- (when (memq '&optional simple-args)
- (cl-decf slen))
- (setq header
+ (let ((slen (length simple-args))
+ (usage-str
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
;; touch the match-data.
(save-match-data
- (cons (help-add-fundoc-usage
- (if (stringp (car header)) (pop header))
- ;; Be careful with make-symbol and (back)quote,
- ;; see bug#12884.
- (help--docstring-quote
- (let ((print-gensym nil) (print-quoted t)
- (print-escape-newlines t))
- (format "%S" (cons 'fn (cl--make-usage-args
- orig-args))))))
- header)))
+ (help--docstring-quote
+ (let ((print-gensym nil) (print-quoted t)
+ (print-escape-newlines t))
+ (format "%S" (cons 'fn (cl--make-usage-args
+ orig-args))))))))
+ (when (memq '&optional simple-args)
+ (cl-decf slen))
+ (setq header
+ (cons
+ (if (eq :documentation (car-safe (car header)))
+ `(:documentation (help-add-fundoc-usage
+ ,(cadr (pop header))
+ ,usage-str))
+ (help-add-fundoc-usage
+ (if (stringp (car header)) (pop header))
+ ;; Be careful with make-symbol and (back)quote,
+ ;; see bug#12884.
+ usage-str))
+ header))
;; FIXME: we'd want to choose an arg name for the &rest param
;; and pass that as `expr' to cl--do-arglist, but that ends up
;; generating code with a redundant let-binding, so we instead
@@ -387,11 +394,17 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
`(iter-defun ,name ,@(cl--transform-lambda (cons args body) name)))
;; The lambda list for macros is different from that of normal lambdas.
-;; Note that &environment is only allowed as first or last items in the
+
+;; `cl-macro-list' is shared between a few different use cases that
+;; don't all support exactly the same set of special keywords: the
+;; debug spec accepts hence a superset of what the macros
+;; actually support.
+;; For example &environment is only allowed as first or last items in the
;; top level list.
(def-edebug-elem-spec 'cl-macro-list
- '(([&optional "&environment" arg]
+ '(([&optional "&whole" arg] ; Only for compiler-macros or at lower levels.
+ [&optional "&environment" arg] ; Only at top-level.
[&rest cl-macro-arg]
[&optional ["&optional" &rest
&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
@@ -403,26 +416,12 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
&or (cl-macro-arg &optional def-form) arg]]
- [&optional "&environment" arg]
+ [&optional "&environment" arg] ; Only at top-level.
+ . [&or arg nil] ; Only allowed at lower levels.
)))
(def-edebug-elem-spec 'cl-macro-arg
- '(&or arg cl-macro-list1))
-
-(def-edebug-elem-spec 'cl-macro-list1
- '(([&optional "&whole" arg] ;; only allowed at lower levels
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (cl-macro-arg &optional def-form) arg]]
- . [&or arg nil])))
+ '(&or arg cl-macro-list))
;;;###autoload
(defmacro cl-defmacro (name args &rest body)
@@ -685,7 +684,7 @@ its argument list allows full Common Lisp conventions."
(defmacro cl-destructuring-bind (args expr &rest body)
"Bind the variables in ARGS to the result of EXPR and execute BODY."
(declare (indent 2)
- (debug (&define cl-macro-list1 def-form cl-declarations def-body)))
+ (debug (&define cl-macro-list def-form cl-declarations def-body)))
(let* ((cl--bind-lets nil)
(cl--bind-forms nil)
(cl--bind-defs nil)
@@ -2139,9 +2138,14 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; setq the fresh new `ofargs' vars instead ;-)
(let ((shadowings
(mapcar (lambda (b) (if (consp b) (car b) b)) bindings)))
- ;; If `var' is shadowed, then it clearly can't be
- ;; tail-called any more.
- (not (memq var shadowings)))))
+ (and
+ ;; If `var' is shadowed, then it clearly can't be
+ ;; tail-called any more.
+ (not (memq var shadowings))
+ ;; If any of the new bindings is a dynamic
+ ;; variable, the body is not in tail position.
+ (not (delq nil (mapcar #'macroexp--dynamic-variable-p
+ shadowings)))))))
`(,(car exp) ,bindings . ,(funcall opt-exps exps)))
((and `(condition-case ,err-var ,bodyform . ,handlers)
(guard (not (eq err-var var))))
@@ -2417,14 +2421,66 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(append bindings venv))
macroexpand-all-environment))))
(if malformed-bindings
- (macroexp-warn-and-return
- (format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
- (nreverse malformed-bindings))
- expansion)
+ (let ((rev-malformed-bindings (nreverse malformed-bindings)))
+ (macroexp-warn-and-return
+ (format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
+ rev-malformed-bindings)
+ expansion nil nil rev-malformed-bindings))
expansion)))
(unless advised
(advice-remove 'macroexpand #'cl--sm-macroexpand)))))
+;;;###autoload
+(defmacro cl-with-gensyms (names &rest body)
+ "Bind each of NAMES to an uninterned symbol and evaluate BODY."
+ (declare (debug (sexp body)) (indent 1))
+ `(let ,(cl-loop for name in names collect
+ `(,name (gensym (symbol-name ',name))))
+ ,@body))
+
+;;;###autoload
+(defmacro cl-once-only (names &rest body)
+ "Generate code to evaluate each of NAMES just once in BODY.
+
+This macro helps with writing other macros. Each of names is
+either (NAME FORM) or NAME, which latter means (NAME NAME).
+During macroexpansion, each NAME is bound to an uninterned
+symbol. The expansion evaluates each FORM and binds it to the
+corresponding uninterned symbol.
+
+For example, consider this macro:
+
+ (defmacro my-cons (x)
+ (cl-once-only (x)
+ \\=`(cons ,x ,x)))
+
+The call (my-cons (pop y)) will expand to something like this:
+
+ (let ((g1 (pop y)))
+ (cons g1 g1))
+
+The use of `cl-once-only' ensures that the pop is performed only
+once, as intended.
+
+See also `macroexp-let2'."
+ (declare (debug (sexp body)) (indent 1))
+ (setq names (mapcar #'ensure-list names))
+ (let ((our-gensyms (cl-loop for _ in names collect (gensym))))
+ ;; During macroexpansion, obtain a gensym for each NAME.
+ `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym)))
+ ;; Evaluate each FORM and bind to the corresponding gensym.
+ ;;
+ ;; We require this explicit call to `list' rather than using
+ ;; (,,@(cl-loop ...)) due to a limitation of Elisp's backquote.
+ `(let ,(list
+ ,@(cl-loop for name in names for gensym in our-gensyms
+ for to-eval = (or (cadr name) (car name))
+ collect ``(,,gensym ,,to-eval)))
+ ;; During macroexpansion, bind each NAME to its gensym.
+ ,(let ,(cl-loop for name in names for gensym in our-gensyms
+ collect `(,(car name) ,gensym))
+ ,@body)))))
+
;;; Multiple values.
;;;###autoload
@@ -2504,7 +2560,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
(push x defun-declarations-alist)))
(defun cl--optimize (f _args &rest qualities)
- "Serve 'cl-optimize' in function declarations.
+ "Serve `cl-optimize' in function declarations.
Example:
(defun foo (x)
(declare (cl-optimize (speed 3) (safety 0)))
@@ -2896,18 +2952,10 @@ To see the documentation for a defined struct type, use
(debug
(&define ;Makes top-level form not be wrapped.
[&or symbolp
- (gate
+ (gate ;; FIXME: Why?
symbolp &rest
- [&or symbolp
- (&or [":conc-name" symbolp]
- [":constructor" symbolp &optional cl-lambda-list]
- [":copier" symbolp]
- [":predicate" symbolp]
- [":include" symbolp &rest sexp] ;; Not finished.
- [":print-function" sexp]
- [":type" symbolp]
- [":named"]
- [":initial-offset" natnump])])]
+ [&or (":constructor" &define name &optional cl-lambda-list)
+ sexp])]
[&optional stringp]
;; All the above is for the following def-form.
&rest &or symbolp (symbolp &optional def-form &rest sexp))))
@@ -3050,7 +3098,7 @@ To see the documentation for a defined struct type, use
`(,predicate cl-x))))
(when pred-form
(push `(,defsym ,predicate (cl-x)
- (declare (side-effect-free error-free))
+ (declare (side-effect-free error-free) (pure t))
,(if (eq (car pred-form) 'and)
(append pred-form '(t))
`(and ,pred-form t)))
@@ -3106,7 +3154,7 @@ To see the documentation for a defined struct type, use
(macroexp-warn-and-return
(format "Missing value for option `%S' of slot `%s' in struct %s!"
(car (last desc)) slot name)
- 'nil)
+ nil nil nil (car (last desc)))
forms)
(when (and (keywordp (car defaults))
(not (keywordp (car desc))))
@@ -3115,7 +3163,7 @@ To see the documentation for a defined struct type, use
(macroexp-warn-and-return
(format " I'll take `%s' to be an option rather than a default value."
kw)
- 'nil)
+ nil nil nil kw)
forms)
(push kw desc)
(setcar defaults nil))))
@@ -3282,8 +3330,9 @@ the form NAME which is a shorthand for (NAME NAME)."
(funcall orig pred1
(cl--defstruct-predicate t2))))
(funcall orig pred1 pred2))))
-(advice-add 'pcase--mutually-exclusive-p
- :around #'cl--pcase-mutually-exclusive-p)
+(when (fboundp 'advice-add) ;Not available during bootstrap.
+ (advice-add 'pcase--mutually-exclusive-p
+ :around #'cl--pcase-mutually-exclusive-p))
(defun cl-struct-sequence-type (struct-type)
@@ -3355,24 +3404,33 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(boolean . booleanp)
(bool-vector . bool-vector-p)
(buffer . bufferp)
+ (byte-code-function . byte-code-function-p)
(character . natnump)
(char-table . char-table-p)
(command . commandp)
+ (compiled-function . byte-code-function-p)
(hash-table . hash-table-p)
(cons . consp)
(fixnum . fixnump)
(float . floatp)
+ (frame . framep)
(function . functionp)
(integer . integerp)
(keyword . keywordp)
(list . listp)
+ (marker . markerp)
+ (natnum . natnump)
(number . numberp)
(null . null)
+ (overlay . overlayp)
+ (process . processp)
(real . numberp)
(sequence . sequencep)
+ (subr . subrp)
(string . stringp)
(symbol . symbolp)
(vector . vectorp)
+ (window . windowp)
;; FIXME: Do we really want to consider this a type?
(integer-or-marker . integer-or-marker-p)
))
@@ -3423,16 +3481,19 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val)))
((and (or 'nil 't) type) (inline-quote ',type))
((and (pred symbolp) type)
- (let* ((name (symbol-name type))
- (namep (intern (concat name "p"))))
- (cond
- ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val)))
- ((cl--macroexp-fboundp
- (setq namep (intern (concat name "-p"))))
- (inline-quote (funcall #',namep ,val)))
- ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
- (t (error "Unknown type %S" type)))))
- (type (error "Bad type spec: %s" type)))))
+ (macroexp-warn-and-return
+ (format-message "Unknown type: %S" type)
+ (let* ((name (symbol-name type))
+ (namep (intern (concat name "p"))))
+ (cond
+ ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp
+ (setq namep (intern (concat name "-p"))))
+ (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
+ (t (error "Unknown type %S" type))))
+ nil nil type))
+ (type (error "Bad type spec: %S" type)))))
;;;###autoload
@@ -3488,7 +3549,10 @@ compiler macros are expanded repeatedly until no further expansions are
possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo."
- (declare (debug cl-defmacro) (indent 2))
+ ;; Like `cl-defmacro', but with the `&whole' special case.
+ (declare (debug (&define name cl-macro-list
+ cl-declarations-or-string def-body))
+ (indent 2))
(let ((p args) (res nil))
(while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
@@ -3624,7 +3688,7 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc."
(define-inline cl-struct-slot-value (struct-type slot-name inst)
"Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
-STRUCT and SLOT-NAME are symbols. INST is a structure instance."
+STRUCT-TYPE and SLOT-NAME are symbols. INST is a structure instance."
(declare (side-effect-free t))
(inline-letevals (struct-type slot-name inst)
(inline-quote
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index ef60b266f9e..94f9654b239 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-2021 Free Software Foundation, Inc
+;; Copyright (C) 2015-2022 Free Software Foundation, Inc
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
@@ -53,13 +53,23 @@
(defconst cl--typeof-types
;; Hand made from the source code of `type-of'.
'((integer number number-or-marker atom)
- (symbol atom) (string array sequence atom)
+ (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom)
(cons list sequence)
;; Markers aren't `numberp', yet they are accepted wherever integers are
;; accepted, pretty much.
(marker number-or-marker atom)
(overlay atom) (float number atom) (window-configuration atom)
- (process atom) (window atom) (subr atom) (compiled-function function atom)
+ (process atom) (window atom)
+ ;; FIXME: We'd want to put `function' here, but that's only true
+ ;; for those `subr's which aren't special forms!
+ (subr atom)
+ ;; FIXME: We should probably reverse the order between
+ ;; `compiled-function' and `byte-code-function' since arguably
+ ;; `subr' and also "compiled functions" but not "byte code functions",
+ ;; but it would require changing the value returned by `type-of' for
+ ;; byte code objects, which risks breaking existing code, which doesn't
+ ;; seem worth the trouble.
+ (compiled-function byte-code-function function atom)
(module-function function atom)
(buffer atom) (char-table array sequence atom)
(bool-vector array sequence atom)
@@ -136,13 +146,13 @@ supertypes from the most specific to least specific.")
(while (recordp parent)
(add-to-list (cl--struct-class-children-sym parent) tag)
;; Only register ourselves as a child of the leftmost parent since structs
- ;; can only only have one parent.
+ ;; can only have one parent.
(setq parent (car (cl--struct-class-parents parent)))))
;;;###autoload
(defun cl-struct-define (name docstring parent type named slots children-sym
tag print)
- (cl-check-type name cl--struct-name)
+ (cl-check-type name (satisfies cl--struct-name-p))
(unless type
;; Legacy defstruct, using tagged vectors. Enable backward compatibility.
(cl-old-struct-compat-mode 1))
@@ -305,6 +315,17 @@ supertypes from the most specific to least specific.")
(cl-assert (cl--class-p (cl--find-class 'cl-structure-class)))
(cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
+(defun cl--class-allparents (class)
+ (let ((parents ())
+ (classes (list class)))
+ ;; BFS precedence. FIXME: Use a topological sort.
+ (while (let ((class (pop classes)))
+ (cl-pushnew (cl--class-name class) parents)
+ (setq classes
+ (append classes
+ (cl--class-parents class)))))
+ (nreverse parents)))
+
;; Make sure functions defined with cl-defsubst can be inlined even in
;; packages which do not require CL. We don't put an autoload cookie
;; directly on that function, since those cookies only go to cl-loaddefs.
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 2aade140e25..30d7e6525a4 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -221,26 +221,11 @@ into a button whose action shows the function's disassembly.")
'byte-code-function object)))))
(princ ")" stream))
-;; This belongs in nadvice.el, of course, but some load-ordering issues make it
-;; complicated: cl-generic uses macros from cl-macs and cl-macs uses advice-add
-;; from nadvice, so nadvice needs to be loaded before cl-generic and hence
-;; can't use cl-defmethod.
-(cl-defmethod cl-print-object :extra "nadvice"
- ((object compiled-function) stream)
- (if (not (advice--p object))
- (cl-call-next-method)
- (princ "#f(advice-wrapper " stream)
- (when (fboundp 'advice--where)
- (princ (advice--where object) stream)
- (princ " " stream))
- (cl-print-object (advice--cdr object) stream)
- (princ " " stream)
- (cl-print-object (advice--car object) stream)
- (let ((props (advice--props object)))
- (when props
- (princ " " stream)
- (cl-print-object props stream)))
- (princ ")" stream)))
+;; This belongs in oclosure.el, of course, but some load-ordering issues make it
+;; complicated.
+(cl-defmethod cl-print-object ((object accessor) stream)
+ ;; FIXME: η-reduce!
+ (oclosure--accessor-cl-print object stream))
(cl-defmethod cl-print-object ((object cl-structure-object) stream)
(if (and cl-print--depth (natnump print-level)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 65710b58c10..6451e34c42f 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
-;; Author: Andrea Corallo <akrl@sdf.com>
+;; Author: Andrea Corallo <akrl@sdf.org>
;; Keywords: lisp
;; Package: emacs
@@ -70,7 +70,7 @@
(irange &aux
(range (list irange))
(typeset ())))
- (:copier comp-cstr-shallow-copy))
+ (:copier nil))
"Internal representation of a type/value constraint."
(typeset '(t) :type list
:documentation "List of possible types the mvar can assume.
@@ -133,6 +133,14 @@ Integer values are handled in the `range' slot.")
:range (copy-tree (range cstr))
:neg (neg cstr))))
+(defsubst comp-cstr-shallow-copy (dst src)
+ "Copy the content of SRC into DST."
+ (with-comp-cstr-accessors
+ (setf (range dst) (range src)
+ (valset dst) (valset src)
+ (typeset dst) (typeset src)
+ (neg dst) (neg src))))
+
(defsubst comp-cstr-empty-p (cstr)
"Return t if CSTR is equivalent to the nil type specifier or nil otherwise."
(with-comp-cstr-accessors
@@ -438,10 +446,7 @@ Return them as multiple value."
ext-range)
ext-range)
(neg dst) nil)
- (setf (typeset dst) (typeset old-dst)
- (valset dst) (valset old-dst)
- (range dst) (range old-dst)
- (neg dst) (neg old-dst)))))
+ (comp-cstr-shallow-copy dst old-dst))))
(defmacro comp-cstr-set-range-for-arithm (dst src1 src2 &rest range-body)
;; Prevent some code duplication for `comp-cstr-add-2'
@@ -583,10 +588,8 @@ DST is returned."
(when (range pos)
'(integer)))))
(typeset neg)))
- (setf (typeset dst) (typeset pos)
- (valset dst) (valset pos)
- (range dst) (range pos)
- (neg dst) nil)
+ (comp-cstr-shallow-copy dst pos)
+ (setf (neg dst) nil)
(cl-return-from comp-cstr-union-1-no-mem dst))
;; Verify disjoint condition between positive types and
@@ -633,15 +636,9 @@ DST is returned."
(comp-range-negation (range neg))
(range pos))))))
- (if (comp-cstr-empty-p neg)
- (setf (typeset dst) (typeset pos)
- (valset dst) (valset pos)
- (range dst) (range pos)
- (neg dst) nil)
- (setf (typeset dst) (typeset neg)
- (valset dst) (valset neg)
- (range dst) (range neg)
- (neg dst) (neg neg)))))
+ (comp-cstr-shallow-copy dst (if (comp-cstr-empty-p neg)
+ pos
+ neg))))
;; (not null) => t
(when (and (neg dst)
@@ -665,10 +662,7 @@ DST is returned."
(mapcar #'comp-cstr-copy srcs)
(apply #'comp-cstr-union-1-no-mem range srcs)
mem-h))))
- (setf (typeset dst) (typeset res)
- (valset dst) (valset res)
- (range dst) (range res)
- (neg dst) (neg res))
+ (comp-cstr-shallow-copy dst res)
res)))
(cl-defun comp-cstr-intersection-homogeneous (dst &rest srcs)
@@ -755,10 +749,8 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
;; In case pos is not relevant return directly the content
;; of neg.
(when (equal (typeset pos) '(t))
- (setf (typeset dst) (typeset neg)
- (valset dst) (valset neg)
- (range dst) (range neg)
- (neg dst) t)
+ (comp-cstr-shallow-copy dst neg)
+ (setf (neg dst) t)
;; (not t) => nil
(when (and (null (valset dst))
@@ -802,10 +794,8 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(cl-set-difference (valset pos) (valset neg)))
;; Return a non negated form.
- (setf (typeset dst) (typeset pos)
- (valset dst) (valset pos)
- (range dst) (range pos)
- (neg dst) nil)))
+ (comp-cstr-shallow-copy dst pos)
+ (setf (neg dst) nil)))
dst))))
@@ -885,7 +875,7 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
"Constraint OP1 being = OP2 setting the result into DST."
(with-comp-cstr-accessors
(cl-flet ((relax-cstr (cstr)
- (setf cstr (comp-cstr-shallow-copy cstr))
+ (setf cstr (copy-sequence cstr))
;; If can be any float extend it to all integers.
(when (memq 'float (typeset cstr))
(setf (range cstr) '((- . +))))
@@ -1010,10 +1000,7 @@ DST is returned."
(mapcar #'comp-cstr-copy srcs)
(apply #'comp-cstr-intersection-no-mem srcs)
mem-h))))
- (setf (typeset dst) (typeset res)
- (valset dst) (valset res)
- (range dst) (range res)
- (neg dst) (neg res))
+ (comp-cstr-shallow-copy dst res)
res)))
(defun comp-cstr-intersection-no-hashcons (dst &rest srcs)
@@ -1069,10 +1056,9 @@ DST is returned."
(valset dst) ()
(range dst) nil
(neg dst) nil))
- (t (setf (typeset dst) (typeset src)
- (valset dst) (valset src)
- (range dst) (range src)
- (neg dst) (not (neg src)))))
+ (t
+ (comp-cstr-shallow-copy dst src)
+ (setf (neg dst) (not (neg src)))))
dst))
(defun comp-cstr-value-negation (dst src)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 7d09d2425b2..c722c0b259c 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
-;; Author: Andrea Corallo <akrl@sdf.com>
+;; Author: Andrea Corallo <akrl@sdf.org>
;; Keywords: lisp
;; Package: emacs
@@ -65,7 +65,7 @@ This is intended for debugging the compiler itself.
2 emit debug symbols and dump pseudo C code.
3 emit debug symbols and dump: pseudo C code, GCC intermediate
passes and libgccjit log file."
- :type 'integer
+ :type 'natnum
:safe #'natnump
:version "28.1")
@@ -76,7 +76,7 @@ This is intended for debugging the compiler itself.
1 final LIMPLE is logged.
2 LAP, final LIMPLE, and some pass info are logged.
3 max verbosity."
- :type 'integer
+ :type 'natnum
:risky t
:version "28.1")
@@ -113,7 +113,7 @@ during bootstrap."
"Default number of subprocesses used for async native compilation.
Value of zero means to use half the number of the CPU's execution units,
or one if there's just one execution unit."
- :type 'integer
+ :type 'natnum
:risky t
:version "28.1")
@@ -240,7 +240,7 @@ native compilation runs.")
(defvar comp-curr-allocation-class 'd-default
"Current allocation class.
-Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.")
+Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
(defconst comp-passes '(comp-spill-lap
comp-limplify
@@ -477,15 +477,15 @@ Useful to hook into pass checkers.")
(one-window-p (function (&optional t t) boolean))
(overlayp (function (t) boolean))
(parse-colon-path (function (string) cons))
- (plist-get (function (list t) t))
- (plist-member (function (list t) list))
+ (plist-get (function (list t &optional t) t))
+ (plist-member (function (list t &optional t) list))
(point (function () integer))
(point-marker (function () marker))
(point-max (function () integer))
(point-min (function () integer))
(preceding-char (function () fixnum))
(previous-window (function (&optional window t t) window))
- (prin1-to-string (function (t &optional t) string))
+ (prin1-to-string (function (t &optional t t) string))
(processp (function (t) boolean))
(proper-list-p (function (t) integer))
(propertize (function (string &rest t) string))
@@ -900,6 +900,8 @@ non local exit (ends with an `unreachable' insn)."))
:documentation "Doc string.")
(int-spec nil :type list
:documentation "Interactive form.")
+ (command-modes nil :type list
+ :documentation "Command modes.")
(lap () :type list
:documentation "LAP assembly representation.")
(ssa-status nil :type symbol
@@ -944,7 +946,7 @@ CFG is mutated by a pass.")
:documentation "Unique id when in SSA form.")
(slot nil :type (or fixnum symbol)
:documentation "Slot number in the array if a number or
- 'scratch' for scratch slot."))
+ `scratch' for scratch slot."))
(defun comp-mvar-type-hint-match-p (mvar type-hint)
"Match MVAR against TYPE-HINT.
@@ -1023,7 +1025,7 @@ To be used by all entry points."
(defun comp-alloc-class-to-container (alloc-class)
"Given ALLOC-CLASS, return the data container for the current context.
-Assume allocation class 'd-default as default."
+Assume allocation class `d-default' as default."
(cl-struct-slot-value 'comp-ctxt (or alloc-class 'd-default) comp-ctxt))
(defsubst comp-add-const-to-relocs (obj)
@@ -1245,6 +1247,7 @@ clashes."
:c-name c-name
:doc (documentation f t)
:int-spec (interactive-form f)
+ :command-modes (command-modes f)
:speed (comp-spill-speed function-name)
:pure (comp-spill-decl-spec function-name
'pure))))
@@ -1284,10 +1287,12 @@ clashes."
(make-comp-func-l :c-name c-name
:doc (documentation form t)
:int-spec (interactive-form form)
+ :command-modes (command-modes form)
:speed (comp-ctxt-speed comp-ctxt))
(make-comp-func-d :c-name c-name
:doc (documentation form t)
:int-spec (interactive-form form)
+ :command-modes (command-modes form)
:speed (comp-ctxt-speed comp-ctxt)))))
(let ((lap (byte-to-native-lambda-lap
(gethash (aref byte-code 1)
@@ -1329,6 +1334,7 @@ clashes."
(comp-func-byte-func func) byte-func
(comp-func-doc func) (documentation byte-func t)
(comp-func-int-spec func) (interactive-form byte-func)
+ (comp-func-command-modes func) (command-modes byte-func)
(comp-func-c-name func) c-name
(comp-func-lap func) lap
(comp-func-frame-size func) (comp-byte-frame-size byte-func)
@@ -1769,6 +1775,7 @@ This is responsible for generating the proper stack adjustment, when known,
and the annotation emission."
(declare (debug (body))
(indent defun))
+ (declare-function comp-body-eff nil (body op-name sp-delta))
`(pcase op
,@(cl-loop for (op . body) in cases
for sp-delta = (gethash op comp-op-stack-info)
@@ -1947,7 +1954,6 @@ and the annotation emission."
(byte-condition-case) ;; Obsolete
(byte-temp-output-buffer-setup-OBSOLETE)
(byte-temp-output-buffer-show-OBSOLETE)
- (byte-unbind-all) ;; Obsolete
(byte-set-marker auto)
(byte-match-beginning auto)
(byte-match-end auto)
@@ -2081,7 +2087,8 @@ and the annotation emission."
(i (hash-table-count h)))
(puthash i (comp-func-doc f) h)
i)
- (comp-func-int-spec f)))
+ (comp-func-int-spec f)
+ (comp-func-command-modes f)))
;; This is the compilation unit it-self passed as
;; parameter.
(make-comp-mvar :slot 0))))))
@@ -2124,7 +2131,8 @@ These are stored in the reloc data array."
(i (hash-table-count h)))
(puthash i (comp-func-doc func) h)
i)
- (comp-func-int-spec func)))
+ (comp-func-int-spec func)
+ (comp-func-command-modes func)))
;; This is the compilation unit it-self passed as
;; parameter.
(make-comp-mvar :slot 0)))))
@@ -2627,8 +2635,8 @@ TARGET-BB-SYM is the symbol name of the target block."
do (comp-emit-call-cstr target insn-cell cstr)))))))
(defun comp-add-cstrs (_)
- "Rewrite conditional branches adding appropriate 'assume' insns.
-This is introducing and placing 'assume' insns in use by fwprop
+ "Rewrite conditional branches adding appropriate `assume' insns.
+This is introducing and placing `assume' insns in use by fwprop
to propagate conditional branch test information on target basic
blocks."
(maphash (lambda (_ f)
@@ -3090,13 +3098,6 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or
(`(setimm ,lval ,v)
(setf (comp-cstr-imm lval) v))))))
-(defun comp-mvar-propagate (lval rval)
- "Propagate into LVAL properties of RVAL."
- (setf (comp-mvar-typeset lval) (comp-mvar-typeset rval)
- (comp-mvar-valset lval) (comp-mvar-valset rval)
- (comp-mvar-range lval) (comp-mvar-range rval)
- (comp-mvar-neg lval) (comp-mvar-neg rval)))
-
(defun comp-function-foldable-p (f args)
"Given function F called with ARGS, return non-nil when optimizable."
(and (comp-function-pure-p f)
@@ -3146,10 +3147,7 @@ Fold the call in case."
(when (comp-cstr-empty-p cstr)
;; Store it to be rewritten as non local exit.
(setf (comp-block-lap-non-ret-insn comp-block) insn))
- (setf (comp-mvar-range lval) (comp-cstr-range cstr)
- (comp-mvar-valset lval) (comp-cstr-valset cstr)
- (comp-mvar-typeset lval) (comp-cstr-typeset cstr)
- (comp-mvar-neg lval) (comp-cstr-neg cstr))))
+ (comp-cstr-shallow-copy lval cstr)))
(cl-case f
(+ (comp-cstr-add lval args))
(- (comp-cstr-sub lval args))
@@ -3167,9 +3165,9 @@ Fold the call in case."
(let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt)))))
(comp-fwprop-call insn lval f args)))
(_
- (comp-mvar-propagate lval rval))))
+ (comp-cstr-shallow-copy lval rval))))
(`(assume ,lval ,(and (pred comp-mvar-p) rval))
- (comp-mvar-propagate lval rval))
+ (comp-cstr-shallow-copy lval rval))
(`(assume ,lval (,kind . ,operands))
(cl-case kind
(and
@@ -3486,7 +3484,7 @@ Return the list of m-var ids nuked."
(defun comp-remove-type-hints-func ()
"Remove type hints from the current function.
-These are substituted with a normal 'set' op."
+These are substituted with a normal `set' op."
(cl-loop
for b being each hash-value of (comp-func-blocks comp-func)
do (comp-loop-insn-in-block b
@@ -3582,7 +3580,7 @@ Update all insn accordingly."
;; Symbols imported by C inlined functions. We do this here because
;; is better to add all objs to the relocation containers before we
;; compacting them.
- (mapc #'comp-add-const-to-relocs '(nil t consp listp))
+ (mapc #'comp-add-const-to-relocs '(nil t consp listp symbol-with-pos-p))
(let* ((d-default (comp-ctxt-d-default comp-ctxt))
(d-default-idx (comp-data-container-idx d-default))
@@ -3930,22 +3928,36 @@ display a message."
(file-newer-than-file-p
source-file (comp-el-to-eln-filename source-file)))
do (let* ((expr `((require 'comp)
- ,(when (boundp 'backtrace-line-length)
- `(setf backtrace-line-length ,backtrace-line-length))
- (setf comp-file-preloaded-p ,comp-file-preloaded-p
- native-compile-target-directory ,native-compile-target-directory
- native-comp-speed ,native-comp-speed
- native-comp-debug ,native-comp-debug
- native-comp-verbose ,native-comp-verbose
- comp-libgccjit-reproducer ,comp-libgccjit-reproducer
- comp-async-compilation t
- native-comp-eln-load-path ',native-comp-eln-load-path
- native-comp-compiler-options
- ',native-comp-compiler-options
- native-comp-driver-options
- ',native-comp-driver-options
- load-path ',load-path
- warning-fill-column most-positive-fixnum)
+ (setq comp-async-compilation t)
+ (setq warning-fill-column most-positive-fixnum)
+ ,(let ((set (list 'setq)))
+ (dolist (var '(comp-file-preloaded-p
+ native-compile-target-directory
+ native-comp-speed
+ native-comp-debug
+ native-comp-verbose
+ comp-libgccjit-reproducer
+ native-comp-eln-load-path
+ native-comp-compiler-options
+ native-comp-driver-options
+ load-path
+ backtrace-line-length
+ ;; package-load-list
+ ;; package-user-dir
+ ;; package-directory-list
+ ))
+ (when (boundp var)
+ (push var set)
+ (push `',(symbol-value var) set)))
+ (nreverse set))
+ ;; FIXME: Activating all packages would align the
+ ;; functionality offered with what is usually done
+ ;; for ELPA packages (and thus fix some compilation
+ ;; issues with some ELPA packages), but it's too
+ ;; blunt an instrument (e.g. we don't even know if
+ ;; we're compiling such an ELPA package at
+ ;; this point).
+ ;;(package-activate-all)
,native-comp-async-env-modifier-form
(message "Compiling %s..." ,source-file)
(comp--native-compile ,source-file ,(and load t))))
@@ -3998,7 +4010,7 @@ display a message."
(run-hooks 'native-comp-async-all-done-hook)
(with-current-buffer (get-buffer-create comp-async-buffer-name)
(save-excursion
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(goto-char (point-max))
(insert "Compilation finished.\n"))))
;; `comp-deferred-pending-h' should be empty at this stage.
@@ -4018,56 +4030,71 @@ the deferred compilation mechanism."
(signal 'native-compiler-error
(list "Not a function symbol or file" function-or-file)))
(catch 'no-native-compile
- (let* ((data function-or-file)
+ (let* ((print-symbols-bare t)
+ (max-specpdl-size (max max-specpdl-size 5000))
+ (data function-or-file)
(comp-native-compiling t)
(byte-native-qualities nil)
+ (symbols-with-pos-enabled t)
;; Have byte compiler signal an error when compilation fails.
(byte-compile-debug t)
(comp-ctxt (make-comp-ctxt :output output
:with-late-load with-late-load)))
(comp-log "\n \n" 1)
- (condition-case err
- (cl-loop
- with report = nil
- for t0 = (current-time)
- for pass in comp-passes
- unless (memq pass comp-disabled-passes)
- do
- (comp-log (format "(%s) Running pass %s:\n"
- function-or-file pass)
- 2)
- (setf data (funcall pass data))
- (push (cons pass (float-time (time-since t0))) report)
- (cl-loop for f in (alist-get pass comp-post-pass-hooks)
- do (funcall f data))
- finally
- (when comp-log-time-report
- (comp-log (format "Done compiling %s" data) 0)
- (cl-loop for (pass . time) in (reverse report)
- do (comp-log (format "Pass %s took: %fs." pass time) 0))))
- (native-compiler-skip)
- (t
- (let ((err-val (cdr err)))
- ;; If we are doing an async native compilation print the
- ;; error in the correct format so is parsable and abort.
- (if (and comp-async-compilation
- (not (eq (car err) 'native-compiler-error)))
- (progn
- (message (if err-val
- "%s: Error: %s %s"
- "%s: Error %s")
- function-or-file
- (get (car err) 'error-message)
- (car-safe err-val))
- (kill-emacs -1))
- ;; Otherwise re-signal it adding the compilation input.
- (signal (car err) (if (consp err-val)
- (cons function-or-file err-val)
- (list function-or-file err-val)))))))
- (if (stringp function-or-file)
- data
- ;; So we return the compiled function.
- (native-elisp-load data)))))
+ (unwind-protect
+ (progn
+ (condition-case err
+ (cl-loop
+ with report = nil
+ for t0 = (current-time)
+ for pass in comp-passes
+ unless (memq pass comp-disabled-passes)
+ do
+ (comp-log (format "(%s) Running pass %s:\n"
+ function-or-file pass)
+ 2)
+ (setf data (funcall pass data))
+ (push (cons pass (float-time (time-since t0))) report)
+ (cl-loop for f in (alist-get pass comp-post-pass-hooks)
+ do (funcall f data))
+ finally
+ (when comp-log-time-report
+ (comp-log (format "Done compiling %s" data) 0)
+ (cl-loop for (pass . time) in (reverse report)
+ do (comp-log (format "Pass %s took: %fs."
+ pass time) 0))))
+ (native-compiler-skip)
+ (t
+ (let ((err-val (cdr err)))
+ ;; If we are doing an async native compilation print the
+ ;; error in the correct format so is parsable and abort.
+ (if (and comp-async-compilation
+ (not (eq (car err) 'native-compiler-error)))
+ (progn
+ (message (if err-val
+ "%s: Error: %s %s"
+ "%s: Error %s")
+ function-or-file
+ (get (car err) 'error-message)
+ (car-safe err-val))
+ (kill-emacs -1))
+ ;; Otherwise re-signal it adding the compilation input.
+ (signal (car err) (if (consp err-val)
+ (cons function-or-file err-val)
+ (list function-or-file err-val)))))))
+ (if (stringp function-or-file)
+ data
+ ;; So we return the compiled function.
+ (native-elisp-load data)))
+ ;; We may have created a temporary file when we're being
+ ;; called with something other than a file as the argument.
+ ;; Delete it.
+ (when (and (not (stringp function-or-file))
+ (not output)
+ comp-ctxt
+ (comp-ctxt-output comp-ctxt)
+ (file-exists-p (comp-ctxt-output comp-ctxt)))
+ (delete-file (comp-ctxt-output comp-ctxt)))))))
(defun native-compile-async-skip-p (file load selector)
"Return non-nil if FILE's compilation should be skipped.
@@ -4089,6 +4116,7 @@ LOAD and SELECTOR work as described in `native--compile-async'."
native-comp-deferred-compilation-deny-list))))
(defun native--compile-async (files &optional recursively load selector)
+ ;; BEWARE, this function is also called directly from C.
"Compile FILES asynchronously.
FILES is one filename or a list of filenames or directories.
@@ -4122,16 +4150,17 @@ bytecode definition was not changed in the meantime)."
(unless (listp files)
(setf files (list files)))
(let (file-list)
- (dolist (path files)
- (cond ((file-directory-p path)
+ (dolist (file-or-dir files)
+ (cond ((file-directory-p file-or-dir)
(dolist (file (if recursively
(directory-files-recursively
- path comp-valid-source-re)
- (directory-files path t comp-valid-source-re)))
+ file-or-dir comp-valid-source-re)
+ (directory-files file-or-dir
+ t comp-valid-source-re)))
(push file file-list)))
- ((file-exists-p path) (push path file-list))
+ ((file-exists-p file-or-dir) (push file-or-dir file-list))
(t (signal 'native-compiler-error
- (list "Path not a file nor directory" path)))))
+ (list "Not a file nor directory" file-or-dir)))))
(dolist (file file-list)
(if-let ((entry (cl-find file comp-files-queue :key #'car :test #'string=)))
;; Most likely the byte-compiler has requested a deferred
@@ -4207,9 +4236,9 @@ last directory in `native-comp-eln-load-path')."
if (or (null byte+native-compile)
(cl-notany (lambda (re) (string-match re file))
native-comp-bootstrap-deny-list))
- do (comp--native-compile file)
+ collect (comp--native-compile file)
else
- do (byte-compile-file file))))
+ collect (byte-compile-file file))))
;;;###autoload
(defun batch-byte+native-compile ()
@@ -4218,17 +4247,25 @@ Generate .elc files in addition to the .eln files.
Force the produced .eln to be outputted in the eln system
directory (the last entry in `native-comp-eln-load-path') unless
`native-compile-target-directory' is non-nil. If the environment
-variable 'NATIVE_DISABLED' is set, only byte compile."
+variable \"NATIVE_DISABLED\" is set, only byte compile."
(comp-ensure-native-compiler)
(if (equal (getenv "NATIVE_DISABLED") "1")
(batch-byte-compile)
(cl-assert (length= command-line-args-left 1))
- (let ((byte+native-compile t)
- (byte-to-native-output-file nil))
- (batch-native-compile)
- (pcase byte-to-native-output-file
- (`(,tempfile . ,target-file)
- (rename-file tempfile target-file t))))))
+ (let* ((byte+native-compile t)
+ (byte-to-native-output-buffer-file nil)
+ (eln-file (car (batch-native-compile))))
+ (pcase byte-to-native-output-buffer-file
+ (`(,temp-buffer . ,target-file)
+ (unwind-protect
+ (progn
+ (byte-write-target-file temp-buffer target-file)
+ ;; Touch the .eln in order to have it older than the
+ ;; corresponding .elc.
+ (when (stringp eln-file)
+ (set-file-times eln-file)))
+ (kill-buffer temp-buffer))))
+ (setq command-line-args-left (cdr command-line-args-left)))))
;;;###autoload
(defun native-compile-async (files &optional recursively load selector)
@@ -4253,6 +4290,30 @@ of (commands) to run simultaneously."
(let ((load (not (not load))))
(native--compile-async files recursively load selector)))
+(defun native-compile-prune-cache ()
+ "Remove .eln files that aren't applicable to the current Emacs invocation."
+ (interactive)
+ (dolist (dir native-comp-eln-load-path)
+ ;; If a directory is non absolute it is assumed to be relative to
+ ;; `invocation-directory'.
+ (setq dir (expand-file-name dir invocation-directory))
+ (when (file-exists-p dir)
+ (dolist (subdir (directory-files dir t))
+ (when (and (file-directory-p subdir)
+ (file-writable-p subdir)
+ (not (equal (file-name-nondirectory
+ (directory-file-name subdir))
+ comp-native-version-dir)))
+ (message "Deleting %s..." subdir)
+ ;; We're being overly cautious here -- there shouldn't be
+ ;; anything but .eln files in these directories.
+ (dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'"))
+ (when (file-writable-p eln)
+ (delete-file eln)))
+ (when (directory-empty-p subdir)
+ (delete-directory subdir))))))
+ (message "Cache cleared"))
+
(provide 'comp)
;; LocalWords: limplified limplified limplification limplify Limple LIMPLE libgccjit elc eln
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 6b600977823..e5087672ae7 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -313,7 +313,7 @@ independently replaces consecutive years with a range."
(> prev-year first-year))
(goto-char range-end)
(delete-region range-start range-end)
- (insert (format "%c%d" sep prev-year))
+ (insert (format "-%d" prev-year))
(goto-char p))
(setq first-year year
range-start (point)))))
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 6bc6d217cef..6d4b29b552c 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -77,38 +77,29 @@
;;; Code:
-;; FIXME I don't see that this needs to exist as a separate variable.
-;; crm-separator should suffice.
-(defconst crm-default-separator "[ \t]*,[ \t]*"
- "Default value of `crm-separator'.")
+(define-obsolete-variable-alias 'crm-default-separator 'crm-separator "29.1")
-(defvar crm-separator crm-default-separator
+(defvar crm-separator "[ \t]*,[ \t]*"
"Separator regexp used for separating strings in `completing-read-multiple'.
-It should be a regexp that does not match the list of completion candidates.
-The default value is `crm-default-separator'.")
-
-(defvar crm-local-completion-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-completion-map)
- (define-key map [remap minibuffer-complete] #'crm-complete)
- (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
- (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
- map)
- "Local keymap for minibuffer multiple input with completion.
-Analog of `minibuffer-local-completion-map'.")
-
-(defvar crm-local-must-match-map
- (let ((map (make-sparse-keymap)))
- ;; We'd want to have multiple inheritance here.
- (set-keymap-parent map minibuffer-local-must-match-map)
- (define-key map [remap minibuffer-complete] #'crm-complete)
- (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
- (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
- (define-key map [remap minibuffer-complete-and-exit]
- #'crm-complete-and-exit)
- map)
- "Local keymap for minibuffer multiple input with exact match completion.
-Analog of `minibuffer-local-must-match-map' for crm.")
+It should be a regexp that does not match the list of completion candidates.")
+
+(defvar-keymap crm-local-completion-map
+ :doc "Local keymap for minibuffer multiple input with completion.
+Analog of `minibuffer-local-completion-map'."
+ :parent minibuffer-local-completion-map
+ "<remap> <minibuffer-complete>" #'crm-complete
+ "<remap> <minibuffer-complete-word>" #'crm-complete-word
+ "<remap> <minibuffer-completion-help>" #'crm-completion-help)
+
+(defvar-keymap crm-local-must-match-map
+ :doc "Local keymap for minibuffer multiple input with exact match completion.
+Analog of `minibuffer-local-must-match-map' for crm."
+ ;; We'd want to have multiple inheritance here.
+ :parent minibuffer-local-must-match-map
+ "<remap> <minibuffer-complete>" #'crm-complete
+ "<remap> <minibuffer-complete-word>" #'crm-complete-word
+ "<remap> <minibuffer-completion-help>" #'crm-completion-help
+ "<remap> <minibuffer-complete-and-exit>" #'crm-complete-and-exit)
(defvar crm-completion-table nil
"An alist whose elements' cars are strings, or an obarray.
@@ -244,30 +235,46 @@ contents of the minibuffer are \"alice,bob,eve\" and point is between
This function returns a list of the strings that were read,
with empty strings removed."
- (unwind-protect
- (progn
- (add-hook 'choose-completion-string-functions
- 'crm--choose-completion-string)
- (let* ((minibuffer-completion-table #'crm--collection-fn)
- (minibuffer-completion-predicate predicate)
- ;; see completing_read in src/minibuf.c
- (minibuffer-completion-confirm
- (unless (eq require-match t) require-match))
- (crm-completion-table table)
- (map (if require-match
- crm-local-must-match-map
- crm-local-completion-map))
- ;; If the user enters empty input, `read-from-minibuffer'
- ;; returns the empty string, not DEF.
- (input (read-from-minibuffer
- prompt initial-input map
- nil hist def inherit-input-method)))
- (when (and def (string-equal input ""))
- (setq input (if (consp def) (car def) def)))
- ;; Remove empty strings in the list of read strings.
- (split-string input crm-separator t)))
- (remove-hook 'choose-completion-string-functions
- 'crm--choose-completion-string)))
+ (let* ((map (if require-match
+ crm-local-must-match-map
+ crm-local-completion-map))
+ input)
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'choose-completion-string-functions
+ 'crm--choose-completion-string nil 'local)
+ (setq-local minibuffer-completion-table #'crm--collection-fn)
+ (setq-local minibuffer-completion-predicate predicate)
+ (setq-local completion-list-insert-choice-function
+ (lambda (start end choice)
+ (if (and (stringp start) (stringp end))
+ (let* ((beg (save-excursion
+ (goto-char (minibuffer-prompt-end))
+ (or (search-forward start nil t)
+ (search-forward-regexp crm-separator nil t)
+ (minibuffer-prompt-end))))
+ (end (save-excursion
+ (goto-char (point-max))
+ (or (search-backward end nil t)
+ (progn
+ (goto-char beg)
+ (search-forward-regexp crm-separator nil t))
+ (point-max)))))
+ (completion--replace beg end choice))
+ (completion--replace start end choice))))
+ ;; see completing_read in src/minibuf.c
+ (setq-local minibuffer-completion-confirm
+ (unless (eq require-match t) require-match))
+ (setq-local crm-completion-table table))
+ (setq input (read-from-minibuffer
+ prompt initial-input map
+ nil hist def inherit-input-method)))
+ ;; If the user enters empty input, `read-from-minibuffer'
+ ;; returns the empty string, not DEF.
+ (when (and def (string-equal input ""))
+ (setq input (if (consp def) (car def) def)))
+ ;; Remove empty strings in the list of read strings.
+ (split-string input crm-separator t)))
;; testing and debugging
;; (defun crm-init-test-environ ()
diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el
new file mode 100644
index 00000000000..a301c73017e
--- /dev/null
+++ b/lisp/emacs-lisp/debug-early.el
@@ -0,0 +1,97 @@
+;;; debug-early.el --- Dump a Lisp backtrace without frills -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Alan Mackenzie <acm@muc.de>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: internal, backtrace, bootstrap.
+;; Package: emacs
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file dumps a backtrace on stderr when an error is thrown. It
+;; has no dependencies on any Lisp libraries and is thus used for
+;; generating backtraces for bugs in the early parts of bootstrapping.
+;; It is also always used in batch model. It was introduced in Emacs
+;; 29, before which there was no backtrace available during early
+;; bootstrap.
+
+;;; Code:
+
+(defalias 'debug-early-backtrace
+ #'(lambda ()
+ "Print a trace of Lisp function calls currently active.
+The output stream used is the value of `standard-output'.
+
+This is a simplified version of the standard `backtrace'
+function, intended for use in debugging the early parts
+of the build process."
+ (princ "\n")
+ (let ((print-escape-newlines t)
+ (print-escape-control-characters t)
+ (print-escape-nonascii t)
+ (prin1 (if (and (fboundp 'cl-prin1)
+ ;; If we're being called while
+ ;; bootstrapping, we won't be able to load
+ ;; cl-print.
+ (require 'cl-print nil t))
+ #'cl-prin1
+ #'prin1)))
+ (mapbacktrace
+ #'(lambda (evald func args _flags)
+ (let ((args args))
+ (if evald
+ (progn
+ (princ " ")
+ (funcall prin1 func)
+ (princ "("))
+ (progn
+ (princ " (")
+ (setq args (cons func args))))
+ (if args
+ (while (progn
+ (funcall prin1 (car args))
+ (setq args (cdr args)))
+ (princ " ")))
+ (princ ")\n")))))))
+
+(defalias 'debug-early
+ #'(lambda (&rest args)
+ "Print an error message with a backtrace of active Lisp function calls.
+The output stream used is the value of `standard-output'.
+
+The Emacs core calls this function after an error has been
+signaled, and supplies two ARGS. These are the symbol
+`error' (which is ignored) and a cons of the error symbol and the
+error data.
+
+`debug-early' is a simplified version of `debug', and is
+available during the early parts of the build process. It is
+superseded by `debug' after enough Lisp has been loaded to
+support the latter, except in batch mode which always uses
+`debug-early'.
+
+\(In versions of Emacs prior to Emacs 29, no backtrace was
+available before `debug' was usable.)"
+ (princ "\nError: ")
+ (prin1 (car (car (cdr args)))) ; The error symbol.
+ (princ " ")
+ (prin1 (cdr (car (cdr args)))) ; The error data.
+ (debug-early-backtrace)))
+
+;;; debug-early.el ends here.
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 2d2da41c0d3..460057b3afd 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -90,6 +90,11 @@ The value used here is passed to `quit-restore-window'."
:group 'debugger
:version "24.3")
+(defcustom debug-allow-recursive-debug nil
+ "If non-nil, erroring in debug and edebug won't recursively debug."
+ :type 'boolean
+ :version "29.1")
+
(defvar debugger-step-after-exit nil
"Non-nil means \"single-step\" after the debugger exits.")
@@ -300,16 +305,15 @@ the debugger will not be entered."
(set-buffer debugger-old-buffer)))
;; Forget debugger window, it won't be back (Bug#17882).
(setq debugger-previous-window nil))
- ;; Restore previous state of debugger-buffer in case we were
- ;; in a recursive invocation of the debugger, otherwise just
- ;; erase the buffer.
+ ;; Restore previous state of debugger-buffer in case we
+ ;; were in a recursive invocation of the debugger,
+ ;; otherwise just exit (after changing the mode, since we
+ ;; can't interact with the buffer in the same way).
(when (buffer-live-p debugger-buffer)
(with-current-buffer debugger-buffer
(if debugger-previous-state
(debugger--restore-buffer-state debugger-previous-state)
- (setq backtrace-insert-header-function nil)
- (setq backtrace-frames nil)
- (backtrace-print))))
+ (backtrace-mode))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
(setq debug-on-next-call debugger-step-after-exit)
@@ -534,62 +538,75 @@ The environment used is the one when entering the activation frame at point."
(error 0)))) ;; If on first line.
(base (debugger--backtrace-base)))
(debugger-env-macro
- (let ((val (backtrace-eval exp nframe base)))
- (prog1
- (debugger--print val t)
- (let ((str (eval-expression-print-format val)))
- (if str (princ str t))))))))
+ (let* ((errored nil)
+ (val (if debug-allow-recursive-debug
+ (backtrace-eval exp nframe base)
+ (condition-case err
+ (backtrace-eval exp nframe base)
+ (error (setq errored
+ (format "%s: %s"
+ (get (car err) 'error-message)
+ (car (cdr err)))))))))
+ (if errored
+ (progn
+ (message "Error: %s" errored)
+ nil)
+ (prog1
+ (debugger--print val t)
+ (let ((str (eval-expression-print-format val)))
+ (if str (princ str t)))))))))
(define-obsolete-function-alias 'debugger-toggle-locals
'backtrace-toggle-locals "28.1")
-(defvar debugger-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map backtrace-mode-map)
- (define-key map "b" 'debugger-frame)
- (define-key map "c" 'debugger-continue)
- (define-key map "j" 'debugger-jump)
- (define-key map "r" 'debugger-return-value)
- (define-key map "u" 'debugger-frame-clear)
- (define-key map "d" 'debugger-step-through)
- (define-key map "l" 'debugger-list-functions)
- (define-key map "q" 'debugger-quit)
- (define-key map "e" 'debugger-eval-expression)
- (define-key map "R" 'debugger-record-expression)
- (define-key map [mouse-2] 'push-button)
- (easy-menu-define nil map ""
- '("Debugger"
- ["Step through" debugger-step-through
- :help "Proceed, stepping through subexpressions of this expression"]
- ["Continue" debugger-continue
- :help "Continue, evaluating this expression without stopping"]
- ["Jump" debugger-jump
- :help "Continue to exit from this frame, with all debug-on-entry suspended"]
- ["Eval Expression..." debugger-eval-expression
- :help "Eval an expression, in an environment like that outside the debugger"]
- ["Display and Record Expression" debugger-record-expression
- :help "Display a variable's value and record it in `*Backtrace-record*' buffer"]
- ["Return value..." debugger-return-value
- :help "Continue, specifying value to return."]
- "--"
- ["Debug frame" debugger-frame
- :help "Request entry to debugger when this frame exits"]
- ["Cancel debug frame" debugger-frame-clear
- :help "Do not enter debugger when this frame exits"]
- ["List debug on entry functions" debugger-list-functions
- :help "Display a list of all the functions now set to debug on entry"]
- "--"
- ["Next Line" next-line
- :help "Move cursor down"]
- ["Help for Symbol" backtrace-help-follow-symbol
- :help "Show help for symbol at point"]
- ["Describe Debugger Mode" describe-mode
- :help "Display documentation for debugger-mode"]
- "--"
- ["Quit" debugger-quit
- :help "Quit debugging and return to top level"]))
- map))
+(defvar-keymap debugger-mode-map
+ :full t
+ :parent backtrace-mode-map
+ "b" #'debugger-frame
+ "c" #'debugger-continue
+ "j" #'debugger-jump
+ "r" #'debugger-return-value
+ "u" #'debugger-frame-clear
+ "d" #'debugger-step-through
+ "l" #'debugger-list-functions
+ "q" #'debugger-quit
+ "e" #'debugger-eval-expression
+ "R" #'debugger-record-expression
+
+ "<mouse-2>" #'push-button
+
+ :menu
+ '("Debugger"
+ ["Step through" debugger-step-through
+ :help "Proceed, stepping through subexpressions of this expression"]
+ ["Continue" debugger-continue
+ :help "Continue, evaluating this expression without stopping"]
+ ["Jump" debugger-jump
+ :help "Continue to exit from this frame, with all debug-on-entry suspended"]
+ ["Eval Expression..." debugger-eval-expression
+ :help "Eval an expression, in an environment like that outside the debugger"]
+ ["Display and Record Expression" debugger-record-expression
+ :help "Display a variable's value and record it in `*Backtrace-record*' buffer"]
+ ["Return value..." debugger-return-value
+ :help "Continue, specifying value to return."]
+ "--"
+ ["Debug frame" debugger-frame
+ :help "Request entry to debugger when this frame exits"]
+ ["Cancel debug frame" debugger-frame-clear
+ :help "Do not enter debugger when this frame exits"]
+ ["List debug on entry functions" debugger-list-functions
+ :help "Display a list of all the functions now set to debug on entry"]
+ "--"
+ ["Next Line" next-line
+ :help "Move cursor down"]
+ ["Help for Symbol" backtrace-help-follow-symbol
+ :help "Show help for symbol at point"]
+ ["Describe Debugger Mode" describe-mode
+ :help "Display documentation for debugger-mode"]
+ "--"
+ ["Quit" debugger-quit
+ :help "Quit debugging and return to top level"]))
(put 'debugger-mode 'mode-class 'special)
@@ -701,7 +718,8 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(interactive
(list (let ((name
(completing-read
- "Cancel debug on entry to function (default all functions): "
+ (format-prompt "Cancel debug on entry to function"
+ "all functions")
(mapcar #'symbol-name (debug--function-list)) nil t)))
(when name
(unless (string= name "")
@@ -804,7 +822,8 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(interactive
(list (let ((name
(completing-read
- "Cancel debug on set for variable (default all variables): "
+ (format-prompt "Cancel debug on set for variable"
+ "all variables")
(mapcar #'symbol-name (debug--variable-list)) nil t)))
(when name
(unless (string= name "")
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 72f49bf3baf..8912eb10cc5 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -175,12 +175,7 @@ See Info node `(elisp)Derived Modes' for more details.
(declare (debug (&define name symbolp sexp [&optional stringp]
[&rest keywordp sexp] def-body))
(doc-string 4)
- ;; Ask not what
- ;;(indent 3)
- ;; can do for you, ask what it can do to others. IOW, the
- ;; missing of indentation setting here is the indentation
- ;; setting and not an oversight.
- )
+ (indent defun))
(when (and docstring (not (stringp docstring)))
;; Some trickiness, since what appears to be the docstring may really be
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index df379035038..c3a4e9fc7ab 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -82,11 +82,9 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
(replace-regexp-in-string (regexp-quote lighter) lighter name t t))))
(defconst easy-mmode--arg-docstring
- "
-
-This is a minor mode. If called interactively, toggle the `%s'
-mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+ "This is a %sminor mode. If called interactively, toggle the
+`%s' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'.
Enable the mode if ARG is nil, omitted, or is a positive number.
@@ -99,28 +97,50 @@ The mode's hook is called both when the mode is enabled and when
it is disabled.")
(defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym
- getter)
- (let ((doc (or doc (format "Toggle %s on or off.
-
-\\{%s}" mode-pretty-name keymap-sym))))
- (if (string-match-p "\\bARG\\b" doc)
- doc
- (let* ((fill-prefix nil)
- (docs-fc (bound-and-true-p emacs-lisp-docstring-fill-column))
- (fill-column (if (integerp docs-fc) docs-fc 65))
- (argdoc (format easy-mmode--arg-docstring mode-pretty-name
- ;; Avoid having quotes turn into pretty quotes.
- (string-replace "'" "\\\\='"
- (format "%S" getter))))
- (filled (if (fboundp 'fill-region)
- (with-temp-buffer
- (insert argdoc)
- (fill-region (point-min) (point-max) 'left t)
- (buffer-string))
- argdoc)))
- (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'"
- (concat filled "\\1")
- doc nil nil 1)))))
+ getter global)
+ ;; If we have a doc string, and it's already complete (which we
+ ;; guess at with the simple heuristic below), then just return that
+ ;; as is.
+ (if (and doc (string-match-p "\\bARG\\b" doc))
+ doc
+ ;; Compose a new doc string.
+ (with-temp-buffer
+ (let ((lines (if doc
+ (string-lines doc)
+ (list (format "Toggle %s on or off." mode-pretty-name)))))
+ ;; Insert the first line from the doc string.
+ (insert (pop lines))
+ ;; Ensure that we have (only) one blank line after the first
+ ;; line.
+ (ensure-empty-lines)
+ (while (and lines
+ (equal (car lines) ""))
+ (pop lines))
+ ;; Insert the doc string.
+ (dolist (line lines)
+ (insert line "\n"))
+ (ensure-empty-lines)
+ ;; Insert the boilerplate.
+ (let* ((fill-prefix nil)
+ (docs-fc (bound-and-true-p emacs-lisp-docstring-fill-column))
+ (fill-column (if (integerp docs-fc) docs-fc 65))
+ (argdoc (format
+ easy-mmode--arg-docstring
+ (if global "global " "")
+ mode-pretty-name
+ ;; Avoid having quotes turn into pretty quotes.
+ (string-replace "'" "\\='" (format "%S" getter)))))
+ (let ((start (point)))
+ (insert argdoc)
+ (when (fboundp 'fill-region)
+ (fill-region start (point) 'left t))))
+ ;; Finally, insert the keymap.
+ (when (and (boundp keymap-sym)
+ (or (not doc)
+ (not (string-search "\\{" doc))))
+ (ensure-empty-lines)
+ (insert (format "\\{%s}" keymap-sym)))
+ (buffer-string)))))
;;;###autoload
(defalias 'easy-mmode-define-minor-mode #'define-minor-mode)
@@ -198,6 +218,7 @@ INIT-VALUE LIGHTER KEYMAP.
\(fn MODE DOC [KEYWORD VAL ... &rest BODY])"
(declare (doc-string 2)
+ (indent defun)
(debug (&define name string-or-null-p
[&optional [&not keywordp] sexp
&optional [&not keywordp] sexp
@@ -316,7 +337,7 @@ or call the function `%s'."))))
warnwrap
`(defun ,modefun (&optional arg ,@extra-args)
,(easy-mmode--mode-docstring doc pretty-name keymap-sym
- getter)
+ getter globalp)
,(when interactive
;; Use `toggle' rather than (if ,mode 0 1) so that using
;; repeat-command still does the toggling correctly.
@@ -387,7 +408,7 @@ or call the function `%s'."))))
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
modefun)))
- ;; Allow using using `M-x customize-variable' on the hook.
+ ;; Allow using `M-x customize-variable' on the hook.
(put ',hook 'custom-type 'hook)
(put ',hook 'standard-value (list nil))
@@ -450,7 +471,7 @@ after running the major mode's hook. However, MODE is not turned
on if the hook has explicitly disabled it.
\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)"
- (declare (doc-string 2))
+ (declare (doc-string 2) (indent defun))
(let* ((global-mode-name (symbol-name global-mode))
(mode-name (symbol-name mode))
(pretty-name (easy-mmode-pretty-mode-name mode))
@@ -695,8 +716,12 @@ Valid keywords and arguments are:
(defmacro easy-mmode-defmap (m bs doc &rest args)
"Define a constant M whose value is the result of `easy-mmode-define-keymap'.
The M, BS, and ARGS arguments are as per that function. DOC is
-the constant's documentation."
- (declare (indent 1))
+the constant's documentation.
+
+This macro is deprecated; use `defvar-keymap' instead."
+ ;; FIXME: Declare obsolete in favor of `defvar-keymap'. It is still
+ ;; used for `gud-menu-map' and `gud-minor-mode-map', so fix that first.
+ (declare (doc-string 3) (indent 1))
`(defconst ,m
(easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
,doc))
@@ -723,7 +748,7 @@ the constant's documentation."
(defmacro easy-mmode-defsyntax (st css doc &rest args)
"Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
- (declare (indent 1))
+ (declare (doc-string 3) (indent 1))
`(progn
(autoload 'easy-mmode-define-syntax "easy-mmode")
(defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
@@ -800,7 +825,6 @@ Interactively, COUNT is the prefix numeric argument, and defaults to 1."
,@body))
(put ',prev-sym 'definition-name ',base))))
-
(provide 'easy-mmode)
;;; easy-mmode.el ends here
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 32dc600a1ab..1a1d58d6e36 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -41,7 +41,7 @@
;; See the Emacs Lisp Reference Manual for more details.
;; If you wish to change the default edebug global command prefix, change:
-;; (setq global-edebug-prefix "\C-xX")
+;; (setq edebug-global-prefix "\C-xX")
;; Edebug was written by
;; Daniel LaLiberte
@@ -57,6 +57,7 @@
(require 'cl-lib)
(require 'seq)
(eval-when-compile (require 'pcase))
+(require 'debug)
;;; Options
@@ -98,7 +99,11 @@ This applies to `eval-defun', `eval-region', `eval-buffer', and
You can use the command `edebug-all-defs' to toggle the value of this
variable. You may wish to make it local to each buffer with
\(make-local-variable \\='edebug-all-defs) in your
-`emacs-lisp-mode-hook'."
+`emacs-lisp-mode-hook'.
+
+Note that this user option has no effect unless the edebug
+package has been loaded."
+ :require 'edebug
:type 'boolean)
;;;###autoload
@@ -670,7 +675,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
(or (and (eq (aref edebug-read-syntax-table (following-char))
'symbol)
(not (= (following-char) ?\;)))
- (memq (following-char) '(?\, ?\.)))))
+ (eq (following-char) ?.))))
'symbol
(aref edebug-read-syntax-table (following-char))))
@@ -2573,6 +2578,13 @@ See `edebug-behavior-alist' for implementations.")
;; Let's at least show a backtrace so the user can figure out
;; which function we're talking about.
(debug))
+ ;; If we're in a `track-mouse' setting, then any previous mouse
+ ;; movements will make `input-pending-p' later return true. So
+ ;; discard the inputs in that case. (And `discard-input' doesn't
+ ;; work here.)
+ (when track-mouse
+ (while (input-pending-p)
+ (read-event)))
;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
;; Uses local variables of edebug-enter, edebug-before, edebug-after
;; and edebug-debugger.
@@ -3519,7 +3531,8 @@ The removes the effect of `edebug-on-entry'. If FUNCTION is
nil, remove `edebug-on-entry' on all functions."
(interactive
(list (let ((name (completing-read
- "Cancel edebug on entry to (default all functions): "
+ (format-prompt "Cancel edebug on entry to"
+ "all functions")
(let ((functions (edebug--edebug-on-entry-functions)))
(unless functions
(user-error "No functions have `edebug-on-entry'"))
@@ -3694,33 +3707,64 @@ Return the result of the last expression."
(defalias 'edebug-format #'format-message)
(defalias 'edebug-message #'message)
-(defun edebug-eval-expression (expr)
+(defun edebug-eval-expression (expr &optional pp)
"Evaluate an expression in the outside environment.
If interactive, prompt for the expression.
-Print result in minibuffer."
- (interactive (list (read--expression "Eval: ")))
- (princ
- (edebug-outside-excursion
- (let ((result (edebug-eval expr)))
- (values--store-value result)
- (concat (edebug-safe-prin1-to-string result)
- (eval-expression-print-format result))))))
-
-(defun edebug-eval-last-sexp (&optional no-truncate)
- "Evaluate sexp before point in the outside environment.
-Print value in minibuffer.
-If NO-TRUNCATE is non-nil (or interactively with a prefix
-argument of zero), show the full length of the expression, not
-limited by `edebug-print-length' or `edebug-print-level'."
+Print result in minibuffer by default, but if PP is non-nil open
+a new window and pretty-print the result there. (Interactively,
+this is the prefix key.)"
+ (interactive (list (read--expression "Edebug eval: ")
+ current-prefix-arg))
+ (let* ((errored nil)
+ (value
+ (edebug-outside-excursion
+ (if debug-allow-recursive-debug
+ (edebug-eval expr)
+ (condition-case err
+ (edebug-eval expr)
+ (error
+ (setq errored
+ (format "%s: %s"
+ (get (car err) 'error-message)
+ (car (cdr err)))))))))
+ (result
+ (unless errored
+ (values--store-value value)
+ (concat (edebug-safe-prin1-to-string value)
+ (eval-expression-print-format value)))))
+ (cond
+ (errored
+ (message "Error: %s" errored))
+ (pp
+ (save-selected-window
+ (pop-to-buffer "*Edebug Results*")
+ (erase-buffer)
+ (pp value (current-buffer))
+ (goto-char (point-min))
+ (lisp-data-mode)))
+ (t
+ (princ result)))))
+
+(defun edebug-eval-last-sexp (&optional display-type)
+ "Evaluate sexp before point in the outside environment.
+If DISPLAY-TYPE is `pretty-print' (interactively, a non-zero
+prefix argument), pretty-print the value in a separate buffer.
+Otherwise, print the value in minibuffer. If DISPLAY-TYPE is any
+other non-nil value (or interactively with a prefix argument of
+zero), show the full length of the expression, not limited by
+`edebug-print-length' or `edebug-print-level'."
(interactive
(list (and current-prefix-arg
- (zerop (prefix-numeric-value current-prefix-arg)))))
- (if no-truncate
- (let ((edebug-print-length nil)
- (edebug-print-level nil))
- (edebug-eval-expression (edebug-last-sexp)))
- (edebug-eval-expression (edebug-last-sexp))))
+ (if (zerop (prefix-numeric-value current-prefix-arg))
+ 'no-truncate
+ 'pretty-print))))
+ (if (or (null display-type)
+ (eq display-type 'pretty-print))
+ (edebug-eval-expression (edebug-last-sexp) display-type)
+ (let ((edebug-print-length nil)
+ (edebug-print-level nil))
+ (edebug-eval-expression (edebug-last-sexp)))))
(defun edebug-eval-print-last-sexp (&optional no-truncate)
"Evaluate sexp before point in outside environment; insert value.
@@ -3765,117 +3809,115 @@ be installed in `emacs-lisp-mode-map'.")
;; The following isn't a GUD binding.
(define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode))
-(defvar edebug-mode-map
- (let ((map (copy-keymap emacs-lisp-mode-map)))
- ;; control
- (define-key map " " 'edebug-step-mode)
- (define-key map "n" 'edebug-next-mode)
- (define-key map "g" 'edebug-go-mode)
- (define-key map "G" 'edebug-Go-nonstop-mode)
- (define-key map "t" 'edebug-trace-mode)
- (define-key map "T" 'edebug-Trace-fast-mode)
- (define-key map "c" 'edebug-continue-mode)
- (define-key map "C" 'edebug-Continue-fast-mode)
-
- ;;(define-key map "f" 'edebug-forward) not implemented
- (define-key map "f" 'edebug-forward-sexp)
- (define-key map "h" 'edebug-goto-here)
-
- (define-key map "I" 'edebug-instrument-callee)
- (define-key map "i" 'edebug-step-in)
- (define-key map "o" 'edebug-step-out)
-
- ;; quitting and stopping
- (define-key map "q" 'top-level)
- (define-key map "Q" 'edebug-top-level-nonstop)
- (define-key map "a" 'abort-recursive-edit)
- (define-key map "S" 'edebug-stop)
-
- ;; breakpoints
- (define-key map "b" 'edebug-set-breakpoint)
- (define-key map "u" 'edebug-unset-breakpoint)
- (define-key map "U" 'edebug-unset-breakpoints)
- (define-key map "B" 'edebug-next-breakpoint)
- (define-key map "x" 'edebug-set-conditional-breakpoint)
- (define-key map "X" 'edebug-set-global-break-condition)
- (define-key map "D" 'edebug-toggle-disable-breakpoint)
-
- ;; evaluation
- (define-key map "r" 'edebug-previous-result)
- (define-key map "e" 'edebug-eval-expression)
- (define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
- (define-key map "E" 'edebug-visit-eval-list)
-
- ;; views
- (define-key map "w" 'edebug-where)
- (define-key map "v" 'edebug-view-outside) ;; maybe obsolete??
- (define-key map "p" 'edebug-bounce-point)
- (define-key map "P" 'edebug-view-outside) ;; same as v
- (define-key map "W" 'edebug-toggle-save-windows)
-
- ;; misc
- (define-key map "?" 'edebug-help)
- (define-key map "d" 'edebug-pop-to-backtrace)
-
- (define-key map "-" 'negative-argument)
-
- ;; statistics
- (define-key map "=" 'edebug-temp-display-freq-count)
-
- ;; GUD bindings
- (define-key map "\C-c\C-s" 'edebug-step-mode)
- (define-key map "\C-c\C-n" 'edebug-next-mode)
- (define-key map "\C-c\C-c" 'edebug-go-mode)
-
- (define-key map "\C-x " 'edebug-set-breakpoint)
- (define-key map "\C-c\C-d" 'edebug-unset-breakpoint)
- (define-key map "\C-c\C-t"
- (lambda () (interactive) (edebug-set-breakpoint t)))
- (define-key map "\C-c\C-l" 'edebug-where)
- map))
+(defvar-keymap edebug-mode-map
+ :parent emacs-lisp-mode-map
+ ;; control
+ "SPC" #'edebug-step-mode
+ "n" #'edebug-next-mode
+ "g" #'edebug-go-mode
+ "G" #'edebug-Go-nonstop-mode
+ "t" #'edebug-trace-mode
+ "T" #'edebug-Trace-fast-mode
+ "c" #'edebug-continue-mode
+ "C" #'edebug-Continue-fast-mode
+
+ ;;"f" #'edebug-forward ; not implemented
+ "f" #'edebug-forward-sexp
+ "h" #'edebug-goto-here
+
+ "I" #'edebug-instrument-callee
+ "i" #'edebug-step-in
+ "o" #'edebug-step-out
+
+ ;; quitting and stopping
+ "q" #'top-level
+ "Q" #'edebug-top-level-nonstop
+ "a" #'abort-recursive-edit
+ "S" #'edebug-stop
+
+ ;; breakpoints
+ "b" #'edebug-set-breakpoint
+ "u" #'edebug-unset-breakpoint
+ "U" #'edebug-unset-breakpoints
+ "B" #'edebug-next-breakpoint
+ "x" #'edebug-set-conditional-breakpoint
+ "X" #'edebug-set-global-break-condition
+ "D" #'edebug-toggle-disable-breakpoint
+
+ ;; evaluation
+ "r" #'edebug-previous-result
+ "e" #'edebug-eval-expression
+ "C-x C-e" #'edebug-eval-last-sexp
+ "E" #'edebug-visit-eval-list
+
+ ;; views
+ "w" #'edebug-where
+ "v" #'edebug-view-outside ; maybe obsolete??
+ "p" #'edebug-bounce-point
+ "P" #'edebug-view-outside ; same as v
+ "W" #'edebug-toggle-save-windows
+
+ ;; misc
+ "?" #'edebug-help
+ "d" #'edebug-pop-to-backtrace
+
+ "-" #'negative-argument
+
+ ;; statistics
+ "=" #'edebug-temp-display-freq-count
+
+ ;; GUD bindings
+ "C-c C-s" #'edebug-step-mode
+ "C-c C-n" #'edebug-next-mode
+ "C-c C-c" #'edebug-go-mode
+
+ "C-x SPC" #'edebug-set-breakpoint
+ "C-c C-d" #'edebug-unset-breakpoint
+ "C-c C-t" (lambda () (interactive) (edebug-set-breakpoint t))
+ "C-c C-l" #'edebug-where)
;; Autoloading these global bindings doesn't make sense because
;; they cannot be used anyway unless Edebug is already loaded and active.
(define-obsolete-variable-alias 'global-edebug-prefix
'edebug-global-prefix "28.1")
-(defvar edebug-global-prefix "\^XX"
+(defvar edebug-global-prefix
+ (when-let ((binding
+ (car (where-is-internal 'Control-X-prefix (list global-map)))))
+ (concat binding [?X]))
"Prefix key for global edebug commands, available from any buffer.")
(define-obsolete-variable-alias 'global-edebug-map
'edebug-global-map "28.1")
-(defvar edebug-global-map
- (let ((map (make-sparse-keymap)))
-
- (define-key map " " 'edebug-step-mode)
- (define-key map "g" 'edebug-go-mode)
- (define-key map "G" 'edebug-Go-nonstop-mode)
- (define-key map "t" 'edebug-trace-mode)
- (define-key map "T" 'edebug-Trace-fast-mode)
- (define-key map "c" 'edebug-continue-mode)
- (define-key map "C" 'edebug-Continue-fast-mode)
-
- ;; breakpoints
- (define-key map "b" 'edebug-set-breakpoint)
- (define-key map "u" 'edebug-unset-breakpoint)
- (define-key map "U" 'edebug-unset-breakpoints)
- (define-key map "x" 'edebug-set-conditional-breakpoint)
- (define-key map "X" 'edebug-set-global-break-condition)
- (define-key map "D" 'edebug-toggle-disable-breakpoint)
-
- ;; views
- (define-key map "w" 'edebug-where)
- (define-key map "W" 'edebug-toggle-save-windows)
-
- ;; quitting
- (define-key map "q" 'top-level)
- (define-key map "Q" 'edebug-top-level-nonstop)
- (define-key map "a" 'abort-recursive-edit)
-
- ;; statistics
- (define-key map "=" 'edebug-display-freq-count)
- map)
- "Global map of edebug commands, available from any buffer.")
+(defvar-keymap edebug-global-map
+ :doc "Global map of edebug commands, available from any buffer."
+ "SPC" #'edebug-step-mode
+ "g" #'edebug-go-mode
+ "G" #'edebug-Go-nonstop-mode
+ "t" #'edebug-trace-mode
+ "T" #'edebug-Trace-fast-mode
+ "c" #'edebug-continue-mode
+ "C" #'edebug-Continue-fast-mode
+
+ ;; breakpoints
+ "b" #'edebug-set-breakpoint
+ "u" #'edebug-unset-breakpoint
+ "U" #'edebug-unset-breakpoints
+ "x" #'edebug-set-conditional-breakpoint
+ "X" #'edebug-set-global-break-condition
+ "D" #'edebug-toggle-disable-breakpoint
+
+ ;; views
+ "w" #'edebug-where
+ "W" #'edebug-toggle-save-windows
+
+ ;; quitting
+ "q" #'top-level
+ "Q" #'edebug-top-level-nonstop
+ "a" #'abort-recursive-edit
+
+ ;; statistics
+ "=" #'edebug-display-freq-count)
(when edebug-global-prefix
(global-unset-key edebug-global-prefix)
@@ -4046,16 +4088,14 @@ May only be called from within `edebug--recursive-edit'."
-(defvar edebug-eval-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map lisp-interaction-mode-map)
- (define-key map "\C-c\C-w" 'edebug-where)
- (define-key map "\C-c\C-d" 'edebug-delete-eval-item)
- (define-key map "\C-c\C-u" 'edebug-update-eval-list)
- (define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
- (define-key map "\C-j" 'edebug-eval-print-last-sexp)
- map)
- "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
+(defvar-keymap edebug-eval-mode-map
+ :doc "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode."
+ :parent lisp-interaction-mode-map
+ "C-c C-w" #'edebug-where
+ "C-c C-d" #'edebug-delete-eval-item
+ "C-c C-u" #'edebug-update-eval-list
+ "C-x C-e" #'edebug-eval-last-sexp
+ "C-j" #'edebug-eval-print-last-sexp)
(put 'edebug-eval-mode 'mode-class 'special)
@@ -4548,7 +4588,8 @@ instrumentation for, defaulting to all functions."
(user-error "Found no functions to remove instrumentation from"))
(let ((name
(completing-read
- "Remove instrumentation from (default all functions): "
+ (format-prompt "Remove instrumentation from"
+ "all functions")
functions)))
(if (and name
(not (equal name "")))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 196747d71a7..5e7b5cbfb2f 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -24,15 +24,14 @@
;;; Commentary:
;;
;; The "core" part of EIEIO is the implementation for the object
-;; system (such as eieio-defclass, or eieio-defmethod) but not the
-;; base classes for the object system, which are defined in EIEIO.
+;; system (such as eieio-defclass-internal, or cl-defmethod) but not
+;; the base classes for the object system, which are defined in EIEIO.
;;
;; See the commentary for eieio.el for more about EIEIO itself.
;;; Code:
(require 'cl-lib)
-(require 'eieio-loaddefs nil t)
;;;
;; A few functions that are better in the official EIEIO src, but
@@ -92,7 +91,7 @@ Currently under control of this var:
(:copier nil))
children
initarg-tuples ;; initarg tuples list
- (class-slots nil :type eieio--slot)
+ (class-slots nil :type (vector-of eieio--slot))
class-allocation-values ;; class allocated value vector
default-object-cache ;; what a newly created object would look like.
; This will speed up instantiation time as
@@ -130,16 +129,15 @@ Currently under control of this var:
class))
(defsubst eieio--object-class (obj)
- (let ((tag (eieio--object-class-tag obj)))
- (if eieio-backward-compatibility
- (eieio--class-object tag)
- tag)))
+ (eieio--class-object (eieio--object-class-tag obj)))
(defun class-p (x)
"Return non-nil if X is a valid class vector.
X can also be is a symbol."
(eieio--class-p (if (symbolp x) (cl--find-class x) x)))
+(cl-deftype class () `(satisfies class-p))
+
(defun eieio--class-print-name (class)
"Return a printed representation of CLASS."
(format "#<class %s>" (eieio-class-name class)))
@@ -168,6 +166,8 @@ Return nil if that option doesn't exist."
(and (recordp obj)
(eieio--class-p (eieio--object-class obj))))
+(cl-deftype eieio-object () `(satisfies eieio-object-p))
+
(define-obsolete-function-alias 'object-p #'eieio-object-p "25.1")
(defun class-abstract-p (class)
@@ -215,7 +215,7 @@ It creates an autoload function for CNAME's constructor."
(when eieio-backward-compatibility
(set cname cname)
(make-obsolete-variable cname (format "\
-use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
+use '%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
(setf (cl--find-class cname) newc)
@@ -265,6 +265,10 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
(defvar eieio--known-slot-names nil)
(defvar eieio--known-class-slot-names nil)
+(defun eieio--known-slot-name-p (name)
+ (or (memq name eieio--known-slot-names)
+ (get name 'slot-name)))
+
(defun eieio-defclass-internal (cname superclasses slots options)
"Define CNAME as a new subclass of SUPERCLASSES.
SLOTS are the slots residing in that class definition, and OPTIONS
@@ -340,7 +344,7 @@ See `defclass' for more information."
;; turn this into a usable self-pointing symbol; FIXME: Why?
(when eieio-backward-compatibility
(set cname cname)
- (make-obsolete-variable cname (format "use \\='%s instead" cname)
+ (make-obsolete-variable cname (format "use '%s instead" cname)
"25.1"))
;; Create a handy list of the class test too
@@ -362,7 +366,7 @@ See `defclass' for more information."
(setq obj (cdr obj)))
ans))))
(make-obsolete csym (format
- "use (cl-typep ... \\='(list-of %s)) instead"
+ "use (cl-typep ... '(list-of %s)) instead"
cname)
"25.1")))
@@ -420,7 +424,7 @@ See `defclass' for more information."
(progn
(set initarg initarg)
(make-obsolete-variable
- initarg (format "use \\='%s instead" initarg) "25.1"))))
+ initarg (format "use '%s instead" initarg) "25.1"))))
;; The customgroup should be a list of symbols.
(cond ((and (null customg) custom)
@@ -450,7 +454,7 @@ See `defclass' for more information."
))
;; Now that everything has been loaded up, all our lists are backwards!
- ;; Fix that up now and then them into vectors.
+ ;; Fix that up now and turn them into vectors.
(cl-callf (lambda (slots) (apply #'vector (nreverse slots)))
(eieio--class-slots newc))
(cl-callf nreverse (eieio--class-initarg-tuples newc))
@@ -478,7 +482,8 @@ See `defclass' for more information."
;; (dotimes (cnt (length cslots))
;; (setf (gethash (cl--slot-descriptor-name (aref cslots cnt)) oa) (- -1 cnt)))
(dotimes (cnt (length slots))
- (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) cnt))
+ (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa)
+ (+ (eval-when-compile eieio--object-num-slots) cnt)))
(setf (eieio--class-index-table newc) oa))
;; Set up a specialized doc string.
@@ -508,6 +513,7 @@ See `defclass' for more information."
;; Create the cached default object.
(let ((cache (make-record newc
(+ (length (eieio--class-slots newc))
+ ;; FIXME: Why +1 -1 ?
(eval-when-compile eieio--object-num-slots)
-1)
nil)))
@@ -702,11 +708,15 @@ an error."
nil
;; Trim off object IDX junk added in for the object index.
(setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
- (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class)
- slot-idx))))
- (if (not (eieio--perform-slot-validation st value))
- (signal 'invalid-slot-type
- (list (eieio--class-name class) slot st value))))))
+ (let* ((sd (aref (eieio--class-slots class)
+ slot-idx))
+ (st (cl--slot-descriptor-type sd)))
+ (cond
+ ((not (eieio--perform-slot-validation st value))
+ (signal 'invalid-slot-type
+ (list (cl--class-name class) slot st value)))
+ ((alist-get :read-only (cl--slot-descriptor-props sd))
+ (signal 'eieio-read-only (list (cl--class-name class) slot)))))))
(defun eieio--validate-class-slot-value (class slot-idx value slot)
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
@@ -719,7 +729,7 @@ an error."
slot-idx))))
(if (not (eieio--perform-slot-validation st value))
(signal 'invalid-slot-type
- (list (eieio--class-name class) slot st value))))))
+ (list (cl--class-name class) slot st value))))))
(defun eieio-barf-if-slot-unbound (value instance slotname fn)
"Throw a signal if VALUE is a representation of an UNBOUND slot.
@@ -740,31 +750,35 @@ Argument FN is the function calling this verifier."
(ignore obj)
(pcase slot
((and (or `',name (and name (pred keywordp)))
- (guard (not (memq name eieio--known-slot-names))))
+ (guard (not (eieio--known-slot-name-p name))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp))))
+ ;; FIXME: Make it a gv-expander such that the hash-table lookup is
+ ;; only performed once when used in `push' and friends?
(gv-setter eieio-oset))
(cl-check-type slot symbol)
- (cl-check-type obj (or eieio-object class))
- (let* ((class (cond ((symbolp obj)
- (error "eieio-oref called on a class: %s" obj)
- (eieio--full-class-object obj))
- (t (eieio--object-class obj))))
- (c (eieio--slot-name-index class slot)))
- (if (not c)
- ;; It might be missing because it is a :class allocated slot.
- ;; Let's check that info out.
- (if (setq c (eieio--class-slot-name-index class slot))
- ;; Oref that slot.
- (aref (eieio--class-class-allocation-values class) c)
- ;; The slot-missing method is a cool way of allowing an object author
- ;; to intercept missing slot definitions. Since it is also the LAST
- ;; thing called in this fn, its return value would be retrieved.
- (slot-missing obj slot 'oref))
- (cl-check-type obj eieio-object)
- (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
+ (cond
+ ((cl-typep obj '(or eieio-object cl-structure-object))
+ (let* ((class (eieio--object-class obj))
+ (c (eieio--slot-name-index class slot)))
+ (if (not c)
+ ;; It might be missing because it is a :class allocated slot.
+ ;; Let's check that info out.
+ (if (setq c (eieio--class-slot-name-index class slot))
+ ;; Oref that slot.
+ (aref (eieio--class-class-allocation-values class) c)
+ ;; The slot-missing method is a cool way of allowing an object author
+ ;; to intercept missing slot definitions. Since it is also the LAST
+ ;; thing called in this fn, its return value would be retrieved.
+ (slot-missing obj slot 'oref))
+ (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
+ ((cl-typep obj 'oclosure) (oclosure--slot-value obj slot))
+ (t
+ (signal 'wrong-type-argument
+ (list '(or eieio-object cl-structure-object oclosure) obj)))))
+
(defun eieio-oref-default (class slot)
@@ -776,15 +790,15 @@ Fills in CLASS's SLOT with its default value."
(ignore class)
(pcase slot
((and (or `',name (and name (pred keywordp)))
- (guard (not (memq name eieio--known-slot-names))))
+ (guard (not (eieio--known-slot-name-p name))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
@@ -811,24 +825,29 @@ Fills in CLASS's SLOT with its default value."
(defun eieio-oset (obj slot value)
"Do the work for the macro `oset'.
Fills in OBJ's SLOT with VALUE."
- (cl-check-type obj eieio-object)
(cl-check-type slot symbol)
- (let* ((class (eieio--object-class obj))
- (c (eieio--slot-name-index class slot)))
- (if (not c)
- ;; It might be missing because it is a :class allocated slot.
- ;; Let's check that info out.
- (if (setq c
- (eieio--class-slot-name-index class slot))
- ;; Oset that slot.
- (progn
- (eieio--validate-class-slot-value class c value slot)
- (aset (eieio--class-class-allocation-values class)
- c value))
- ;; See oref for comment on `slot-missing'
- (slot-missing obj slot 'oset value))
- (eieio--validate-slot-value class c value slot)
- (aset obj c value))))
+ (cond
+ ((cl-typep obj '(or eieio-object cl-structure-object))
+ (let* ((class (eieio--object-class obj))
+ (c (eieio--slot-name-index class slot)))
+ (if (not c)
+ ;; It might be missing because it is a :class allocated slot.
+ ;; Let's check that info out.
+ (if (setq c
+ (eieio--class-slot-name-index class slot))
+ ;; Oset that slot.
+ (progn
+ (eieio--validate-class-slot-value class c value slot)
+ (aset (eieio--class-class-allocation-values class)
+ c value))
+ ;; See oref for comment on `slot-missing'
+ (slot-missing obj slot 'oset value))
+ (eieio--validate-slot-value class c value slot)
+ (aset obj c value))))
+ ((cl-typep obj 'oclosure) (oclosure--set-slot-value obj slot value))
+ (t
+ (signal 'wrong-type-argument
+ (list '(or eieio-object cl-structure-object oclosure) obj)))))
(defun eieio-oset-default (class slot value)
"Do the work for the macro `oset-default'.
@@ -838,15 +857,15 @@ Fills in the default value in CLASS' in SLOT with VALUE."
(ignore class value)
(pcase slot
((and (or `',name (and name (pred keywordp)))
- (guard (not (memq name eieio--known-slot-names))))
+ (guard (not (eieio--known-slot-name-p name))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
@@ -861,7 +880,7 @@ Fills in the default value in CLASS' in SLOT with VALUE."
(eieio--validate-class-slot-value class c value slot)
(aset (eieio--class-class-allocation-values class) c
value))
- (signal 'invalid-slot-name (list (eieio--class-name class) slot)))
+ (signal 'invalid-slot-name (list (cl--class-name class) slot)))
;; `oset-default' on an instance-allocated slot is allowed by EIEIO but
;; not by CLOS and is mildly inconsistent with the :initform thingy, so
;; it'd be nice to get rid of it.
@@ -890,9 +909,9 @@ The slot is a symbol which is installed in CLASS by the `defclass' call.
If SLOT is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; Removed checks to outside this call
- (let* ((fsi (gethash slot (eieio--class-index-table class))))
+ (let* ((fsi (gethash slot (cl--class-index-table class))))
(if (integerp fsi)
- (+ (eval-when-compile eieio--object-num-slots) fsi)
+ fsi
(let ((fn (eieio--initarg-to-attribute class slot)))
(if fn
;; Accessing a slot via its :initarg is accepted by EIEIO
@@ -1061,6 +1080,7 @@ method invocation orders of the involved classes."
;;
(define-error 'invalid-slot-name "Invalid slot name")
(define-error 'invalid-slot-type "Invalid slot type")
+(define-error 'eieio-read-only "Read-only slot")
(define-error 'unbound-slot "Unbound slot")
(define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy")
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index ebb6f2cd8c8..0bec3bb0d59 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -329,11 +329,9 @@ Argument OBJ is the object that has been customized."
Optional argument GROUP is the sub-group of slots to display."
(eieio-customize-object obj group))
-(defvar eieio-custom-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- map)
- "Keymap for EIEIO Custom mode.")
+(defvar-keymap eieio-custom-mode-map
+ :doc "Keymap for EIEIO Custom mode."
+ :parent widget-keymap)
(define-derived-mode eieio-custom-mode fundamental-mode "EIEIO Custom"
"Major mode for customizing EIEIO objects.
@@ -469,8 +467,4 @@ Return the symbol for the group, or nil."
(provide 'eieio-custom)
-;; Local variables:
-;; generated-autoload-file: "eieio-loaddefs.el"
-;; End:
-
;;; eieio-custom.el ends here
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index c7e7384144c..5f67263f177 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -130,6 +130,7 @@ are not abstract."
;;;###autoload
(defun eieio-help-constructor (ctr)
"Describe CTR if it is a class constructor."
+ (declare (obsolete "use `describe-function' or `cl--describe-class'." "29.1"))
(when (class-p ctr)
(erase-buffer)
(let ((location (find-lisp-object-file-name ctr 'define-type))
@@ -347,8 +348,4 @@ INDENT is the current indentation level."
(provide 'eieio-opt)
-;; Local variables:
-;; generated-autoload-file: "eieio-loaddefs.el"
-;; End:
-
;;; eieio-opt.el ends here
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 3b633e4fa36..565eaf2d733 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -110,7 +110,7 @@ Options in CLOS not supported in EIEIO:
Due to the way class options are set up, you can add any tags you wish,
and reference them using the function `class-option'."
- (declare (doc-string 4))
+ (declare (doc-string 4) (indent defun))
(cl-check-type superclasses list)
(cond ((and (stringp (car options-and-doc))
@@ -181,9 +181,11 @@ and reference them using the function `class-option'."
;; Is there an initarg, but allocation of class?
(when (and initarg (eq alloc :class))
- (push (format "Meaningless :initarg for class allocated slot '%S'"
- sname)
- warnings))
+ (push
+ (cons sname
+ (format "Meaningless :initarg for class allocated slot '%S'"
+ sname))
+ warnings))
(let ((init (plist-get soptions :initform)))
(unless (or (macroexp-const-p init)
@@ -194,8 +196,9 @@ and reference them using the function `class-option'."
;; heuristic says and if it disagrees with normal evaluation
;; then tweak the initform to make it fit and emit
;; a warning accordingly.
- (push (format "Ambiguous initform needs quoting: %S" init)
- warnings)))
+ (push
+ (cons init (format "Ambiguous initform needs quoting: %S" init))
+ warnings)))
;; Anyone can have an accessor function. This creates a function
;; of the specified name, and also performs a `defsetf' if applicable
@@ -242,7 +245,8 @@ This method is obsolete."
`(progn
,@(mapcar (lambda (w)
- (macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
+ (macroexp-warn-and-return
+ (cdr w) `(progn ',(cdr w)) nil 'compile-only (car w)))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
@@ -256,7 +260,7 @@ This method is obsolete."
(let ((f (intern (format "%s-child-p" name))))
`((defalias ',f #',testsym2)
(make-obsolete
- ',f ,(format "use (cl-typep ... \\='%s) instead" name)
+ ',f ,(format "use (cl-typep ... '%s) instead" name)
"25.1"))))
;; When using typep, (typep OBJ 'myclass) returns t for objects which
@@ -267,7 +271,8 @@ This method is obsolete."
;; test, so we can let typep have the CLOS documented behavior
;; while keeping our above predicate clean.
- (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2)
+ (eval-and-compile
+ (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2))
(eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
@@ -297,7 +302,8 @@ This method is obsolete."
;; Keep the name arg, for backward compatibility,
;; but hide it so we don't trigger indefinitely.
`(,(car whole) (identity ,(car slots))
- ,@(cdr slots)))))))
+ ,@(cdr slots))
+ nil nil (car slots))))))
(apply #'make-instance ',name slots))))))
@@ -359,9 +365,7 @@ variable name of the same name as the slot."
(defun eieio-pcase-slot-index-from-index-table (index-table slot)
"Find the index to pass to `aref' to access SLOT."
- (let ((index (gethash slot index-table)))
- (if index (+ (eval-when-compile eieio--object-num-slots)
- index))))
+ (gethash slot index-table))
(pcase-defmacro eieio (&rest fields)
"Pcase patterns that match EIEIO object EXPVAL.
@@ -994,11 +998,6 @@ of `eq'."
(error "EIEIO: `change-class' is unimplemented"))
(define-obsolete-function-alias 'change-class #'eieio-change-class "26.1")
-;; Hook ourselves into help system for describing classes and methods.
-;; FIXME: This is not actually needed any more since we can click on the
-;; hyperlink from the constructor's docstring to see the type definition.
-(add-hook 'help-fns-describe-function-functions #'eieio-help-constructor)
-
(provide 'eieio)
;;; eieio.el ends here
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 5300b0594d2..0b8078579cc 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -5,7 +5,7 @@
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: extensions
;; Created: 1995-10-06
-;; Version: 1.11.0
+;; Version: 1.12.0
;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -102,7 +102,7 @@ put in the echo area. If a positive integer, the number is used
directly, while a float specifies the number of lines as a
proportion of the echo area frame's height.
-If value is the symbol `truncate-sym-name-if-fit' t, the part of
+If value is the symbol `truncate-sym-name-if-fit', the part of
the doc string that represents a symbol's name may be truncated
if it will enable the rest of the doc string to fit on a single
line, without resizing the echo area.
@@ -380,7 +380,19 @@ Also store it in `eldoc-last-message' and return that value."
;; it undesirable to print eldoc messages right this instant.
(defun eldoc-display-message-no-interference-p ()
"Return nil if displaying a message would cause interference."
- (not (or executing-kbd-macro (bound-and-true-p edebug-active))))
+ (not (or executing-kbd-macro
+ (bound-and-true-p edebug-active)
+ ;; The following configuration shows "Matches..." in the
+ ;; echo area when point is after a closing bracket, which
+ ;; conflicts with eldoc.
+ (and (boundp 'show-paren-context-when-offscreen)
+ show-paren-context-when-offscreen
+ ;; There's no conflict with the child-frame and
+ ;; overlay versions.
+ (not (memq show-paren-context-when-offscreen
+ '(child-frame overlay)))
+ (not (pos-visible-in-window-p
+ (overlay-end show-paren--overlay)))))))
(defvar eldoc-documentation-functions nil
@@ -452,19 +464,22 @@ directly from the user or from ElDoc's automatic mechanisms'.")
(defvar eldoc--doc-buffer-docs nil "Documentation items in `eldoc--doc-buffer'.")
-(defun eldoc-doc-buffer ()
- "Display ElDoc documentation buffer.
+(defun eldoc-doc-buffer (&optional interactive)
+ "Get or display ElDoc documentation buffer.
-This holds the results of the last documentation request."
- (interactive)
+The buffer holds the results of the last documentation request.
+If INTERACTIVE, display it. Else, return said buffer."
+ (interactive (list t))
(unless (buffer-live-p eldoc--doc-buffer)
(user-error (format
"ElDoc buffer doesn't exist, maybe `%s' to produce one."
(substitute-command-keys "\\[eldoc]"))))
(with-current-buffer eldoc--doc-buffer
- (rename-buffer (replace-regexp-in-string "^ *" ""
- (buffer-name)))
- (display-buffer (current-buffer))))
+ (cond (interactive
+ (rename-buffer (replace-regexp-in-string "^ *" ""
+ (buffer-name)))
+ (display-buffer (current-buffer)))
+ (t (current-buffer)))))
(defun eldoc--format-doc-buffer (docs)
"Ensure DOCS are displayed in an *eldoc* buffer."
@@ -513,7 +528,8 @@ Helper for `eldoc-display-in-echo-area'."
(goto-char (point-min))
(skip-chars-forward " \t\n")
(point))
- (goto-char (line-end-position available))
+ (forward-visible-line (1- available))
+ (end-of-visible-line)
(skip-chars-backward " \t\n")))
(truncated (save-excursion
(skip-chars-forward " \t\n")
@@ -523,7 +539,8 @@ Helper for `eldoc-display-in-echo-area'."
((and truncated
(> available 1)
eldoc-echo-area-display-truncation-message)
- (goto-char (line-end-position 0))
+ (forward-visible-line -1)
+ (end-of-visible-line)
(concat (buffer-substring start (point))
(format
"\n(Documentation truncated. Use `%s' to see rest)"
@@ -598,7 +615,8 @@ Honor `eldoc-echo-area-use-multiline-p' and
(let ((string
(with-current-buffer (eldoc--format-doc-buffer docs)
(buffer-substring (goto-char (point-min))
- (line-end-position 1)))))
+ (progn (end-of-visible-line)
+ (point))))))
(if (> (length string) width) ; truncation to happen
(unless (eldoc--echo-area-prefer-doc-buffer-p t)
(truncate-string-to-width string width))
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 4b20e8f756c..03c5b94e3b4 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -202,14 +202,13 @@ This variable is set by the master function.")
(defvar elp-not-profilable
;; First, the functions used inside each instrumented function:
'(called-interactively-p
- ;; Then the functions used by the above functions. I used
- ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
- ;; (aref (symbol-function 'elp-wrapper) 2)))
- ;; to help me find this list.
- error call-interactively apply current-time
+ ;; (delq
+ ;; nil (mapcar
+ ;; (lambda (x) (and (symbolp x) (fboundp x) x))
+ ;; (aref (aref (aref (symbol-function 'elp--make-wrapper) 2) 1) 2)))
+ error apply current-time float-time time-subtract
;; Andreas Politz reports problems profiling these (Bug#4233):
- + byte-code-function-p functionp byte-code subrp
- indirect-function fboundp)
+ + byte-code-function-p functionp byte-code subrp fboundp)
"List of functions that cannot be profiled.
Those functions are used internally by the profiling code and profiling
them would thus lead to infinite recursion.")
@@ -288,7 +287,12 @@ type \"nil\" to use `elp-function-list'."
"Instrument for profiling, all functions which start with PREFIX.
For example, to instrument all ELP functions, do the following:
- \\[elp-instrument-package] RET elp- RET"
+ \\[elp-instrument-package] RET elp- RET
+
+Note that only functions that are currently loaded will be
+instrumented. If you run this function, and then later load
+further functions that start with PREFIX, they will not be
+instrumented automatically."
(interactive
(list (completing-read "Prefix of package to instrument: "
obarray 'elp-profilable-p)))
@@ -299,10 +303,18 @@ For example, to instrument all ELP functions, do the following:
'intern
(all-completions prefix obarray 'elp-profilable-p))))
+(defun elp-restore-package (prefix)
+ "Remove instrumentation from functions with names starting with PREFIX."
+ (interactive "SPrefix: ")
+ (elp-restore-list
+ (mapcar #'intern
+ (all-completions (symbol-name prefix)
+ obarray 'elp-profilable-p))))
+
(defun elp-restore-list (&optional list)
"Restore the original definitions for all functions in `elp-function-list'.
Use optional LIST if provided instead."
- (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!?
+ (interactive)
(mapcar #'elp-restore-function (or list elp-function-list)))
(defun elp-restore-all ()
@@ -324,7 +336,7 @@ Use optional LIST if provided instead."
(defun elp-reset-list (&optional list)
"Reset the profiling information for all functions in `elp-function-list'.
Use optional LIST if provided instead."
- (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!?
+ (interactive)
(let ((list (or list elp-function-list)))
(mapcar 'elp-reset-function list)))
@@ -460,13 +472,11 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
(insert atstr))
(insert "\n"))))
-(defvar elp-results-symname-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'elp-results-jump-to-definition)
- (define-key map [follow-link] 'mouse-face)
- (define-key map "\C-m" 'elp-results-jump-to-definition)
- map)
- "Keymap used on the function name column." )
+(defvar-keymap elp-results-symname-map
+ :doc "Keymap used on the function name column."
+ "<mouse-2>" #'elp-results-jump-to-definition
+ "<follow-link>" 'mouse-face
+ "RET" #'elp-results-jump-to-definition)
(defun elp-results-jump-to-definition (&optional event)
"Jump to the definition of the function at point."
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 12534c7c4ce..4436d0a4b16 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -158,9 +158,6 @@ test for `called-interactively' in the command will fail."
(run-hooks 'pre-command-hook)
(setq return-value (apply (car command) (cdr command)))
(run-hooks 'post-command-hook)
- (and (boundp 'deferred-action-list)
- deferred-action-list
- (run-hooks 'deferred-action-function))
(setq real-last-command (car command)
last-command this-command)
(when (boundp 'last-repeatable-command)
@@ -338,7 +335,8 @@ unless the output is going to the echo area (when PRINTCHARFUN is
t or PRINTCHARFUN is nil and `standard-output' is t). If the
output is destined for the echo area, the advice function will
convert it to a string and pass it to COLLECTOR first."
- (lambda (func object &optional printcharfun)
+ ;;; FIXME: Pass on OVERRIDES.
+ (lambda (func object &optional printcharfun _overrides)
(if (not (eq t (or printcharfun standard-output)))
(funcall func object printcharfun)
(funcall collector (with-output-to-string
@@ -352,7 +350,6 @@ convert it to a string and pass it to COLLECTOR first."
(defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el"
"Regexp for `string-trim' (right) used by `ert-resource-directory'.")
-;; Has to be a macro for `load-file-name'.
(defmacro ert-resource-directory ()
"Return absolute file name of the resource (test data) directory.
@@ -368,17 +365,17 @@ variable `ert-resource-directory-format'. Before formatting, the
file name will be trimmed using `string-trim' with arguments
`ert-resource-directory-trim-left-regexp' and
`ert-resource-directory-trim-right-regexp'."
- `(let* ((testfile ,(or (macroexp-file-name)
- buffer-file-name))
- (default-directory (file-name-directory testfile)))
- (file-truename
- (if (file-accessible-directory-p "resources/")
- (expand-file-name "resources/")
- (expand-file-name
- (format ert-resource-directory-format
- (string-trim testfile
- ert-resource-directory-trim-left-regexp
- ert-resource-directory-trim-right-regexp)))))))
+ `(when-let ((testfile ,(or (macroexp-file-name)
+ buffer-file-name)))
+ (let ((default-directory (file-name-directory testfile)))
+ (file-truename
+ (if (file-accessible-directory-p "resources/")
+ (expand-file-name "resources/")
+ (expand-file-name
+ (format ert-resource-directory-format
+ (string-trim testfile
+ ert-resource-directory-trim-left-regexp
+ ert-resource-directory-trim-right-regexp))))))))
(defmacro ert-resource-file (file)
"Return absolute file name of resource (test data) file named FILE.
@@ -386,6 +383,145 @@ A resource file is defined as any file placed in the resource
directory as returned by `ert-resource-directory'."
`(expand-file-name ,file (ert-resource-directory)))
+(defvar ert-temp-file-prefix "emacs-test-"
+ "Prefix used by `ert-with-temp-file' and `ert-with-temp-directory'.")
+
+(defvar ert-temp-file-suffix nil
+ "Suffix used by `ert-with-temp-file' and `ert-with-temp-directory'.")
+
+(defun ert--with-temp-file-generate-suffix (filename)
+ "Generate temp file suffix from FILENAME."
+ (thread-last
+ (file-name-base filename)
+ (replace-regexp-in-string (rx string-start
+ (group (+? not-newline))
+ (regexp "-?tests?")
+ string-end)
+ "\\1")
+ (concat "-")))
+
+(defmacro ert-with-temp-file (name &rest body)
+ "Bind NAME to the name of a new temporary file and evaluate BODY.
+Delete the temporary file after BODY exits normally or
+non-locally. NAME will be bound to the file name of the temporary
+file.
+
+The following keyword arguments are supported:
+
+:prefix STRING If non-nil, pass STRING to `make-temp-file' as
+ the PREFIX argument. Otherwise, use the value of
+ `ert-temp-file-prefix'.
+
+:suffix STRING If non-nil, pass STRING to `make-temp-file' as the
+ SUFFIX argument. Otherwise, use the value of
+ `ert-temp-file-suffix'; if the value of that
+ variable is nil, generate a suffix based on the
+ name of the file that `ert-with-temp-file' is
+ called from.
+
+:text STRING If non-nil, pass STRING to `make-temp-file' as
+ the TEXT argument.
+
+:coding CODING If non-nil, bind `coding-system-for-write' to CODING
+ when executing BODY. This is handy when STRING includes
+ non-ASCII characters or the temporary file must have a
+ specific encoding or end-of-line format.
+
+See also `ert-with-temp-directory'."
+ (declare (indent 1) (debug (symbolp body)))
+ (cl-check-type name symbol)
+ (let (keyw prefix suffix directory text extra-keywords coding)
+ (while (keywordp (setq keyw (car body)))
+ (setq body (cdr body))
+ (pcase keyw
+ (:prefix (setq prefix (pop body)))
+ (:suffix (setq suffix (pop body)))
+ (:directory (setq directory (pop body)))
+ (:text (setq text (pop body)))
+ (:coding (setq coding (pop body)))
+ (_ (push keyw extra-keywords) (pop body))))
+ (when extra-keywords
+ (error "Invalid keywords: %s" (mapconcat #'symbol-name extra-keywords " ")))
+ (let ((temp-file (make-symbol "temp-file"))
+ (prefix (or prefix ert-temp-file-prefix))
+ (suffix (or suffix ert-temp-file-suffix
+ (ert--with-temp-file-generate-suffix
+ (or (macroexp-file-name) buffer-file-name)))))
+ `(let* ((coding-system-for-write ,(or coding coding-system-for-write))
+ (,temp-file (,(if directory 'file-name-as-directory 'identity)
+ (make-temp-file ,prefix ,directory ,suffix ,text)))
+ (,name ,(if directory
+ `(file-name-as-directory ,temp-file)
+ temp-file)))
+ (unwind-protect
+ (progn ,@body)
+ (ignore-errors
+ ,(if directory
+ `(delete-directory ,temp-file :recursive)
+ `(delete-file ,temp-file))))))))
+
+(defmacro ert-with-temp-directory (name &rest body)
+ "Bind NAME to the name of a new temporary directory and evaluate BODY.
+Delete the temporary directory after BODY exits normally or
+non-locally.
+
+NAME is bound to the directory name, not the directory file
+name. (In other words, it will end with the directory delimiter;
+on Unix-like systems, it will end with \"/\".)
+
+The same keyword arguments are supported as in
+`ert-with-temp-file' (which see), except for :text."
+ (declare (indent 1) (debug (symbolp body)))
+ (let ((tail body) keyw)
+ (while (keywordp (setq keyw (car tail)))
+ (setq tail (cddr tail))
+ (pcase keyw (:text (error "Invalid keyword for directory: :text")))))
+ `(ert-with-temp-file ,name
+ :directory t
+ ,@body))
+
+(defun ert-gcc-is-clang-p ()
+ "Return non-nil if the `gcc' command actually runs the Clang compiler."
+ ;; Some macOS machines run llvm when you type gcc. (!)
+ ;; We can't even check if it's a symlink; it's a binary placed in
+ ;; "/usr/bin/gcc". So we need to check the output.
+ (string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app"
+ (shell-command-to-string "gcc --version")))
+
+(defvar tramp-default-host-alist)
+(defvar tramp-methods)
+(defvar tramp-remote-path)
+
+;; This should happen on hydra only.
+(when (and (featurep 'tramp) (getenv "EMACS_HYDRA_CI"))
+ (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
+
+;; If this defconst is used in a test file, `tramp' shall be loaded
+;; prior `ert-x'. There is no default value on w32 systems, which
+;; could work out of the box.
+(defconst ert-remote-temporary-file-directory
+ (when (featurep 'tramp)
+ (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)))
+ (add-to-list
+ 'tramp-default-host-alist
+ `("\\`mock\\'" nil ,(system-name)))
+ ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed
+ ;; in batch mode only, therefore.
+ (unless (and (null noninteractive) (file-directory-p "~/"))
+ (setenv "HOME" temporary-file-directory))
+ (format "/mock::%s" temporary-file-directory))))
+ "Temporary directory for remote file tests.")
+
(provide 'ert-x)
;;; ert-x.el ends here
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 156eeadb5db..49b54c2d00f 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1,6 +1,6 @@
;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2022 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
;; Keywords: lisp, tools
@@ -39,19 +39,17 @@
;; but signals a different error when its condition is violated that
;; is caught and processed by ERT. In addition, it analyzes its
;; argument form and records information that helps debugging
-;; (`assert' tries to do something similar when its second argument
+;; (`cl-assert' tries to do something similar when its second argument
;; SHOW-ARGS is true, but `should' is more sophisticated). For
;; information on `should-not' and `should-error', see their
;; docstrings. `skip-unless' skips the test immediately without
;; processing further, this is useful for checking the test
;; environment (like availability of features, external binaries, etc).
;;
-;; See ERT's info manual as well as the docstrings for more details.
-;;
-;; To see some examples of tests written in ERT, see its self-tests in
-;; ert-tests.el. Some of these are tricky due to the bootstrapping
-;; problem of writing tests for a testing tool, others test simple
-;; functions and are straightforward.
+;; See ERT's Info manual `(ert) Top' as well as the docstrings for
+;; more details. To see some examples of tests written in ERT, see
+;; the test suite distributed with the Emacs source distribution (in
+;; the "test" directory).
;;; Code:
@@ -61,6 +59,9 @@
(require 'ewoc)
(require 'find-func)
(require 'pp)
+(require 'map)
+
+(autoload 'xml-escape-string "xml.el")
;;; UI customization options.
@@ -74,6 +75,35 @@
Use nil for no limit (caution: backtrace lines can be very long)."
:type '(choice (const :tag "No truncation" nil) integer))
+(defvar ert-batch-print-length 10
+ "`print-length' setting used in `ert-run-tests-batch'.
+
+When formatting lists in test conditions, `print-length' will be
+temporarily set to this value. See also
+`ert-batch-backtrace-line-length' for its effect on stack
+traces.")
+
+(defvar ert-batch-print-level 5
+ "`print-level' setting used in `ert-run-tests-batch'.
+
+When formatting lists in test conditions, `print-level' will be
+temporarily set to this value. See also
+`ert-batch-backtrace-line-length' for its effect on stack
+traces.")
+
+(defvar ert-batch-backtrace-line-length t
+ "Target length for lines in ERT batch backtraces.
+
+Even modest settings for `print-length' and `print-level' can
+produce extremely long lines in backtraces and lengthy delays in
+forming them. This variable governs the target maximum line
+length by manipulating these two variables while printing stack
+traces. Setting this variable to t will re-use the value of
+`backtrace-line-length' while printing stack traces in ERT batch
+mode. Any other value will be temporarily bound to
+`backtrace-line-length' when producing stack traces in batch
+mode.")
+
(defface ert-test-result-expected '((((class color) (background light))
:background "green1")
(((class color) (background dark))
@@ -86,23 +116,6 @@ Use nil for no limit (caution: backtrace lines can be very long)."
:background "red3"))
"Face used for unexpected results in the ERT results buffer.")
-
-;;; Copies/reimplementations of cl functions.
-
-(defun ert-equal-including-properties (a b)
- "Return t if A and B have similar structure and contents.
-
-This is like `equal-including-properties' except that it compares
-the property values of text properties structurally (by
-recursing) rather than with `eq'. Perhaps this is what
-`equal-including-properties' should do in the first place; see
-Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
- ;; This implementation is inefficient. Rather than making it
- ;; efficient, let's hope bug 6581 gets fixed so that we can delete
- ;; it altogether.
- (not (ert--explain-equal-including-properties a b)))
-
-
;;; Defining and locating tests.
;; The data structure that represents a test case.
@@ -112,7 +125,8 @@ Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
(body (cl-assert nil))
(most-recent-result nil)
(expected-result-type ':passed)
- (tags '()))
+ (tags '())
+ (file-name nil))
(defun ert-test-boundp (symbol)
"Return non-nil if SYMBOL names a test."
@@ -134,6 +148,10 @@ Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
;; Note that nil is still a valid value for the `name' slot in
;; ert-test objects. It designates an anonymous test.
(error "Attempt to define a test named nil"))
+ (when (and noninteractive (get symbol 'ert--test))
+ ;; Make sure duplicated tests are discovered since the older test would
+ ;; be ignored silently otherwise.
+ (error "Test `%s' redefined" symbol))
(define-symbol-prop symbol 'ert--test definition)
definition)
@@ -189,6 +207,9 @@ Macros in BODY are expanded when the test is defined, not when it
is run. If a macro (possibly with side effects) is to be tested,
it has to be wrapped in `(eval (quote ...))'.
+If NAME is already defined as a test and Emacs is running
+in batch mode, an error is signalled.
+
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
[:tags \\='(TAG...)] BODY...)"
(declare (debug (&define [&name "test@" symbolp]
@@ -216,11 +237,8 @@ it has to be wrapped in `(eval (quote ...))'.
`(:expected-result-type ,expected-result))
,@(when tags-supplied-p
`(:tags ,tags))
- :body (lambda ()
- ;; Use the value of `lexical-binding' in
- ;; the source file when evaluating the body.
- (let ((lexical-binding ,lexical-binding))
- ,@body))))
+ :body (lambda () ,@body)
+ :file-name ,(or (macroexp-file-name) buffer-file-name)))
',name))))
(defvar ert--find-test-regexp
@@ -229,7 +247,6 @@ it has to be wrapped in `(eval (quote ...))'.
"%s\\(\\s-\\|$\\)")
"The regexp the `find-function' mechanisms use for finding test definitions.")
-
(define-error 'ert-test-failed "Test failed")
(define-error 'ert-test-skipped "Test skipped")
@@ -316,15 +333,20 @@ It should only be stopped when ran from inside `ert--run-test-internal'."
(unless (eql ,value ',default-value)
(list :value ,value))
(unless (eql ,value ',default-value)
- (let ((-explainer-
- (and (symbolp ',fn-name)
- (get ',fn-name 'ert-explainer))))
- (when -explainer-
- (list :explanation
- (apply -explainer- ,args))))))
+ (when-let ((-explainer-
+ (ert--get-explainer ',fn-name)))
+ (list :explanation
+ (apply -explainer- ,args)))))
value)
,value))))))))
+(defun ert--get-explainer (fn-name)
+ (when (symbolp fn-name)
+ (cl-loop for fn in (cons fn-name (function-alias-p fn-name))
+ for explainer = (get fn 'ert-explainer)
+ when explainer
+ return explainer)))
+
(defun ert--expand-should (whole form inner-expander)
"Helper function for the `should' macro and its variants.
@@ -467,7 +489,7 @@ Errors during evaluation are caught and handled like nil."
(defun ert--explain-equal-rec (a b)
"Return a programmer-readable explanation of why A and B are not `equal'.
-Returns nil if they are."
+Return nil if they are."
(if (not (eq (type-of a) (type-of b)))
`(different-types ,a ,b)
(pcase a
@@ -600,14 +622,9 @@ If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix."
(t
(substring s 0 len)))))
-;; TODO(ohler): Once bug 6581 is fixed, rename this to
-;; `ert--explain-equal-including-properties-rec' and add a fast-path
-;; wrapper like `ert--explain-equal'.
-(defun ert--explain-equal-including-properties (a b)
- "Explainer function for `ert-equal-including-properties'.
-
-Returns a programmer-readable explanation of why A and B are not
-`ert-equal-including-properties', or nil if they are."
+(defun ert--explain-equal-including-properties-rec (a b)
+ "Return explanation of why A and B are not `equal-including-properties'.
+Return nil if they are."
(if (not (equal a b))
(ert--explain-equal a b)
(cl-assert (stringp a) t)
@@ -629,15 +646,17 @@ Returns a programmer-readable explanation of why A and B are not
,(ert--abbreviate-string
(substring-no-properties a (1+ i))
10 nil))))
- ;; TODO(ohler): Get `equal-including-properties' fixed in
- ;; Emacs, delete `ert-equal-including-properties', and
- ;; re-enable this assertion.
- ;;finally (cl-assert (equal-including-properties a b) t)
- )))
-(put 'ert-equal-including-properties
- 'ert-explainer
- 'ert--explain-equal-including-properties)
+ finally (cl-assert (equal-including-properties a b) t))))
+(defun ert--explain-equal-including-properties (a b)
+ "Explainer function for `equal-including-properties'."
+ ;; Do a quick comparison in C to avoid running our expensive
+ ;; comparison when possible.
+ (if (equal-including-properties a b)
+ nil
+ (ert--explain-equal-including-properties-rec a b)))
+(put 'equal-including-properties 'ert-explainer
+ 'ert--explain-equal-including-properties)
;;; Implementation of `ert-info'.
@@ -662,7 +681,6 @@ and is displayed in front of the value of MESSAGE-FORM."
,@body))
-
;;; Facilities for running a single test.
(defvar ert-debug-on-error nil
@@ -777,7 +795,8 @@ This mainly sets up debugger-related bindings."
;; handle ert errors. Once that's done, remove
;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for
;; details.
- (let ((debugger (lambda (&rest args)
+ (let ((lexical-binding t)
+ (debugger (lambda (&rest args)
(ert--run-test-debugger test-execution-info
args)))
(debug-on-error t)
@@ -934,7 +953,8 @@ t -- Selects UNIVERSE.
:expected, :unexpected -- Select tests according to their most recent result.
a string -- A regular expression selecting all tests with matching names.
a test -- (i.e., an object of the ert-test data-type) Selects that test.
-a symbol -- Selects the test that the symbol names, errors if none.
+a symbol -- Selects the test that the symbol names, signals an
+ `ert-test-unbound' error if none.
\(member TESTS...) -- Selects the elements of TESTS, a list of tests
or symbols naming tests.
\(eql TEST) -- Selects TEST, a test or a symbol naming a test.
@@ -996,52 +1016,47 @@ contained in UNIVERSE."
universe))))
((pred ert-test-p) (list selector))
((pred symbolp)
- (cl-assert (ert-test-boundp selector))
+ (unless (ert-test-boundp selector)
+ (signal 'ert-test-unbound (list selector)))
(list (ert-get-test selector)))
- (`(,operator . ,operands)
- (cl-ecase operator
- (member
- (mapcar (lambda (purported-test)
- (pcase-exhaustive purported-test
- ((pred symbolp)
- (cl-assert (ert-test-boundp purported-test))
- (ert-get-test purported-test))
- ((pred ert-test-p) purported-test)))
- operands))
- (eql
- (cl-assert (eql (length operands) 1))
- (ert-select-tests `(member ,@operands) universe))
- (and
- ;; Do these definitions of AND, NOT and OR satisfy de
- ;; Morgan's laws? Should they?
- (cl-case (length operands)
- (0 (ert-select-tests 't universe))
- (t (ert-select-tests `(and ,@(cdr operands))
- (ert-select-tests (car operands)
- universe)))))
- (not
- (cl-assert (eql (length operands) 1))
- (let ((all-tests (ert-select-tests 't universe)))
- (cl-set-difference all-tests
- (ert-select-tests (car operands)
- all-tests))))
- (or
- (cl-case (length operands)
- (0 (ert-select-tests 'nil universe))
- (t (cl-union (ert-select-tests (car operands) universe)
- (ert-select-tests `(or ,@(cdr operands))
- universe)))))
- (tag
- (cl-assert (eql (length operands) 1))
- (let ((tag (car operands)))
- (ert-select-tests `(satisfies
- ,(lambda (test)
- (member tag (ert-test-tags test))))
- universe)))
- (satisfies
- (cl-assert (eql (length operands) 1))
- (cl-remove-if-not (car operands)
- (ert-select-tests 't universe)))))))
+ (`(member . ,operands)
+ (mapcar (lambda (purported-test)
+ (pcase-exhaustive purported-test
+ ((pred symbolp)
+ (unless (ert-test-boundp purported-test)
+ (signal 'ert-test-unbound
+ (list purported-test)))
+ (ert-get-test purported-test))
+ ((pred ert-test-p) purported-test)))
+ operands))
+ (`(eql ,operand)
+ (ert-select-tests `(member ,operand) universe))
+ ;; Do these definitions of AND, NOT and OR satisfy de Morgan's
+ ;; laws? Should they?
+ (`(and)
+ (ert-select-tests 't universe))
+ (`(and ,first . ,rest)
+ (ert-select-tests `(and ,@rest)
+ (ert-select-tests first universe)))
+ (`(not ,operand)
+ (let ((all-tests (ert-select-tests 't universe)))
+ (cl-set-difference all-tests
+ (ert-select-tests operand all-tests))))
+ (`(or)
+ (ert-select-tests 'nil universe))
+ (`(or ,first . ,rest)
+ (cl-union (ert-select-tests first universe)
+ (ert-select-tests `(or ,@rest) universe)))
+ (`(tag ,tag)
+ (ert-select-tests `(satisfies
+ ,(lambda (test)
+ (member tag (ert-test-tags test))))
+ universe))
+ (`(satisfies ,predicate)
+ (cl-remove-if-not predicate
+ (ert-select-tests 't universe)))))
+
+(define-error 'ert-test-unbound "ERT test is unbound")
(defun ert--insert-human-readable-selector (selector)
"Insert a human-readable presentation of SELECTOR into the current buffer."
@@ -1353,6 +1368,22 @@ RESULT must be an `ert-test-result-with-condition'."
(defvar ert-quiet nil
"Non-nil makes ERT only print important information in batch mode.")
+(defun ert-test-location (test)
+ "Return a string description the source location of TEST."
+ (when-let ((loc
+ (ignore-errors
+ (find-function-search-for-symbol
+ (ert-test-name test) 'ert-deftest (ert-test-file-name test)))))
+ (let* ((buffer (car loc))
+ (point (cdr loc))
+ (file (file-relative-name (buffer-file-name buffer)))
+ (line (with-current-buffer buffer
+ (line-number-at-pos point))))
+ (format "at %s:%s" file line))))
+
+(defvar ert-batch-backtrace-right-margin 70
+ "The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+
;;;###autoload
(defun ert-run-tests-batch (&optional selector)
"Run the tests specified by SELECTOR, printing results to the terminal.
@@ -1406,7 +1437,8 @@ Returns the stats object."
(message "%9s %S%s"
(ert-string-for-test-result result nil)
(ert-test-name test)
- (if (getenv "EMACS_TEST_VERBOSE")
+ (if (cl-plusp
+ (length (getenv "EMACS_TEST_VERBOSE")))
(ert-reason-for-test-result result)
""))))
(message "%s" ""))
@@ -1418,12 +1450,14 @@ Returns the stats object."
(message "%9s %S%s"
(ert-string-for-test-result result nil)
(ert-test-name test)
- (if (getenv "EMACS_TEST_VERBOSE")
+ (if (cl-plusp
+ (length (getenv "EMACS_TEST_VERBOSE")))
(ert-reason-for-test-result result)
""))))
- (message "%s" "")))))
- (test-started
- )
+ (message "%s" ""))
+ (when (getenv "EMACS_TEST_JUNIT_REPORT")
+ (ert-write-junit-test-report stats)))))
+ (test-started)
(test-ended
(cl-destructuring-bind (stats test result) event-args
(unless (ert-test-result-expected-p test result)
@@ -1433,8 +1467,14 @@ Returns the stats object."
(ert-test-result-with-condition
(message "Test %S backtrace:" (ert-test-name test))
(with-temp-buffer
- (insert (backtrace-to-string
- (ert-test-result-with-condition-backtrace result)))
+ (let ((backtrace-line-length
+ (if (eq ert-batch-backtrace-line-length t)
+ backtrace-line-length
+ ert-batch-backtrace-line-length))
+ (print-level ert-batch-print-level)
+ (print-length ert-batch-print-length))
+ (insert (backtrace-to-string
+ (ert-test-result-with-condition-backtrace result))))
(if (not ert-batch-backtrace-right-margin)
(message "%s"
(buffer-substring-no-properties (point-min)
@@ -1453,8 +1493,8 @@ Returns the stats object."
(ert--insert-infos result)
(insert " ")
(let ((print-escape-newlines t)
- (print-level 5)
- (print-length 10))
+ (print-level ert-batch-print-level)
+ (print-length ert-batch-print-length))
(ert--pp-with-indentation-and-newline
(ert-test-result-with-condition-condition result)))
(goto-char (1- (point-max)))
@@ -1471,14 +1511,17 @@ Returns the stats object."
(let* ((max (prin1-to-string (length (ert--stats-tests stats))))
(format-string (concat "%9s %"
(prin1-to-string (length max))
- "s/" max " %S (%f sec)")))
+ "s/" max " %S (%f sec)%s")))
(message format-string
(ert-string-for-test-result result
(ert-test-result-expected-p
test result))
(1+ (ert--stats-test-pos stats test))
(ert-test-name test)
- (ert-test-result-duration result))))))))
+ (ert-test-result-duration result)
+ (if (ert-test-result-expected-p test result)
+ ""
+ (concat " " (ert-test-location test))))))))))
nil))
;;;###autoload
@@ -1491,19 +1534,206 @@ of the tests (e.g. invalid SELECTOR or bug in the code that runs
the tests)."
(or noninteractive
(user-error "This function is only for use in batch mode"))
- ;; Better crash loudly than attempting to recover from undefined
- ;; behavior.
- (setq attempt-stack-overflow-recovery nil
- attempt-orderly-shutdown-on-fatal-signal nil)
- (unwind-protect
- (let ((stats (ert-run-tests-batch selector)))
- (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1)))
+ (let ((eln-dir (and (featurep 'native-compile)
+ (make-temp-file "test-nativecomp-cache-" t))))
+ (when eln-dir
+ (startup-redirect-eln-cache eln-dir))
+ ;; Better crash loudly than attempting to recover from undefined
+ ;; behavior.
+ (setq attempt-stack-overflow-recovery nil
+ attempt-orderly-shutdown-on-fatal-signal nil)
(unwind-protect
- (progn
- (message "Error running tests")
- (backtrace))
- (kill-emacs 2))))
-
+ (let ((stats (ert-run-tests-batch selector)))
+ (when eln-dir
+ (ignore-errors
+ (delete-directory eln-dir t)))
+ (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1)))
+ (unwind-protect
+ (progn
+ (message "Error running tests")
+ (backtrace))
+ (when eln-dir
+ (ignore-errors
+ (delete-directory eln-dir t)))
+ (kill-emacs 2)))))
+
+(defvar ert-load-file-name nil
+ "The name of the loaded ERT test file, a string.
+Usually, it is not needed to be defined, but if different ERT
+test packages depend on each other, it might be helpful.")
+
+(defun ert-write-junit-test-report (stats)
+ "Write a JUnit test report, generated from STATS."
+ ;; https://www.ibm.com/docs/en/developer-for-zos/14.1.0?topic=formats-junit-xml-format
+ ;; https://llg.cubic.org/docs/junit/
+ (when-let ((symbol (car (apropos-internal "" #'ert-test-boundp)))
+ (test-file (symbol-file symbol 'ert--test))
+ (test-report
+ (file-name-with-extension
+ (or ert-load-file-name test-file) "xml")))
+ (with-temp-file test-report
+ (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
+ (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
+ (file-name-nondirectory test-report)
+ (ert-stats-total stats)
+ (if (ert--stats-aborted-p stats) 1 0)
+ (ert-stats-completed-unexpected stats)
+ (ert-stats-skipped stats)
+ (float-time
+ (time-subtract
+ (ert--stats-end-time stats)
+ (ert--stats-start-time stats)))))
+ (insert (format " <testsuite id=\"0\" name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
+ (file-name-nondirectory test-report)
+ (ert-stats-total stats)
+ (if (ert--stats-aborted-p stats) 1 0)
+ (ert-stats-completed-unexpected stats)
+ (ert-stats-skipped stats)
+ (float-time
+ (time-subtract
+ (ert--stats-end-time stats)
+ (ert--stats-start-time stats)))
+ (ert--format-time-iso8601 (ert--stats-end-time stats))))
+ ;; If the test has aborted, `ert--stats-selector' might return
+ ;; huge junk. Skip this.
+ (when (< (length (format "%s" (ert--stats-selector stats))) 1024)
+ (insert " <properties>\n"
+ (format " <property name=\"selector\" value=\"%s\"/>\n"
+ (xml-escape-string
+ (format "%s" (ert--stats-selector stats)) 'noerror))
+ " </properties>\n"))
+ (cl-loop for test across (ert--stats-tests stats)
+ for result = (ert-test-most-recent-result test) do
+ (insert (format " <testcase name=\"%s\" status=\"%s\" time=\"%s\""
+ (xml-escape-string
+ (symbol-name (ert-test-name test)) 'noerror)
+ (ert-string-for-test-result
+ result
+ (ert-test-result-expected-p test result))
+ (ert-test-result-duration result)))
+ (if (and (ert-test-result-expected-p test result)
+ (not (ert-test-aborted-with-non-local-exit-p result))
+ (not (ert-test-skipped-p result))
+ (zerop (length (ert-test-result-messages result))))
+ (insert "/>\n")
+ (insert ">\n")
+ (cond
+ ((ert-test-skipped-p result)
+ (insert (format " <skipped message=\"%s\" type=\"%s\">\n"
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result))
+ 'noerror)
+ (ert-string-for-test-result
+ result
+ (ert-test-result-expected-p
+ test result)))
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result))
+ 'noerror)
+ "\n"
+ " </skipped>\n"))
+ ((ert-test-aborted-with-non-local-exit-p result)
+ (insert (format " <error message=\"%s\" type=\"%s\">\n"
+ (file-name-nondirectory test-report)
+ (ert-string-for-test-result
+ result
+ (ert-test-result-expected-p
+ test result)))
+ (format "Test %s aborted with non-local exit\n"
+ (xml-escape-string
+ (symbol-name (ert-test-name test)) 'noerror))
+ " </error>\n"))
+ ((not (ert-test-result-type-p
+ result (ert-test-expected-result-type test)))
+ (insert (format " <failure message=\"%s\" type=\"%s\">\n"
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result))
+ 'noerror)
+ (ert-string-for-test-result
+ result
+ (ert-test-result-expected-p
+ test result)))
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result))
+ 'noerror)
+ "\n"
+ " </failure>\n")))
+ (unless (zerop (length (ert-test-result-messages result)))
+ (insert " <system-out>\n"
+ (xml-escape-string
+ (ert-test-result-messages result) 'noerror)
+ " </system-out>\n"))
+ (insert " </testcase>\n")))
+ (insert " </testsuite>\n")
+ (insert "</testsuites>\n"))))
+
+(defun ert-write-junit-test-summary-report (&rest logfiles)
+ "Write a JUnit summary test report, generated from LOGFILES."
+ (let ((report (file-name-with-extension
+ (getenv "EMACS_TEST_JUNIT_REPORT") "xml"))
+ (tests 0) (errors 0) (failures 0) (skipped 0) (time 0) (id 0))
+ (with-temp-file report
+ (dolist (logfile logfiles)
+ (let ((test-report (file-name-with-extension logfile "xml")))
+ (if (not (file-readable-p test-report))
+ (let* ((logfile (file-name-with-extension logfile "log"))
+ (logfile-contents
+ (when (file-readable-p logfile)
+ (with-temp-buffer
+ (insert-file-contents-literally logfile)
+ (buffer-string)))))
+ (unless
+ ;; No defined tests, perhaps a helper file.
+ (and logfile-contents
+ (string-match-p "^Running 0 tests" logfile-contents))
+ (insert (format " <testsuite id=\"%s\" name=\"%s\" tests=\"1\" errors=\"1\" failures=\"0\" skipped=\"0\" time=\"0\" timestamp=\"%s\">\n"
+ id test-report
+ (ert--format-time-iso8601 (current-time))))
+ (insert (format " <testcase name=\"Test report missing %s\" status=\"error\" time=\"0\">\n"
+ (file-name-nondirectory test-report)))
+ (insert (format " <error message=\"Test report missing %s\" type=\"error\">\n"
+ (file-name-nondirectory test-report)))
+ (when logfile-contents
+ (insert (xml-escape-string logfile-contents 'noerror)))
+ (insert " </error>\n"
+ " </testcase>\n"
+ " </testsuite>\n")
+ (cl-incf errors 1)
+ (cl-incf id 1)))
+
+ (insert-file-contents-literally test-report)
+ (when (looking-at-p
+ (regexp-quote "<?xml version=\"1.0\" encoding=\"utf-8\"?>"))
+ (delete-region (point) (line-beginning-position 2)))
+ (when (looking-at
+ "<testsuites name=\".+\" tests=\"\\(.+\\)\" errors=\"\\(.+\\)\" failures=\"\\(.+\\)\" skipped=\"\\(.+\\)\" time=\"\\(.+\\)\">")
+ (cl-incf tests (string-to-number (match-string 1)))
+ (cl-incf errors (string-to-number (match-string 2)))
+ (cl-incf failures (string-to-number (match-string 3)))
+ (cl-incf skipped (string-to-number (match-string 4)))
+ (cl-incf time (string-to-number (match-string 5)))
+ (delete-region (point) (line-beginning-position 2)))
+ (when (looking-at " <testsuite id=\"\\(0\\)\"")
+ (replace-match (number-to-string id) nil nil nil 1)
+ (cl-incf id 1))
+ (goto-char (point-max))
+ (beginning-of-line 0)
+ (when (looking-at-p "</testsuites>")
+ (delete-region (point) (line-beginning-position 2))))
+
+ (narrow-to-region (point-max) (point-max))))
+
+ (insert "</testsuites>\n")
+ (widen)
+ (goto-char (point-min))
+ (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
+ (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
+ (file-name-nondirectory report)
+ tests errors failures skipped time)))))
(defun ert-summarize-tests-batch-and-exit (&optional high)
"Summarize the results of testing.
@@ -1519,6 +1749,8 @@ If HIGH is a natural number, the HIGH long lasting tests are summarized."
;; behavior.
(setq attempt-stack-overflow-recovery nil
attempt-orderly-shutdown-on-fatal-signal nil)
+ (when (getenv "EMACS_TEST_JUNIT_REPORT")
+ (apply #'ert-write-junit-test-summary-report command-line-args-left))
(let ((nlogs (length command-line-args-left))
(ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0)
nnotrun logfile notests badtests unexpected skipped tests)
@@ -1834,7 +2066,6 @@ Also sets `ert--results-progress-bar-button-begin'."
;; should test it again.)
"\n")))
-
(defvar ert-test-run-redisplay-interval-secs .1
"How many seconds ERT should wait between redisplays while running tests.
@@ -1982,13 +2213,13 @@ otherwise."
(ewoc-refresh ert--results-ewoc)
(font-lock-default-function enabledp))
-(defun ert--setup-results-buffer (stats listener buffer-name)
+(defvar ert--output-buffer-name "*ert*")
+
+(defun ert--setup-results-buffer (stats listener)
"Set up a test results buffer.
-STATS is the stats object; LISTENER is the results listener;
-BUFFER-NAME, if non-nil, is the buffer name to use."
- (unless buffer-name (setq buffer-name "*ert*"))
- (let ((buffer (get-buffer-create buffer-name)))
+STATS is the stats object; LISTENER is the results listener."
+ (let ((buffer (get-buffer-create ert--output-buffer-name)))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(buffer-disable-undo)
@@ -2016,22 +2247,14 @@ BUFFER-NAME, if non-nil, is the buffer name to use."
(goto-char (1- (point-max)))
buffer)))))
-
(defvar ert--selector-history nil
"List of recent test selectors read from terminal.")
-;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here?
-;; They are needed only for our automated self-tests at the moment.
-;; Or should there be some other mechanism?
;;;###autoload
-(defun ert-run-tests-interactively (selector
- &optional output-buffer-name message-fn)
+(defun ert-run-tests-interactively (selector)
"Run the tests specified by SELECTOR and display the results in a buffer.
-SELECTOR works as described in `ert-select-tests'.
-OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they
-are used for automated self-tests and specify which buffer to use
-and how to display message."
+SELECTOR works as described in `ert-select-tests'."
(interactive
(list (let ((default (if ert--selector-history
;; Can't use `first' here as this form is
@@ -2042,25 +2265,18 @@ and how to display message."
(read
(completing-read (format-prompt "Run tests" default)
obarray #'ert-test-boundp nil nil
- 'ert--selector-history default nil)))
- nil))
- (unless message-fn (setq message-fn 'message))
- (let ((output-buffer-name output-buffer-name)
- buffer
- listener
- (message-fn message-fn))
+ 'ert--selector-history default nil)))))
+ (let (buffer listener)
(setq listener
(lambda (event-type &rest event-args)
(cl-ecase event-type
(run-started
(cl-destructuring-bind (stats) event-args
- (setq buffer (ert--setup-results-buffer stats
- listener
- output-buffer-name))
+ (setq buffer (ert--setup-results-buffer stats listener))
(pop-to-buffer buffer)))
(run-ended
(cl-destructuring-bind (stats abortedp) event-args
- (funcall message-fn
+ (message
"%sRan %s tests, %s results were as expected%s%s"
(if (not abortedp)
""
@@ -2414,7 +2630,7 @@ To be used in the ERT results buffer."
(interactive nil ert-results-mode)
(cl-assert (eql major-mode 'ert-results-mode))
(let ((selector (ert--stats-selector ert--results-stats)))
- (ert-run-tests-interactively selector (buffer-name))))
+ (ert-run-tests-interactively selector)))
(defun ert-results-rerun-test-at-point ()
"Re-run the test at point.
@@ -2663,9 +2879,141 @@ To be used in the ERT results buffer."
'ert--activate-font-lock-keywords)
nil)
+(defun ert-test-erts-file (file &optional transform)
+ "Parse FILE as a file containing before/after parts (an erts file).
+
+This function puts the \"before\" section of an .erts file into a
+temporary buffer, calls the TRANSFORM function, and then compares
+the result with the \"after\" section.
+
+See Info node `(ert) erts files' for more information on how to
+write erts files."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let ((gen-specs (list (cons 'dummy t)
+ (cons 'code transform))))
+ ;; Find the start of a test.
+ (while (re-search-forward "^=-=\n" nil t)
+ (setq gen-specs (ert-test--erts-test gen-specs file))
+ ;; Search to the end of the test.
+ (re-search-forward "^=-=-=\n")))))
+
+(defun ert-test--erts-test (gen-specs file)
+ (let* ((file-buffer (current-buffer))
+ (specs (ert--erts-specifications (match-beginning 0)))
+ (name (cdr (assq 'name specs)))
+ (start-before (point))
+ (end-after (if (re-search-forward "^=-=-=\n" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (skip (cdr (assq 'skip specs)))
+ end-before start-after
+ after after-point)
+ (unless name
+ (error "No name for test case"))
+ (if (and skip
+ (eval (car (read-from-string skip))))
+ ;; Skipping this test.
+ ()
+ ;; Do the test.
+ (goto-char end-after)
+ ;; We have a separate after section.
+ (if (re-search-backward "^=-=\n" start-before t)
+ (setq end-before (match-beginning 0)
+ start-after (match-end 0))
+ (setq end-before end-after
+ start-after start-before))
+ ;; Update persistent specs.
+ (when-let ((point-char (assq 'point-char specs)))
+ (setq gen-specs
+ (map-insert gen-specs 'point-char (cdr point-char))))
+ (when-let ((code (cdr (assq 'code specs))))
+ (setq gen-specs
+ (map-insert gen-specs 'code (car (read-from-string code)))))
+ ;; Get the "after" strings.
+ (with-temp-buffer
+ (insert-buffer-substring file-buffer start-after end-after)
+ (ert--erts-unquote)
+ ;; Remove the newline at the end of the buffer.
+ (when-let ((no-newline (cdr (assq 'no-after-newline specs))))
+ (goto-char (point-min))
+ (when (re-search-forward "\n\\'" nil t)
+ (delete-region (match-beginning 0) (match-end 0))))
+ ;; Get the expected "after" point.
+ (when-let ((point-char (cdr (assq 'point-char gen-specs))))
+ (goto-char (point-min))
+ (when (search-forward point-char nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq after-point (point))))
+ (setq after (buffer-string)))
+ ;; Do the test.
+ (with-temp-buffer
+ (insert-buffer-substring file-buffer start-before end-before)
+ (ert--erts-unquote)
+ ;; Remove the newline at the end of the buffer.
+ (when-let ((no-newline (cdr (assq 'no-before-newline specs))))
+ (goto-char (point-min))
+ (when (re-search-forward "\n\\'" nil t)
+ (delete-region (match-beginning 0) (match-end 0))))
+ (goto-char (point-min))
+ ;; Place point in the specified place.
+ (when-let ((point-char (cdr (assq 'point-char gen-specs))))
+ (when (search-forward point-char nil t)
+ (delete-region (match-beginning 0) (match-end 0))))
+ (let ((code (cdr (assq 'code gen-specs))))
+ (unless code
+ (error "No code to run the transform"))
+ (funcall code))
+ (unless (equal (buffer-string) after)
+ (ert-fail (list (format "Mismatch in test \"%s\", file %s"
+ name file)
+ (buffer-string)
+ after)))
+ (when (and after-point
+ (not (= after-point (point))))
+ (ert-fail (list (format "Point wrong in test \"%s\", expected point %d, actual %d, file %s"
+ name
+ after-point (point)
+ file)
+ (buffer-string)))))))
+ ;; Return the new value of the general specifications.
+ gen-specs)
+
+(defun ert--erts-unquote ()
+ (goto-char (point-min))
+ (while (re-search-forward "^\\=-=\\(-=\\)$" nil t)
+ (delete-region (match-beginning 0) (1+ (match-beginning 0)))))
+
+(defun ert--erts-specifications (end)
+ "Find specifications before point (back to the previous test)."
+ (save-excursion
+ (goto-char end)
+ (goto-char
+ (if (re-search-backward "^=-=-=\n" nil t)
+ (match-end 0)
+ (point-min)))
+ (let ((specs nil))
+ (while (< (point) end)
+ (if (looking-at "\\([^ \n\t:]+\\):\\([ \t]+\\)?\\(.*\\)")
+ (let ((name (intern (downcase (match-string 1))))
+ (value (match-string 3)))
+ (forward-line 1)
+ (while (looking-at "[ \t]+\\(.*\\)")
+ (setq value (concat value (match-string 1)))
+ (forward-line 1))
+ (push (cons name (substring-no-properties value)) specs))
+ (forward-line 1)))
+ (nreverse specs))))
+
(defvar ert-unload-hook ())
(add-hook 'ert-unload-hook #'ert--unload-function)
+;;; Obsolete
+
+(define-obsolete-function-alias 'ert-equal-including-properties
+ #'equal-including-properties "29.1")
+(put 'ert-equal-including-properties 'ert-explainer
+ 'ert--explain-equal-including-properties)
(provide 'ert)
diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el
index 77689f434c2..b44132dcead 100644
--- a/lisp/emacs-lisp/faceup.el
+++ b/lisp/emacs-lisp/faceup.el
@@ -1006,7 +1006,7 @@ which could be defined as:
(defun my-test-explain (args...)
(let ((faceup-test-explain t))
(the-test args...)))
- (put 'my-test 'ert-explainer 'my-test-explain)
+ (put \\='my-test \\='ert-explainer \\='my-test-explain)
Alternative, you can use the macro `faceup-defexplainer' as follows:
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index c4f48b8a79e..486d5d08614 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -61,6 +61,7 @@
"^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
+cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\
menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)"
find-function-space-re
"\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
@@ -123,6 +124,15 @@ should insert the feature name."
:group 'xref
:version "25.1")
+(defcustom find-ert-deftest-regexp
+ "(ert-deftest +'%s"
+ "The regexp used to search for an ert-deftest definition.
+Note it must contain a `%s' at the place where `format'
+should insert the feature name."
+ :type 'regexp
+ :group 'xref
+ :version "29.1")
+
(defun find-function--defface (symbol)
(catch 'found
(while (re-search-forward (format find-face-regexp symbol) nil t)
@@ -136,7 +146,8 @@ should insert the feature name."
(defvar . find-variable-regexp)
(defface . find-function--defface)
(feature . find-feature-regexp)
- (defalias . find-alias-regexp))
+ (defalias . find-alias-regexp)
+ (ert-deftest . find-ert-deftest-regexp))
"Alist mapping definition types into regexp variables.
Each regexp variable's value should actually be a format string
to be used to substitute the desired symbol name into the regexp.
@@ -173,6 +184,16 @@ See the functions `find-function' and `find-variable'."
:group 'find-function
:version "20.3")
+(defcustom find-library-include-other-files t
+ "If non-nil, `read-library-name' will also include non-library files.
+This affects commands like `read-library'.
+
+If nil, only library files (i.e., \".el\" files) will be offered
+for completion."
+ :type 'boolean
+ :version "29.1"
+ :group 'find-function)
+
;;; Functions:
(defun find-library-suffixes ()
@@ -248,11 +269,7 @@ defined in C.")
If FUNC is not a symbol, return it. Else, if it's not advised,
return the symbol's function definition."
(or (and (symbolp func)
- (featurep 'nadvice)
- (let ((ofunc (advice--symbol-function func)))
- (if (advice--p ofunc)
- (advice--cd*r ofunc)
- ofunc)))
+ (advice--cd*r (symbol-function func)))
func))
(defun find-function-C-source (fun-or-var file type)
@@ -292,7 +309,10 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
Interactively, prompt for LIBRARY using the one at or near point.
This function searches `find-library-source-path' if non-nil, and
-`load-path' otherwise."
+`load-path' otherwise.
+
+See the `find-library-include-other-files' user option for
+customizing the candidate completions."
(interactive (list (read-library-name)))
(prog1
(switch-to-buffer (find-file-noselect (find-library-name library)))
@@ -307,8 +327,6 @@ in a directory under `load-path' (or `find-library-source-path',
if non-nil)."
(let* ((dirs (or find-library-source-path load-path))
(suffixes (find-library-suffixes))
- (table (apply-partially 'locate-file-completion-table
- dirs suffixes))
(def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the
@@ -322,10 +340,28 @@ if non-nil)."
(thing-at-point 'symbol))
(error nil))
(thing-at-point 'symbol))))
- (when (and def (not (test-completion def table)))
- (setq def nil))
- (completing-read (format-prompt "Library name" def)
- table nil nil nil nil def)))
+ (if find-library-include-other-files
+ (let ((table (apply-partially #'locate-file-completion-table
+ dirs suffixes)))
+ (when (and def (not (test-completion def table)))
+ (setq def nil))
+ (completing-read (format-prompt "Library name" def)
+ table nil nil nil nil def))
+ (let ((files (read-library-name--find-files dirs suffixes)))
+ (when (and def (not (member def files)))
+ (setq def nil))
+ (completing-read (format-prompt "Library name" def)
+ files nil t nil nil def)))))
+
+(defun read-library-name--find-files (dirs suffixes)
+ "Return a list of all files in DIRS that match SUFFIXES."
+ (let ((files nil)
+ (regexp (concat (regexp-opt suffixes) "\\'")))
+ (dolist (dir dirs)
+ (dolist (file (ignore-errors (directory-files dir nil regexp t)))
+ (and (string-match regexp file)
+ (push (substring file 0 (match-beginning 0)) files))))
+ files))
;;;###autoload
(defun find-library-other-window (library)
@@ -476,8 +512,8 @@ Return t if any PRED returns t."
(defun find-function-library (function &optional lisp-only verbose)
"Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION.
-ORIG-FUNCTION is the original name, after removing all advice and
-resolving aliases. LIBRARY is an absolute file name, a relative
+ORIG-FUNCTION is the original name, after resolving aliases.
+LIBRARY is an absolute file name, a relative
file name inside the C sources directory, or a name of an
autoloaded feature.
@@ -764,7 +800,10 @@ See `find-function-on-key'."
(define-key ctl-x-5-map "K" 'find-function-on-key-other-frame)
(define-key ctl-x-map "V" 'find-variable)
(define-key ctl-x-4-map "V" 'find-variable-other-window)
- (define-key ctl-x-5-map "V" 'find-variable-other-frame))
+ (define-key ctl-x-5-map "V" 'find-variable-other-frame)
+ (define-key ctl-x-map "L" 'find-library)
+ (define-key ctl-x-4-map "L" 'find-library-other-window)
+ (define-key ctl-x-5-map "L" 'find-library-other-frame))
(provide 'find-func)
diff --git a/lisp/emacs-lisp/generate-lisp-file.el b/lisp/emacs-lisp/generate-lisp-file.el
new file mode 100644
index 00000000000..8896a3f7019
--- /dev/null
+++ b/lisp/emacs-lisp/generate-lisp-file.el
@@ -0,0 +1,113 @@
+;;; generate-lisp-file.el --- utility functions for generated files -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Keywords: maint
+;; Package: emacs
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(cl-defun generate-lisp-file-heading (file generator
+ &key title commentary (code t))
+ "Insert a standard header for FILE created by GENERATOR.
+This header will specify that this is a generated file that
+should not be edited.
+
+If `standard-output' is bound to a buffer, insert in that buffer.
+If no, insert at point in the current buffer.
+
+TITLE (if any) will be used in the first line.
+
+COMMENTARY (if given) will be inserted as a comment.
+
+If CODE is non-nil (which is the default), a Code: line is
+inserted."
+ (with-current-buffer (if (bufferp standard-output)
+ standard-output
+ (current-buffer))
+ (insert ";;; " (file-name-nondirectory file)
+ " --- "
+ (or title "automatically generated")
+ " (do not edit) "
+ " -*- lexical-binding: t -*-\n"
+ (format ";; Generated by the `%s' function.\n\n" generator)
+ ";; This file is part of GNU Emacs.\n\n")
+ (when commentary
+ (insert ";;; Commentary:\n\n")
+ (let ((start (point))
+ (fill-prefix ";; "))
+ (insert ";; " commentary)
+ (fill-region start (point))))
+ (ensure-empty-lines 1)
+ (when code
+ (insert ";;; Code:\n\n"))))
+
+(cl-defun generate-lisp-file-trailer (file &key version inhibit-provide
+ (coding 'utf-8-emacs-unix) autoloads
+ compile provide)
+ "Insert a standard trailer for FILE.
+By default, this trailer inhibits version control, byte
+compilation, updating autoloads, and uses a `utf-8-emacs-unix'
+coding system. These can be inhibited by providing non-nil
+values to the VERSION, NO-PROVIDE, AUTOLOADS and COMPILE
+keyword arguments.
+
+CODING defaults to `utf-8-emacs-unix'. Use a nil value to
+inhibit generating this setting, or a coding system value to use
+that.
+
+If PROVIDE is non-nil, use that in the `provide' statement
+instead of using FILE as the basis.
+
+If `standard-output' is bound to a buffer, insert in that buffer.
+If no, insert at point in the current buffer."
+ (with-current-buffer (if (bufferp standard-output)
+ standard-output
+ (current-buffer))
+ (ensure-empty-lines 1)
+ (unless inhibit-provide
+ (insert (format "(provide '%s)\n\n"
+ (or provide
+ (file-name-sans-extension
+ (file-name-nondirectory file))))))
+ ;; Some of the strings below are chopped into bits to inhibit
+ ;; automatic scanning tools from thinking that they are actual
+ ;; directives.
+ (insert ";; Local " "Variables:\n")
+ (unless version
+ (insert ";; version-control: never\n"))
+ (unless compile
+ (insert ";; no-byte-" "compile: t\n")) ;; #$ is byte-compiled into nil.
+ (unless autoloads
+ (insert ";; no-update-autoloads: t\n"))
+ (when coding
+ (insert (format ";; coding: %s\n"
+ (if (eq coding t)
+ 'utf-8-emacs-unix
+ coding))))
+ (insert
+ ";; End:\n\n"
+ ";;; " (file-name-nondirectory file) " ends here\n")))
+
+(provide 'generate-lisp-file)
+
+;;; generate-lisp-file.el ends here
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index be48699a278..8fbc3b03648 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -143,8 +143,7 @@ the CPS state machinery."
(setf ,static-var ,dynamic-var)))))
(defmacro cps--with-dynamic-binding (dynamic-var static-var &rest body)
- "Evaluate BODY such that generated atomic evaluations run with
-DYNAMIC-VAR bound to STATIC-VAR."
+ "Run BODY's atomic evaluations run with DYNAMIC-VAR bound to STATIC-VAR."
(declare (indent 2))
`(cps--with-value-wrapper
(cps--make-dynamic-binding-wrapper ,dynamic-var ,static-var)
@@ -291,22 +290,28 @@ DYNAMIC-VAR bound to STATIC-VAR."
(cps--transform-1 `(progn ,@rest)
next-state)))
- ;; Process `let' in a helper function that transforms it into a
- ;; let* with temporaries.
+ (`(,(or 'let 'let*) () . ,body)
+ (cps--transform-1 `(progn ,@body) next-state))
+
+ ;; Transform multi-variable `let' into `let*':
+ ;; (let ((v1 e1) ... (vN eN)) BODY)
+ ;; -> (let* ((t1 e1) ... (tN-1 eN-1) (vN eN) (v1 t1) (vN-1 tN-1)) BODY)
(`(let ,bindings . ,body)
(let* ((bindings (cl-loop for binding in bindings
collect (if (symbolp binding)
(list binding nil)
binding)))
- (temps (cl-loop for (var _value-form) in bindings
+ (butlast-bindings (butlast bindings))
+ (temps (cl-loop for (var _value-form) in butlast-bindings
collect (cps--add-binding var))))
(cps--transform-1
`(let* ,(append
- (cl-loop for (_var value-form) in bindings
+ (cl-loop for (_var value-form) in butlast-bindings
for temp in temps
collect (list temp value-form))
- (cl-loop for (var _binding) in bindings
+ (last bindings)
+ (cl-loop for (var _binding) in butlast-bindings
for temp in temps
collect (list var temp)))
,@body)
@@ -315,9 +320,6 @@ DYNAMIC-VAR bound to STATIC-VAR."
;; Process `let*' binding: process one binding at a time. Flatten
;; lexical bindings.
- (`(let* () . ,body)
- (cps--transform-1 `(progn ,@body) next-state))
-
(`(let* (,binding . ,more-bindings) . ,body)
(let* ((var (if (symbolp binding) binding (car binding)))
(value-form (car (cdr-safe binding)))
@@ -642,12 +644,11 @@ modified copy."
(iter-close iterator)))))
iterator))))
-(defun iter-yield (value)
+(defun iter-yield (_value)
"When used inside a generator, yield control to caller.
The caller of `iter-next' receives VALUE, and the next call to
`iter-next' resumes execution with the form immediately following this
`iter-yield' call."
- (identity value)
(error "`iter-yield' used outside a generator"))
(defmacro iter-yield-from (value)
@@ -689,8 +690,10 @@ of values. Callers can retrieve each value using `iter-next'."
(declare (indent defun)
(debug (&define lambda-list lambda-doc &rest sexp)))
(cl-assert lexical-binding)
- `(lambda ,arglist
- ,(cps-generate-evaluator body)))
+ (pcase-let* ((`(,declarations . ,exps) (macroexp-parse-body body)))
+ `(lambda ,arglist
+ ,@declarations
+ ,(cps-generate-evaluator exps))))
(defmacro iter-make (&rest body)
"Return a new iterator."
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 33e85e49c7b..54ddc7ac757 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -74,7 +74,7 @@
;; (defvar gv--macro-environment nil
;; "Macro expanders for generalized variables.")
-(define-error 'gv-invalid-place "%S is not a valid place expression")
+(define-error 'gv-invalid-place "Invalid place expression")
;;;###autoload
(defun gv-get (place do)
@@ -594,7 +594,7 @@ binding mode."
code
(macroexp-warn-and-return
"Use of gv-ref probably requires lexical-binding"
- code))))
+ code nil nil place))))
(defsubst gv-deref (ref)
"Dereference REF, returning the referenced value.
@@ -602,7 +602,7 @@ This is like the `*' operator of the C language.
REF must have been previously obtained with `gv-ref'."
(funcall (car ref)))
;; Don't use `declare' because it seems to introduce circularity problems:
-;; Warning: Eager macro-expansion skipped due to cycle:
+;; Eager macro-expansion skipped due to cycle:
;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 930dbfe6c49..654dbbc5fef 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,6 +1,6 @@
;;; helper.el --- utility help package supporting help in electric modes -*- lexical-binding: t; -*-
-;; Copyright (C) 1985, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
@@ -39,19 +39,16 @@
;; keymap either.
-(defvar Helper-help-map
- (let ((map (make-sparse-keymap)))
- ;(fillarray map 'undefined)
- (define-key map "m" 'Helper-describe-mode)
- (define-key map "b" 'Helper-describe-bindings)
- (define-key map "c" 'Helper-describe-key-briefly)
- (define-key map "k" 'Helper-describe-key)
- ;(define-key map "f" 'Helper-describe-function)
- ;(define-key map "v" 'Helper-describe-variable)
- (define-key map "?" 'Helper-help-options)
- (define-key map (char-to-string help-char) 'Helper-help-options)
- (fset 'Helper-help-map map)
- map))
+(defvar-keymap Helper-help-map
+ "m" #'Helper-describe-mode
+ "b" #'Helper-describe-bindings
+ "c" #'Helper-describe-key-briefly
+ "k" #'Helper-describe-key
+ ;;"f" #'Helper-describe-function
+ ;;"v" #'Helper-describe-variable
+ "?" #'Helper-help-options
+ (key-description (char-to-string help-char)) #'Helper-help-options)
+(fset 'Helper-help-map Helper-help-map)
(defun Helper-help-scroller ()
(let ((blurb (or (and (boundp 'Helper-return-blurb)
@@ -68,26 +65,30 @@
(setq state (+ (* 2 (if (pos-visible-in-window-p (point-max)) 1 0))
(if (pos-visible-in-window-p (point-min)) 1 0)))
(message
- (nth state
- '("Space forward, Delete back. Other keys %s"
- "Space scrolls forward. Other keys %s"
- "Delete scrolls back. Other keys %s"
- "Type anything to %s"))
+ (nth state
+ (mapcar
+ #'substitute-command-keys
+ '("\\`SPC' forward, \\`DEL' back. Other keys %s"
+ "\\`SPC' scrolls forward. Other keys %s"
+ "\\`DEL' scrolls back. Other keys %s"
+ "Type anything to %s")))
blurb)
(setq continue (read-event))
(cond ((and (memq continue '(?\s ?\C-v)) (< state 2))
(scroll-up))
- ((= continue ?\C-l)
+ ((eq continue ?\C-l)
(recenter))
- ((and (= continue ?\177) (zerop (% state 2)))
+ ((and (or (eq continue 'backspace)
+ (eq continue ?\177))
+ (zerop (% state 2)))
(scroll-down))
(t (setq continue nil))))))))
(defun Helper-help-options ()
"Describe help options."
(interactive)
- (message "c (key briefly), m (mode), k (key), b (bindings)")
- ;(message "c (key briefly), m (mode), k (key), v (variable), f (function)")
+ (message (substitute-command-keys
+ "\\`c' (key briefly), \\`m' (mode), \\`k' (key), \\`b' (bindings)"))
(sit-for 4))
(defun Helper-describe-key-briefly (key)
@@ -140,7 +141,8 @@
(interactive)
(let ((continue t) c)
(while continue
- (message "Help (Type ? for further options)")
+ (message (substitute-command-keys
+ "Help (Type \\`?' for further options)"))
(setq c (read-key-sequence nil))
(setq c (lookup-key Helper-help-map c))
(cond ((eq c 'Helper-help-options)
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index b871a832466..7c6f89deb11 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -111,8 +111,6 @@
;;; Code:
-(require 'mail-parse)
-
;;; Variables:
(defgroup lisp-mnt nil
@@ -361,6 +359,8 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")"
(defun lm-crack-address (x)
"Split up email address(es) X into full name and real email address.
The value is a list of elements of the form (FULLNAME . ADDRESS)."
+ (require 'mail-parse)
+ (declare-function mail-header-parse-addresses-lax "mail-parse" (string))
(mapcar (lambda (elem)
(cons (cdr elem) (car elem)))
(mail-header-parse-addresses-lax x)))
@@ -505,7 +505,7 @@ absent, return nil."
(if (and page (string-match (rx bol "<" (+ nonl) ">" eol) page))
(substring page 1 -1)
page)))
-(defalias 'lm-homepage 'lm-website) ; for backwards-compatibility
+(defalias 'lm-homepage #'lm-website) ; for backwards-compatibility
;;; Verification and synopses
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index c6fcc06e38d..c906ee6e31d 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -29,6 +29,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
(defvar font-lock-comment-face)
(defvar font-lock-doc-face)
@@ -88,73 +89,88 @@
table)
"Syntax table used in `lisp-mode'.")
+(rx-define lisp-mode-symbol (+ (| (syntax word)
+ (syntax symbol)
+ (: "\\" nonl))))
+
(eval-and-compile
- (defconst lisp-mode-symbol-regexp "\\(?:\\sw\\|\\s_\\|\\\\.\\)+"))
+ (defconst lisp-mode-symbol-regexp (rx lisp-mode-symbol)))
(defvar lisp-imenu-generic-expression
(list
(list nil
(purecopy (concat "^\\s-*("
- (eval-when-compile
- (regexp-opt
- '("defun" "defmacro"
- ;; Elisp.
- "defun*" "defsubst" "define-inline"
- "define-advice" "defadvice" "define-skeleton"
- "define-compilation-mode" "define-minor-mode"
- "define-global-minor-mode"
- "define-globalized-minor-mode"
- "define-derived-mode" "define-generic-mode"
- "ert-deftest"
- "cl-defun" "cl-defsubst" "cl-defmacro"
- "cl-define-compiler-macro" "cl-defgeneric"
- "cl-defmethod"
- ;; CL.
- "define-compiler-macro" "define-modify-macro"
- "defsetf" "define-setf-expander"
- "define-method-combination"
- ;; CLOS and EIEIO
- "defgeneric" "defmethod")
- t))
- "\\s-+\\(" lisp-mode-symbol-regexp "\\)"))
+ (regexp-opt
+ '("defun" "defmacro"
+ ;; Elisp.
+ "defun*" "defsubst" "define-inline"
+ "define-advice" "defadvice" "define-skeleton"
+ "define-compilation-mode" "define-minor-mode"
+ "define-global-minor-mode"
+ "define-globalized-minor-mode"
+ "define-derived-mode" "define-generic-mode"
+ "ert-deftest"
+ "cl-defun" "cl-defsubst" "cl-defmacro"
+ "cl-define-compiler-macro" "cl-defgeneric"
+ "cl-defmethod"
+ ;; CL.
+ "define-compiler-macro" "define-modify-macro"
+ "defsetf" "define-setf-expander"
+ "define-method-combination"
+ ;; CLOS and EIEIO
+ "defgeneric" "defmethod")
+ t)
+ "\\s-+\\(" (rx lisp-mode-symbol) "\\)"))
+ 2)
+ ;; Like the previous, but uses a quoted symbol as the name.
+ (list nil
+ (purecopy (concat "^\\s-*("
+ (regexp-opt
+ '("defalias" "define-obsolete-function-alias")
+ t)
+ "\\s-+'\\(" (rx lisp-mode-symbol) "\\)"))
2)
(list (purecopy "Variables")
(purecopy (concat "^\\s-*("
- (eval-when-compile
- (regexp-opt
- '(;; Elisp
- "defconst" "defcustom"
- ;; CL
- "defconstant"
- "defparameter" "define-symbol-macro")
- t))
- "\\s-+\\(" lisp-mode-symbol-regexp "\\)"))
+ (regexp-opt
+ '(;; Elisp
+ "defconst" "defcustom"
+ ;; CL
+ "defconstant"
+ "defparameter" "define-symbol-macro")
+ t)
+ "\\s-+\\(" (rx lisp-mode-symbol) "\\)"))
2)
;; For `defvar'/`defvar-local', we ignore (defvar FOO) constructs.
(list (purecopy "Variables")
(purecopy (concat "^\\s-*(defvar\\(?:-local\\)?\\s-+\\("
- lisp-mode-symbol-regexp "\\)"
+ (rx lisp-mode-symbol) "\\)"
"[[:space:]\n]+[^)]"))
1)
(list (purecopy "Types")
(purecopy (concat "^\\s-*("
- (eval-when-compile
- (regexp-opt
- '(;; Elisp
- "defgroup" "deftheme"
- "define-widget" "define-error"
- "defface" "cl-deftype" "cl-defstruct"
- ;; CL
- "deftype" "defstruct"
- "define-condition" "defpackage"
- ;; CLOS and EIEIO
- "defclass")
- t))
- "\\s-+'?\\(" lisp-mode-symbol-regexp "\\)"))
+ (regexp-opt
+ '(;; Elisp
+ "defgroup" "deftheme"
+ "define-widget" "define-error"
+ "defface" "cl-deftype" "cl-defstruct"
+ ;; CL
+ "deftype" "defstruct"
+ "define-condition" "defpackage"
+ ;; CLOS and EIEIO
+ "defclass")
+ t)
+ "\\s-+'?\\(" (rx lisp-mode-symbol) "\\)"))
2))
"Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
+(defconst lisp-mode-autoload-regexp
+ "^;;;###\\(\\([-[:alnum:]]+?\\)-\\)?\\(autoload\\)"
+ "Regexp to match autoload cookies.
+The second group matches package names used to redirect autoloads
+to a package-local <package>-loaddefs.el file.")
+
;; This was originally in autoload.el and is still used there.
(put 'autoload 'doc-string-elt 3)
(put 'defmethod 'doc-string-elt 3)
@@ -234,6 +250,9 @@
('let
(forward-sexp 1)
(>= pos (point)))
+ ((or 'defun 'defmacro 'cl-defmethod 'cl-defun)
+ (forward-sexp 2)
+ (>= pos (point)))
('condition-case
;; If (cdr paren-posns), then we're in the BODY
;; of HANDLERS.
@@ -250,8 +269,7 @@
;; FIXME: Move to elisp-mode.el.
(catch 'found
(while (re-search-forward
- (eval-when-compile
- (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
+ (concat "(\\(" (rx lisp-mode-symbol) "\\)\\_>")
limit t)
(let ((sym (intern-soft (match-string 1))))
(when (and (or (special-form-p sym) (macrop sym))
@@ -400,8 +418,8 @@ This will generate compile-time constants from BINDINGS."
;; Any whitespace and defined object.
"[ \t']*"
"\\(([ \t']*\\)?" ;; An opening paren.
- "\\(\\(setf\\)[ \t]+" lisp-mode-symbol-regexp
- "\\|" lisp-mode-symbol-regexp "\\)?")
+ "\\(\\(setf\\)[ \t]+" (rx lisp-mode-symbol)
+ "\\|" (rx lisp-mode-symbol) "\\)?")
(1 font-lock-keyword-face)
(3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
(cond ((eq type 'var) font-lock-variable-name-face)
@@ -417,7 +435,8 @@ This will generate compile-time constants from BINDINGS."
nil t))
;; Emacs Lisp autoload cookies. Supports the slightly different
;; forms used by mh-e, calendar, etc.
- ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
+ (,lisp-mode-autoload-regexp (3 font-lock-warning-face prepend)
+ (2 font-lock-function-name-face prepend t)))
"Subdued level highlighting for Emacs Lisp mode.")
(defconst lisp-cl-font-lock-keywords-1
@@ -426,8 +445,8 @@ This will generate compile-time constants from BINDINGS."
;; Any whitespace and defined object.
"[ \t']*"
"\\(([ \t']*\\)?" ;; An opening paren.
- "\\(\\(setf\\)[ \t]+" lisp-mode-symbol-regexp
- "\\|" lisp-mode-symbol-regexp "\\)?")
+ "\\(\\(setf\\)[ \t]+" (rx lisp-mode-symbol)
+ "\\|" (rx lisp-mode-symbol) "\\)?")
(1 font-lock-keyword-face)
(3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
(cond ((eq type 'var) font-lock-variable-name-face)
@@ -453,23 +472,34 @@ This will generate compile-time constants from BINDINGS."
(lisp--el-match-keyword . 1)
;; Exit/Feature symbols as constants.
(,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
- "[ \t']*\\(" lisp-mode-symbol-regexp "\\)?")
+ "[ \t']*\\(" (rx lisp-mode-symbol) "\\)?")
(1 font-lock-keyword-face)
(2 font-lock-constant-face nil t))
- ;; Words inside \\[] tend to be for `substitute-command-keys'.
- (,(concat "\\\\\\\\\\[\\(" lisp-mode-symbol-regexp "\\)\\]")
+ ;; Words inside \\[], \\<>, \\{} or \\`' tend to be for
+ ;; `substitute-command-keys'.
+ (,(rx "\\\\" (or (seq "[" (group-n 1 lisp-mode-symbol) "]")
+ (seq "`" (group-n 1
+ ;; allow multiple words, e.g. "C-x a"
+ lisp-mode-symbol (* " " lisp-mode-symbol))
+ "'")))
(1 font-lock-constant-face prepend))
+ (,(rx "\\\\" (or (seq "<" (group-n 1 lisp-mode-symbol) ">")
+ (seq "{" (group-n 1 lisp-mode-symbol) "}")))
+ (1 font-lock-variable-name-face prepend))
;; Ineffective backslashes (typically in need of doubling).
("\\(\\\\\\)\\([^\"\\]\\)"
(1 (elisp--font-lock-backslash) prepend))
;; Words inside ‘’, '' and `' tend to be symbol names.
- (,(concat "[`‘']\\(" lisp-mode-symbol-regexp "\\)['’]")
+ (,(concat "[`‘']\\(" (rx lisp-mode-symbol) "\\)['’]")
(1 font-lock-constant-face prepend))
+ ;; \\= tends to be an escape in doc strings.
+ (,(rx "\\\\=")
+ (0 font-lock-builtin-face prepend))
;; Constant values.
- (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>")
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>")
. font-lock-type-face)
;; ELisp regexp grouping constructs
(,(lambda (bound)
@@ -506,30 +536,30 @@ This will generate compile-time constants from BINDINGS."
(,(concat "(" cl-kws-re "\\_>") . 1)
;; Exit/Feature symbols as constants.
(,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
- "[ \t']*\\(" lisp-mode-symbol-regexp "\\)?")
+ "[ \t']*\\(" (rx lisp-mode-symbol) "\\)?")
(1 font-lock-keyword-face)
(2 font-lock-constant-face nil t))
;; Erroneous structures.
(,(concat "(" cl-errs-re "\\_>")
(1 font-lock-warning-face))
;; Words inside ‘’ and `' tend to be symbol names.
- (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
+ (,(concat "[`‘]\\(" (rx lisp-mode-symbol) "\\)['’]")
(1 font-lock-constant-face prepend))
;; Uninterned symbols, e.g., (defpackage #:my-package ...)
;; must come before keywords below to have effect
- (,(concat "#:" lisp-mode-symbol-regexp "") 0 font-lock-builtin-face)
+ (,(concat "#:" (rx lisp-mode-symbol) "") 0 font-lock-builtin-face)
;; Constant values.
- (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>")
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>")
. font-lock-type-face)
;; This is too general -- rms.
;; A user complained that he has functions whose names start with `do'
;; and that they get the wrong color.
;; That user has violated the https://www.cliki.net/Naming+conventions:
;; CL (but not EL!) `with-' (context) and `do-' (iteration)
- (,(concat "(\\(\\(do-\\|with-\\)" lisp-mode-symbol-regexp "\\)")
+ (,(concat "(\\(\\(do-\\|with-\\)" (rx lisp-mode-symbol) "\\)")
(1 font-lock-keyword-face))
(lisp--match-hidden-arg
(0 '(face font-lock-warning-face
@@ -556,16 +586,15 @@ This will generate compile-time constants from BINDINGS."
"Gaudy highlighting from Emacs Lisp mode used in Backtrace mode.")
(defun lisp-string-in-doc-position-p (listbeg startpos)
- "Return non-nil if a doc string may occur at STARTPOS inside a list.
+ "Return non-nil if a doc string may occur at STARTPOS inside a list.
LISTBEG is the position of the start of the innermost list
containing STARTPOS."
(let* ((firstsym (and listbeg
(save-excursion
(goto-char listbeg)
(and (looking-at
- (eval-when-compile
- (concat "([ \t\n]*\\("
- lisp-mode-symbol-regexp "\\)")))
+ (concat "([ \t\n]*\\("
+ (rx lisp-mode-symbol) "\\)"))
(match-string 1)))))
(docelt (and firstsym
(function-get (intern-soft firstsym)
@@ -590,6 +619,8 @@ containing STARTPOS."
(defun lisp-string-after-doc-keyword-p (listbeg startpos)
"Return non-nil if `:documentation' symbol ends at STARTPOS inside a list.
+`:doc' can also be used.
+
LISTBEG is the position of the start of the innermost list
containing STARTPOS."
(and listbeg ; We are inside a Lisp form.
@@ -597,7 +628,7 @@ containing STARTPOS."
(goto-char startpos)
(ignore-errors
(progn (backward-sexp 1)
- (looking-at ":documentation\\_>"))))))
+ (looking-at ":documentation\\_>\\|:doc\\_>"))))))
(defun lisp-font-lock-syntactic-face-function (state)
"Return syntactic face function for the position represented by STATE.
@@ -645,7 +676,9 @@ font-lock keywords will not be case sensitive."
(setq-local indent-line-function 'lisp-indent-line)
(setq-local indent-region-function 'lisp-indent-region)
(setq-local comment-indent-function #'lisp-comment-indent)
- (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
+ (setq-local outline-regexp (concat ";;;;* [^ \t\n]\\|(\\|\\("
+ lisp-mode-autoload-regexp
+ "\\)"))
(setq-local outline-level 'lisp-outline-level)
(setq-local add-log-current-defun-function #'lisp-current-defun-name)
(setq-local comment-start ";")
@@ -685,7 +718,8 @@ font-lock keywords will not be case sensitive."
;; Expects outline-regexp is ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|("
;; and point is at the beginning of a matching line.
(let ((len (- (match-end 0) (match-beginning 0))))
- (cond ((looking-at "(\\|;;;###autoload")
+ (cond ((or (looking-at-p "(")
+ (looking-at-p lisp-mode-autoload-regexp))
1000)
((looking-at ";;\\(;+\\) ")
(- (match-end 1) (match-beginning 1)))
@@ -719,17 +753,16 @@ font-lock keywords will not be case sensitive."
(progn (forward-sexp 1)
(point)))))))
-(defvar lisp-mode-shared-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map prog-mode-map)
- (define-key map "\e\C-q" 'indent-sexp)
- (define-key map "\177" 'backward-delete-char-untabify)
- ;; This gets in the way when viewing a Lisp file in view-mode. As
- ;; long as [backspace] is mapped into DEL via the
- ;; function-key-map, this should remain disabled!!
- ;;;(define-key map [backspace] 'backward-delete-char-untabify)
- map)
- "Keymap for commands shared by all sorts of Lisp modes.")
+(defvar-keymap lisp-mode-shared-map
+ :doc "Keymap for commands shared by all sorts of Lisp modes."
+ :parent prog-mode-map
+ "C-M-q" #'indent-sexp
+ "DEL" #'backward-delete-char-untabify
+ ;; This gets in the way when viewing a Lisp file in view-mode. As
+ ;; long as [backspace] is mapped into DEL via the
+ ;; function-key-map, this should remain disabled!!
+ ;;;"<backspace>" #'backward-delete-char-untabify
+ )
(defcustom lisp-mode-hook nil
"Hook run when entering Lisp mode."
@@ -745,14 +778,12 @@ font-lock keywords will not be case sensitive."
;;; Generic Lisp mode.
-(defvar lisp-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\e\C-x" 'lisp-eval-defun)
- (define-key map "\C-c\C-z" 'run-lisp)
- map)
- "Keymap for ordinary Lisp mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
+(defvar-keymap lisp-mode-map
+ :doc "Keymap for ordinary Lisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map."
+ :parent lisp-mode-shared-map
+ "C-M-x" #'lisp-eval-defun
+ "C-c C-z" #'run-lisp)
(easy-menu-define lisp-mode-menu lisp-mode-map
"Menu for ordinary Lisp mode."
@@ -807,9 +838,8 @@ or to switch back to an existing one."
(defcustom lisp-indent-offset nil
"If non-nil, indent second line of expressions that many more columns."
:group 'lisp
- :type '(choice (const nil) integer))
-(put 'lisp-indent-offset 'safe-local-variable
- (lambda (x) (or (null x) (integerp x))))
+ :type '(choice (const nil) integer)
+ :safe (lambda (x) (or (null x) (integerp x))))
(defcustom lisp-indent-function 'lisp-indent-function
"A function to be called by `calculate-lisp-indent'.
@@ -1106,6 +1136,53 @@ is the buffer position of the start of the containing expression."
(t
normal-indent))))))
+(defun lisp--local-defform-body-p (state)
+ "Return non-nil when at local definition body according to STATE.
+STATE is the `parse-partial-sexp' state for current position."
+ (when-let ((start-of-innermost-containing-list (nth 1 state)))
+ (let* ((parents (nth 9 state))
+ (first-cons-after (cdr parents))
+ (second-cons-after (cdr first-cons-after))
+ first-order-parent second-order-parent)
+ (while second-cons-after
+ (when (= start-of-innermost-containing-list
+ (car second-cons-after))
+ (setq second-order-parent (pop parents)
+ first-order-parent (pop parents)
+ ;; Leave the loop.
+ second-cons-after nil))
+ (pop second-cons-after)
+ (pop parents))
+ (when second-order-parent
+ (let (local-definitions-starting-point)
+ (and (save-excursion
+ (goto-char (1+ second-order-parent))
+ (when-let ((head (ignore-errors
+ ;; FIXME: This does not distinguish
+ ;; between reading nil and a read error.
+ ;; We don't care but still, better fix this.
+ (read (current-buffer)))))
+ (when (memq head '( cl-flet cl-labels cl-macrolet cl-flet*
+ cl-symbol-macrolet))
+ ;; In what follows, we rely on (point) returning non-nil.
+ (setq local-definitions-starting-point
+ (progn
+ (parse-partial-sexp
+ (point) first-order-parent nil
+ ;; From docstring of `parse-partial-sexp':
+ ;; Fourth arg non-nil means stop
+ ;; when we come to any character
+ ;; that starts a sexp.
+ t)
+ (point))))))
+ (save-excursion
+ (when (ignore-errors
+ ;; We rely on `backward-up-list' working
+ ;; even when sexp is incomplete “to the right”.
+ (backward-up-list 2)
+ t)
+ (= local-definitions-starting-point (point))))))))))
+
(defun lisp-indent-function (indent-point state)
"This function is the normal value of the variable `lisp-indent-function'.
The function `calculate-lisp-indent' calls this to determine
@@ -1139,16 +1216,19 @@ Lisp function does not specify a special indentation."
(if (and (elt state 2)
(not (looking-at "\\sw\\|\\s_")))
;; car of form doesn't seem to be a symbol
- (progn
+ (if (lisp--local-defform-body-p state)
+ ;; We nevertheless check whether we are in flet-like form
+ ;; as we presume local function names could be non-symbols.
+ (lisp-indent-defform state indent-point)
(if (not (> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp))
- (progn (goto-char calculate-lisp-indent-last-sexp)
- (beginning-of-line)
- (parse-partial-sexp (point)
- calculate-lisp-indent-last-sexp 0 t)))
- ;; Indent under the list or under the first sexp on the same
- ;; line as calculate-lisp-indent-last-sexp. Note that first
- ;; thing on that line has to be complete sexp since we are
+ (progn (goto-char calculate-lisp-indent-last-sexp)
+ (beginning-of-line)
+ (parse-partial-sexp (point)
+ calculate-lisp-indent-last-sexp 0 t)))
+ ;; Indent under the list or under the first sexp on the same
+ ;; line as calculate-lisp-indent-last-sexp. Note that first
+ ;; thing on that line has to be complete sexp since we are
;; inside the innermost containing sexp.
(backward-prefix-chars)
(current-column))
@@ -1159,21 +1239,20 @@ Lisp function does not specify a special indentation."
'lisp-indent-function)
(get (intern-soft function) 'lisp-indent-hook)))
(cond ((or (eq method 'defun)
- (and (null method)
- (> (length function) 3)
- (string-match "\\`def" function)))
+ ;; Check whether we are in flet-like form.
+ (lisp--local-defform-body-p state))
(lisp-indent-defform state indent-point))
((integerp method)
(lisp-indent-specform method state
indent-point normal-indent))
(method
- (funcall method indent-point state)))))))
+ (funcall method indent-point state)))))))
(defcustom lisp-body-indent 2
"Number of columns to indent the second line of a `(def...)' form."
:group 'lisp
- :type 'integer)
-(put 'lisp-body-indent 'safe-local-variable 'integerp)
+ :type 'integer
+ :safe #'integerp)
(defun lisp-indent-specform (count state indent-point normal-indent)
(let ((containing-form-start (elt state 1))
@@ -1235,6 +1314,13 @@ Lisp function does not specify a special indentation."
(put 'autoload 'lisp-indent-function 'defun) ;Elisp
(put 'progn 'lisp-indent-function 0)
+(put 'defvar 'lisp-indent-function 'defun)
+(put 'defalias 'lisp-indent-function 'defun)
+(put 'defvaralias 'lisp-indent-function 'defun)
+(put 'defconst 'lisp-indent-function 'defun)
+(put 'define-category 'lisp-indent-function 'defun)
+(put 'define-charset-internal 'lisp-indent-function 'defun)
+(put 'define-fringe-bitmap 'lisp-indent-function 'defun)
(put 'prog1 'lisp-indent-function 1)
(put 'save-excursion 'lisp-indent-function 0) ;Elisp
(put 'save-restriction 'lisp-indent-function 0) ;Elisp
@@ -1249,6 +1335,7 @@ Lisp function does not specify a special indentation."
(put 'handler-bind 'lisp-indent-function 1) ;CL
(put 'unwind-protect 'lisp-indent-function 1)
(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
+(put 'closure 'lisp-indent-function 2)
(defun indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
@@ -1326,9 +1413,8 @@ Any non-integer value means do not use a different value of
`fill-column' when filling docstrings."
:type '(choice (integer)
(const :tag "Use the current `fill-column'" t))
+ :safe (lambda (x) (or (eq x t) (integerp x)))
:group 'lisp)
-(put 'emacs-lisp-docstring-fill-column 'safe-local-variable
- (lambda (x) (or (eq x t) (integerp x))))
(defun lisp-fill-paragraph (&optional justify)
"Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings.
@@ -1341,6 +1427,9 @@ and initial semicolons."
;; a comment: Point is on a program line; we are interested
;; particularly in docstring lines.
;;
+ ;; FIXME: The below bindings are probably mostly irrelevant
+ ;; since we're now narrowing to a region before filling.
+ ;;
;; We bind `paragraph-start' and `paragraph-separate' temporarily. They
;; are buffer-local, but we avoid changing them so that they can be set
;; to make `forward-paragraph' and friends do something the user wants.
@@ -1376,29 +1465,61 @@ and initial semicolons."
(derived-mode-p 'emacs-lisp-mode))
emacs-lisp-docstring-fill-column
fill-column)))
- (save-restriction
+ (let ((ppss (syntax-ppss))
+ (start (point))
+ ;; Avoid recursion if we're being called directly with
+ ;; `M-x lisp-fill-paragraph' in an `emacs-lisp-mode' buffer.
+ (fill-paragraph-function t))
(save-excursion
- (let ((ppss (syntax-ppss))
- (start (point)))
- ;; If we're in a string, then narrow (roughly) to that
- ;; string before filling. This avoids filling Lisp
- ;; statements that follow the string.
- (when (ppss-string-terminator ppss)
- (goto-char (ppss-comment-or-string-start ppss))
- (beginning-of-line)
- ;; The string may be unterminated -- in that case, don't
- ;; narrow.
- (when (ignore-errors
- (progn
- (forward-sexp 1)
- t))
- (narrow-to-region (ppss-comment-or-string-start ppss)
- (point))))
- ;; Move back to where we were.
+ (save-restriction
+ ;; If we're not inside a string, then do very basic
+ ;; filling. This avoids corrupting embedded strings in
+ ;; code.
+ (if (not (ppss-comment-or-string-start ppss))
+ (lisp--fill-line-simple)
+ ;; If we're in a string, then narrow (roughly) to that
+ ;; string before filling. This avoids filling Lisp
+ ;; statements that follow the string.
+ (when (ppss-string-terminator ppss)
+ (goto-char (ppss-comment-or-string-start ppss))
+ ;; The string may be unterminated -- in that case, don't
+ ;; narrow.
+ (when (ignore-errors
+ (progn
+ (forward-sexp 1)
+ t))
+ (narrow-to-region (1+ (ppss-comment-or-string-start ppss))
+ (1- (point)))))
+ ;; Move back to where we were.
+ (goto-char start)
+ ;; We should fill the first line of a string
+ ;; separately (since it's usually a doc string).
+ (if (= (line-number-at-pos) 1)
+ (narrow-to-region (line-beginning-position)
+ (line-beginning-position 2))
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line 1)
+ (narrow-to-region (point) (point-max))))
+ (fill-paragraph justify)))))))
+ ;; Never return nil.
+ t)
+
+(defun lisp--fill-line-simple ()
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (re-search-forward "\\_>" nil t))
+ (when (> (current-column) fill-column)
+ (let ((start (point)))
+ (backward-sexp)
+ (if (looking-back "[[(]" (point-min))
(goto-char start)
- (fill-paragraph justify)))))
- ;; Never return nil.
- t))
+ (skip-chars-backward " \t")
+ (insert "\n")
+ (forward-sexp))))
+ (unless (eobp)
+ (forward-char 1))))
(defun indent-code-rigidly (start end arg &optional nochange-regexp)
"Indent all lines of code, starting in the region, sideways by ARG columns.
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 4aeca9c6b00..4b85414943a 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -171,6 +171,8 @@ This command assumes point is not in a string or comment.
If INTERACTIVE is non-nil, as it is interactively,
report errors as appropriate for this kind of usage."
(interactive "^p\nd")
+ (when (ppss-comment-or-string-start (syntax-ppss))
+ (user-error "This command doesn't work in strings or comments"))
(if interactive
(condition-case _
(down-list arg nil)
@@ -855,14 +857,33 @@ The option `delete-pair-blink-delay' can disable blinking."
(delete-char -1)))
(delete-char 1))))
-(defun raise-sexp (&optional arg)
- "Raise ARG sexps higher up the tree."
+(defun raise-sexp (&optional n)
+ "Raise N sexps one level higher up the tree.
+
+This function removes the sexp enclosing the form which follows
+point, and then re-inserts N sexps that originally followe point,
+thus raising those N sexps one level up.
+
+Interactively, N is the numeric prefix argument, and defaults to 1.
+
+For instance, if you have:
+
+ (let ((foo 2))
+ (progn
+ (setq foo 3)
+ (zot)
+ (+ foo 2)))
+
+and point is before (zot), \\[raise-sexp] will give you
+
+ (let ((foo 2))
+ (zot))"
(interactive "p")
(let ((s (if (and transient-mark-mode mark-active)
(buffer-substring (region-beginning) (region-end))
(buffer-substring
(point)
- (save-excursion (forward-sexp arg) (point))))))
+ (save-excursion (forward-sexp n) (point))))))
(backward-up-list 1)
(delete-region (point) (save-excursion (forward-sexp 1) (point)))
(save-excursion (insert s))))
@@ -922,14 +943,7 @@ character."
(defun field-complete (table &optional predicate)
(declare (obsolete completion-in-region "24.4"))
(let ((minibuffer-completion-table table)
- (minibuffer-completion-predicate predicate)
- ;; This made sense for lisp-complete-symbol, but for
- ;; field-complete, this is out of place. --Stef
- ;; (completion-annotate-function
- ;; (unless (eq predicate 'fboundp)
- ;; (lambda (str)
- ;; (if (fboundp (intern-soft str)) " <f>"))))
- )
+ (minibuffer-completion-predicate predicate))
(call-interactively 'minibuffer-complete)))
(defun lisp-complete-symbol (&optional _predicate)
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
new file mode 100644
index 00000000000..2c92a8e7fe8
--- /dev/null
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -0,0 +1,710 @@
+;;; loaddefs-gen.el --- generate loaddefs.el files -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Keywords: maint
+;; Package: emacs
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package generates the main lisp/loaddefs.el file, as well as
+;; all the other loaddefs files, like calendar/diary-loaddefs.el, etc.
+
+;; The main entry point is `loaddefs-generate' (normally called
+;; from loaddefs-generate-batch via lisp/Makefile).
+;;
+;; The "other" loaddefs files are specified either via a file-local
+;; setting of `generated-autoload-file', or by specifying
+;;
+;; ;;;###foo-autoload
+;;
+;; This makes the autoload go to foo-loaddefs.el in the current directory.
+;; Normal ;;;###autoload specs go to the main loaddefs file.
+
+;;; Code:
+
+(require 'radix-tree)
+(require 'lisp-mnt)
+(require 'generate-lisp-file)
+
+(defvar autoload-compute-prefixes t
+ "If non-nil, autoload will add code to register the prefixes used in a file.
+Standard prefixes won't be registered anyway. I.e. if a file
+\"foo.el\" defines variables or functions that use \"foo-\" as
+prefix, that will not be registered. But all other prefixes will
+be included.")
+(put 'autoload-compute-prefixes 'safe-local-variable #'booleanp)
+
+(defvar autoload-ignored-definitions
+ '("define-obsolete-function-alias"
+ "define-obsolete-variable-alias"
+ "define-category" "define-key"
+ "defgroup" "defface" "defadvice"
+ "def-edebug-spec"
+ ;; Hmm... this is getting ugly:
+ "define-widget"
+ "define-erc-module"
+ "define-erc-response-handler"
+ "defun-rcirc-command")
+ "List of strings naming definitions to ignore for prefixes.
+More specifically those definitions will not be considered for the
+`register-definition-prefixes' call.")
+
+(defvar generated-autoload-file nil
+ "File into which to write autoload definitions.
+A Lisp file can set this in its local variables section to make
+its autoloads go somewhere else.
+
+If this is a relative file name, the directory is determined as
+follows:
+ - If a Lisp file defined `generated-autoload-file' as a
+ file-local variable, use its containing directory.
+ - Otherwise use the \"lisp\" subdirectory of `source-directory'.
+
+The autoload file is assumed to contain a trailer starting with a
+FormFeed character.")
+;;;###autoload
+(put 'generated-autoload-file 'safe-local-variable 'stringp)
+
+(defvar generated-autoload-load-name nil
+ "Load name for `autoload' statements generated from autoload cookies.
+If nil, this defaults to the file name, sans extension.
+Typically, you need to set this when the directory containing the file
+is not in `load-path'.
+This also affects the generated cus-load.el file.")
+;;;###autoload
+(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
+
+(defun loaddefs-generate--file-load-name (file outfile)
+ "Compute the name that will be used to load FILE.
+OUTFILE should be the name of the global loaddefs.el file, which
+is expected to be at the root directory of the files we are
+scanning for autoloads and will be in the `load-path'."
+ (let* ((name (file-relative-name file (file-name-directory outfile)))
+ (names '())
+ (dir (file-name-directory outfile)))
+ ;; If `name' has directory components, only keep the
+ ;; last few that are really needed.
+ (while name
+ (setq name (directory-file-name name))
+ (push (file-name-nondirectory name) names)
+ (setq name (file-name-directory name)))
+ (while (not name)
+ (cond
+ ((null (cdr names)) (setq name (car names)))
+ ((file-exists-p (expand-file-name "subdirs.el" dir))
+ ;; FIXME: here we only check the existence of subdirs.el,
+ ;; without checking its content. This makes it generate wrong load
+ ;; names for cases like lisp/term which is not added to load-path.
+ (setq dir (expand-file-name (pop names) dir)))
+ (t (setq name (mapconcat #'identity names "/")))))
+ (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
+ (substring name 0 (match-beginning 0))
+ name)))
+
+(defun loaddefs-generate--make-autoload (form file &optional expansion)
+ "Turn FORM into an autoload or defvar for source file FILE.
+Returns nil if FORM is not a special autoload form (i.e. a function definition
+or macro definition or a defcustom).
+If EXPANSION is non-nil, we're processing the macro expansion of an
+expression, in which case we want to handle forms differently."
+ (let ((car (car-safe form)) expand)
+ (cond
+ ((and expansion (eq car 'defalias))
+ (pcase-let*
+ ((`(,_ ,_ ,arg . ,rest) form)
+ ;; `type' is non-nil if it defines a macro.
+ ;; `fun' is the function part of `arg' (defaults to `arg').
+ ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
+ (and (let fun arg) (let type nil)))
+ arg)
+ ;; `lam' is the lambda expression in `fun' (or nil if not
+ ;; recognized).
+ (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
+ ;; `args' is the list of arguments (or t if not recognized).
+ ;; `body' is the body of `lam' (or t if not recognized).
+ ((or `(lambda ,args . ,body)
+ (and (let args t) (let body t)))
+ lam)
+ ;; Get the `doc' from `body' or `rest'.
+ (doc (cond ((stringp (car-safe body)) (car body))
+ ((stringp (car-safe rest)) (car rest))))
+ ;; Look for an interactive spec.
+ (interactive (pcase body
+ ((or `((interactive . ,iargs) . ,_)
+ `(,_ (interactive . ,iargs) . ,_))
+ ;; List of modes or just t.
+ (if (nthcdr 1 iargs)
+ (list 'quote (nthcdr 1 iargs))
+ t)))))
+ ;; Add the usage form at the end where describe-function-1
+ ;; can recover it.
+ (when (consp args) (setq doc (help-add-fundoc-usage doc args)))
+ ;; (message "autoload of %S" (nth 1 form))
+ `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
+
+ ((and expansion (memq car '(progn prog1)))
+ (let ((end (memq :autoload-end form)))
+ (when end ;Cut-off anything after the :autoload-end marker.
+ (setq form (copy-sequence form))
+ (setcdr (memq :autoload-end form) nil))
+ (let ((exps (delq nil (mapcar (lambda (form)
+ (loaddefs-generate--make-autoload
+ form file expansion))
+ (cdr form)))))
+ (when exps (cons 'progn exps)))))
+
+ ;; For complex cases, try again on the macro-expansion.
+ ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
+ define-globalized-minor-mode defun defmacro
+ easy-mmode-define-minor-mode define-minor-mode
+ define-inline cl-defun cl-defmacro cl-defgeneric
+ cl-defstruct pcase-defmacro iter-defun cl-iter-defun))
+ (macrop car)
+ (setq expand (let ((load-true-file-name file)
+ (load-file-name file))
+ (macroexpand form)))
+ (memq (car expand) '(progn prog1 defalias)))
+ ;; Recurse on the expansion.
+ (loaddefs-generate--make-autoload expand file 'expansion))
+
+ ;; For special function-like operators, use the `autoload' function.
+ ((memq car '(define-skeleton define-derived-mode
+ define-compilation-mode define-generic-mode
+ easy-mmode-define-global-mode define-global-minor-mode
+ define-globalized-minor-mode
+ easy-mmode-define-minor-mode define-minor-mode
+ cl-defun defun* cl-defmacro defmacro*
+ define-overloadable-function))
+ (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
+ (name (nth 1 form))
+ (args (pcase car
+ ((or 'defun 'defmacro
+ 'defun* 'defmacro* 'cl-defun 'cl-defmacro
+ 'define-overloadable-function)
+ (nth 2 form))
+ ('define-skeleton '(&optional str arg))
+ ((or 'define-generic-mode 'define-derived-mode
+ 'define-compilation-mode)
+ nil)
+ (_ t)))
+ (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
+ (doc (if (stringp (car body)) (pop body))))
+ ;; Add the usage form at the end where describe-function-1
+ ;; can recover it.
+ (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
+ ;; `define-generic-mode' quotes the name, so take care of that
+ `(autoload ,(if (listp name) name (list 'quote name))
+ ,file ,doc
+ ,(or (and (memq car '(define-skeleton define-derived-mode
+ define-generic-mode
+ easy-mmode-define-global-mode
+ define-global-minor-mode
+ define-globalized-minor-mode
+ easy-mmode-define-minor-mode
+ define-minor-mode))
+ t)
+ (and (eq (car-safe (car body)) 'interactive)
+ ;; List of modes or just t.
+ (or (if (nthcdr 1 (car body))
+ (list 'quote (nthcdr 1 (car body)))
+ t))))
+ ,(if macrop ''macro nil))))
+
+ ;; For defclass forms, use `eieio-defclass-autoload'.
+ ((eq car 'defclass)
+ (let ((name (nth 1 form))
+ (superclasses (nth 2 form))
+ (doc (nth 4 form)))
+ (list 'eieio-defclass-autoload (list 'quote name)
+ (list 'quote superclasses) file doc)))
+
+ ;; Convert defcustom to less space-consuming data.
+ ((eq car 'defcustom)
+ (let* ((varname (car-safe (cdr-safe form)))
+ (props (nthcdr 4 form))
+ (initializer (plist-get props :initialize))
+ (init (car-safe (cdr-safe (cdr-safe form))))
+ (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
+ ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
+ )
+ `(progn
+ ,(if (not (member initializer '(nil 'custom-initialize-default
+ #'custom-initialize-default
+ 'custom-initialize-reset
+ #'custom-initialize-reset)))
+ form
+ `(defvar ,varname ,init ,doc))
+ ;; When we include the complete `form', this `custom-autoload'
+ ;; is not indispensable, but it still helps in case the `defcustom'
+ ;; doesn't specify its group explicitly, and probably in a few other
+ ;; corner cases.
+ (custom-autoload ',varname ,file
+ ,(condition-case nil
+ (null (plist-get props :set))
+ (error nil)))
+ ;; Propagate the :safe property to the loaddefs file.
+ ,@(when-let ((safe (plist-get props :safe)))
+ `((put ',varname 'safe-local-variable ,safe))))))
+
+ ((eq car 'defgroup)
+ ;; In Emacs this is normally handled separately by cus-dep.el, but for
+ ;; third party packages, it can be convenient to explicitly autoload
+ ;; a group.
+ (let ((groupname (nth 1 form)))
+ `(let ((loads (get ',groupname 'custom-loads)))
+ (if (member ',file loads) nil
+ (put ',groupname 'custom-loads (cons ',file loads))))))
+
+ ;; When processing a macro expansion, any expression
+ ;; before a :autoload-end should be included. These are typically (put
+ ;; 'fun 'prop val) and things like that.
+ ((and expansion (consp form)) form)
+
+ ;; nil here indicates that this is not a special autoload form.
+ (t nil))))
+
+(defun loaddefs-generate--make-prefixes (defs file)
+ ;; Remove the defs that obey the rule that file foo.el (or
+ ;; foo-mode.el) uses "foo-" as prefix. Then compute a small set of
+ ;; prefixes that cover all the remaining definitions.
+ (let* ((tree (let ((tree radix-tree-empty))
+ (dolist (def defs)
+ (setq tree (radix-tree-insert tree def t)))
+ tree))
+ (prefixes nil))
+ ;; Get the root prefixes, that we should include in any case.
+ (radix-tree-iter-subtrees
+ tree (lambda (prefix subtree)
+ (push (cons prefix subtree) prefixes)))
+ ;; In some cases, the root prefixes are too short, e.g. if you define
+ ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
+ (dolist (pair (prog1 prefixes (setq prefixes nil)))
+ (let ((s (car pair)))
+ (if (or (and (> (length s) 2) ; Long enough!
+ ;; But don't use "def" from deffoo-pkg-thing.
+ (not (string= "def" s)))
+ (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
+ (radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
+ (push pair prefixes) ;Keep it as is.
+ (radix-tree-iter-subtrees
+ (cdr pair) (lambda (prefix subtree)
+ (push (cons (concat s prefix) subtree) prefixes))))))
+ (when prefixes
+ (let ((strings
+ (mapcar
+ (lambda (x)
+ (let ((prefix (car x)))
+ (if (or (> (length prefix) 2) ;Long enough!
+ (and (eq (length prefix) 2)
+ (string-match "[[:punct:]]" prefix)))
+ prefix
+ ;; Some packages really don't follow the rules.
+ ;; Drop the most egregious cases such as the
+ ;; one-letter prefixes.
+ (let ((dropped ()))
+ (radix-tree-iter-mappings
+ (cdr x) (lambda (s _)
+ (push (concat prefix s) dropped)))
+ (message "%s:0: Warning: Not registering prefix \"%s\". Affects: %S"
+ file prefix dropped)
+ nil))))
+ prefixes)))
+ `(register-definition-prefixes ,file ',(sort (delq nil strings)
+ 'string<))))))
+
+(defun loaddefs-generate--parse-file (file main-outfile &optional package-data)
+ "Examing FILE for ;;;###autoload statements.
+MAIN-OUTFILE is the main loaddefs file these statements are
+destined for, but this can be overriden by the buffer-local
+setting of `generated-autoload-file' in FILE, and
+by ;;;###foo-autoload statements.
+
+If PACKAGE-DATA is `only', return only the package data. If t,
+include the package data with the rest of the data. Otherwise,
+don't include."
+ (let ((defs nil)
+ (load-name (loaddefs-generate--file-load-name file main-outfile))
+ (compute-prefixes t)
+ local-outfile inhibit-autoloads)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-max))
+ ;; We "open-code" this version of `hack-local-variables',
+ ;; because it's really slow in bootstrap-emacs.
+ (when (search-backward ";; Local Variables:" (- (point-max) 1000) t)
+ (save-excursion
+ (when (re-search-forward "generated-autoload-file: *" nil t)
+ ;; Buffer-local file that should be interpreted relative to
+ ;; the .el file.
+ (setq local-outfile (expand-file-name (read (current-buffer))
+ (file-name-directory file)))))
+ (save-excursion
+ (when (re-search-forward "generated-autoload-load-name: *" nil t)
+ (setq load-name (read (current-buffer)))))
+ (save-excursion
+ (when (re-search-forward "no-update-autoloads: *" nil t)
+ (setq inhibit-autoloads (read (current-buffer)))))
+ (save-excursion
+ (when (re-search-forward "autoload-compute-prefixes: *" nil t)
+ (setq compute-prefixes (read (current-buffer))))))
+
+ ;; We always return the package version (even for pre-dumped
+ ;; files).
+ (if (not package-data)
+ ;; We have to switch `emacs-lisp-mode' when scanning
+ ;; loaddefs for packages so that `syntax-ppss' later gives
+ ;; correct results.
+ (emacs-lisp-mode)
+ (let ((version (lm-header "version"))
+ package)
+ (when (and version
+ (setq version (ignore-errors (version-to-list version)))
+ (setq package (or (lm-header "package")
+ (file-name-sans-extension
+ (file-name-nondirectory file)))))
+ (push (list (or local-outfile main-outfile) file
+ `(push (purecopy ',(cons (intern package) version))
+ package--builtin-versions))
+ defs))))
+
+ ;; Obey the `no-update-autoloads' file local variable.
+ (when (and (not inhibit-autoloads)
+ (not (eq package-data 'only)))
+ (goto-char (point-min))
+ ;; The cookie might be like ;;;###tramp-autoload...
+ (while (re-search-forward lisp-mode-autoload-regexp nil t)
+ (when (or package-data
+ ;; Outside of the main Emacs build (`package-data'
+ ;; is set in the Emacs build), check that we don't
+ ;; have an autoload cookie on the first column of a
+ ;; doc string or the like. (The Emacs tree
+ ;; shouldn't contain any such instances.)
+ (not (ppss-string-terminator (syntax-ppss))))
+ ;; ... and if we have one of these names, then alter outfile.
+ (let* ((aname (match-string 2))
+ (to-file (if aname
+ (expand-file-name
+ (concat aname "-loaddefs.el")
+ (file-name-directory file))
+ (or local-outfile main-outfile))))
+ (if (eolp)
+ ;; We have a form following.
+ (let* ((form (prog1
+ (read (current-buffer))
+ (unless (bolp)
+ (forward-line 1))))
+ (autoload (or (loaddefs-generate--make-autoload
+ form load-name)
+ form)))
+ ;; We get back either an autoload form, or a tree
+ ;; structure of `(progn ...)' things, so unravel that.
+ (let ((forms (if (eq (car autoload) 'progn)
+ (cdr autoload)
+ (list autoload))))
+ (while forms
+ (let ((elem (pop forms)))
+ (if (eq (car elem) 'progn)
+ ;; More recursion; add it to the start.
+ (setq forms (nconc (cdr elem) forms))
+ ;; We have something to add to the defs; do it.
+ (push (list to-file file elem) defs))))))
+ ;; Just put the rest of the line into the loaddefs.
+ ;; FIXME: We skip the first space if there's more
+ ;; whitespace after.
+ (when (looking-at-p " [\t ]")
+ (forward-char 1))
+ (push (list to-file file
+ (buffer-substring (point) (line-end-position)))
+ defs)))))
+
+ (when (and autoload-compute-prefixes
+ compute-prefixes)
+ (when-let ((form (loaddefs-generate--compute-prefixes load-name)))
+ ;; This output needs to always go in the main loaddefs.el,
+ ;; regardless of `generated-autoload-file'.
+ (push (list main-outfile file form) defs)))))
+ defs))
+
+(defun loaddefs-generate--compute-prefixes (load-name)
+ (goto-char (point-min))
+ (let ((prefs nil))
+ ;; Avoid (defvar <foo>) by requiring a trailing space.
+ (while (re-search-forward
+ "^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
+ (unless (member (match-string 1) autoload-ignored-definitions)
+ (let ((name (match-string-no-properties 2)))
+ (when (save-excursion
+ (goto-char (match-beginning 0))
+ (or (bobp)
+ (progn
+ (forward-line -1)
+ (not (looking-at ";;;###autoload")))))
+ (push name prefs)))))
+ (loaddefs-generate--make-prefixes prefs load-name)))
+
+(defun loaddefs-generate--rubric (file &optional type feature)
+ "Return a string giving the appropriate autoload rubric for FILE.
+TYPE (default \"autoloads\") is a string stating the type of
+information contained in FILE. TYPE \"package\" acts like the default,
+but adds an extra line to the output to modify `load-path'.
+
+If FEATURE is non-nil, FILE will provide a feature. FEATURE may
+be a string naming the feature, otherwise it will be based on
+FILE's name."
+ (let ((lp (and (equal type "package") (setq type "autoloads"))))
+ (with-temp-buffer
+ (generate-lisp-file-heading
+ file 'loaddefs-generate
+ :title (concat "automatically extracted " (or type "autoloads"))
+ :commentary (and (string-match "/lisp/loaddefs\\.el\\'" file)
+ "This file will be copied to ldefs-boot.el and checked in periodically."))
+ (when lp
+ (insert "(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))\n\n"))
+ (insert " \n;;; End of scraped data\n\n")
+ (generate-lisp-file-trailer
+ file :provide (and (stringp feature) feature)
+ :inhibit-provide (not feature))
+ (buffer-string))))
+
+(defun loaddefs-generate--insert-section-header (outbuf autoloads
+ load-name file time)
+ "Insert into buffer OUTBUF the section-header line for FILE.
+The header line lists the file name, its \"load name\", its autoloads,
+and the time the FILE was last updated (the time is inserted only
+if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
+ (insert "\f\n;;;### ")
+ (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
+ outbuf)
+ (terpri outbuf)
+ ;; Break that line at spaces, to avoid very long lines.
+ ;; Make each sub-line into a comment.
+ (with-current-buffer outbuf
+ (save-excursion
+ (forward-line -1)
+ (while (not (eolp))
+ (move-to-column 64)
+ (skip-chars-forward "^ \n")
+ (or (eolp)
+ (insert "\n" ";;;;;; "))))))
+
+;;;###autoload
+(defun loaddefs-generate (dir output-file &optional excluded-files
+ extra-data include-package-version
+ generate-full)
+ "Generate loaddefs files for Lisp files in the directories DIRS.
+DIR can be either a single directory or a list of directories.
+
+The autoloads will be written to OUTPUT-FILE. If any Lisp file
+binds `generated-autoload-file' as a file-local variable, write
+its autoloads into the specified file instead.
+
+The function does NOT recursively descend into subdirectories of the
+directory or directories specified.
+
+If EXTRA-DATA, include this string at the start of the generated
+file. This will also force generation of OUTPUT-FILE even if
+there are no autoloads to put into the file.
+
+If INCLUDE-PACKAGE-VERSION, include package version data.
+
+If GENERATE-FULL, don't update, but regenerate all the loaddefs files."
+ (let* ((files-re (let ((tmp nil))
+ (dolist (suf (get-load-suffixes))
+ ;; We don't use module-file-suffix below because
+ ;; we don't want to depend on whether Emacs was
+ ;; built with or without modules support, nor
+ ;; what is the suffix for the underlying OS.
+ (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf)
+ (push suf tmp)))
+ (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'")))
+ (files (apply #'nconc
+ (mapcar (lambda (d)
+ (directory-files (expand-file-name d)
+ t files-re))
+ (if (consp dir) dir (list dir)))))
+ (updating (and (file-exists-p output-file) (not generate-full)))
+ (defs nil))
+
+ ;; Collect all the autoload data.
+ (let ((progress (make-progress-reporter
+ (byte-compile-info
+ (concat "Scraping files for loaddefs"))
+ 0 (length files) nil 10))
+ (output-time
+ (file-attribute-modification-time (file-attributes output-file)))
+ (file-count 0))
+ (dolist (file files)
+ (progress-reporter-update progress (setq file-count (1+ file-count)))
+ (when (or (not updating)
+ (time-less-p output-time
+ (file-attribute-modification-time
+ (file-attributes file))))
+ (setq defs (nconc
+ (loaddefs-generate--parse-file
+ file output-file
+ ;; We only want the package name from the
+ ;; excluded files.
+ (and include-package-version
+ (if (member (expand-file-name file) excluded-files)
+ 'only
+ t)))
+ defs))))
+ (progress-reporter-done progress))
+
+ ;; If we have no autoloads data, but we have EXTRA-DATA, then
+ ;; generate the (almost) empty file anyway.
+ (if (and (not defs) extra-data)
+ (with-temp-buffer
+ (insert (loaddefs-generate--rubric output-file nil t))
+ (search-backward "\f")
+ (insert extra-data)
+ (ensure-empty-lines 1)
+ (write-region (point-min) (point-max) output-file nil 'silent))
+ ;; We have some data, so generate the loaddef files. First
+ ;; group per output file.
+ (dolist (fdefs (seq-group-by #'car defs))
+ (let ((loaddefs-file (car fdefs)))
+ (with-temp-buffer
+ (if (and updating (file-exists-p loaddefs-file))
+ (insert-file-contents loaddefs-file)
+ (insert (loaddefs-generate--rubric loaddefs-file nil t))
+ (search-backward "\f")
+ (when extra-data
+ (insert extra-data)
+ (ensure-empty-lines 1)))
+ ;; Then group by source file (and sort alphabetically).
+ (dolist (section (sort (seq-group-by #'cadr (cdr fdefs))
+ (lambda (e1 e2)
+ (string<
+ (file-name-sans-extension
+ (file-name-nondirectory (car e1)))
+ (file-name-sans-extension
+ (file-name-nondirectory (car e2)))))))
+ (pop section)
+ (let* ((relfile (file-relative-name
+ (cadar section)
+ (file-name-directory loaddefs-file)))
+ (head (concat "\n\f\n;;; Generated autoloads from "
+ relfile "\n\n")))
+ (when (file-exists-p loaddefs-file)
+ ;; If we're updating an old loaddefs file, then see if
+ ;; there's a section here for this file already.
+ (goto-char (point-min))
+ (if (not (search-forward head nil t))
+ ;; It's a new file; put the data at the end.
+ (progn
+ (goto-char (point-max))
+ (search-backward "\f\n"))
+ ;; Delete the old version of the section.
+ (delete-region (match-beginning 0)
+ (and (search-forward "\n\f\n;;;")
+ (match-beginning 0)))
+ (forward-line -2)))
+ (insert head)
+ (dolist (def (reverse section))
+ (setq def (caddr def))
+ (if (stringp def)
+ (princ def (current-buffer))
+ (loaddefs-generate--print-form def))
+ (unless (bolp)
+ (insert "\n")))))
+ (write-region (point-min) (point-max) loaddefs-file nil 'silent)
+ (byte-compile-info (file-relative-name loaddefs-file lisp-directory)
+ t "GEN")))))))
+
+(defun loaddefs-generate--print-form (def)
+ "Print DEF in the way make-docfile.c expects it."
+ (if (or (not (consp def))
+ (not (symbolp (car def)))
+ (memq (car def) '( make-obsolete
+ define-obsolete-function-alias))
+ (not (stringp (nth 3 def))))
+ (prin1 def (current-buffer) t)
+ ;; The salient point here is that we have to have the doc string
+ ;; that starts with a backslash and a newline, and there mustn't
+ ;; be any newlines before that. So -- typically
+ ;; (defvar foo 'value "\
+ ;; Doc string" ...).
+ (insert "(")
+ (dotimes (_ 3)
+ (prin1 (pop def) (current-buffer)
+ '(t (escape-newlines . t)
+ (escape-control-characters . t)))
+ (insert " "))
+ (let ((start (point)))
+ (prin1 (pop def) (current-buffer) t)
+ (save-excursion
+ (goto-char (1+ start))
+ (insert "\\\n")))
+ (while def
+ (insert " ")
+ (prin1 (pop def) (current-buffer) t))
+ (insert ")")))
+
+(defun loaddefs-generate--excluded-files ()
+ ;; Exclude those files that are preloaded on ALL platforms.
+ ;; These are the ones in loadup.el where "(load" is at the start
+ ;; of the line (crude, but it works).
+ (let ((default-directory (file-name-directory lisp-directory))
+ (excludes nil)
+ file)
+ (with-temp-buffer
+ (insert-file-contents "loadup.el")
+ (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
+ (setq file (match-string 1))
+ (or (string-match "\\.el\\'" file)
+ (setq file (format "%s.el" file)))
+ (or (string-match "\\`site-" file)
+ (push (expand-file-name file) excludes))))
+ ;; Don't scan ldefs-boot.el, either.
+ (cons (expand-file-name "ldefs-boot.el") excludes)))
+
+;;;###autoload
+(defun loaddefs-generate-batch ()
+ "Generate loaddefs.el files in batch mode.
+This scans for ;;;###autoload forms and related things.
+
+The first element on the command line should be the (main)
+loaddefs.el output file, and the rest are the directories to
+use."
+ (let ((args command-line-args-left))
+ (setq command-line-args-left nil)
+ (loaddefs-generate (cdr args) (expand-file-name (car args)))))
+
+(defun loaddefs-generate--emacs-batch ()
+ "Generate the loaddefs for the Emacs build.
+This is like `loaddefs-generate-batch', but has some specific
+rules for built-in packages and excluded files."
+ (let ((args command-line-args-left)
+ (output-file (expand-file-name "loaddefs.el" lisp-directory)))
+ (setq command-line-args-left nil)
+ (loaddefs-generate
+ args output-file
+ (loaddefs-generate--excluded-files)
+ nil t
+ ;; Always do a complete update if loaddefs-gen.el has been
+ ;; updated.
+ (file-newer-than-file-p
+ (expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory)
+ output-file))))
+
+(provide 'loaddefs-gen)
+
+;;; loaddefs-gen.el ends here
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index f1bb2c1cf37..4db50bbaa9b 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -28,6 +28,17 @@
;;; Code:
+(defvar byte-compile-form-stack nil
+ "Dynamic list of successive enclosing forms.
+This is used by the warning message routines to determine a
+source code position. The most accessible element is the current
+most deeply nested form.
+
+Normally a form is manually pushed onto the list at the beginning
+of `byte-compile-form', etc., and manually popped off at its end.
+This is to preserve the data in it in the event of a
+condition-case handling a signaled error.")
+
;; Bound by the top-level `macroexpand-all', and modified to include any
;; macros defined by `defmacro'.
(defvar macroexpand-all-environment nil)
@@ -96,10 +107,11 @@ each clause."
(defun macroexp--compiler-macro (handler form)
(condition-case-unless-debug err
- (apply handler form (cdr form))
+ (let ((symbols-with-pos-enabled t))
+ (apply handler form (cdr form)))
(error
- (message "Compiler-macro error for %S: %S" (car form) err)
- form)))
+ (message "Compiler-macro error for %S: Handler: %S\n%S" (car form) handler err)
+ form)))
(defun macroexp--funcall-if-compiled (_form)
"Pseudo function used internally by macroexp to delay warnings.
@@ -135,22 +147,27 @@ Other uses risk returning non-nil value that point to the wrong file."
(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
-(defun macroexp--warn-wrap (msg form category)
- (let ((when-compiled (lambda ()
- (when (byte-compile-warning-enabled-p category)
- (byte-compile-warn "%s" msg)))))
+(defun macroexp--warn-wrap (arg msg form category)
+ (let ((when-compiled
+ (lambda ()
+ (when (if (consp category)
+ (apply #'byte-compile-warning-enabled-p category)
+ (byte-compile-warning-enabled-p category))
+ (byte-compile-warn-x arg "%s" msg)))))
`(progn
(macroexp--funcall-if-compiled ',when-compiled)
,form)))
(define-obsolete-function-alias 'macroexp--warn-and-return
#'macroexp-warn-and-return "28.1")
-(defun macroexp-warn-and-return (msg form &optional category compile-only)
+(defun macroexp-warn-and-return (msg form &optional category compile-only arg)
"Return code equivalent to FORM labeled with warning MSG.
CATEGORY is the category of the warning, like the categories that
can appear in `byte-compile-warnings'.
COMPILE-ONLY non-nil means no warning should be emitted if the code
-is executed without being compiled first."
+is executed without being compiled first.
+ARG is a symbol (or a form) giving the source code position for the message.
+It should normally be a symbol with position and it defaults to FORM."
(cond
((null msg) form)
((macroexp-compiling-p)
@@ -160,7 +177,7 @@ is executed without being compiled first."
;; macroexpand-all gets right back to macroexpanding `form'.
form
(puthash form form macroexp--warned)
- (macroexp--warn-wrap msg form category)))
+ (macroexp--warn-wrap (or arg form) msg form category)))
(t
(unless compile-only
(message "%sWarning: %s"
@@ -220,7 +237,7 @@ is executed without being compiled first."
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
- new-form 'obsolete))
+ new-form (list 'obsolete fun) nil fun))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
@@ -275,7 +292,7 @@ is executed without being compiled first."
"attempt to open-code `%s' with too few arguments"
"attempt to open-code `%s' with too many arguments")
name)
- form)
+ form nil nil arglist)
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
@@ -286,118 +303,185 @@ is executed without being compiled first."
`(let ,(nreverse bindings) . ,body)
(macroexp-progn body)))))
+(defun macroexp--dynamic-variable-p (var)
+ "Whether the variable VAR is dynamically scoped.
+Only valid during macro-expansion."
+ (defvar byte-compile-bound-variables)
+ (or (not lexical-binding)
+ (special-variable-p var)
+ (memq var macroexp--dynvars)
+ (and (boundp 'byte-compile-bound-variables)
+ (memq var byte-compile-bound-variables))))
+
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
Assumes the caller has bound `macroexpand-all-environment'."
- (if (eq (car-safe form) 'backquote-list*)
- ;; Special-case `backquote-list*', as it is normally a macro that
- ;; generates exceedingly deep expansions from relatively shallow input
- ;; forms. We just process it `in reverse' -- first we expand all the
- ;; arguments, _then_ we expand the top-level definition.
- (macroexpand (macroexp--all-forms form 1)
- macroexpand-all-environment)
- ;; Normal form; get its expansion, and then expand arguments.
- (setq form (macroexp-macroexpand form macroexpand-all-environment))
- ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
- ;; I tried it, it broke the bootstrap :-(
- (pcase form
- (`(cond . ,clauses)
- (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
- (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
- (macroexp--cons
- 'condition-case
- (macroexp--cons err
- (macroexp--cons (macroexp--expand-all body)
- (macroexp--all-clauses handlers 1)
- (cddr form))
- (cdr form))
- form))
- (`(,(or 'defvar 'defconst) . ,_) (macroexp--all-forms form 2))
- (`(function ,(and f `(lambda . ,_)))
- (macroexp--cons 'function
- (macroexp--cons (macroexp--all-forms f 2)
- nil
- (cdr form))
- form))
- (`(,(or 'function 'quote) . ,_) form)
- (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
- pcase--dontcare))
- (macroexp--cons
- fun
- (macroexp--cons
- (macroexp--all-clauses bindings 1)
- (if (null body)
- (macroexp-unprogn
- (macroexp-warn-and-return
- (format "Empty %s body" fun)
- nil nil 'compile-only))
- (macroexp--all-forms body))
- (cdr form))
- form))
- (`(,(and fun `(lambda . ,_)) . ,args)
- ;; Embedded lambda in function position.
- ;; If the byte-optimizer is loaded, try to unfold this,
- ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
- ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
- ;; creation of a closure, thus resulting in much better code.
- (let ((newform (macroexp--unfold-lambda form)))
- (if (eq newform form)
- ;; Unfolding failed for some reason, avoid infinite recursion.
- (macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form)
- (macroexp--expand-all newform))))
-
- (`(funcall . ,(or `(,exp . ,args) pcase--dontcare))
- (let ((eexp (macroexp--expand-all exp))
- (eargs (macroexp--all-forms args)))
- ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
- ;; has a compiler-macro, or to unfold it.
- (pcase eexp
- (`#',f (macroexp--expand-all `(,f . ,eargs)))
- (_ `(funcall ,eexp . ,eargs)))))
- (`(,func . ,_)
- (let ((handler (function-get func 'compiler-macro))
- (funargs (function-get func 'funarg-positions)))
- ;; Check functions quoted with ' rather than with #'
- (dolist (funarg funargs)
- (let ((arg (nth funarg form)))
- (when (and (eq 'quote (car-safe arg))
- (eq 'lambda (car-safe (cadr arg))))
- (setcar (nthcdr funarg form)
- (macroexp-warn-and-return
- (format "%S quoted with ' rather than with #'"
- (let ((f (cadr arg)))
- (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
- arg)))))
- ;; Macro expand compiler macros. This cannot be delayed to
- ;; byte-optimize-form because the output of the compiler-macro can
- ;; use macros.
- (if (null handler)
- ;; No compiler macro. We just expand each argument (for
- ;; setq/setq-default this works alright because the variable names
- ;; are symbols).
- (macroexp--all-forms form 1)
- ;; If the handler is not loaded yet, try (auto)loading the
- ;; function itself, which may in turn load the handler.
- (unless (functionp handler)
- (with-demoted-errors "macroexp--expand-all: %S"
- (autoload-do-load (indirect-function func) func)))
- (let ((newform (macroexp--compiler-macro handler form)))
- (if (eq form newform)
- ;; The compiler macro did not find anything to do.
- (if (equal form (setq newform (macroexp--all-forms form 1)))
- form
- ;; Maybe after processing the args, some new opportunities
- ;; appeared, so let's try the compiler macro again.
- (setq form (macroexp--compiler-macro handler newform))
- (if (eq newform form)
- newform
- (macroexp--expand-all newform)))
- (macroexp--expand-all newform))))))
-
- (_ form))))
+ (push form byte-compile-form-stack)
+ (prog1
+ (if (eq (car-safe form) 'backquote-list*)
+ ;; Special-case `backquote-list*', as it is normally a macro that
+ ;; generates exceedingly deep expansions from relatively shallow input
+ ;; forms. We just process it `in reverse' -- first we expand all the
+ ;; arguments, _then_ we expand the top-level definition.
+ (macroexpand (macroexp--all-forms form 1)
+ macroexpand-all-environment)
+ ;; Normal form; get its expansion, and then expand arguments.
+ (setq form (macroexp-macroexpand form macroexpand-all-environment))
+ ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
+ ;; I tried it, it broke the bootstrap :-(
+ (let ((fn (car-safe form)))
+ (pcase form
+ (`(cond . ,clauses)
+ (macroexp--cons fn (macroexp--all-clauses clauses) form))
+ (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
+ (macroexp--cons
+ fn
+ (macroexp--cons err
+ (macroexp--cons (macroexp--expand-all body)
+ (macroexp--all-clauses handlers 1)
+ (cddr form))
+ (cdr form))
+ form))
+ (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
+ (push name macroexp--dynvars)
+ (macroexp--all-forms form 2))
+ (`(function ,(and f `(lambda . ,_)))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons fn
+ (macroexp--cons (macroexp--all-forms f 2)
+ nil
+ (cdr form))
+ form)))
+ (`(,(or 'function 'quote) . ,_) form)
+ (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
+ pcase--dontcare))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons
+ fun
+ (macroexp--cons
+ (macroexp--all-clauses bindings 1)
+ (if (null body)
+ (macroexp-unprogn
+ (macroexp-warn-and-return
+ (format "Empty %s body" fun)
+ nil nil 'compile-only fun))
+ (macroexp--all-forms body))
+ (cdr form))
+ form)))
+ (`(setq ,(and var (pred symbolp)
+ (pred (not booleanp)) (pred (not keywordp)))
+ ,expr)
+ ;; Fast path for the setq common case.
+ (let ((new-expr (macroexp--expand-all expr)))
+ (if (eq new-expr expr)
+ form
+ `(,fn ,var ,new-expr))))
+ (`(setq . ,args)
+ ;; Normalise to a sequence of (setq SYM EXPR).
+ ;; Malformed code is translated to code that signals an error
+ ;; at run time.
+ (let ((nargs (length args)))
+ (if (/= (logand nargs 1) 0)
+ (macroexp-warn-and-return
+ "odd number of arguments in `setq' form"
+ `(signal 'wrong-number-of-arguments '(setq ,nargs))
+ nil 'compile-only fn)
+ (let ((assignments nil))
+ (while (consp (cdr-safe args))
+ (let* ((var (car args))
+ (expr (cadr args))
+ (new-expr (macroexp--expand-all expr))
+ (assignment
+ (if (and (symbolp var)
+ (not (booleanp var)) (not (keywordp var)))
+ `(,fn ,var ,new-expr)
+ (macroexp-warn-and-return
+ (format-message "attempt to set %s `%s'"
+ (if (symbolp var)
+ "constant"
+ "non-variable")
+ var)
+ (cond
+ ((keywordp var)
+ ;; Accept `(setq :a :a)' for compatibility.
+ `(if (eq ,var ,new-expr)
+ ,var
+ (signal 'setting-constant (list ',var))))
+ ((symbolp var)
+ `(signal 'setting-constant (list ',var)))
+ (t
+ `(signal 'wrong-type-argument
+ (list 'symbolp ',var))))
+ nil 'compile-only var))))
+ (push assignment assignments))
+ (setq args (cddr args)))
+ (cons 'progn (nreverse assignments))))))
+ (`(,(and fun `(lambda . ,_)) . ,args)
+ ;; Embedded lambda in function position.
+ ;; If the byte-optimizer is loaded, try to unfold this,
+ ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
+ ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
+ ;; creation of a closure, thus resulting in much better code.
+ (let ((newform (macroexp--unfold-lambda form)))
+ (if (eq newform form)
+ ;; Unfolding failed for some reason, avoid infinite recursion.
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
+ form)
+ (macroexp--expand-all newform))))
+ (`(funcall ,exp . ,args)
+ (let ((eexp (macroexp--expand-all exp))
+ (eargs (macroexp--all-forms args)))
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro, or to unfold it.
+ (pcase eexp
+ ((and `#',f
+ (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636
+ (macroexp--expand-all `(,f . ,eargs)))
+ (_ `(funcall ,eexp . ,eargs)))))
+ (`(funcall . ,_) form) ;bug#53227
+ (`(,func . ,_)
+ (let ((handler (function-get func 'compiler-macro))
+ (funargs (function-get func 'funarg-positions)))
+ ;; Check functions quoted with ' rather than with #'
+ (dolist (funarg funargs)
+ (let ((arg (nth funarg form)))
+ (when (and (eq 'quote (car-safe arg))
+ (eq 'lambda (car-safe (cadr arg))))
+ (setcar (nthcdr funarg form)
+ (macroexp-warn-and-return
+ (format "%S quoted with ' rather than with #'"
+ (let ((f (cadr arg)))
+ (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
+ arg nil nil (cadr arg))))))
+ ;; Macro expand compiler macros. This cannot be delayed to
+ ;; byte-optimize-form because the output of the compiler-macro can
+ ;; use macros.
+ (if (null handler)
+ ;; No compiler macro. We just expand each argument (for
+ ;; setq/setq-default this works alright because the variable names
+ ;; are symbols).
+ (macroexp--all-forms form 1)
+ ;; If the handler is not loaded yet, try (auto)loading the
+ ;; function itself, which may in turn load the handler.
+ (unless (functionp handler)
+ (with-demoted-errors "macroexp--expand-all: %S"
+ (autoload-do-load (indirect-function func) func)))
+ (let ((newform (macroexp--compiler-macro handler form)))
+ (if (eq form newform)
+ ;; The compiler macro did not find anything to do.
+ (if (equal form (setq newform (macroexp--all-forms form 1)))
+ form
+ ;; Maybe after processing the args, some new opportunities
+ ;; appeared, so let's try the compiler macro again.
+ (setq form (macroexp--compiler-macro handler newform))
+ (if (eq newform form)
+ newform
+ (macroexp--expand-all newform)))
+ (macroexp--expand-all newform))))))
+ (_ form))))
+ (pop byte-compile-form-stack)))
;; Record which arguments expect functions, so we can warn when those
;; are accidentally quoted with ' rather than with #'
@@ -418,6 +502,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
If no macros are expanded, FORM is returned unchanged.
The second optional arg ENVIRONMENT specifies an environment of macro
definitions to shadow the loaded ones for use in file byte-compilation."
+ (let ((macroexpand-all-environment environment)
+ (macroexp--dynvars macroexp--dynvars))
+ (macroexp--expand-all form)))
+
+;; This function is like `macroexpand-all' but for use with top-level
+;; forms. It does not dynbind `macroexp--dynvars' because we want
+;; top-level `defvar' declarations to be recorded in that variable.
+(defun macroexpand--all-toplevel (form &optional environment)
(let ((macroexpand-all-environment environment))
(macroexp--expand-all form)))
@@ -524,12 +616,20 @@ cases where EXP is a constant."
(defmacro macroexp-let2* (test bindings &rest body)
"Multiple binding version of `macroexp-let2'.
-BINDINGS is a list of elements of the form (SYM EXP). Each EXP
-can refer to symbols specified earlier in the binding list."
+BINDINGS is a list of elements of the form (SYM EXP) or just SYM,
+which then stands for (SYM SYM).
+Each EXP can refer to symbols specified earlier in the binding list.
+
+TEST has to be a symbol, and if it is nil it can be omitted."
(declare (indent 2) (debug (sexp (&rest (sexp form)) body)))
+ (when (consp test) ;; `test' was omitted.
+ (push bindings body)
+ (setq bindings test)
+ (setq test nil))
(pcase-exhaustive bindings
('nil (macroexp-progn body))
- (`((,var ,exp) . ,tl)
+ (`(,(or `(,var ,exp) (and (pred symbolp) var (let exp var)))
+ . ,tl)
`(macroexp-let2 ,test ,var ,exp
(macroexp-let2* ,test ,tl ,@body)))))
@@ -679,38 +779,40 @@ test of free variables in the following ways:
(defun internal-macroexpand-for-load (form full-p)
;; Called from the eager-macroexpansion in readevalloop.
- (cond
- ;; Don't repeat the same warning for every top-level element.
- ((eq 'skip (car macroexp--pending-eager-loads)) form)
- ;; If we detect a cycle, skip macro-expansion for now, and output a warning
- ;; with a trimmed backtrace.
- ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
- (let* ((bt (delq nil
- (mapcar #'macroexp--trim-backtrace-frame
- (macroexp--backtrace))))
- (elem `(load ,(file-name-nondirectory load-file-name)))
- (tail (member elem (cdr (member elem bt)))))
- (if tail (setcdr tail (list '…)))
- (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
- (if macroexp--debug-eager
- (debug 'eager-macroexp-cycle)
- (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
+ (let ((symbols-with-pos-enabled t)
+ (print-symbols-bare t))
+ (cond
+ ;; Don't repeat the same warning for every top-level element.
+ ((eq 'skip (car macroexp--pending-eager-loads)) form)
+ ;; If we detect a cycle, skip macro-expansion for now, and output a warning
+ ;; with a trimmed backtrace.
+ ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
+ (let* ((bt (delq nil
+ (mapcar #'macroexp--trim-backtrace-frame
+ (macroexp--backtrace))))
+ (elem `(load ,(file-name-nondirectory load-file-name)))
+ (tail (member elem (cdr (member elem bt)))))
+ (if tail (setcdr tail (list '…)))
+ (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
+ (if macroexp--debug-eager
+ (debug 'eager-macroexp-cycle)
+ (error "Eager macro-expansion skipped due to cycle:\n %s"
(mapconcat #'prin1-to-string (nreverse bt) " => ")))
- (push 'skip macroexp--pending-eager-loads)
- form))
- (t
- (condition-case err
- (let ((macroexp--pending-eager-loads
- (cons load-file-name macroexp--pending-eager-loads)))
- (if full-p
- (macroexpand-all form)
- (macroexpand form)))
- (error
- ;; Hopefully this shouldn't happen thanks to the cycle detection,
- ;; but in case it does happen, let's catch the error and give the
- ;; code a chance to macro-expand later.
- (message "Eager macro-expansion failure: %S" err)
- form)))))
+ (push 'skip macroexp--pending-eager-loads)
+ form))
+ (t
+ (condition-case err
+ (let ((macroexp--pending-eager-loads
+ (cons load-file-name macroexp--pending-eager-loads)))
+ (if full-p
+ (macroexpand--all-toplevel form)
+ (macroexpand form)))
+ (error
+ ;; Hopefully this shouldn't happen thanks to the cycle detection,
+ ;; but in case it does happen, let's catch the error and give the
+ ;; code a chance to macro-expand later.
+ (error "Eager macro-expansion failure: %S" err)
+ form))))))
;; ¡¡¡ Big Ugly Hack !!!
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index f6848008249..c47025f8846 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -215,12 +215,12 @@ The function's value is the number of actions taken."
(action (or (nth 2 help) "act on")))
(concat
(format-message
- "\
-Type SPC or `y' to %s the current %s;
-DEL or `n' to skip the current %s;
-RET or `q' to skip the current and all remaining %s;
-C-g to quit (cancel the whole command);
-! to %s all remaining %s;\n"
+ (substitute-command-keys "\
+Type \\`SPC' or \\`y' to %s the current %s;
+\\`DEL' or \\`n' to skip the current %s;
+\\`RET' or \\`q' to skip the current and all remaining %s;
+\\`C-g' to quit (cancel the whole command);
+\\`!' to %s all remaining %s;\n")
action object object objects action objects)
(mapconcat (lambda (elt)
(format "%s to %s;\n"
@@ -278,11 +278,17 @@ C-g to quit (cancel the whole command);
;; For backward compatibility check if short y/n answers are preferred.
(defcustom read-answer-short 'auto
- "If non-nil, `read-answer' accepts single-character answers.
+ "If non-nil, the `read-answer' function accepts single-character answers.
If t, accept short (single key-press) answers to the question.
If nil, require long answers. If `auto', accept short answers if
`use-short-answers' is non-nil, or the function cell of `yes-or-no-p'
-is set to `y-or-n-p'."
+is set to `y-or-n-p'.
+
+Note that this variable does not affect calls to the more
+commonly-used `yes-or-no-p' function; it only affects calls to
+the `read-answer' function. To control whether `yes-or-no-p'
+requires a long or a short answer, see the `use-short-answers'
+variable."
:type '(choice (const :tag "Accept short answers" t)
(const :tag "Require long answer" nil)
(const :tag "Guess preference" auto))
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index dea5b34991a..8c67d7c7a25 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -175,7 +175,17 @@ MAP can be an alist, plist, hash-table, or array."
(cl-defgeneric map-delete (map key)
"Delete KEY in-place from MAP and return MAP.
-Keys not present in MAP are ignored.")
+Keys not present in MAP are ignored.
+
+Note that if MAP is a list (either alist or plist), and you're
+deleting the final element in the list, the list isn't actually
+destructively modified (but the return value will reflect the
+deletion). So if you're using this method on a list, you have to
+say
+
+ (setq map (map-delete map key))
+
+for this to work reliably.")
(cl-defmethod map-delete ((map list) key)
;; FIXME: Signal map-not-inplace i.s.o returning a different list?
@@ -540,7 +550,7 @@ TYPE is a list whose car is `hash-table' and cdr a list of
keyword-args forwarded to `make-hash-table'.
Example:
- (map-into '((1 . 3)) '(hash-table :test eql))"
+ (map-into \\='((1 . 3)) \\='(hash-table :test eql))"
(map--into-hash map (cdr type)))
(defun map--make-pcase-bindings (args)
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index d9c0f02820e..56b1ea6ed48 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -31,7 +31,7 @@
(require 'subr-x)
(require 'cl-lib)
-(defvar memory-report--type-size (make-hash-table))
+(defvar memory-report--type-size nil)
;;;###autoload
(defun memory-report ()
@@ -75,7 +75,7 @@ by counted more than once."
(defun memory-report-object-size (object)
"Return the size of OBJECT in bytes."
- (when (zerop (hash-table-count memory-report--type-size))
+ (unless memory-report--type-size
(memory-report--garbage-collect))
(memory-report--object-size (make-hash-table :test #'eq) object))
@@ -84,6 +84,7 @@ by counted more than once."
(gethash 'object memory-report--type-size)))
(defun memory-report--set-size (elems)
+ (setq memory-report--type-size (make-hash-table))
(setf (gethash 'string memory-report--type-size)
(cadr (assq 'strings elems)))
(setf (gethash 'cons memory-report--type-size)
@@ -182,6 +183,10 @@ by counted more than once."
(cl-defgeneric memory-report--object-size-1 (_counted _value)
0)
+;; This shouldn't happen, but there's some leakage.
+(cl-defmethod memory-report--object-size-1 (_ (_value symbol-with-pos))
+ (memory-report--size 'symbol))
+
(cl-defmethod memory-report--object-size-1 (_ (value symbol))
;; Don't count global symbols -- makes sizes of lists of symbols too
;; heavy.
@@ -282,7 +287,7 @@ by counted more than once."
buffers)
do (insert (memory-report--format size)
" "
- (button-buttonize
+ (buttonize
(buffer-name buffer)
#'memory-report--buffer-details buffer)
"\n"))
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
new file mode 100644
index 00000000000..d6f1ab98faa
--- /dev/null
+++ b/lisp/emacs-lisp/multisession.el
@@ -0,0 +1,454 @@
+;;; multisession.el --- Multisession storage for variables -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'sqlite)
+(require 'tabulated-list)
+
+(defcustom multisession-storage 'files
+ "Storage method for multisession variables.
+Valid methods are `sqlite' and `files'."
+ :type '(choice (const :tag "SQLite" sqlite)
+ (const :tag "Files" files))
+ :version "29.1"
+ :group 'files)
+
+(defcustom multisession-directory (expand-file-name "multisession/"
+ user-emacs-directory)
+ "Directory to store multisession variables."
+ :type 'file
+ :version "29.1"
+ :group 'files)
+
+;;;###autoload
+(defmacro define-multisession-variable (name initial-value &optional doc
+ &rest args)
+ "Make NAME into a multisession variable initialized from INITIAL-VALUE.
+DOC should be a doc string, and ARGS are keywords as applicable to
+`make-multisession'."
+ (declare (indent defun))
+ (unless (plist-get args :package)
+ (setq args (nconc (list :package
+ (replace-regexp-in-string "-.*" ""
+ (symbol-name name)))
+ args)))
+ `(defvar ,name
+ (make-multisession :key ,(symbol-name name)
+ :initial-value ,initial-value
+ ,@args)
+ ,@(list doc)))
+
+(defconst multisession--unbound (make-symbol "unbound"))
+
+(cl-defstruct (multisession
+ (:constructor nil)
+ (:constructor multisession--create)
+ (:conc-name multisession--))
+ "A persistent variable that will live across Emacs invocations."
+ key
+ (initial-value nil)
+ package
+ (storage multisession-storage)
+ (synchronized nil)
+ (cached-value multisession--unbound)
+ (cached-sequence 0))
+
+(cl-defun make-multisession (&key key initial-value package synchronized
+ storage)
+ "Create a multisession object."
+ (unless package
+ (error "No package for the multisession object"))
+ (unless key
+ (error "No key for the multisession object"))
+ (unless (stringp package)
+ (error "The package has to be a string"))
+ (unless (stringp key)
+ (error "The key has to be a string"))
+ (multisession--create
+ :key key
+ :synchronized synchronized
+ :initial-value initial-value
+ :package package
+ :storage (or storage multisession-storage)))
+
+(defun multisession-value (object)
+ "Return the value of the multisession OBJECT."
+ (if (null user-init-file)
+ ;; If we don't have storage, then just return the value from the
+ ;; object.
+ (if (eq (multisession--cached-value object) multisession--unbound)
+ (multisession--initial-value object)
+ (multisession--cached-value object))
+ ;; We have storage, so we update from storage.
+ (multisession-backend-value (multisession--storage object) object)))
+
+(defun multisession--set-value (object value)
+ "Set the stored value of OBJECT to VALUE."
+ (if (null user-init-file)
+ ;; We have no backend, so just store the value.
+ (setf (multisession--cached-value object) value)
+ ;; We have a backend.
+ (multisession--backend-set-value (multisession--storage object)
+ object value)))
+
+(defun multisession-delete (object)
+ "Delete OBJECT from the backend storage."
+ (multisession--backend-delete (multisession--storage object) object))
+
+(gv-define-simple-setter multisession-value multisession--set-value)
+
+;; SQLite Backend
+
+(declare-function sqlite-execute "sqlite.c")
+(declare-function sqlite-select "sqlite.c")
+(declare-function sqlite-open "sqlite.c")
+(declare-function sqlite-pragma "sqlite.c")
+(declare-function sqlite-transaction "sqlite.c")
+(declare-function sqlite-commit "sqlite.c")
+
+(defvar multisession--db nil)
+
+(defun multisession--ensure-db ()
+ (unless multisession--db
+ (let* ((file (expand-file-name "sqlite/multisession.sqlite"
+ multisession-directory))
+ (dir (file-name-directory file)))
+ (unless (file-exists-p dir)
+ (make-directory dir t))
+ (setq multisession--db (sqlite-open file)))
+ (with-sqlite-transaction multisession--db
+ ;; Use a write-ahead-log (available since 2010), which makes
+ ;; writes a lot faster.
+ (sqlite-pragma multisession--db "journal_mode = WAL")
+ (sqlite-pragma multisession--db "synchronous = NORMAL")
+ (unless (sqlite-select
+ multisession--db
+ "select name from sqlite_master where type = 'table' and name = 'multisession'")
+ ;; Tidy up the database automatically.
+ (sqlite-pragma multisession--db "auto_vacuum = FULL")
+ ;; Create the table.
+ (sqlite-execute
+ multisession--db
+ "create table multisession (package text not null, key text not null, sequence number not null default 1, value text not null)")
+ (sqlite-execute
+ multisession--db
+ "create unique index multisession_idx on multisession (package, key)")))))
+
+(cl-defmethod multisession-backend-value ((_type (eql 'sqlite)) object)
+ (multisession--ensure-db)
+ (let ((id (list (multisession--package object)
+ (multisession--key object))))
+ (cond
+ ;; We have no value yet; check the database.
+ ((eq (multisession--cached-value object) multisession--unbound)
+ (let ((stored
+ (car
+ (sqlite-select
+ multisession--db
+ "select value, sequence from multisession where package = ? and key = ?"
+ id))))
+ (if stored
+ (let ((value (car (read-from-string (car stored)))))
+ (setf (multisession--cached-value object) value
+ (multisession--cached-sequence object) (cadr stored))
+ value)
+ ;; Nothing; return the initial value.
+ (multisession--initial-value object))))
+ ;; We have a value, but we want to update in case some other
+ ;; Emacs instance has updated.
+ ((multisession--synchronized object)
+ (let ((stored
+ (car
+ (sqlite-select
+ multisession--db
+ "select value, sequence from multisession where sequence > ? and package = ? and key = ?"
+ (cons (multisession--cached-sequence object) id)))))
+ (if stored
+ (let ((value (car (read-from-string (car stored)))))
+ (setf (multisession--cached-value object) value
+ (multisession--cached-sequence object) (cadr stored))
+ value)
+ ;; Nothing, return the cached value.
+ (multisession--cached-value object))))
+ ;; Just return the cached value.
+ (t
+ (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql 'sqlite))
+ object value)
+ (catch 'done
+ (let ((i 0))
+ (while (< i 10)
+ (condition-case nil
+ (throw 'done (multisession--set-value-sqlite object value))
+ (sqlite-locked-error
+ (setq i (1+ i))
+ (sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
+ (signal 'sqlite-locked-error "Database is locked"))))
+
+(defun multisession--set-value-sqlite (object value)
+ (multisession--ensure-db)
+ (with-sqlite-transaction multisession--db
+ (let ((id (list (multisession--package object)
+ (multisession--key object)))
+ (pvalue
+ (let ((print-length nil)
+ (print-circle t)
+ (print-level nil))
+ (readablep value))))
+ (when (and value (not pvalue))
+ (error "Unable to store unreadable value: %s" value))
+ (sqlite-execute
+ multisession--db
+ "insert into multisession(package, key, sequence, value) values(?, ?, 1, ?) on conflict(package, key) do update set sequence = sequence + 1, value = ?"
+ (append id (list pvalue pvalue)))
+ (setf (multisession--cached-sequence object)
+ (caar (sqlite-select
+ multisession--db
+ "select sequence from multisession where package = ? and key = ?"
+ id)))
+ (setf (multisession--cached-value object) value))))
+
+(cl-defmethod multisession--backend-values ((_type (eql 'sqlite)))
+ (multisession--ensure-db)
+ (sqlite-select
+ multisession--db
+ "select package, key, value from multisession order by package, key"))
+
+(cl-defmethod multisession--backend-delete ((_type (eql 'sqlite)) object)
+ (sqlite-execute multisession--db
+ "delete from multisession where package = ? and key = ?"
+ (list (multisession--package object)
+ (multisession--key object))))
+
+;; Files Backend
+
+(defun multisession--encode-file-name (name)
+ (url-hexify-string name))
+
+(defun multisession--read-file-value (file object)
+ (catch 'done
+ (let ((i 0)
+ last-error)
+ (while (< i 10)
+ (condition-case err
+ (throw 'done
+ (with-temp-buffer
+ (let* ((time (file-attribute-modification-time
+ (file-attributes file)))
+ (coding-system-for-read 'utf-8-emacs-unix))
+ (insert-file-contents file)
+ (let ((stored (read (current-buffer))))
+ (setf (multisession--cached-value object) stored
+ (multisession--cached-sequence object) time)
+ stored))))
+ ;; Windows uses OS-level file locking that may preclude
+ ;; reading the file in some circumstances. In addition,
+ ;; rename-file is not an atomic operation on MS-Windows,
+ ;; when the target file already exists, so there could be a
+ ;; small race window when the file to read doesn't yet
+ ;; exist. So when these problems happen, wait a bit and retry.
+ ((permission-denied file-missing)
+ (setq i (1+ i)
+ last-error err)
+ (sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
+ (signal (car last-error) (cdr last-error)))))
+
+(defun multisession--object-file-name (object)
+ (expand-file-name
+ (concat "files/"
+ (multisession--encode-file-name (multisession--package object))
+ "/"
+ (multisession--encode-file-name (multisession--key object))
+ ".value")
+ multisession-directory))
+
+(cl-defmethod multisession-backend-value ((_type (eql 'files)) object)
+ (let ((file (multisession--object-file-name object)))
+ (cond
+ ;; We have no value yet; see whether it's stored.
+ ((eq (multisession--cached-value object) multisession--unbound)
+ (if (file-exists-p file)
+ (multisession--read-file-value file object)
+ ;; Nope; return the initial value.
+ (multisession--initial-value object)))
+ ;; We have a value, but we want to update in case some other
+ ;; Emacs instance has updated.
+ ((multisession--synchronized object)
+ (if (and (file-exists-p file)
+ (time-less-p (multisession--cached-sequence object)
+ (file-attribute-modification-time
+ (file-attributes file))))
+ (multisession--read-file-value file object)
+ ;; Nothing, return the cached value.
+ (multisession--cached-value object)))
+ ;; Just return the cached value.
+ (t
+ (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql 'files))
+ object value)
+ (let ((file (multisession--object-file-name object))
+ (time (current-time)))
+ ;; Ensure that the directory exists.
+ (let ((dir (file-name-directory file)))
+ (unless (file-exists-p dir)
+ (make-directory dir t)))
+ (with-temp-buffer
+ (let ((print-length nil)
+ (print-circle t)
+ (print-level nil))
+ (prin1 value (current-buffer)))
+ (goto-char (point-min))
+ (condition-case nil
+ (read (current-buffer))
+ (error (error "Unable to store unreadable value: %s" (buffer-string))))
+ ;; Write to a temp file in the same directory and rename to the
+ ;; file for somewhat better atomicity.
+ (let ((coding-system-for-write 'utf-8-emacs-unix)
+ (create-lockfiles nil)
+ (temp (make-temp-name file))
+ (write-region-inhibit-fsync nil))
+ (write-region (point-min) (point-max) temp nil 'silent)
+ (set-file-times temp time)
+ (rename-file temp file t)))
+ (setf (multisession--cached-sequence object) time
+ (multisession--cached-value object) value)))
+
+(cl-defmethod multisession--backend-values ((_type (eql 'files)))
+ (mapcar (lambda (file)
+ (let ((bits (file-name-split file)))
+ (list (url-unhex-string (car (last bits 2)))
+ (url-unhex-string
+ (file-name-sans-extension (car (last bits))))
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8-emacs-unix))
+ (insert-file-contents file)
+ (read (current-buffer)))))))
+ (directory-files-recursively
+ (expand-file-name "files" multisession-directory)
+ "\\.value\\'")))
+
+(cl-defmethod multisession--backend-delete ((_type (eql 'files)) object)
+ (let ((file (multisession--object-file-name object)))
+ (when (file-exists-p file)
+ (delete-file file))))
+
+;; Mode for editing.
+
+(defvar-keymap multisession-edit-mode-map
+ :parent tabulated-list-mode-map
+ "d" #'multisession-delete-value
+ "e" #'multisession-edit-value)
+
+(define-derived-mode multisession-edit-mode special-mode "Multisession"
+ "This mode lists all elements in the \"multisession\" database."
+ :interactive nil
+ (buffer-disable-undo)
+ (setq-local buffer-read-only t
+ truncate-lines t)
+ (setq tabulated-list-format
+ [("Package" 10)
+ ("Key" 30)
+ ("Value" 30)])
+ (setq-local revert-buffer-function #'multisession-edit-mode--revert))
+
+;;;###autoload
+(defun list-multisession-values (&optional choose-storage)
+ "List all values in the \"multisession\" database.
+If CHOOSE-STORAGE (interactively, the prefix), query for the
+storage method to list."
+ (interactive "P")
+ (let ((storage
+ (if choose-storage
+ (intern (completing-read "Storage method: " '(sqlite files) nil t))
+ multisession-storage)))
+ (pop-to-buffer (get-buffer-create (format "*Multisession %s*" storage)))
+ (multisession-edit-mode)
+ (setq-local multisession-storage storage)
+ (multisession-edit-mode--revert)
+ (goto-char (point-min))))
+
+(defun multisession-edit-mode--revert (&rest _)
+ (let ((inhibit-read-only t)
+ (id (get-text-property (point) 'tabulated-list-id)))
+ (erase-buffer)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar (lambda (elem)
+ (list
+ (cons (car elem) (cadr elem))
+ (vector (car elem) (cadr elem)
+ (string-replace "\n" "\\n"
+ (format "%s" (caddr elem))))))
+ (multisession--backend-values multisession-storage)))
+ (tabulated-list-print t)
+ (goto-char (point-min))
+ (when id
+ (when-let ((match
+ (text-property-search-forward 'tabulated-list-id id t)))
+ (goto-char (prop-match-beginning match))))))
+
+(defun multisession-delete-value (id)
+ "Delete the value at point."
+ (interactive (list (get-text-property (point) 'tabulated-list-id))
+ multisession-edit-mode)
+ (unless id
+ (error "No value on the current line"))
+ (unless (yes-or-no-p "Really delete this item? ")
+ (user-error "Not deleting"))
+ (multisession--backend-delete multisession-storage
+ (make-multisession :package (car id)
+ :key (cdr id)))
+ (let ((inhibit-read-only t))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+
+(defun multisession-edit-value (id)
+ "Edit the value at point."
+ (interactive (list (get-text-property (point) 'tabulated-list-id))
+ multisession-edit-mode)
+ (unless id
+ (error "No value on the current line"))
+ (let* ((object (or
+ ;; If the multisession variable already exists, use
+ ;; it (so that we update it).
+ (and (intern-soft (cdr id))
+ (bound-and-true-p (intern (cdr id))))
+ ;; Create a new object.
+ (make-multisession
+ :package (car id)
+ :key (cdr id)
+ :storage multisession-storage)))
+ (value (multisession-value object)))
+ (setf (multisession-value object)
+ (car (read-from-string
+ (read-string "New value: " (prin1-to-string value))))))
+ (multisession-edit-mode--revert))
+
+(provide 'multisession)
+
+;;; multisession.el ends here
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index eae4a0f0ec8..2d5a1b5e77b 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -42,55 +42,61 @@
;; as this one), so we have to do it by hand!
(push (purecopy '(nadvice 1 0)) package--builtin-versions)
+(oclosure-define (advice
+ (:predicate advice--p)
+ (:copier advice--cons (cdr))
+ (:copier advice--copy (car cdr how props)))
+ car cdr how props)
+
+(eval-when-compile
+ (defmacro advice--make-how-alist (&rest args)
+ `(list
+ ,@(mapcar
+ (lambda (arg)
+ (pcase-let ((`(,how . ,body) arg))
+ `(list ,how
+ (oclosure-lambda (advice (how ,how)) (&rest r)
+ ,@body)
+ ,(replace-regexp-in-string
+ "\\<car\\>" "FUNCTION"
+ (replace-regexp-in-string
+ "\\<cdr\\>" "OLDFUN"
+ (format "%S" `(lambda (&rest r) ,@body))
+ t t)
+ t t))))
+ args))))
+
;;;; Lightweight advice/hook
-(defvar advice--where-alist
- '((:around "\300\301\302\003#\207" 5)
- (:before "\300\301\002\"\210\300\302\002\"\207" 4)
- (:after "\300\302\002\"\300\301\003\"\210\207" 5)
- (:override "\300\301\002\"\207" 4)
- (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4)
- (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4)
- (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4)
- (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4)
- (:filter-args "\300\302\301\003!\"\207" 5)
- (:filter-return "\301\300\302\003\"!\207" 5))
+(defvar advice--how-alist
+ (advice--make-how-alist
+ (:around (apply car cdr r))
+ (:before (apply car r) (apply cdr r))
+ (:after (prog1 (apply cdr r) (apply car r)))
+ (:override (apply car r))
+ (:after-until (or (apply cdr r) (apply car r)))
+ (:after-while (and (apply cdr r) (apply car r)))
+ (:before-until (or (apply car r) (apply cdr r)))
+ (:before-while (and (apply car r) (apply cdr r)))
+ (:filter-args (apply cdr (funcall car r)))
+ (:filter-return (funcall car (apply cdr r))))
"List of descriptions of how to add a function.
-Each element has the form (WHERE BYTECODE STACK) where:
- WHERE is a keyword indicating where the function is added.
- BYTECODE is the corresponding byte-code that will be used.
- STACK is the amount of stack space needed by the byte-code.")
-
-(defvar advice--bytecodes (mapcar #'cadr advice--where-alist))
-
-(defun advice--p (object)
- (and (byte-code-function-p object)
- (eq 128 (aref object 0))
- (memq (length object) '(5 6))
- (memq (aref object 1) advice--bytecodes)
- (eq #'apply (aref (aref object 2) 0))))
-
-(defsubst advice--car (f) (aref (aref f 2) 1))
-(defsubst advice--cdr (f) (aref (aref f 2) 2))
-(defsubst advice--props (f) (aref (aref f 2) 3))
+Each element has the form (HOW OCL DOC) where HOW is a keyword,
+OCL is a \"prototype\" function of type `advice', and
+DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
(defun advice--cd*r (f)
(while (advice--p f)
(setq f (advice--cdr f)))
f)
-(defun advice--where (f)
- (let ((bytecode (aref f 1))
- (where nil))
- (dolist (elem advice--where-alist)
- (if (eq bytecode (cadr elem)) (setq where (car elem))))
- where))
+(define-obsolete-function-alias 'advice--where #'advice--how "29.1")
(defun advice--make-single-doc (flist function macrop)
- (let ((where (advice--where flist)))
+ (let ((how (advice--how flist)))
(concat
(format "This %s has %s advice: "
(if macrop "macro" "function")
- where)
+ how)
(let ((fun (advice--car flist)))
(if (symbolp fun) (format-message "`%S'." fun)
(let* ((name (cdr (assq 'name (advice--props flist))))
@@ -180,33 +186,41 @@ Each element has the form (WHERE BYTECODE STACK) where:
`(funcall ',fspec ',(cadr ifm))
(cadr (or iff ifm)))))
-(defun advice--make-1 (byte-code stack-depth function main props)
- "Build a function value that adds FUNCTION to MAIN."
- (let ((adv-sig (gethash main advertised-signature-table))
- (advice
- (apply #'make-byte-code 128 byte-code
- (vector #'apply function main props) stack-depth nil
- (and (or (commandp function) (commandp main))
- (list (advice--make-interactive-form
- function main))))))
- (when adv-sig (puthash advice adv-sig advertised-signature-table))
- advice))
-
-(defun advice--make (where function main props)
- "Build a function value that adds FUNCTION to MAIN at WHERE.
-WHERE is a symbol to select an entry in `advice--where-alist'."
+
+(cl-defmethod oclosure-interactive-form ((ad advice) &optional _)
+ (let ((car (advice--car ad))
+ (cdr (advice--cdr ad)))
+ (when (or (commandp car) (commandp cdr))
+ `(interactive ,(advice--make-interactive-form car cdr)))))
+
+(cl-defmethod cl-print-object ((object advice) stream)
+ (cl-assert (advice--p object))
+ (princ "#f(advice " stream)
+ (cl-print-object (advice--car object) stream)
+ (princ " " stream)
+ (princ (advice--how object) stream)
+ (princ " " stream)
+ (cl-print-object (advice--cdr object) stream)
+ (let ((props (advice--props object)))
+ (when props
+ (princ " " stream)
+ (cl-print-object props stream)))
+ (princ ")" stream))
+
+(defun advice--make (how function main props)
+ "Build a function value that adds FUNCTION to MAIN at HOW.
+HOW is a symbol to select an entry in `advice--how-alist'."
(let ((fd (or (cdr (assq 'depth props)) 0))
(md (if (advice--p main)
(or (cdr (assq 'depth (advice--props main))) 0))))
(if (and md (> fd md))
;; `function' should go deeper.
- (let ((rest (advice--make where function (advice--cdr main) props)))
- (advice--make-1 (aref main 1) (aref main 3)
- (advice--car main) rest (advice--props main)))
- (let ((desc (assq where advice--where-alist)))
- (unless desc (error "Unknown add-function location `%S'" where))
- (advice--make-1 (nth 1 desc) (nth 2 desc)
- function main props)))))
+ (let ((rest (advice--make how function (advice--cdr main) props)))
+ (advice--cons main rest))
+ (let ((proto (assq how advice--how-alist)))
+ (unless proto (error "Unknown add-function location `%S'" how))
+ (advice--copy (cadr proto)
+ function main how props)))))
(defun advice--member-p (function use-name definition)
(let ((found nil))
@@ -232,8 +246,7 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
(if val (car val)
(let ((nrest (advice--tweak rest tweaker)))
(if (eq rest nrest) flist
- (advice--make-1 (aref flist 1) (aref flist 3)
- first nrest props))))))))
+ (advice--cons flist nrest))))))))
;;;###autoload
(defun advice--remove-function (flist function)
@@ -273,10 +286,33 @@ different, but `function-equal' will hopefully ignore those differences.")
((symbolp place) `(default-value ',place))
(t place))))
+(defun nadvice--make-docstring (sym)
+ (let* ((main (documentation (symbol-function sym) 'raw))
+ (ud (help-split-fundoc main 'pcase))
+ (doc (or (cdr ud) main))
+ (col1width (apply #'max (mapcar (lambda (x)
+ (string-width (symbol-name (car x))))
+ advice--how-alist)))
+ (table (mapconcat (lambda (x)
+ (format (format " %%-%ds %%s" col1width)
+ (car x) (nth 2 x)))
+ advice--how-alist "\n"))
+ (table (if global-prettify-symbols-mode
+ (replace-regexp-in-string "(lambda\\>" "(λ" table t t)
+ table))
+ (combined-doc
+ (if (not (string-match "<<>>" doc))
+ doc
+ (replace-match table t t doc))))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))
+
+(put 'add-function 'function-documentation
+ '(nadvice--make-docstring 'add-function))
+
;;;###autoload
-(defmacro add-function (where place function &optional props)
+(defmacro add-function (how place function &optional props)
;; TODO:
- ;; - maybe let `where' specify some kind of predicate and use it
+ ;; - maybe let `how' specify some kind of predicate and use it
;; to implement things like mode-local or cl-defmethod.
;; Of course, that only makes sense if the predicates of all advices can
;; be combined and made more efficient.
@@ -285,20 +321,11 @@ different, but `function-equal' will hopefully ignore those differences.")
;; :before-until is like add-hook on run-hook-with-args-until-success.
;; Same with :after-* but for (add-hook ... 'append).
"Add a piece of advice on the function stored at PLACE.
-FUNCTION describes the code to add. WHERE describes where to add it.
-WHERE can be explained by showing the resulting new function, as the
+FUNCTION describes the code to add. HOW describes how to add it.
+HOW can be explained by showing the resulting new function, as the
result of combining FUNCTION and the previous value of PLACE, which we
call OLDFUN here:
-`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
-`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
-`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r))
-`:override' (lambda (&rest r) (apply FUNCTION r))
-`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
-`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r)))
-`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
-`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r)))
-`:filter-args' (lambda (&rest r) (apply OLDFUN (funcall FUNCTION r)))
-`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r)))
+<<>>
If FUNCTION was already added, do nothing.
PROPS is an alist of additional properties, among which the following have
a special meaning:
@@ -325,14 +352,14 @@ is also interactive. There are 3 cases:
(declare
;;(indent 2)
(debug (form [&or symbolp ("local" form) ("var" sexp) gv-place]
- form &optional form)))
- `(advice--add-function ,where (gv-ref ,(advice--normalize-place place))
+ form &optional form)))
+ `(advice--add-function ,how (gv-ref ,(advice--normalize-place place))
,function ,props))
(declare-function comp-subr-trampoline-install "comp")
;;;###autoload
-(defun advice--add-function (where ref function props)
+(defun advice--add-function (how ref function props)
(when (and (featurep 'native-compile)
(subr-primitive-p (gv-deref ref)))
(let ((subr-name (intern (subr-name (gv-deref ref)))))
@@ -357,7 +384,7 @@ is also interactive. There are 3 cases:
(advice--remove-function (gv-deref ref)
(or name (advice--car a)))))
(setf (gv-deref ref)
- (advice--make where function (gv-deref ref) props))))
+ (advice--make how function (gv-deref ref) props))))
;;;###autoload
(defmacro remove-function (place function)
@@ -455,11 +482,16 @@ of the piece of advice."
(put symbol 'advice--pending (advice--subst-main oldadv nil)))
(funcall fsetfun symbol newdef))))
+(put 'advice-add 'function-documentation
+ '(nadvice--make-docstring 'advice-add))
+
;;;###autoload
-(defun advice-add (symbol where function &optional props)
+(defun advice-add (symbol how function &optional props)
"Like `add-function' but for the function named SYMBOL.
Contrary to `add-function', this will properly handle the cases where SYMBOL
-is defined as a macro, alias, command, ..."
+is defined as a macro, alias, command, ...
+HOW can be one of:
+<<>>"
;; TODO:
;; - record the advice location, to display in describe-function.
;; - change all defadvice in lisp/**/*.el.
@@ -467,19 +499,21 @@ is defined as a macro, alias, command, ..."
(let* ((f (symbol-function symbol))
(nf (advice--normalize symbol f)))
(unless (eq f nf) (fset symbol nf))
- (add-function where (cond
- ((eq (car-safe nf) 'macro) (cdr nf))
- ;; Reasons to delay installation of the advice:
- ;; - If the function is not yet defined, installing
- ;; the advice would affect `fboundp'ness.
- ;; - the symbol-function slot of an autoloaded
- ;; function is not itself a function value.
- ;; - `autoload' does nothing if the function is
- ;; not an autoload or undefined.
- ((or (not nf) (autoloadp nf))
- (get symbol 'advice--pending))
- (t (symbol-function symbol)))
+ (add-function how (cond
+ ((eq (car-safe nf) 'macro) (cdr nf))
+ ;; Reasons to delay installation of the advice:
+ ;; - If the function is not yet defined, installing
+ ;; the advice would affect `fboundp'ness.
+ ;; - the symbol-function slot of an autoloaded
+ ;; function is not itself a function value.
+ ;; - `autoload' does nothing if the function is
+ ;; not an autoload or undefined.
+ ((or (not nf) (autoloadp nf))
+ (get symbol 'advice--pending))
+ (t (symbol-function symbol)))
function props)
+ ;; FIXME: We could use a defmethod on `function-documentation' instead,
+ ;; except when (autoloadp nf)!
(put symbol 'function-documentation `(advice--make-docstring ',symbol))
(add-function :around (get symbol 'defalias-fset-function)
#'advice--defalias-fset))
@@ -515,12 +549,12 @@ See `advice-add' and `add-function' for explanation on the
arguments. Note if NAME is nil the advice is anonymous;
otherwise it is named `SYMBOL@NAME'.
-\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
+\(fn SYMBOL (HOW LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
(declare (indent 2) (doc-string 3) (debug (sexp sexp def-body)))
(or (listp args) (signal 'wrong-type-argument (list 'listp args)))
(or (<= 2 (length args) 4)
(signal 'wrong-number-of-arguments (list 2 4 (length args))))
- (let* ((where (nth 0 args))
+ (let* ((how (nth 0 args))
(lambda-list (nth 1 args))
(name (nth 2 args))
(depth (nth 3 args))
@@ -530,7 +564,7 @@ otherwise it is named `SYMBOL@NAME'.
(intern (format "%s@%s" symbol name)))
(t (error "Unrecognized name spec `%S'" name)))))
`(prog1 ,@(and (symbolp advice) `((defun ,advice ,lambda-list ,@body)))
- (advice-add ',symbol ,where #',advice ,@(and props `(',props))))))
+ (advice-add ',symbol ,how #',advice ,@(and props `(',props))))))
(defun advice-mapc (fun symbol)
"Apply FUN to every advice function in SYMBOL.
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
new file mode 100644
index 00000000000..9775e8cc656
--- /dev/null
+++ b/lisp/emacs-lisp/oclosure.el
@@ -0,0 +1,562 @@
+;;; oclosure.el --- Open Closures -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; 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:
+
+;; An OClosure is an object that combines the properties of records
+;; with those of a function. More specifically it is a function extended
+;; with a notion of type (e.g. for defmethod dispatch) as well as the
+;; ability to have some fields that are accessible from the outside.
+
+;; See "Open closures", ELS'2022 (https://zenodo.org/record/6228797).
+
+;; Here are some cases of "callable objects" where OClosures have found use:
+;; - nadvice.el (the original motivation)
+;; - kmacros (for cl-print and for `kmacro-extract-lambda')
+;; - cl-generic: turn `cl--generic-isnot-nnm-p' into a mere type test
+;; (by putting the no-next-methods into their own class).
+;; - Slot accessor functions, where the type-dispatch can be used to
+;; dynamically compute the docstring, and also to pretty print them.
+;; - `save-some-buffers-function'
+;; Here are other cases of "callable objects" where OClosures could be used:
+;; - Use the type to distinguish macros from functions.
+;; - Use a `name' and `depth' property from the function passed to
+;; `add-function' (or `add-hook') instead of passing it via "props".
+;; - iterators (generator.el), thunks (thunk.el), streams (stream.el).
+;; - PEG rules: they're currently just functions, but they should carry
+;; their original (macro-expanded) definition (and should be printed
+;; differently from functions)!
+;; - auto-generate docstrings for cl-defstruct slot accessors instead of
+;; storing them in the accessor itself?
+;; - SRFI-17's `setter'.
+;; - coercion wrappers, as in "Threesomes, with and without blame"
+;; https://dl.acm.org/doi/10.1145/1706299.1706342, or
+;; "On the Runtime Complexity of Type-Directed Unboxing"
+;; http://sv.c.titech.ac.jp/minamide/papers.html
+;; - An efficient `negate' operation such that
+;; (negate (negate f)) returns just `f' and (negate #'<) returns #'>=.
+;; - Autoloads (tho currently our bytecode functions (and hence OClosures)
+;; are too fat for that).
+
+;; Related constructs:
+;; - `funcallable-standard-object' (FSO) in Common-Lisp. These are different
+;; from OClosures in that they involve an additional indirection to get
+;; to the actual code, and that they offer the possibility of
+;; changing (via mutation) the code associated with
+;; an FSO. Also the FSO's function can't directly access the FSO's
+;; other fields, contrary to the case with OClosures where those are directly
+;; available as local variables.
+;; - Function objects in Javascript.
+;; - Function objects in Python.
+;; - Callable/Applicable classes in OO languages, i.e. classes with
+;; a single method called `apply' or `call'. The most obvious
+;; difference with OClosures (beside the fact that Callable can be
+;; extended with additional methods) is that all instances of
+;; a given Callable class have to use the same method, whereas every
+;; OClosure object comes with its own code, so two OClosure objects of the
+;; same type can have different code. Of course, you can get the
+;; same result by turning every `oclosure-lambda' into its own class
+;; declaration creating an ad-hoc subclass of the specified type.
+;; In this sense, OClosures are just a generalization of `lambda' which brings
+;; some of the extra feature of Callable objects.
+;; - Apply hooks and "entities" in MIT Scheme
+;; https://www.gnu.org/software/mit-scheme/documentation/stable/mit-scheme-ref/Application-Hooks.html
+;; Apply hooks are basically the same as Common-Lisp's FSOs, and "entities"
+;; are a variant of it where the inner function gets the FSO itself as
+;; additional argument (a kind of "self" arg), thus making it easier
+;; for the code to get data from the object's extra info, tho still
+;; not as easy as with OClosures.
+;; - "entities" in Lisp Machine Lisp (LML)
+;; https://hanshuebner.github.io/lmman/fd-clo.xml
+;; These are arguably identical to OClosures, modulo the fact that LML doesn't
+;; have lexically-scoped closures and uses a form of closures based on
+;; capturing (and reinstating) dynamically scoped bindings instead.
+
+;; Naming: OClosures were originally named FunCallableRecords (FCR), but
+;; that name suggested these were fundamentally records that happened
+;; to be called, whereas OClosures are really just closures that happen
+;; to enjoy some characteristics of records.
+;; The "O" comes from "Open" because OClosures aren't completely opaque
+;; (for that same reason, an alternative name suggested at the time was
+;; "disclosures").
+;; The "O" can also be understood to mean "Object" since you have notions
+;; of inheritance, and the ability to associate methods with particular
+;; OClosure types, just as is the case for OO classes.
+
+;;; Code:
+
+;; TODO:
+;; - `oclosure-(cl-)defun', `oclosure-(cl-)defsubst', `oclosure-define-inline'?
+;; - Use accessor in cl-defstruct.
+;; - Add pcase patterns for OClosures.
+;; - anonymous OClosure types.
+;; - copiers for mixins
+;; - class-allocated slots?
+;; - code-allocated slots?
+;; The `where' slot of `advice' would like to be code-allocated, and the
+;; interactive-spec of commands is currently code-allocated but would like
+;; to be instance-allocated. Their scoping rules are a bit odd, so maybe
+;; it's best to avoid them.
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x)) ;For `named-let'.
+
+(defun oclosure--index-table (slotdescs)
+ (let ((i -1)
+ (it (make-hash-table :test #'eq)))
+ (dolist (desc slotdescs)
+ (let* ((slot (cl--slot-descriptor-name desc)))
+ (cl-incf i)
+ (when (gethash slot it)
+ (error "Duplicate slot name: %S" slot))
+ (setf (gethash slot it) i)))
+ it))
+
+(cl-defstruct (oclosure--class
+ (:constructor nil)
+ (:constructor oclosure--class-make
+ ( name docstring slots parents allparents
+ &aux (index-table (oclosure--index-table slots))))
+ (:include cl--class)
+ (:copier nil))
+ "Metaclass for OClosure classes."
+ (allparents nil :read-only t :type (list-of symbol)))
+
+(setf (cl--find-class 'oclosure)
+ (oclosure--class-make 'oclosure
+ "The root parent of all OClosure classes"
+ nil nil '(oclosure)))
+(defun oclosure--p (oclosure)
+ (not (not (oclosure-type oclosure))))
+
+(cl-deftype oclosure () '(satisfies oclosure--p))
+
+(defun oclosure--slot-mutable-p (slotdesc)
+ (not (alist-get :read-only (cl--slot-descriptor-props slotdesc))))
+
+(defun oclosure--defstruct-make-copiers (copiers slotdescs name)
+ (require 'cl-macs) ;`cl--arglist-args' is not autoloaded.
+ (let* ((mutables '())
+ (slots (mapcar
+ (lambda (desc)
+ (let ((name (cl--slot-descriptor-name desc)))
+ (when (oclosure--slot-mutable-p desc)
+ (push name mutables))
+ name))
+ slotdescs)))
+ (mapcar
+ (lambda (copier)
+ (pcase-let*
+ ((cname (pop copier))
+ (args (or (pop copier) `(&key ,@slots)))
+ (inline (and (eq :inline (car copier)) (pop copier)))
+ (doc (or (pop copier)
+ (format "Copier for objects of type `%s'." name)))
+ (obj (make-symbol "obj"))
+ (absent (make-symbol "absent"))
+ (anames (cl--arglist-args args))
+ (mnames
+ (let ((res '())
+ (tmp args))
+ (while (and tmp
+ (not (memq (car tmp)
+ cl--lambda-list-keywords)))
+ (push (pop tmp) res))
+ res))
+ (index -1)
+ (mutlist '())
+ (argvals
+ (mapcar
+ (lambda (slot)
+ (setq index (1+ index))
+ (let* ((mutable (memq slot mutables))
+ (get `(oclosure--get ,obj ,index ,(not (not mutable)))))
+ (push mutable mutlist)
+ (cond
+ ((not (memq slot anames)) get)
+ ((memq slot mnames) slot)
+ (t
+ `(if (eq ',absent ,slot)
+ ,get
+ ,slot)))))
+ slots)))
+ `(,(if inline 'cl-defsubst 'cl-defun) ,cname
+ (&cl-defs (',absent) ,obj ,@args)
+ ,doc
+ (declare (side-effect-free t))
+ (oclosure--copy ,obj ',(if (remq nil mutlist) (nreverse mutlist))
+ ,@argvals))))
+ copiers)))
+
+
+(defmacro oclosure-define (name &optional docstring &rest slots)
+ "Define a new OClosure type.
+NAME should be a symbol which is the name of the new type.
+It can also be of the form (NAME . PROPS) in which case PROPS
+is a list of additional properties among the following:
+ (:predicate PRED): asks to create a predicate function named PRED.
+ (:parent TYPE): make TYPE (another OClosure type) be a parent of NAME.
+ (:copier COPIER ARGS): asks to create a \"copier\" (i.e. functional update
+ function) named COPIER. It will take an object of type NAME as first
+ argument followed by ARGS. ARGS lists the names of the slots that will
+ be updated with the value of the corresponding argument.
+SLOTS is a list if slot descriptions. Each slot can be a single symbol
+which is the name of the slot, or it can be of the form (SLOT-NAME . SPROPS)
+where SLOT-NAME is then the name of the slot and SPROPS is a property
+list of slot properties. The currently known properties are the following:
+ `:mutable': A non-nil value mean the slot can be mutated.
+ `:type': Specifies the type of the values expected to appear in the slot."
+ (declare (doc-string 2) (indent 1))
+ (unless (or (stringp docstring) (null docstring))
+ (push docstring slots)
+ (setq docstring nil))
+ (let* ((options (when (consp name)
+ (prog1 (copy-sequence (cdr name))
+ (setq name (car name)))))
+ (get-opt (lambda (opt &optional all)
+ (let ((val (assq opt options))
+ tmp)
+ (when val (setq options (delq val options)))
+ (if (not all)
+ (cdr val)
+ (when val
+ (setq val (list (cdr val)))
+ (while (setq tmp (assq opt options))
+ (push (cdr tmp) val)
+ (setq options (delq tmp options)))
+ (nreverse val))))))
+ (predicate (car (funcall get-opt :predicate)))
+ (parent-names (or (funcall get-opt :parent)
+ (funcall get-opt :include)))
+ (copiers (funcall get-opt :copier 'all)))
+ `(progn
+ ,(when options (macroexp-warn-and-return name
+ (format "Ignored options: %S" options)
+ nil))
+ (eval-and-compile
+ (oclosure--define ',name ,docstring ',parent-names ',slots
+ ,@(when predicate `(:predicate ',predicate))))
+ (oclosure--define-functions ,name ,copiers))))
+
+(defun oclosure--build-class (name docstring parent-names slots)
+ (cl-assert (null (cdr parent-names)))
+ (let* ((parent-class (let ((name (or (car parent-names) 'oclosure)))
+ (or (cl--find-class name)
+ (error "Unknown class: %S" name))))
+ (slotdescs
+ (append
+ (oclosure--class-slots parent-class)
+ (mapcar (lambda (field)
+ (if (not (consp field))
+ (cl--make-slot-descriptor field nil nil
+ '((:read-only . t)))
+ (let ((name (pop field))
+ (type nil)
+ (read-only t)
+ (props '()))
+ (while field
+ (pcase (pop field)
+ (:mutable (setq read-only (not (car field))))
+ (:type (setq type (car field)))
+ (p (message "Unknown property: %S" p)
+ (push (cons p (car field)) props)))
+ (setq field (cdr field)))
+ (cl--make-slot-descriptor name nil type
+ `((:read-only . ,read-only)
+ ,@props)))))
+ slots))))
+ (oclosure--class-make name docstring slotdescs
+ (if (cdr parent-names)
+ (oclosure--class-parents parent-class)
+ (list parent-class))
+ (cons name (oclosure--class-allparents
+ parent-class)))))
+
+(defmacro oclosure--define-functions (name copiers)
+ (let* ((class (cl--find-class name))
+ (slotdescs (oclosure--class-slots class)))
+ `(progn
+ ,@(let ((i -1))
+ (mapcar (lambda (desc)
+ (let* ((slot (cl--slot-descriptor-name desc))
+ (mutable (oclosure--slot-mutable-p desc))
+ ;; Always use a double hyphen: if users wants to
+ ;; make it public, they can do so with an alias.
+ (aname (intern (format "%S--%S" name slot))))
+ (cl-incf i)
+ (if (not mutable)
+ `(defalias ',aname
+ ;; We use `oclosure--copy' instead of
+ ;; `oclosure--accessor-copy' here to circumvent
+ ;; bootstrapping problems.
+ (oclosure--copy
+ oclosure--accessor-prototype
+ nil ',name ',slot ,i))
+ (require 'gv) ;For `gv-setter'.
+ `(progn
+ (defalias ',aname
+ (oclosure--accessor-copy
+ oclosure--mut-getter-prototype
+ ',name ',slot ,i))
+ (defalias ',(gv-setter aname)
+ (oclosure--accessor-copy
+ oclosure--mut-setter-prototype
+ ',name ',slot ,i))))))
+ slotdescs))
+ ,@(oclosure--defstruct-make-copiers
+ copiers slotdescs name))))
+
+;;;###autoload
+(defun oclosure--define (name docstring parent-names slots
+ &rest props)
+ (let* ((class (oclosure--build-class name docstring parent-names slots))
+ (pred (lambda (oclosure)
+ (let ((type (oclosure-type oclosure)))
+ (when type
+ (memq name (oclosure--class-allparents
+ (cl--find-class type)))))))
+ (predname (or (plist-get props :predicate)
+ (intern (format "%s--internal-p" name)))))
+ (setf (cl--find-class name) class)
+ (dolist (slot (oclosure--class-slots class))
+ (put (cl--slot-descriptor-name slot) 'slot-name t))
+ (defalias predname pred)
+ (put name 'cl-deftype-satisfies predname)))
+
+(defmacro oclosure--lambda (type bindings mutables args &rest body)
+ "Low level construction of an OClosure object.
+TYPE should be a form returning an OClosure type (a symbol)
+BINDINGS should list all the slots expected by this type, in the proper order.
+MUTABLE is a list of symbols indicating which of the BINDINGS
+should be mutable.
+No checking is performed,"
+ (declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body)))
+ ;; FIXME: Fundamentally `oclosure-lambda' should be a special form.
+ ;; We define it here as a macro which expands to something that
+ ;; looks like "normal code" in order to avoid backward compatibility
+ ;; issues with third party macros that do "code walks" and would
+ ;; likely mishandle such a new special form (e.g. `generator.el').
+ ;; But don't be fooled: this macro is tightly bound to `cconv.el'.
+ (pcase-let*
+ ((`(,prebody . ,body) (macroexp-parse-body body))
+ (rovars (mapcar #'car bindings)))
+ (dolist (mutable mutables)
+ (setq rovars (delq mutable rovars)))
+ `(let ,(mapcar (lambda (bind)
+ (if (cdr bind) bind
+ ;; Bind to something that doesn't look
+ ;; like a value to avoid the "Variable
+ ;; ‘foo’ left uninitialized" warning.
+ `(,(car bind) (progn nil))))
+ (reverse bindings))
+ ;; FIXME: Make sure the slotbinds whose value is duplicable aren't
+ ;; just value/variable-propagated by the optimizer (tho I think our
+ ;; optimizer is too naive to be a problem currently).
+ (oclosure--fix-type
+ ;; This `oclosure--fix-type' + `ignore' call is used by the compiler (in
+ ;; `cconv.el') to detect and signal an error in case of
+ ;; store-conversion (i.e. if a variable/slot is mutated).
+ (ignore ,@rovars)
+ (lambda ,args
+ (:documentation ,type)
+ ,@prebody
+ ;; Add dummy code which accesses the field's vars to make sure
+ ;; they're captured in the closure.
+ (if t nil ,@rovars ,@(mapcar (lambda (m) `(setq ,m ,m)) mutables))
+ ,@body)))))
+
+(defmacro oclosure-lambda (type-and-slots args &rest body)
+ "Define anonymous OClosure function.
+TYPE-AND-SLOTS should be of the form (TYPE . SLOTS)
+where TYPE is an OClosure type name (defined by `oclosure-define')
+and SLOTS is a let-style list of bindings for the various slots of TYPE.
+ARGS and BODY are the same as for `lambda'."
+ (declare (indent 2) (debug ((sexp &rest (sexp form)) sexp def-body)))
+ ;; FIXME: Should `oclosure-define' distinguish "optional" from
+ ;; "mandatory" slots, and/or provide default values for slots missing
+ ;; from `fields'?
+ (pcase-let*
+ ((`(,type . ,fields) type-and-slots)
+ (class (or (cl--find-class type)
+ (error "Unknown class: %S" type)))
+ (slots (oclosure--class-slots class))
+ (mutables '())
+ (slotbinds (mapcar (lambda (slot)
+ (let ((name (cl--slot-descriptor-name slot)))
+ (when (oclosure--slot-mutable-p slot)
+ (push name mutables))
+ (list name)))
+ slots))
+ (tempbinds (mapcar
+ (lambda (field)
+ (let* ((name (car field))
+ (bind (assq name slotbinds)))
+ (cond
+ ;; FIXME: Should we also warn about missing slots?
+ ((not bind)
+ (error "Unknown slot: %S" name))
+ ((cdr bind)
+ (error "Duplicate slot: %S" name))
+ (t
+ (let ((temp (gensym "temp")))
+ (setcdr bind (list temp))
+ (cons temp (cdr field)))))))
+ fields)))
+ ;; FIXME: Optimize temps away when they're provided in the right order?
+ `(let ,tempbinds
+ (oclosure--lambda ',type ,slotbinds ,mutables ,args ,@body))))
+
+(defun oclosure--fix-type (_ignore oclosure)
+ "Helper function to implement `oclosure-lambda' via a macro.
+This has 2 uses:
+- For interpreted code, this converts the representation of type information
+ by moving it from the docstring to the environment.
+- For compiled code, this is used as a marker which cconv uses to check that
+ immutable fields are indeed not mutated."
+ (if (byte-code-function-p oclosure)
+ ;; Actually, this should never happen since the `cconv.el' should have
+ ;; optimized away the call to this function.
+ oclosure
+ ;; For byte-coded functions, we store the type as a symbol in the docstring
+ ;; slot. For interpreted functions, there's no specific docstring slot
+ ;; so `Ffunction' turns the symbol into a string.
+ ;; We thus have convert it back into a symbol (via `intern') and then
+ ;; stuff it into the environment part of the closure with a special
+ ;; marker so we can distinguish this entry from actual variables.
+ (cl-assert (eq 'closure (car-safe oclosure)))
+ (let ((typename (nth 3 oclosure))) ;; The "docstring".
+ (cl-assert (stringp typename))
+ (push (cons :type (intern typename))
+ (cadr oclosure))
+ oclosure)))
+
+(defun oclosure--copy (oclosure mutlist &rest args)
+ (if (byte-code-function-p oclosure)
+ (apply #'make-closure oclosure
+ (if (null mutlist)
+ args
+ (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
+ (cl-assert (eq 'closure (car-safe oclosure))
+ nil "oclosure not closure: %S" oclosure)
+ (cl-assert (eq :type (caar (cadr oclosure))))
+ (let ((env (cadr oclosure)))
+ `(closure
+ (,(car env)
+ ,@(named-let loop ((env (cdr env)) (args args))
+ (when args
+ (cons (cons (caar env) (car args))
+ (loop (cdr env) (cdr args)))))
+ ,@(nthcdr (1+ (length args)) env))
+ ,@(nthcdr 2 oclosure)))))
+
+(defun oclosure--get (oclosure index mutable)
+ (if (byte-code-function-p oclosure)
+ (let* ((csts (aref oclosure 2))
+ (v (aref csts index)))
+ (if mutable (car v) v))
+ (cl-assert (eq 'closure (car-safe oclosure)))
+ (cl-assert (eq :type (caar (cadr oclosure))))
+ (cdr (nth (1+ index) (cadr oclosure)))))
+
+(defun oclosure--set (v oclosure index)
+ (if (byte-code-function-p oclosure)
+ (let* ((csts (aref oclosure 2))
+ (cell (aref csts index)))
+ (setcar cell v))
+ (cl-assert (eq 'closure (car-safe oclosure)))
+ (cl-assert (eq :type (caar (cadr oclosure))))
+ (setcdr (nth (1+ index) (cadr oclosure)) v)))
+
+(defun oclosure-type (oclosure)
+ "Return the type of OCLOSURE, or nil if the arg is not a OClosure."
+ (if (byte-code-function-p oclosure)
+ (let ((type (and (> (length oclosure) 4) (aref oclosure 4))))
+ (if (symbolp type) type))
+ (and (eq 'closure (car-safe oclosure))
+ (let* ((env (car-safe (cdr oclosure)))
+ (first-var (car-safe env)))
+ (and (eq :type (car-safe first-var))
+ (cdr first-var))))))
+
+(defconst oclosure--accessor-prototype
+ ;; Use `oclosure--lambda' to circumvent a bootstrapping problem:
+ ;; `oclosure-accessor' is not yet defined at this point but
+ ;; `oclosure--accessor-prototype' is needed when defining `oclosure-accessor'.
+ (oclosure--lambda 'oclosure-accessor ((type) (slot) (index)) nil
+ (oclosure) (oclosure--get oclosure index nil)))
+
+(oclosure-define accessor
+ "OClosure function to access a specific slot of an object."
+ type slot)
+
+(defun oclosure--accessor-cl-print (object stream)
+ (princ "#f(accessor " stream)
+ (prin1 (accessor--type object) stream)
+ (princ "." stream)
+ (prin1 (accessor--slot object) stream)
+ (princ ")" stream))
+
+(defun oclosure--accessor-docstring (f)
+ ;; This would like to be a (cl-defmethod function-documentation ...)
+ ;; but for circularity reason the defmethod is in `simple.el'.
+ (format "Access slot \"%S\" of OBJ of type `%S'.\n\n(fn OBJ)"
+ (accessor--slot f) (accessor--type f)))
+
+(oclosure-define (oclosure-accessor
+ (:parent accessor)
+ (:copier oclosure--accessor-copy (type slot index)))
+ "OClosure function to access a specific slot of an OClosure function."
+ index)
+
+(defun oclosure--slot-index (oclosure slotname)
+ (gethash slotname
+ (oclosure--class-index-table
+ (cl--find-class (oclosure-type oclosure)))))
+
+(defun oclosure--slot-value (oclosure slotname)
+ (let ((class (cl--find-class (oclosure-type oclosure)))
+ (index (oclosure--slot-index oclosure slotname)))
+ (oclosure--get oclosure index
+ (oclosure--slot-mutable-p
+ (nth index (oclosure--class-slots class))))))
+
+(defun oclosure--set-slot-value (oclosure slotname value)
+ (let ((class (cl--find-class (oclosure-type oclosure)))
+ (index (oclosure--slot-index oclosure slotname)))
+ (unless (oclosure--slot-mutable-p
+ (nth index (oclosure--class-slots class)))
+ (signal 'setting-constant (list oclosure slotname)))
+ (oclosure--set value oclosure index)))
+
+(defconst oclosure--mut-getter-prototype
+ (oclosure-lambda (oclosure-accessor (type) (slot) (index)) (oclosure)
+ (oclosure--get oclosure index t)))
+(defconst oclosure--mut-setter-prototype
+ ;; FIXME: The generated docstring is wrong.
+ (oclosure-lambda (oclosure-accessor (type) (slot) (index)) (val oclosure)
+ (oclosure--set val oclosure index)))
+
+;; Ideally, this should be in `files.el', but that file is loaded
+;; before `oclosure.el'.
+(oclosure-define (save-some-buffers-function
+ (:predicate save-some-buffers-function--p)))
+
+
+(provide 'oclosure)
+;;; oclosure.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 7679ba2fae5..00beee811ba 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -355,10 +355,10 @@ More specifically the value can be:
This also applies to the \"archive-contents\" file that lists the
contents of the archive."
- :type '(choice (const nil :tag "Never")
- (const allow-unsigned :tag "Allow unsigned")
- (const t :tag "Check always")
- (const all :tag "Check all signatures"))
+ :type '(choice (const :value nil :tag "Never")
+ (const :value allow-unsigned :tag "Allow unsigned")
+ (const :value t :tag "Check always")
+ (const :value all :tag "Check all signatures"))
:risky t
:version "27.1")
@@ -418,22 +418,22 @@ synchronously."
(defcustom package-name-column-width 30
"Column width for the Package name in the package menu."
- :type 'number
+ :type 'natnum
:version "28.1")
(defcustom package-version-column-width 14
"Column width for the Package version in the package menu."
- :type 'number
+ :type 'natnum
:version "28.1")
(defcustom package-status-column-width 12
"Column width for the Package status in the package menu."
- :type 'number
+ :type 'natnum
:version "28.1")
(defcustom package-archive-column-width 8
"Column width for the Package archive in the package menu."
- :type 'number
+ :type 'natnum
:version "28.1")
@@ -566,9 +566,9 @@ This is the name of the package with its version appended."
"Return file-name extension of package-desc object PKG-DESC.
Depending on the `package-desc-kind' of PKG-DESC, this is one of:
- 'single - \".el\"
- 'tar - \".tar\"
- 'dir - \"\"
+ \\='single - \".el\"
+ \\='tar - \".tar\"
+ \\='dir - \"\"
Signal an error if the kind is none of the above."
(pcase (package-desc-kind pkg-desc)
@@ -720,7 +720,7 @@ REQUIREMENTS is a list of dependencies on other packages.
where OTHER-VERSION is a string.
EXTRA-PROPERTIES is currently unused."
- ;; FIXME: Placeholder! Should we keep it?
+ (declare (obsolete nil "29.1") (indent defun))
(error "Don't call me!"))
@@ -763,47 +763,47 @@ PKG-DESC is a `package-desc' object."
(format "%s-autoloads" (package-desc-name pkg-desc))
(package-desc-dir pkg-desc)))
-(defun package--activate-autoloads-and-load-path (pkg-desc)
- "Load the autoloads file and add package dir to `load-path'.
-PKG-DESC is a `package-desc' object."
- (let* ((old-lp load-path)
- (pkg-dir (package-desc-dir pkg-desc))
- (pkg-dir-dir (file-name-as-directory pkg-dir)))
- (with-demoted-errors "Error loading autoloads: %s"
- (load (package--autoloads-file-name pkg-desc) nil t))
- (when (and (eq old-lp load-path)
- (not (or (member pkg-dir load-path)
- (member pkg-dir-dir load-path))))
- ;; Old packages don't add themselves to the `load-path', so we have to
- ;; do it ourselves.
- (push pkg-dir load-path))))
-
(defvar Info-directory-list)
(declare-function info-initialize "info" ())
(defvar package--quickstart-pkgs t
"If set to a list, we're computing the set of pkgs to activate.")
-(defun package--load-files-for-activation (pkg-desc reload)
- "Load files for activating a package given by PKG-DESC.
-Load the autoloads file, and ensure `load-path' is setup. If
-RELOAD is non-nil, also load all files in the package that
-correspond to previously loaded files."
- (let* ((loaded-files-list
- (when reload
- (package--list-loaded-files (package-desc-dir pkg-desc)))))
- ;; Add to load path, add autoloads, and activate the package.
- (package--activate-autoloads-and-load-path pkg-desc)
- ;; Call `load' on all files in `package-desc-dir' already present in
- ;; `load-history'. This is done so that macros in these files are updated
- ;; to their new definitions. If another package is being installed which
- ;; depends on this new definition, not doing this update would cause
- ;; compilation errors and break the installation.
- (with-demoted-errors "Error in package--load-files-for-activation: %s"
- (mapc (lambda (feature) (load feature nil t))
- ;; Skip autoloads file since we already evaluated it above.
- (remove (file-truename (package--autoloads-file-name pkg-desc))
- loaded-files-list)))))
+(defsubst package--library-stem (file)
+ (catch 'done
+ (let (result)
+ (dolist (suffix (get-load-suffixes) file)
+ (setq result (string-trim file nil suffix))
+ (unless (equal file result)
+ (throw 'done result))))))
+
+(defun package--reload-previously-loaded (pkg-desc)
+ "Force reimportation of files in PKG-DESC already present in `load-history'.
+New editions of files contain macro definitions and
+redefinitions, the overlooking of which would cause
+byte-compilation of the new package to fail."
+ (with-demoted-errors "Error in package--load-files-for-activation: %s"
+ (let* (result
+ (dir (package-desc-dir pkg-desc))
+ (load-path-sans-dir
+ (cl-remove-if (apply-partially #'string= dir)
+ (or (bound-and-true-p find-function-source-path)
+ load-path)))
+ (files (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))
+ (history (mapcar #'file-truename
+ (cl-remove-if-not #'stringp
+ (mapcar #'car load-history)))))
+ (dolist (file files)
+ (when-let ((library (package--library-stem
+ (file-relative-name file dir)))
+ (canonical (locate-library library nil load-path-sans-dir))
+ (found (member (file-truename canonical) history))
+ (recent-index (length found)))
+ (unless (equal (file-name-base library)
+ (format "%s-autoloads" (package-desc-name pkg-desc)))
+ (push (cons (expand-file-name library dir) recent-index) result))))
+ (mapc (lambda (c) (load (car c) nil t))
+ (sort result (lambda (x y) (< (cdr x) (cdr y))))))))
(defun package-activate-1 (pkg-desc &optional reload deps)
"Activate package given by PKG-DESC, even if it was already active.
@@ -830,7 +830,11 @@ correspond to previously loaded files (those returned by
(if (listp package--quickstart-pkgs)
;; We're only collecting the set of packages to activate!
(push pkg-desc package--quickstart-pkgs)
- (package--load-files-for-activation pkg-desc reload))
+ (when reload
+ (package--reload-previously-loaded pkg-desc))
+ (with-demoted-errors "Error loading autoloads: %s"
+ (load (package--autoloads-file-name pkg-desc) nil t))
+ (add-to-list 'load-path (directory-file-name pkg-dir)))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
@@ -841,48 +845,6 @@ correspond to previously loaded files (those returned by
;; Don't return nil.
t)))
-(defun package--files-load-history ()
- (delq nil
- (mapcar (lambda (x)
- (let ((f (car x)))
- (and (stringp f)
- (file-name-sans-extension (file-truename f)))))
- load-history)))
-
-(defun package--list-of-conflicts (dir history)
- (require 'find-func)
- (declare-function find-library-name "find-func" (library))
- (delq
- nil
- (mapcar
- (lambda (x) (let* ((file (file-relative-name x dir))
- ;; Previously loaded file, if any.
- (previous
- (ignore-error file-error ;"Can't find library"
- (file-name-sans-extension
- (file-truename (find-library-name file)))))
- (pos (when previous (member previous history))))
- ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
- (when pos
- (cons (file-name-sans-extension file) (length pos)))))
- (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))
-
-(defun package--list-loaded-files (dir)
- "Recursively list all files in DIR which correspond to loaded features.
-Returns the `file-name-sans-extension' of each file, relative to
-DIR, sorted by most recently loaded last."
- (let* ((history (package--files-load-history))
- (dir (file-truename dir))
- ;; List all files that have already been loaded.
- (list-of-conflicts (package--list-of-conflicts dir history)))
- ;; Turn the list of (FILENAME . POS) back into a list of features. Files in
- ;; subdirectories are returned relative to DIR (so not actually features).
- (let ((default-directory (file-name-as-directory dir)))
- (mapcar (lambda (x) (file-truename (car x)))
- (sort list-of-conflicts
- ;; Sort the files by ascending HISTORY-POSITION.
- (lambda (x y) (< (cdr x) (cdr y))))))))
-
;;;; `package-activate'
(defun package--get-activatable-pkg (pkg-name)
@@ -1001,7 +963,7 @@ untar into a directory named DIR; otherwise, signal an error."
(package--native-compile-async new-desc))
;; After compilation, load again any files loaded by
;; `activate-1', so that we use the byte-compiled definitions.
- (package--load-files-for-activation new-desc :reload)))
+ (package--reload-previously-loaded new-desc)))
pkg-dir))
(defun package-generate-description-file (pkg-desc pkg-file)
@@ -1040,9 +1002,11 @@ untar into a directory named DIR; otherwise, signal an error."
(defun package-autoload-ensure-default-file (file)
"Make sure that the autoload file FILE exists and if not create it."
+ (declare (obsolete nil "29.1"))
(unless (file-exists-p file)
(require 'autoload)
- (write-region (autoload-rubric file "package" nil) nil file nil 'silent))
+ (let ((coding-system-for-write 'utf-8-emacs-unix))
+ (write-region (autoload-rubric file "package" nil) nil file nil 'silent)))
file)
(defvar autoload-timestamps)
@@ -1057,8 +1021,11 @@ untar into a directory named DIR; otherwise, signal an error."
(autoload-timestamps nil)
(backup-inhibited t)
(version-control 'never))
- (package-autoload-ensure-default-file output-file)
- (make-directory-autoloads pkg-dir output-file)
+ (loaddefs-generate
+ pkg-dir output-file
+ nil
+ "(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))")
(let ((buf (find-buffer-visiting output-file)))
(when buf (kill-buffer buf)))
auto-name))
@@ -1224,13 +1191,17 @@ The return result is a `package-desc'."
info)
(while files
(with-temp-buffer
- (insert-file-contents (pop files))
- ;; When we find the file with the data,
- (when (setq info (ignore-errors (package-buffer-info)))
- ;; stop looping,
- (setq files nil)
- ;; set the 'dir kind,
- (setf (package-desc-kind info) 'dir))))
+ (let ((file (pop files)))
+ ;; The file may be a link to a nonexistent file; e.g., a
+ ;; lock file.
+ (when (file-exists-p file)
+ (insert-file-contents file)
+ ;; When we find the file with the data,
+ (when (setq info (ignore-errors (package-buffer-info)))
+ ;; stop looping,
+ (setq files nil)
+ ;; set the 'dir kind,
+ (setf (package-desc-kind info) 'dir))))))
(unless info
(error "No .el files with package headers in `%s'" default-directory))
;; and return the info.
@@ -1661,7 +1632,9 @@ The variable `package-load-list' controls which packages to load."
(qs (if (file-readable-p elc) elc
(if (file-readable-p package-quickstart-file)
package-quickstart-file))))
- (if qs
+ ;; The quickstart file presumes that it has a blank slate,
+ ;; so don't use it if we already activated some packages.
+ (if (and qs (not (bound-and-true-p package-activated-list)))
;; Skip load-source-file-function which would slow us down by a factor
;; 2 when loading the .el file (this assumes we were careful to
;; save this file so it doesn't need any decoding).
@@ -1886,8 +1859,12 @@ SEEN is used internally to detect infinite recursion."
(error "Need package `%s-%s', but only %s is available"
next-pkg (package-version-join next-version)
found-something))
- (t (error "Package `%s-%s' is unavailable"
- next-pkg (package-version-join next-version)))))
+ (t
+ (if (eq next-pkg 'emacs)
+ (error "This package requires Emacs version %s"
+ (package-version-join next-version))
+ (error "Package `%s-%s' is unavailable"
+ next-pkg (package-version-join next-version))))))
(setq packages
(package-compute-transaction (cons found packages)
(package-desc-reqs found)
@@ -2072,6 +2049,7 @@ if all the in-between dependencies are also in PACKAGE-LIST."
package-alist))))
(setf (package-desc-signed (car pkg-descs)) t))))))))))
+;;;###autoload
(defun package-installed-p (package &optional min-version)
"Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed.
If PACKAGE is a symbol, it is the package name and MIN-VERSION
@@ -2163,6 +2141,61 @@ to install it but still mark it as selected."
(message "Package `%s' installed." name))
(message "`%s' is already installed" name))))
+;;;###autoload
+(defun package-update (name)
+ "Update package NAME if a newer version exists."
+ (interactive
+ (list (completing-read
+ "Update package: " (package--updateable-packages) nil t)))
+ (let ((package (if (symbolp name)
+ name
+ (intern name))))
+ (package-delete (cadr (assq package package-alist)) 'force)
+ (package-install package 'dont-select)))
+
+(defun package--updateable-packages ()
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (package--archives-initialize)
+ (mapcar
+ #'car
+ (seq-filter
+ (lambda (elt)
+ (let ((available
+ (assq (car elt) package-archive-contents)))
+ (and available
+ (version-list-<
+ (package-desc-priority-version (cadr elt))
+ (package-desc-priority-version (cadr available))))))
+ package-alist)))
+
+;;;###autoload
+(defun package-update-all (&optional query)
+ "Refresh package list and upgrade all packages.
+If QUERY, ask the user before updating packages. When called
+interactively, QUERY is always true."
+ (interactive (list (not noninteractive)))
+ (package-refresh-contents)
+ (let ((updateable (package--updateable-packages)))
+ (if (not updateable)
+ (message "No packages to update")
+ (when (and query
+ (not (yes-or-no-p
+ (if (length= updateable 1)
+ "One package to update. Do it? "
+ (format "%s packages to update. Do it?"
+ (length updateable))))))
+ (user-error "Updating aborted"))
+ (mapc #'package-update updateable))))
+
+(defun package--dependencies (pkg)
+ "Return a list of all dependencies PKG has.
+This is done recursively."
+ ;; Can we have circular dependencies? Assume "nope".
+ (when-let* ((desc (cadr (assq pkg package-archive-contents)))
+ (deps (mapcar #'car (package-desc-reqs desc))))
+ (delete-dups (apply #'nconc deps (mapcar #'package--dependencies deps)))))
+
(defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR.
If the result looks like a dotted numeric version, return it.
@@ -2389,6 +2422,35 @@ object."
(package-install pkg 'dont-select))
;;;###autoload
+(defun package-recompile (pkg)
+ "Byte-compile package PKG again.
+PKG should be either a symbol, the package name, or a `package-desc'
+object."
+ (interactive (list (intern (completing-read
+ "Recompile package: "
+ (mapcar #'symbol-name
+ (mapcar #'car package-alist))))))
+ (let ((pkg-desc (if (package-desc-p pkg)
+ pkg
+ (cadr (assq pkg package-alist)))))
+ ;; Delete the old .elc files to ensure that we don't inadvertently
+ ;; load them (in case they contain byte code/macros that are now
+ ;; invalid).
+ (dolist (elc (directory-files-recursively
+ (package-desc-dir pkg-desc) "\\.elc\\'"))
+ (delete-file elc))
+ (package--compile pkg-desc)))
+
+;;;###autoload
+(defun package-recompile-all ()
+ "Byte-compile all installed packages.
+This is meant to be used only in the case the byte-compiled files
+are invalid due to changed byte-code, macros or the like."
+ (interactive)
+ (pcase-dolist (`(_ ,pkg-desc) package-alist)
+ (package-recompile pkg-desc)))
+
+;;;###autoload
(defun package-autoremove ()
"Remove packages that are no longer needed.
@@ -2494,6 +2556,15 @@ The description is read from the installed package files."
(format "%s.el" (package-desc-name desc)) srcdir))
"")))
+(defun package--describe-add-library-links ()
+ "Add links to library names in package description."
+ (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
+ (if (locate-library (match-string 1))
+ (make-text-button (match-beginning 1) (match-end 1)
+ 'xref (match-string-no-properties 1)
+ 'help-echo "Read this file's commentary"
+ :type 'package--finder-xref))))
+
(defun describe-package-1 (pkg)
"Insert the package description for PKG.
Helper function for `describe-package'."
@@ -2720,6 +2791,9 @@ Helper function for `describe-package'."
t)
(insert (or readme-string
"This package does not provide a description.")))))
+ ;; Make library descriptions into links.
+ (goto-char start-of-description)
+ (package--describe-add-library-links)
;; Make URLs in the description into links.
(goto-char start-of-description)
(browse-url-add-buttons))))
@@ -2765,6 +2839,15 @@ function is a convenience wrapper used by `describe-package-1'."
(apply #'insert-text-button button-text 'face button-face 'follow-link t
properties)))
+(defun package--finder-goto-xref (button)
+ "Jump to a Lisp file for the BUTTON at point."
+ (let* ((file (button-get button 'xref))
+ (lib (locate-library file)))
+ (if lib (finder-commentary lib)
+ (message "Unable to locate `%s'" file))))
+
+(define-button-type 'package--finder-xref 'action #'package--finder-goto-xref)
+
(defun package--print-email-button (recipient)
"Insert a button whose action will send an email to RECIPIENT.
NAME should have the form (FULLNAME . EMAIL) where FULLNAME is
@@ -2786,35 +2869,33 @@ either a full name or nil, and EMAIL is a valid email address."
;;;; Package menu mode.
-(defvar package-menu-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map tabulated-list-mode-map)
- (define-key map "\C-m" 'package-menu-describe-package)
- (define-key map "u" 'package-menu-mark-unmark)
- (define-key map "\177" 'package-menu-backup-unmark)
- (define-key map "d" 'package-menu-mark-delete)
- (define-key map "i" 'package-menu-mark-install)
- (define-key map "U" 'package-menu-mark-upgrades)
- (define-key map "r" 'revert-buffer)
- (define-key map "~" 'package-menu-mark-obsolete-for-deletion)
- (define-key map "w" 'package-browse-url)
- (define-key map "x" 'package-menu-execute)
- (define-key map "h" 'package-menu-quick-help)
- (define-key map "H" #'package-menu-hide-package)
- (define-key map "?" 'package-menu-describe-package)
- (define-key map "(" #'package-menu-toggle-hiding)
- (define-key map (kbd "/ /") 'package-menu-clear-filter)
- (define-key map (kbd "/ a") 'package-menu-filter-by-archive)
- (define-key map (kbd "/ d") 'package-menu-filter-by-description)
- (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
- (define-key map (kbd "/ N") 'package-menu-filter-by-name-or-description)
- (define-key map (kbd "/ n") 'package-menu-filter-by-name)
- (define-key map (kbd "/ s") 'package-menu-filter-by-status)
- (define-key map (kbd "/ v") 'package-menu-filter-by-version)
- (define-key map (kbd "/ m") 'package-menu-filter-marked)
- (define-key map (kbd "/ u") 'package-menu-filter-upgradable)
- map)
- "Local keymap for `package-menu-mode' buffers.")
+(defvar-keymap package-menu-mode-map
+ :doc "Local keymap for `package-menu-mode' buffers."
+ :parent tabulated-list-mode-map
+ "C-m" #'package-menu-describe-package
+ "u" #'package-menu-mark-unmark
+ "DEL" #'package-menu-backup-unmark
+ "d" #'package-menu-mark-delete
+ "i" #'package-menu-mark-install
+ "U" #'package-menu-mark-upgrades
+ "r" #'revert-buffer
+ "~" #'package-menu-mark-obsolete-for-deletion
+ "w" #'package-browse-url
+ "x" #'package-menu-execute
+ "h" #'package-menu-quick-help
+ "H" #'package-menu-hide-package
+ "?" #'package-menu-describe-package
+ "(" #'package-menu-toggle-hiding
+ "/ /" #'package-menu-clear-filter
+ "/ a" #'package-menu-filter-by-archive
+ "/ d" #'package-menu-filter-by-description
+ "/ k" #'package-menu-filter-by-keyword
+ "/ N" #'package-menu-filter-by-name-or-description
+ "/ n" #'package-menu-filter-by-name
+ "/ s" #'package-menu-filter-by-status
+ "/ v" #'package-menu-filter-by-version
+ "/ m" #'package-menu-filter-marked
+ "/ u" #'package-menu-filter-upgradable)
(easy-menu-define package-menu-mode-menu package-menu-mode-map
"Menu for `package-menu-mode'."
@@ -2868,7 +2949,13 @@ either a full name or nil, and EMAIL is a valid email address."
(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
"Major mode for browsing a list of packages.
-Letters do not insert themselves; instead, they are commands.
+The most useful commands here are:
+
+ `x': Install the package under point if it isn't already installed,
+ and delete it if it's already installed,
+ `i': mark a package for installation, and
+ `d': mark a package for deletion. Use the `x' command to perform the
+ actions on the marked files.
\\<package-menu-mode-map>
\\{package-menu-mode-map}"
:interactive nil
@@ -3432,9 +3519,6 @@ The full list of keys can be viewed with \\[describe-mode]."
(message (mapconcat #'package--prettify-quick-help-key
package--quick-help-keys "\n")))
-(define-obsolete-function-alias
- 'package-menu-view-commentary 'package-menu-describe-package "24.1")
-
(defun package-menu-get-status ()
"Return status text of package at point in Package Menu."
(package--ensure-package-menu-mode)
@@ -3473,7 +3557,7 @@ corresponding to the newer version."
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
(status (aref (cadr entry) 2)))
- (cond ((member status '("installed" "dependency" "unsigned"))
+ (cond ((member status '("installed" "dependency" "unsigned" "external"))
(push pkg-desc installed))
((member status '("available" "new"))
(setq available (package--append-to-alist pkg-desc available))))))
@@ -3530,17 +3614,34 @@ immediately."
(setq package-menu--mark-upgrades-pending t)
(message "Waiting for refresh to finish...")))
-(defun package-menu--list-to-prompt (packages)
+(defun package-menu--list-to-prompt (packages &optional include-dependencies)
"Return a string listing PACKAGES that's usable in a prompt.
PACKAGES is a list of `package-desc' objects.
Formats the returned string to be usable in a minibuffer
-prompt (see `package-menu--prompt-transaction-p')."
+prompt (see `package-menu--prompt-transaction-p').
+
+If INCLUDE-DEPENDENCIES, also include the number of uninstalled
+dependencies."
;; The case where `package' is empty is handled in
;; `package-menu--prompt-transaction-p' below.
- (format "%d (%s)"
+ (format "%d (%s)%s"
(length packages)
- (mapconcat #'package-desc-full-name packages " ")))
-
+ (mapconcat #'package-desc-full-name packages " ")
+ (let ((deps
+ (seq-remove
+ #'package-installed-p
+ (delete-dups
+ (apply
+ #'nconc
+ (mapcar (lambda (package)
+ (package--dependencies
+ (package-desc-name package)))
+ packages))))))
+ (if (and include-dependencies deps)
+ (if (length= deps 1)
+ (format " plus 1 dependency")
+ (format " plus %d dependencies" (length deps)))
+ ""))))
(defun package-menu--prompt-transaction-p (delete install upgrade)
"Prompt the user about DELETE, INSTALL, and UPGRADE.
@@ -3549,11 +3650,14 @@ Either may be nil, but not all."
(y-or-n-p
(concat
(when delete
- (format "Packages to delete: %s. " (package-menu--list-to-prompt delete)))
+ (format "Packages to delete: %s. "
+ (package-menu--list-to-prompt delete)))
(when install
- (format "Packages to install: %s. " (package-menu--list-to-prompt install)))
+ (format "Packages to install: %s. "
+ (package-menu--list-to-prompt install t)))
(when upgrade
- (format "Packages to upgrade: %s. " (package-menu--list-to-prompt upgrade)))
+ (format "Packages to upgrade: %s. "
+ (package-menu--list-to-prompt upgrade)))
"Proceed? ")))
@@ -3615,8 +3719,13 @@ packages list, respectively."
(defun package-menu-execute (&optional noquery)
"Perform marked Package Menu actions.
Packages marked for installation are downloaded and installed,
-packages marked for deletion are removed,
-and packages marked for upgrading are downloaded and upgraded.
+packages marked for deletion are removed, and packages marked for
+upgrading are downloaded and upgraded.
+
+If no packages are marked, the action taken depends on the state
+of the package under point. If it's not already installed, this
+command will install the package, and if it's installed, it will
+delete the package.
Optional argument NOQUERY non-nil means do not ask the user to confirm."
(interactive nil package-menu-mode)
@@ -3634,8 +3743,20 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
((eq cmd ?I)
(push pkg-desc install-list))))
(forward-line)))
+ ;; Nothing marked.
(unless (or delete-list install-list)
- (user-error "No operations specified"))
+ ;; Not on a package line.
+ (unless (tabulated-list-get-id)
+ (user-error "No operations specified"))
+ (let* ((id (tabulated-list-get-id))
+ (status (package-menu-get-status)))
+ (cond
+ ((member status '("installed"))
+ (push id delete-list))
+ ((member status '("available" "avail-obso" "new" "dependency"))
+ (push id install-list))
+ (t (user-error "No default action available for status: %s"
+ status)))))
(let-alist (package-menu--partition-transaction install-list delete-list)
(when (or noquery
(package-menu--prompt-transaction-p .delete .install .upgrade))
@@ -3867,16 +3988,14 @@ packages."
(mapcar #'car package-archives)))
package-menu-mode)
(package--ensure-package-menu-mode)
- (let ((re (if (listp archive)
- (regexp-opt archive)
- archive)))
- (package-menu--filter-by (lambda (pkg-desc)
- (let ((pkg-archive (package-desc-archive pkg-desc)))
- (and pkg-archive
- (string-match-p re pkg-archive))))
- (concat "archive:" (if (listp archive)
- (string-join archive ",")
- archive)))))
+ (let ((archives (ensure-list archive)))
+ (package-menu--filter-by
+ (lambda (pkg-desc)
+ (let ((pkg-archive (package-desc-archive pkg-desc)))
+ (or (null archives)
+ (and pkg-archive
+ (member pkg-archive archives)))))
+ (concat "archive:" (string-join archives ",")))))
(defun package-menu-filter-by-description (description)
"Filter the \"*Packages*\" buffer by DESCRIPTION regexp.
@@ -4096,7 +4215,9 @@ The list is displayed in a buffer named `*Packages*'."
"Return the version number of the package in which this is used.
Assumes it is used from an Elisp file placed inside the top-level directory
of an installed ELPA package.
-The return value is a string (or nil in case we can't find it)."
+The return value is a string (or nil in case we can't find it).
+It works in more cases if the call is in the file which contains
+the `Version:' header."
;; In a sense, this is a lie, but it does just what we want: precompute
;; the version at compile time and hardcodes it into the .elc file!
(declare (pure t))
@@ -4115,6 +4236,7 @@ The return value is a string (or nil in case we can't find it)."
(let* ((pkgdir (file-name-directory file))
(pkgname (file-name-nondirectory (directory-file-name pkgdir)))
(mainfile (expand-file-name (concat pkgname ".el") pkgdir)))
+ (unless (file-readable-p mainfile) (setq mainfile file))
(when (file-readable-p mainfile)
(require 'lisp-mnt)
(with-temp-buffer
@@ -4193,17 +4315,19 @@ activations need to be changed, such as when `package-load-list' is modified."
(locate-library (package--autoloads-file-name pkg))))
(pfile (prin1-to-string file)))
(insert "(let ((load-true-file-name " pfile ")\
-(load-file-name " pfile "))\n")
+\(load-file-name " pfile "))\n")
(insert-file-contents file)
;; Fixup the special #$ reader form and throw away comments.
(while (re-search-forward "#\\$\\|^;\\(.*\n\\)" nil 'move)
- (unless (nth 8 (syntax-ppss))
+ (unless (ppss-string-terminator (save-match-data (syntax-ppss)))
(replace-match (if (match-end 1) "" pfile) t t)))
(unless (bolp) (insert "\n"))
(insert ")\n")))
+ (pp `(defvar package-activated-list) (current-buffer))
(pp `(setq package-activated-list
- (append ',(mapcar #'package-desc-name package--quickstart-pkgs)
- package-activated-list))
+ (delete-dups
+ (append ',(mapcar #'package-desc-name package--quickstart-pkgs)
+ package-activated-list)))
(current-buffer))
(let ((info-dirs (butlast Info-directory-list)))
(when info-dirs
@@ -4218,6 +4342,7 @@ activations need to be changed, such as when `package-load-list' is modified."
;; Local\sVariables:
;; version-control: never
;; no-update-autoloads: t
+;; byte-compile-warnings: (not make-local)
;; End:
"))
;; FIXME: Do it asynchronously in an Emacs subprocess, and
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 7a82b416e55..07443dabfef 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -328,7 +328,7 @@ PATTERNS are normal `pcase' patterns, and VALUES are expression.
Evaluation happens sequentially as in `setq' (not in parallel).
-An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)]))
+An example: (pcase-setq \\=`((,a) [(,b)]) \\='((1) [(2)]))
VAL is presumed to match PAT. Failure to match may signal an error or go
undetected, binding variables to arbitrary values, such as nil.
@@ -435,7 +435,7 @@ how many time this CODEGEN is called."
(macroexp-warn-and-return
(format "pcase pattern %S shadowed by previous pcase pattern"
(car case))
- main))))
+ main nil nil (car case)))))
main)))
(defun pcase--expand (exp cases)
@@ -941,7 +941,7 @@ Otherwise, it defers to REST which is a list of branches of the form
(if (eq upat '_) code
(macroexp-warn-and-return
"Pattern t is deprecated. Use `_' instead"
- code))))
+ code nil nil upat))))
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
(if (eq (car upat) 'pred) (pcase--mark-used sym))
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 9a48c7f908e..a3ff2ecbaa6 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -24,6 +24,7 @@
;;; Code:
+(require 'cl-lib)
(defvar font-lock-verbose)
(defgroup pp nil
@@ -33,22 +34,43 @@
(defcustom pp-escape-newlines t
"Value of `print-escape-newlines' used by pp-* functions."
+ :type 'boolean)
+
+(defcustom pp-max-width t
+ "Max width to use when formatting.
+If nil, there's no max width. If t, use the window width.
+Otherwise this should be a number."
+ :type '(choice (const :tag "none" nil)
+ (const :tag "window width" t)
+ number)
+ :version "29.1")
+
+(defcustom pp-use-max-width nil
+ "If non-nil, `pp'-related functions will try to fold lines.
+The target width is given by the `pp-max-width' variable."
:type 'boolean
- :group 'pp)
+ :version "29.1")
+
+(defvar pp--inhibit-function-formatting nil)
;;;###autoload
(defun pp-to-string (object)
"Return a string containing the pretty-printed representation of OBJECT.
OBJECT can be any Lisp object. Quoting characters are used as needed
to make output that `read' can handle, whenever this is possible."
- (with-temp-buffer
- (lisp-mode-variables nil)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (let ((print-escape-newlines pp-escape-newlines)
- (print-quoted t))
- (prin1 object (current-buffer)))
- (pp-buffer)
- (buffer-string)))
+ (if pp-use-max-width
+ (let ((pp--inhibit-function-formatting t))
+ (with-temp-buffer
+ (pp-emacs-lisp-code object)
+ (buffer-string)))
+ (with-temp-buffer
+ (lisp-mode-variables nil)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (let ((print-escape-newlines pp-escape-newlines)
+ (print-quoted t))
+ (prin1 object (current-buffer)))
+ (pp-buffer)
+ (buffer-string))))
;;;###autoload
(defun pp-buffer ()
@@ -56,7 +78,6 @@ to make output that `read' can handle, whenever this is possible."
(interactive)
(goto-char (point-min))
(while (not (eobp))
- ;; (message "%06d" (- (point-max) (point)))
(cond
((ignore-errors (down-list 1) t)
(save-excursion
@@ -82,11 +103,21 @@ to make output that `read' can handle, whenever this is possible."
"Output the pretty-printed representation of OBJECT, any Lisp object.
Quoting characters are printed as needed to make output that `read'
can handle, whenever this is possible.
+
+This function does not apply special formatting rules for Emacs
+Lisp code. See `pp-emacs-lisp-code' instead.
+
+By default, this function won't limit the line length of lists
+and vectors. Bind `pp-use-max-width' to a non-nil value to do so.
+
Output stream is STREAM, or value of `standard-output' (which see)."
(princ (pp-to-string object) (or stream standard-output)))
-(defun pp-display-expression (expression out-buffer-name)
+;;;###autoload
+(defun pp-display-expression (expression out-buffer-name &optional lisp)
"Prettify and display EXPRESSION in an appropriate way, depending on length.
+If LISP, format with `pp-emacs-lisp-code'; use `pp' otherwise.
+
If a temporary buffer is needed for representation, it will be named
after OUT-BUFFER-NAME."
(let* ((old-show-function temp-buffer-show-function)
@@ -110,11 +141,13 @@ after OUT-BUFFER-NAME."
(select-window window)
(run-hooks 'temp-buffer-show-hook))
(when (window-live-p old-selected)
- (select-window old-selected))
- (message "See buffer %s." out-buffer-name)))
+ (select-window old-selected))))
(message "%s" (buffer-substring (point-min) (point))))))))
(with-output-to-temp-buffer out-buffer-name
- (pp expression)
+ (if lisp
+ (with-current-buffer standard-output
+ (pp-emacs-lisp-code expression))
+ (pp expression))
(with-current-buffer standard-output
(emacs-lisp-mode)
(setq buffer-read-only nil)
@@ -144,6 +177,10 @@ Also add the value to the front of the list in the variable `values'."
(let ((pt (point)))
(save-excursion
(forward-sexp -1)
+ ;; Make `pp-eval-last-sexp' work the same way `eval-last-sexp'
+ ;; does.
+ (when (looking-at ",@?")
+ (goto-char (match-end 0)))
(read
;; If first line is commented, ignore all leading comments:
(if (save-excursion (beginning-of-line) (looking-at-p "[ \t]*;"))
@@ -179,6 +216,192 @@ Ignores leading comment characters."
(insert (pp-to-string (macroexpand-1 (pp-last-sexp))))
(pp-macroexpand-expression (pp-last-sexp))))
+;;;###autoload
+(defun pp-emacs-lisp-code (sexp)
+ "Insert SEXP into the current buffer, formatted as Emacs Lisp code.
+Use the `pp-max-width' variable to control the desired line length."
+ (require 'edebug)
+ (let ((obuf (current-buffer)))
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (pp--insert-lisp sexp)
+ (insert "\n")
+ (goto-char (point-min))
+ (indent-sexp)
+ (while (re-search-forward " +$" nil t)
+ (replace-match ""))
+ (insert-into-buffer obuf))))
+
+(defun pp--insert-lisp (sexp)
+ (cl-case (type-of sexp)
+ (vector (pp--format-vector sexp))
+ (cons (cond
+ ((consp (cdr sexp))
+ (if (and (length= sexp 2)
+ (memq (car sexp) '(quote function)))
+ (cond
+ ((symbolp (cadr sexp))
+ (let ((print-quoted t))
+ (prin1 sexp (current-buffer))))
+ ((consp (cadr sexp))
+ (insert (if (eq (car sexp) 'quote)
+ "'" "#'"))
+ (pp--format-list (cadr sexp)
+ (set-marker (make-marker) (1- (point))))))
+ (pp--format-list sexp)))
+ (t
+ (prin1 sexp (current-buffer)))))
+ ;; Print some of the smaller integers as characters, perhaps?
+ (integer
+ (if (<= ?0 sexp ?z)
+ (let ((print-integers-as-characters t))
+ (princ sexp (current-buffer)))
+ (princ sexp (current-buffer))))
+ (string
+ (let ((print-escape-newlines t))
+ (prin1 sexp (current-buffer))))
+ (otherwise (princ sexp (current-buffer)))))
+
+(defun pp--format-vector (sexp)
+ (insert "[")
+ (cl-loop for i from 0
+ for element across sexp
+ do (pp--insert (and (> i 0) " ") element))
+ (insert "]"))
+
+(defun pp--format-list (sexp &optional start)
+ (if (and (symbolp (car sexp))
+ (not pp--inhibit-function-formatting)
+ (not (keywordp (car sexp))))
+ (pp--format-function sexp)
+ (insert "(")
+ (pp--insert start (pop sexp))
+ (while sexp
+ (if (consp sexp)
+ (pp--insert " " (pop sexp))
+ (pp--insert " . " sexp)
+ (setq sexp nil)))
+ (insert ")")))
+
+(defun pp--format-function (sexp)
+ (let* ((sym (car sexp))
+ (edebug (get sym 'edebug-form-spec))
+ (indent (get sym 'lisp-indent-function))
+ (doc (get sym 'doc-string-elt)))
+ (when (eq indent 'defun)
+ (setq indent 2))
+ ;; We probably want to keep all the elements before the doc string
+ ;; on a single line.
+ (when doc
+ (setq indent (1- doc)))
+ ;; Special-case closures -- these shouldn't really exist in actual
+ ;; source code, so there's no indentation information. But make
+ ;; them output slightly better.
+ (when (and (not indent)
+ (eq sym 'closure))
+ (setq indent 0))
+ (pp--insert "(" sym)
+ (pop sexp)
+ ;; Get the first entries on the first line.
+ (if indent
+ (pp--format-definition sexp indent edebug)
+ (let ((prev 0))
+ (while sexp
+ (let ((start (point)))
+ ;; Don't put sexps on the same line as a multi-line sexp
+ ;; preceding it.
+ (pp--insert (if (> prev 1) "\n" " ")
+ (pop sexp))
+ (setq prev (count-lines start (point)))))))
+ (insert ")")))
+
+(defun pp--format-definition (sexp indent edebug)
+ (while (and (cl-plusp indent)
+ sexp)
+ (insert " ")
+ ;; We don't understand all the edebug specs.
+ (unless (consp edebug)
+ (setq edebug nil))
+ (if (and (consp (car edebug))
+ (eq (caar edebug) '&rest))
+ (pp--insert-binding (pop sexp))
+ (if (null (car sexp))
+ (insert "()")
+ (pp--insert-lisp (car sexp)))
+ (pop sexp))
+ (pop edebug)
+ (cl-decf indent))
+ (when (stringp (car sexp))
+ (insert "\n")
+ (prin1 (pop sexp) (current-buffer)))
+ ;; Then insert the rest with line breaks before each form.
+ (while sexp
+ (insert "\n")
+ (if (keywordp (car sexp))
+ (progn
+ (pp--insert-lisp (pop sexp))
+ (when sexp
+ (pp--insert " " (pop sexp))))
+ (pp--insert-lisp (pop sexp)))))
+
+(defun pp--insert-binding (sexp)
+ (insert "(")
+ (while sexp
+ (if (consp (car sexp))
+ ;; Newlines after each (...) binding.
+ (progn
+ (pp--insert-lisp (car sexp))
+ (when (cdr sexp)
+ (insert "\n")))
+ ;; Keep plain symbols on the same line.
+ (pp--insert " " (car sexp)))
+ (pop sexp))
+ (insert ")"))
+
+(defun pp--insert (delim &rest things)
+ (let ((start (if (markerp delim)
+ (prog1
+ delim
+ (setq delim nil))
+ (point-marker))))
+ (when delim
+ (insert delim))
+ (dolist (thing things)
+ (pp--insert-lisp thing))
+ ;; We need to indent what we have so far to see if we have to fold.
+ (pp--indent-buffer)
+ (when (> (current-column) (pp--max-width))
+ (save-excursion
+ (goto-char start)
+ (unless (looking-at "[ \t]+$")
+ (insert "\n"))
+ (pp--indent-buffer)
+ (goto-char (point-max))
+ ;; If we're still too wide, then go up one step and try to
+ ;; insert a newline there.
+ (when (> (current-column) (pp--max-width))
+ (condition-case ()
+ (backward-up-list 1)
+ (:success (when (and (not (bobp)) (looking-back " " 2))
+ (insert "\n")))
+ (error nil)))))))
+
+(defun pp--max-width ()
+ (cond ((numberp pp-max-width)
+ pp-max-width)
+ ((null pp-max-width)
+ most-positive-fixnum)
+ ((eq pp-max-width t)
+ (window-width))
+ (t
+ (error "Invalid pp-max-width value: %s" pp-max-width))))
+
+(defun pp--indent-buffer ()
+ (goto-char (point-min))
+ (while (not (eobp))
+ (lisp-indent-line)
+ (forward-line 1)))
+
(provide 'pp) ; so (require 'pp) works
;;; pp.el ends here
diff --git a/lisp/emacs-lisp/range.el b/lisp/emacs-lisp/range.el
new file mode 100644
index 00000000000..38c2866cd4c
--- /dev/null
+++ b/lisp/emacs-lisp/range.el
@@ -0,0 +1,467 @@
+;;; ranges.el --- range functions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A "range" is a list that represents a list of integers. A range is
+;; a list containing cons cells of start/end pairs, as well as integers.
+;;
+;; ((2 . 5) 9 (11 . 13))
+;;
+;; represents the list (2 3 4 5 9 11 12 13).
+
+;;; Code:
+
+(defun range-normalize (range)
+ "Normalize RANGE.
+If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
+ (if (listp (cdr-safe range))
+ range
+ (list range)))
+
+(defun range-denormalize (range)
+ "If RANGE contains a single range, then return that.
+If not, return RANGE as is."
+ (if (and (consp (car range))
+ (length= range 1))
+ (car range)
+ range))
+
+(defun range-difference (range1 range2)
+ "Return the range of elements in RANGE1 that do not appear in RANGE2.
+Both ranges must be in ascending order."
+ (setq range1 (range-normalize range1))
+ (setq range2 (range-normalize range2))
+ (let* ((new-range (cons nil (copy-sequence range1)))
+ (r new-range))
+ (while (cdr r)
+ (let* ((r1 (cadr r))
+ (r2 (car range2))
+ (min1 (if (numberp r1) r1 (car r1)))
+ (max1 (if (numberp r1) r1 (cdr r1)))
+ (min2 (if (numberp r2) r2 (car r2)))
+ (max2 (if (numberp r2) r2 (cdr r2))))
+
+ (cond ((> min1 max1)
+ ;; Invalid range: may result from overlap condition (below)
+ ;; remove Invalid range
+ (setcdr r (cddr r)))
+ ((and (= min1 max1)
+ (listp r1))
+ ;; Inefficient representation: may result from overlap
+ ;; condition (below)
+ (setcar (cdr r) min1))
+ ((not min2)
+ ;; All done with range2
+ (setq r nil))
+ ((< max1 min2)
+ ;; No overlap: range1 precedes range2
+ (pop r))
+ ((< max2 min1)
+ ;; No overlap: range2 precedes range1
+ (pop range2))
+ ((and (<= min2 min1) (<= max1 max2))
+ ;; Complete overlap: range1 removed
+ (setcdr r (cddr r)))
+ (t
+ (setcdr r (nconc (list (cons min1 (1- min2))
+ (cons (1+ max2) max1))
+ (cddr r)))))))
+ (cdr new-range)))
+
+(defun range-intersection (range1 range2)
+ "Return intersection of RANGE1 and RANGE2."
+ (let* (out
+ (min1 (car range1))
+ (max1 (if (numberp min1)
+ (if (numberp (cdr range1))
+ (prog1 (cdr range1)
+ (setq range1 nil)) min1)
+ (prog1 (cdr min1)
+ (setq min1 (car min1)))))
+ (min2 (car range2))
+ (max2 (if (numberp min2)
+ (if (numberp (cdr range2))
+ (prog1 (cdr range2)
+ (setq range2 nil)) min2)
+ (prog1 (cdr min2)
+ (setq min2 (car min2))))))
+ (setq range1 (cdr range1)
+ range2 (cdr range2))
+ (while (and min1 min2)
+ (cond ((< max1 min2) ; range1 precedes range2
+ (setq range1 (cdr range1)
+ min1 nil))
+ ((< max2 min1) ; range2 precedes range1
+ (setq range2 (cdr range2)
+ min2 nil))
+ (t ; some sort of overlap is occurring
+ (let ((min (max min1 min2))
+ (max (min max1 max2)))
+ (setq out (if (= min max)
+ (cons min out)
+ (cons (cons min max) out))))
+ (if (< max1 max2) ; range1 ends before range2
+ (setq min1 nil) ; incr range1
+ (setq min2 nil)))) ; incr range2
+ (unless min1
+ (setq min1 (car range1)
+ max1 (if (numberp min1) min1
+ (prog1 (cdr min1) (setq min1 (car min1))))
+ range1 (cdr range1)))
+ (unless min2
+ (setq min2 (car range2)
+ max2 (if (numberp min2) min2
+ (prog1 (cdr min2) (setq min2 (car min2))))
+ range2 (cdr range2))))
+ (cond ((cdr out)
+ (nreverse out))
+ ((numberp (car out))
+ out)
+ (t
+ (car out)))))
+
+(defun range-compress-list (numbers)
+ "Convert a sorted list of numbers to a range list."
+ (let ((first (car numbers))
+ (last (car numbers))
+ result)
+ (cond
+ ((null numbers)
+ nil)
+ ((not (listp (cdr numbers)))
+ numbers)
+ (t
+ (while numbers
+ (cond ((= last (car numbers)) nil) ;Omit duplicated number
+ ((= (1+ last) (car numbers)) ;Still in sequence
+ (setq last (car numbers)))
+ (t ;End of one sequence
+ (setq result
+ (cons (if (= first last) first
+ (cons first last))
+ result))
+ (setq first (car numbers))
+ (setq last (car numbers))))
+ (setq numbers (cdr numbers)))
+ (nreverse (cons (if (= first last) first (cons first last))
+ result))))))
+
+(defun range-uncompress (ranges)
+ "Expand a list of ranges into a list of numbers.
+RANGES is either a single range on the form `(num . num)' or a list of
+these ranges."
+ (let (first last result)
+ (cond
+ ((null ranges)
+ nil)
+ ((not (listp (cdr ranges)))
+ (setq first (car ranges))
+ (setq last (cdr ranges))
+ (while (<= first last)
+ (setq result (cons first result))
+ (setq first (1+ first)))
+ (nreverse result))
+ (t
+ (while ranges
+ (if (atom (car ranges))
+ (when (numberp (car ranges))
+ (setq result (cons (car ranges) result)))
+ (setq first (caar ranges))
+ (setq last (cdar ranges))
+ (while (<= first last)
+ (setq result (cons first result))
+ (setq first (1+ first))))
+ (setq ranges (cdr ranges)))
+ (nreverse result)))))
+
+(defun range-add-list (ranges list)
+ "Return a list of ranges that has all articles from both RANGES and LIST.
+Note: LIST has to be sorted over `<'."
+ (if (not ranges)
+ (range-compress-list list)
+ (setq list (copy-sequence list))
+ (unless (listp (cdr ranges))
+ (setq ranges (list ranges)))
+ (let ((out ranges)
+ ilist lowest highest temp)
+ (while (and ranges list)
+ (setq ilist list)
+ (setq lowest (or (and (atom (car ranges)) (car ranges))
+ (caar ranges)))
+ (while (and list (cdr list) (< (cadr list) lowest))
+ (setq list (cdr list)))
+ (when (< (car ilist) lowest)
+ (setq temp list)
+ (setq list (cdr list))
+ (setcdr temp nil)
+ (setq out (nconc (range-compress-list ilist) out)))
+ (setq highest (or (and (atom (car ranges)) (car ranges))
+ (cdar ranges)))
+ (while (and list (<= (car list) highest))
+ (setq list (cdr list)))
+ (setq ranges (cdr ranges)))
+ (when list
+ (setq out (nconc (range-compress-list list) out)))
+ (setq out (sort out (lambda (r1 r2)
+ (< (or (and (atom r1) r1) (car r1))
+ (or (and (atom r2) r2) (car r2))))))
+ (setq ranges out)
+ (while ranges
+ (if (atom (car ranges))
+ (when (cdr ranges)
+ (if (atom (cadr ranges))
+ (when (= (1+ (car ranges)) (cadr ranges))
+ (setcar ranges (cons (car ranges)
+ (cadr ranges)))
+ (setcdr ranges (cddr ranges)))
+ (when (= (1+ (car ranges)) (caadr ranges))
+ (setcar (cadr ranges) (car ranges))
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges)))))
+ (when (cdr ranges)
+ (if (atom (cadr ranges))
+ (when (= (1+ (cdar ranges)) (cadr ranges))
+ (setcdr (car ranges) (cadr ranges))
+ (setcdr ranges (cddr ranges)))
+ (when (= (1+ (cdar ranges)) (caadr ranges))
+ (setcdr (car ranges) (cdadr ranges))
+ (setcdr ranges (cddr ranges))))))
+ (setq ranges (cdr ranges)))
+ out)))
+
+(defun range-remove (range1 range2)
+ "Return a range that has all articles from RANGE2 removed from RANGE1.
+The returned range is always a list. RANGE2 can also be a unsorted
+list of articles. RANGE1 is modified by side effects, RANGE2 is not
+modified."
+ (if (or (null range1) (null range2))
+ range1
+ (let (out r1 r2 r1-min r1-max r2-min r2-max
+ (range2 (copy-tree range2)))
+ (setq range1 (if (listp (cdr range1)) range1 (list range1))
+ range2 (sort (if (listp (cdr range2)) range2 (list range2))
+ (lambda (e1 e2)
+ (< (if (consp e1) (car e1) e1)
+ (if (consp e2) (car e2) e2))))
+ r1 (car range1)
+ r2 (car range2)
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)
+ r2-min (if (consp r2) (car r2) r2)
+ r2-max (if (consp r2) (cdr r2) r2))
+ (while (and range1 range2)
+ (cond ((< r2-max r1-min) ; r2 < r1
+ (pop range2)
+ (setq r2 (car range2)
+ r2-min (if (consp r2) (car r2) r2)
+ r2-max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r2-min r1-min) (<= r1-max r2-max)) ; r2 overlap r1
+ (pop range1)
+ (setq r1 (car range1)
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)))
+ ((and (<= r2-min r1-min) (<= r2-max r1-max)) ; r2 overlap min r1
+ (pop range2)
+ (setq r1-min (1+ r2-max)
+ r2 (car range2)
+ r2-min (if (consp r2) (car r2) r2)
+ r2-max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r1-min r2-min) (<= r2-max r1-max)) ; r2 contained in r1
+ (if (eq r1-min (1- r2-min))
+ (push r1-min out)
+ (push (cons r1-min (1- r2-min)) out))
+ (pop range2)
+ (if (< r2-max r1-max) ; finished with r1?
+ (setq r1-min (1+ r2-max))
+ (pop range1)
+ (setq r1 (car range1)
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)))
+ (setq r2 (car range2)
+ r2-min (if (consp r2) (car r2) r2)
+ r2-max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r2-min r1-max) (<= r1-max r2-max)) ; r2 overlap max r1
+ (if (eq r1-min (1- r2-min))
+ (push r1-min out)
+ (push (cons r1-min (1- r2-min)) out))
+ (pop range1)
+ (setq r1 (car range1)
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)))
+ ((< r1-max r2-min) ; r2 > r1
+ (pop range1)
+ (if (eq r1-min r1-max)
+ (push r1-min out)
+ (push (cons r1-min r1-max) out))
+ (setq r1 (car range1)
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)))))
+ (when r1
+ (if (eq r1-min r1-max)
+ (push r1-min out)
+ (push (cons r1-min r1-max) out))
+ (pop range1))
+ (while range1
+ (push (pop range1) out))
+ (nreverse out))))
+
+(defun range-member-p (number ranges)
+ "Say whether NUMBER is in RANGES."
+ (if (not (listp (cdr ranges)))
+ (and (>= number (car ranges))
+ (<= number (cdr ranges)))
+ (let ((not-stop t))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (>= number (car ranges))
+ (>= number (caar ranges)))
+ not-stop)
+ (when (if (numberp (car ranges))
+ (= number (car ranges))
+ (and (>= number (caar ranges))
+ (<= number (cdar ranges))))
+ (setq not-stop nil))
+ (setq ranges (cdr ranges)))
+ (not not-stop))))
+
+(defun range-list-intersection (list ranges)
+ "Return a list of numbers in LIST that are members of RANGES.
+oLIST is a sorted list."
+ (setq ranges (range-normalize ranges))
+ (let (number result)
+ (while (setq number (pop list))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (< (car ranges) number)
+ (< (cdar ranges) number)))
+ (setq ranges (cdr ranges)))
+ (when (and ranges
+ (if (numberp (car ranges))
+ (= (car ranges) number)
+ ;; (caar ranges) <= number <= (cdar ranges)
+ (>= number (caar ranges))))
+ (push number result)))
+ (nreverse result)))
+
+(defun range-list-difference (list ranges)
+ "Return a list of numbers in LIST that are not members of RANGES.
+LIST is a sorted list."
+ (setq ranges (range-normalize ranges))
+ (let (number result)
+ (while (setq number (pop list))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (< (car ranges) number)
+ (< (cdar ranges) number)))
+ (setq ranges (cdr ranges)))
+ (when (or (not ranges)
+ (if (numberp (car ranges))
+ (not (= (car ranges) number))
+ ;; not ((caar ranges) <= number <= (cdar ranges))
+ (< number (caar ranges))))
+ (push number result)))
+ (nreverse result)))
+
+(defun range-length (range)
+ "Return the length RANGE would have if uncompressed."
+ (cond
+ ((null range)
+ 0)
+ ((not (listp (cdr range)))
+ (- (cdr range) (car range) -1))
+ (t
+ (let ((sum 0))
+ (dolist (x range sum)
+ (setq sum
+ (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
+
+(defun range-concat (range1 range2)
+ "Add RANGE2 to RANGE1 (nondestructively)."
+ (unless (listp (cdr range1))
+ (setq range1 (list range1)))
+ (unless (listp (cdr range2))
+ (setq range2 (list range2)))
+ (let ((item1 (pop range1))
+ (item2 (pop range2))
+ range item selector)
+ (while (or item1 item2)
+ (setq selector
+ (cond
+ ((null item1) nil)
+ ((null item2) t)
+ ((and (numberp item1) (numberp item2)) (< item1 item2))
+ ((numberp item1) (< item1 (car item2)))
+ ((numberp item2) (< (car item1) item2))
+ (t (< (car item1) (car item2)))))
+ (setq item
+ (or
+ (let ((tmp1 item) (tmp2 (if selector item1 item2)))
+ (cond
+ ((null tmp1) tmp2)
+ ((null tmp2) tmp1)
+ ((and (numberp tmp1) (numberp tmp2))
+ (cond
+ ((eq tmp1 tmp2) tmp1)
+ ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
+ ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
+ (t nil)))
+ ((numberp tmp1)
+ (cond
+ ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2)
+ ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2)))
+ ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1))
+ (t nil)))
+ ((numberp tmp2)
+ (cond
+ ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1)
+ ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1)))
+ ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2))
+ (t nil)))
+ ((< (1+ (cdr tmp1)) (car tmp2)) nil)
+ ((< (1+ (cdr tmp2)) (car tmp1)) nil)
+ (t (cons (min (car tmp1) (car tmp2))
+ (max (cdr tmp1) (cdr tmp2))))))
+ (progn
+ (if item (push item range))
+ (if selector item1 item2))))
+ (if selector
+ (setq item1 (pop range1))
+ (setq item2 (pop range2))))
+ (if item (push item range))
+ (reverse range)))
+
+(defun range-map (func range)
+ "Apply FUNC to each value contained by RANGE."
+ (setq range (range-normalize range))
+ (while range
+ (let ((span (pop range)))
+ (if (numberp span)
+ (funcall func span)
+ (let ((first (car span))
+ (last (cdr span)))
+ (while (<= first last)
+ (funcall func first)
+ (setq first (1+ first))))))))
+
+(provide 'range)
+
+;;; range.el ends here
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index d460407a803..46b429ce6fe 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -216,19 +216,17 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
"Buffer to use for the RE Builder.")
;; Define the local "\C-c" keymap
-(defvar reb-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'reb-toggle-case)
- (define-key map "\C-c\C-q" 'reb-quit)
- (define-key map "\C-c\C-w" 'reb-copy)
- (define-key map "\C-c\C-s" 'reb-next-match)
- (define-key map "\C-c\C-r" 'reb-prev-match)
- (define-key map "\C-c\C-i" 'reb-change-syntax)
- (define-key map "\C-c\C-e" 'reb-enter-subexp-mode)
- (define-key map "\C-c\C-b" 'reb-change-target-buffer)
- (define-key map "\C-c\C-u" 'reb-force-update)
- map)
- "Keymap used by the RE Builder.")
+(defvar-keymap reb-mode-map
+ :doc "Keymap used by the RE Builder."
+ "C-c C-c" #'reb-toggle-case
+ "C-c C-q" #'reb-quit
+ "C-c C-w" #'reb-copy
+ "C-c C-s" #'reb-next-match
+ "C-c C-r" #'reb-prev-match
+ "C-c C-i" #'reb-change-syntax
+ "C-c C-e" #'reb-enter-subexp-mode
+ "C-c C-b" #'reb-change-target-buffer
+ "C-c C-u" #'reb-force-update)
(easy-menu-define reb-mode-menu reb-mode-map
"Menu for the RE Builder."
@@ -263,31 +261,35 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(setq-local blink-matching-paren nil)
(reb-mode-common))
-(defvar reb-lisp-mode-map
- (let ((map (make-sparse-keymap)))
- ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from
- ;; `emacs-lisp-mode'
- (define-key map "\C-c" (lookup-key reb-mode-map "\C-c"))
- map))
+(defvar-keymap reb-lisp-mode-map
+ ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from
+ ;; `emacs-lisp-mode'
+ "C-c" (keymap-lookup reb-mode-map "C-c"))
(define-derived-mode reb-lisp-mode
emacs-lisp-mode "RE Builder Lisp"
"Major mode for interactively building symbolic Regular Expressions."
;; Pull in packages as needed
- (cond ((memq reb-re-syntax '(sregex rx)) ; rx-to-string is autoloaded
- (require 'rx))) ; require rx anyway
+ (when (eq reb-re-syntax 'rx) ; rx-to-string is autoloaded
+ (require 'rx)) ; require rx anyway
(reb-mode-common))
-(defvar reb-subexp-mode-map
- (let ((m (make-keymap)))
- (suppress-keymap m)
- ;; Again share the "\C-c" keymap for the commands
- (define-key m "\C-c" (lookup-key reb-mode-map "\C-c"))
- (define-key m "q" 'reb-quit-subexp-mode)
- (dotimes (digit 10)
- (define-key m (int-to-string digit) 'reb-display-subexp))
- m)
- "Keymap used by the RE Builder for the subexpression mode.")
+(defvar-keymap reb-subexp-mode-map
+ :doc "Keymap used by the RE Builder for the subexpression mode."
+ :full t :suppress t
+ ;; Again share the "\C-c" keymap for the commands
+ "C-c" (keymap-lookup reb-mode-map "C-c")
+ "q" #'reb-quit-subexp-mode
+ "0" #'reb-display-subexp
+ "1" #'reb-display-subexp
+ "2" #'reb-display-subexp
+ "3" #'reb-display-subexp
+ "4" #'reb-display-subexp
+ "5" #'reb-display-subexp
+ "6" #'reb-display-subexp
+ "7" #'reb-display-subexp
+ "8" #'reb-display-subexp
+ "9" #'reb-display-subexp)
(defun reb-mode-common ()
"Setup functions common to functions `reb-mode' and `reb-lisp-mode'."
@@ -307,8 +309,8 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(eq 'color (frame-parameter nil 'display-type)))
(defsubst reb-lisp-syntax-p ()
- "Return non-nil if RE Builder uses a Lisp syntax."
- (memq reb-re-syntax '(sregex rx)))
+ "Return non-nil if RE Builder uses `rx' syntax."
+ (eq reb-re-syntax 'rx))
(defmacro reb-target-binding (symbol)
"Return binding for SYMBOL in the RE Builder target buffer."
@@ -323,7 +325,10 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(reb-lisp-mode))
(t (reb-mode)))
(reb-restart-font-lock)
- (reb-do-update))
+ ;; When using `rx' syntax, the initial syntax () is invalid. But
+ ;; don't signal an error in that case.
+ (ignore-errors
+ (reb-do-update)))
(defun reb-mode-buffer-p ()
"Return non-nil if the current buffer is a RE Builder buffer."
@@ -448,7 +453,8 @@ provided in the Commentary section of this library."
(setq reb-subexp-mode t)
(reb-update-modestring)
(use-local-map reb-subexp-mode-map)
- (message "`0'-`9' to display subexpressions `q' to quit subexp mode"))
+ (message (substitute-command-keys
+ "\\`0'-\\`9' to display subexpressions \\`q' to quit subexp mode")))
(defun reb-show-subexp (subexp &optional pause)
"Visually show limit of subexpression SUBEXP of recent search.
@@ -482,11 +488,11 @@ Optional argument SYNTAX must be specified if called non-interactively."
(list (intern
(completing-read
(format-prompt "Select syntax" reb-re-syntax)
- '(read string sregex rx)
+ '(read string rx)
nil t nil nil (symbol-name reb-re-syntax)
'reb-change-syntax-hist))))
- (if (memq syntax '(read string sregex rx))
+ (if (memq syntax '(read string rx))
(let ((buffer (get-buffer reb-buffer)))
(setq reb-re-syntax syntax)
(when buffer
@@ -605,9 +611,9 @@ optional fourth argument FORCE is non-nil."
(defun reb-cook-regexp (re)
"Return RE after processing it according to `reb-re-syntax'."
- (cond ((memq reb-re-syntax '(sregex rx))
- (rx-to-string (eval (car (read-from-string re)))))
- (t re)))
+ (if (eq reb-re-syntax 'rx)
+ (rx-to-string (eval (car (read-from-string re))))
+ re))
(defun reb-update-regexp ()
"Update the regexp for the target buffer.
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index df0fc339e6d..dae6590b9bc 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -23,10 +23,108 @@
;;; Code:
-(require 'seq)
+(defun rmc--add-key-description (elem)
+ (let* ((char (car elem))
+ (name (cadr elem))
+ (pos (seq-position name char))
+ (desc (key-description (char-to-string char)))
+ (graphical-terminal
+ (display-supports-face-attributes-p
+ '(:underline t) (window-frame)))
+ (altered-name
+ (cond
+ ;; Not in the name string, or a special character.
+ ((or (not pos)
+ (member desc '("ESC" "TAB" "RET" "DEL" "SPC")))
+ (format "%s %s"
+ (if graphical-terminal
+ (propertize desc 'face 'read-multiple-choice-face)
+ (propertize desc 'face 'help-key-binding))
+ name))
+ ;; The prompt character is in the name, so highlight
+ ;; it on graphical terminals.
+ (graphical-terminal
+ (setq name (copy-sequence name))
+ (put-text-property pos (1+ pos)
+ 'face 'read-multiple-choice-face
+ name)
+ name)
+ ;; And put it in [bracket] on non-graphical terminals.
+ (t
+ (concat
+ (substring name 0 pos)
+ "["
+ (upcase (substring name pos (1+ pos)))
+ "]"
+ (substring name (1+ pos)))))))
+ (cons char altered-name)))
+
+(defun rmc--show-help (prompt help-string show-help choices altered-names)
+ (let* ((buf-name (if (stringp show-help)
+ show-help
+ "*Multiple Choice Help*"))
+ (buf (get-buffer-create buf-name)))
+ (if (stringp help-string)
+ (with-help-window buf
+ (with-current-buffer buf
+ (insert help-string)))
+ (with-help-window buf
+ (with-current-buffer buf
+ (erase-buffer)
+ (pop-to-buffer buf)
+ (insert prompt "\n\n")
+ (let* ((columns (/ (window-width) 25))
+ (fill-column 21)
+ (times 0)
+ (start (point)))
+ (dolist (elem choices)
+ (goto-char start)
+ (unless (zerop times)
+ (if (zerop (mod times columns))
+ ;; Go to the next "line".
+ (goto-char (setq start (point-max)))
+ ;; Add padding.
+ (while (not (eobp))
+ (end-of-line)
+ (insert (make-string (max (- (* (mod times columns)
+ (+ fill-column 4))
+ (current-column))
+ 0)
+ ?\s))
+ (forward-line 1))))
+ (setq times (1+ times))
+ (let ((text
+ (with-temp-buffer
+ (insert (format
+ "%c: %s\n"
+ (car elem)
+ (cdr (assq (car elem) altered-names))))
+ (fill-region (point-min) (point-max))
+ (when (nth 2 elem)
+ (let ((start (point)))
+ (insert (nth 2 elem))
+ (unless (bolp)
+ (insert "\n"))
+ (fill-region start (point-max))))
+ (buffer-string))))
+ (goto-char start)
+ (dolist (line (split-string text "\n"))
+ (end-of-line)
+ (if (not (bolp))
+ (insert line)
+ (insert (make-string
+ (max (- (* (mod (1- times) columns)
+ (+ fill-column 4))
+ (current-column))
+ 0)
+ ?\s))
+ (insert line "\n"))
+ (forward-line 1))))))))
+ buf))
;;;###autoload
-(defun read-multiple-choice (prompt choices &optional help-string)
+(defun read-multiple-choice (prompt choices &optional help-string show-help
+ long-form)
"Ask user to select an entry from CHOICES, promting with PROMPT.
This function allows to ask the user a multiple-choice question.
@@ -42,6 +140,9 @@ the optional argument HELP-STRING. This argument is a string that
should contain a more detailed description of all of the possible
choices. `read-multiple-choice' will display that description in a
help buffer if the user requests that.
+If optional argument SHOW-HELP is non-nil, show the help screen
+immediately, before any user input. If SHOW-HELP is a string,
+use it as the name of the help buffer.
This function translates user input into responses by consulting
the bindings in `query-replace-map'; see the documentation of
@@ -61,51 +162,35 @@ dialogs. Otherwise, the function will always use text-mode dialogs.
The return value is the matching entry from the CHOICES list.
+If LONG-FORM, do a `completing-read' over the NAME elements in
+CHOICES instead.
+
Usage example:
\(read-multiple-choice \"Continue connecting?\"
\\='((?a \"always\")
(?s \"session only\")
(?n \"no\")))"
- (let* ((altered-names nil)
+ (if long-form
+ (read-multiple-choice--long-answers prompt choices)
+ (read-multiple-choice--short-answers
+ prompt choices help-string show-help)))
+
+(defun read-multiple-choice--short-answers (prompt choices help-string show-help)
+ (let* ((prompt-choices
+ (if show-help choices (append choices '((?? "?")))))
+ (altered-names (mapcar #'rmc--add-key-description prompt-choices))
(full-prompt
(format
"%s (%s): "
prompt
- (mapconcat
- (lambda (elem)
- (let* ((name (cadr elem))
- (pos (seq-position name (car elem)))
- (altered-name
- (cond
- ;; Not in the name string.
- ((not pos)
- (format "[%c] %s" (car elem) name))
- ;; The prompt character is in the name, so highlight
- ;; it on graphical terminals...
- ((display-supports-face-attributes-p
- '(:underline t) (window-frame))
- (setq name (copy-sequence name))
- (put-text-property pos (1+ pos)
- 'face 'read-multiple-choice-face
- name)
- name)
- ;; And put it in [bracket] on non-graphical terminals.
- (t
- (concat
- (substring name 0 pos)
- "["
- (upcase (substring name pos (1+ pos)))
- "]"
- (substring name (1+ pos)))))))
- (push (cons (car elem) altered-name)
- altered-names)
- altered-name))
- (append choices '((?? "?")))
- ", ")))
+ (mapconcat (lambda (e) (cdr e)) altered-names ", ")))
tchar buf wrong-char answer)
(save-window-excursion
(save-excursion
+ (if show-help
+ (setq buf (rmc--show-help prompt help-string show-help
+ choices altered-names)))
(while (not tchar)
(message "%s%s"
(if wrong-char
@@ -124,7 +209,7 @@ Usage example:
(lambda (elem)
(cons (capitalize (cadr elem))
(car elem)))
- choices)))
+ prompt-choices)))
(condition-case nil
(let ((cursor-in-echo-area t))
(read-event))
@@ -161,61 +246,23 @@ Usage example:
tchar nil)
(when wrong-char
(ding))
- (setq buf (get-buffer-create "*Multiple Choice Help*"))
- (if (stringp help-string)
- (with-help-window buf
- (with-current-buffer buf
- (insert help-string)))
- (with-help-window buf
- (with-current-buffer buf
- (erase-buffer)
- (pop-to-buffer buf)
- (insert prompt "\n\n")
- (let* ((columns (/ (window-width) 25))
- (fill-column 21)
- (times 0)
- (start (point)))
- (dolist (elem choices)
- (goto-char start)
- (unless (zerop times)
- (if (zerop (mod times columns))
- ;; Go to the next "line".
- (goto-char (setq start (point-max)))
- ;; Add padding.
- (while (not (eobp))
- (end-of-line)
- (insert (make-string (max (- (* (mod times columns)
- (+ fill-column 4))
- (current-column))
- 0)
- ?\s))
- (forward-line 1))))
- (setq times (1+ times))
- (let ((text
- (with-temp-buffer
- (insert (format
- "%c: %s\n"
- (car elem)
- (cdr (assq (car elem) altered-names))))
- (fill-region (point-min) (point-max))
- (when (nth 2 elem)
- (let ((start (point)))
- (insert (nth 2 elem))
- (unless (bolp)
- (insert "\n"))
- (fill-region start (point-max))))
- (buffer-string))))
- (goto-char start)
- (dolist (line (split-string text "\n"))
- (end-of-line)
- (if (bolp)
- (insert line "\n")
- (insert line))
- (forward-line 1))))))))))))
+ (setq buf (rmc--show-help prompt help-string show-help
+ choices altered-names))))))
(when (buffer-live-p buf)
(kill-buffer buf))
(assq tchar choices)))
+(defun read-multiple-choice--long-answers (prompt choices)
+ (let ((answer
+ (completing-read
+ (concat prompt " ("
+ (mapconcat #'identity (mapcar #'cadr choices) "/")
+ ") ")
+ (mapcar #'cadr choices) nil t)))
+ (seq-find (lambda (elem)
+ (equal (cadr elem) answer))
+ choices)))
+
(provide 'rmc)
;;; rmc.el ends here
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index aa2486b47ec..18eb168a70a 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1110,6 +1110,15 @@ can expand to any number of values."
(append rx--builtin-forms rx--builtin-symbols)
"List of built-in rx names. These cannot be redefined by the user.")
+;; Declare Lisp indentation rules for constructs that take 1 or 2
+;; parameters before a body of RX forms.
+;; (`>=' and `=' are omitted because they are more likely to be used
+;; as Lisp functions than RX constructs; `repeat' is a `defcustom' type.)
+(put 'group-n 'lisp-indent-function 1)
+(put 'submatch-n 'lisp-indent-function 1)
+(put '** 'lisp-indent-function 2)
+
+
(defun rx--translate (item)
"Translate the rx-expression ITEM. Return (REGEXP . PRECEDENCE)."
(cond
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index abfe51d32b5..36c17f4cd5e 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -59,8 +59,8 @@
(eval-when-compile (require 'cl-generic))
;; We used to use some sequence functions from cl-lib, but this
-;; dependency was swapped around so that it will be easier to make
-;; seq.el preloaded in the future. See also Bug#39761#26.
+;; dependency was swapped around so that it's easier to make seq.el
+;; preloaded. See also Bug#39761#26.
(defmacro seq-doseq (spec &rest body)
"Loop over a sequence.
@@ -299,6 +299,7 @@ sorted. FUNCTION must be a function of one argument."
TYPE must be one of following symbols: vector, string or list.
\n(fn TYPE SEQUENCE...)"
+ (setq sequences (mapcar #'seq-into-sequence sequences))
(pcase type
('vector (apply #'vconcat sequences))
('string (apply #'concat sequences))
@@ -402,23 +403,23 @@ found or not."
(setq count (+ 1 count))))
count))
-(with-suppressed-warnings ((obsolete seq-contains))
- (cl-defgeneric seq-contains (sequence elt &optional testfn)
- "Return the first element in SEQUENCE that is equal to ELT.
+(cl-defgeneric seq-contains (sequence elt &optional testfn)
+ "Return the first element in SEQUENCE that is equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
- (declare (obsolete seq-contains-p "27.1"))
- (seq-some (lambda (e)
- (when (funcall (or testfn #'equal) elt e)
- e))
- sequence)))
+ (declare (obsolete seq-contains-p "27.1"))
+ (seq-some (lambda (e)
+ (when (funcall (or testfn #'equal) elt e)
+ e))
+ sequence))
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
"Return non-nil if SEQUENCE contains an element equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(catch 'seq--break
(seq-doseq (e sequence)
- (when (funcall (or testfn #'equal) e elt)
- (throw 'seq--break t)))
+ (let ((r (funcall (or testfn #'equal) e elt)))
+ (when r
+ (throw 'seq--break r))))
nil))
(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
@@ -631,5 +632,20 @@ Signal an error if SEQUENCE is empty."
;; we automatically highlight macros.
(add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
+(defun seq-split (sequence length)
+ "Split SEQUENCE into a list of sub-sequences of at most LENGTH.
+All the sub-sequences will be of LENGTH, except the last one,
+which may be shorter."
+ (when (< length 1)
+ (error "Sub-sequence length must be larger than zero"))
+ (let ((result nil)
+ (seq-length (length sequence))
+ (start 0))
+ (while (< start seq-length)
+ (push (seq-subseq sequence start
+ (setq start (min seq-length (+ start length))))
+ result))
+ (nreverse result)))
+
(provide 'seq)
;;; seq.el ends here
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 2c83bc7b503..2343a9b589f 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -151,9 +151,6 @@ See the documentation for `list-load-path-shadows' for further information."
;; Return the list of shadowings.
shadows))
-(define-obsolete-function-alias 'find-emacs-lisp-shadows
- 'load-path-shadows-find "23.3")
-
;; Return true if neither file exists, or if both exist and have identical
;; contents.
(defun load-path-shadows-same-file-or-nonexistent (f1 f2)
@@ -180,12 +177,11 @@ See the documentation for `list-load-path-shadows' for further information."
. (1 font-lock-warning-face)))
"Keywords to highlight in `load-path-shadows-mode'.")
-(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows"
+(define-derived-mode load-path-shadows-mode special-mode "LP-Shadows"
"Major mode for `load-path' shadows buffer."
(setq-local font-lock-defaults
'((load-path-shadows-font-lock-keywords)))
- (setq buffer-undo-list t
- buffer-read-only t))
+ (setq buffer-undo-list t))
;; TODO use text-properties instead, a la dired.
(define-button-type 'load-path-shadows-find-file
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 99035c9e892..a2d954cadbb 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -41,40 +41,78 @@
'((t :inherit variable-pitch))
"Face used for a section.")
-(defvar shortdoc--groups nil)
+;;;###autoload
+(progn
+ (defvar shortdoc--groups nil)
-(defmacro define-short-documentation-group (group &rest functions)
- "Add GROUP to the list of defined documentation groups.
+ (defmacro define-short-documentation-group (group &rest functions)
+ "Add GROUP to the list of defined documentation groups.
FUNCTIONS is a list of elements on the form:
- (fun
+ (FUNC
:no-manual BOOL
:args ARGS
- :eval EXAMPLE-FORM
+ :eval EVAL
:no-eval EXAMPLE-FORM
- :no-eval* EXAMPLE-FORM
:no-value EXAMPLE-FORM
+ :no-eval* EXAMPLE-FORM
:result RESULT-FORM
- :result-string RESULT-FORM
+ :result-string RESULT-STRING
:eg-result RESULT-FORM
- :eg-result-string RESULT-FORM)
+ :eg-result-string RESULT-STRING)
-BOOL should be non-nil if the function isn't documented in the
+FUNC is the function being documented.
+
+NO-MANUAL should be non-nil if FUNC isn't documented in the
manual.
-ARGS is optional; the function's signature is displayed if ARGS
-is not present.
+ARGS is optional list of function FUNC's arguments. FUNC's
+signature is displayed automatically if ARGS is not present.
+Specifying ARGS might be useful where you don't want to document
+some of the uncommon arguments a function might have.
+
+While the `:no-manual' and `:args' property can be used for
+any (FUNC ..) form, all of the other properties shown above
+cannot be used simultaneously in such a form.
+
+Here are some common forms with examples of properties that go
+together:
+
+1. Document a form or string, and its evaluated return value.
+ (FUNC
+ :eval EVAL)
+
+If EVAL is a string, it will be inserted as is, and then that
+string will be `read' and evaluated.
+
+2. Document a form or string, but manually document its evaluation
+ result. The provided form will not be evaluated.
+
+ (FUNC
+ :no-eval EXAMPLE-FORM
+ :result RESULT-FORM) ;Use `:result-string' if value is in string form
-If EVAL isn't a string, it will be printed with `prin1', and then
-evaluated to give a result, which is also printed. If it's a
-string, it'll be inserted as is, then the string will be `read',
-and then evaluated.
+Using `:no-value' is the same as using `:no-eval'.
-There can be any number of :example/:result elements."
- `(progn
- (setq shortdoc--groups (delq (assq ',group shortdoc--groups)
- shortdoc--groups))
- (push (cons ',group ',functions) shortdoc--groups)))
+Use `:no-eval*' instead of `:no-eval' where the successful
+execution of the documented form depends on some conditions.
+
+3. Document a form or string EXAMPLE-FORM. Also manually
+ document an example result. This result could be unrelated to
+ the documented form.
+
+ (FUNC
+ :no-eval EXAMPLE-FORM
+ :eg-result RESULT-FORM) ;Use `:eg-result-string' if value is in string form
+
+A FUNC form can have any number of `:no-eval' (or `:no-value'),
+`:no-eval*', `:result', `:result-string', `:eg-result' and
+`:eg-result-string' properties."
+ (declare (indent defun))
+ `(progn
+ (setq shortdoc--groups (delq (assq ',group shortdoc--groups)
+ shortdoc--groups))
+ (push (cons ',group ',functions) shortdoc--groups))))
(define-short-documentation-group alist
"Alist Basics"
@@ -195,6 +233,13 @@ There can be any number of :example/:result elements."
:eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3))
(try-completion
:eval (try-completion "foo" '("foobar" "foozot" "gazonk")))
+ "Unicode Strings"
+ (string-glyph-split
+ :eval (string-glyph-split "Hello, 👼🏻🧑🏼‍🤝‍🧑🏻"))
+ (string-glyph-compose
+ :eval (string-glyph-compose "Å"))
+ (string-glyph-decompose
+ :eval (string-glyph-decompose "Å"))
"Predicates for Strings"
(string-equal
:eval (string-equal "foo" "foo"))
@@ -215,11 +260,16 @@ There can be any number of :example/:result elements."
:no-manual t
:eval (string-blank-p " \n"))
(string-lessp
- :eval (string-lessp "foo" "bar"))
+ :eval (string-lessp "foo" "bar")
+ :eval (string-lessp "pic4.png" "pic32.png")
+ :eval (string-lessp "1.1" "1 2"))
(string-greaterp
:eval (string-greaterp "foo" "bar"))
(string-version-lessp
- :eval (string-version-lessp "pic4.png" "pic32.png"))
+ :eval (string-version-lessp "pic4.png" "pic32.png")
+ :eval (string-version-lessp "1.1" "1 2"))
+ (string-collate-lessp
+ :eval (string-collate-lessp "1.1" "1 2"))
(string-prefix-p
:eval (string-prefix-p "foo" "foobar"))
(string-suffix-p
@@ -241,7 +291,14 @@ There can be any number of :example/:result elements."
:eval (number-to-string 42))
"Data About Strings"
(length
- :eval (length "foo"))
+ :eval (length "foo")
+ :eval (length "avocado: 🥑"))
+ (string-width
+ :eval (string-width "foo")
+ :eval (string-width "avocado: 🥑"))
+ (string-pixel-width
+ :eval (string-pixel-width "foo")
+ :eval (string-pixel-width "avocado: 🥑"))
(string-search
:eval (string-search "bar" "foobarzot"))
(assoc-string
@@ -271,6 +328,9 @@ There can be any number of :example/:result elements."
:eval (file-name-base "/tmp/foo.txt"))
(file-relative-name
:eval (file-relative-name "/tmp/foo" "/tmp"))
+ (file-name-split
+ :eval (file-name-split "/tmp/foo")
+ :eval (file-name-split "foo/bar"))
(make-temp-name
:eval (make-temp-name "/tmp/foo-"))
(file-name-concat
@@ -293,6 +353,13 @@ There can be any number of :example/:result elements."
(abbreviate-file-name
:no-eval (abbreviate-file-name "/home/some-user")
:eg-result "~some-user")
+ (file-parent-directory
+ :eval (file-parent-directory "/foo/bar")
+ :eval (file-parent-directory "~")
+ :eval (file-parent-directory "/tmp/")
+ :eval (file-parent-directory "foo/bar")
+ :eval (file-parent-directory "foo")
+ :eval (file-parent-directory "/"))
"Quoted File Names"
(file-name-quote
:args (name)
@@ -348,6 +415,9 @@ There can be any number of :example/:result elements."
(file-newer-than-file-p
:no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar")
:eg-result nil)
+ (file-has-changed-p
+ :no-eval (file-has-changed-p "/tmp/foo")
+ :eg-result t)
(file-equal-p
:no-eval (file-equal-p "/tmp/foo" "/tmp/bar")
:eg-result nil)
@@ -405,7 +475,9 @@ There can be any number of :example/:result elements."
:no-eval* (directory-files-and-attributes "/tmp/foo"))
(file-expand-wildcards
:no-eval (file-expand-wildcards "/tmp/*.png")
- :eg-result ("/tmp/foo.png" "/tmp/zot.png"))
+ :eg-result ("/tmp/foo.png" "/tmp/zot.png")
+ :no-eval (file-expand-wildcards "/*/foo.png")
+ :eg-result ("/tmp/foo.png" "/var/foo.png"))
(locate-dominating-file
:no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot")
:eg-result "/tmp/foo.png")
@@ -626,11 +698,6 @@ There can be any number of :example/:result elements."
(plist-put
:no-eval (setq plist (plist-put plist 'd 4))
:eq-result (a 1 b 2 c 3 d 4))
- (lax-plist-get
- :eval (lax-plist-get '("a" 1 "b" 2 "c" 3) "b"))
- (lax-plist-put
- :no-eval (setq plist (lax-plist-put plist "d" 4))
- :eq-result '("a" 1 "b" 2 "c" 3 "d" 4))
(plist-member
:eval (plist-member '(a 1 b 2 c 3) 'b))
"Data About Lists"
@@ -829,6 +896,8 @@ There can be any number of :example/:result elements."
:eval (seq-subseq '(a b c d e) 2 4))
(seq-take
:eval (seq-take '(a b c d e) 3))
+ (seq-split
+ :eval (seq-split [0 1 2 3 5] 2))
(seq-take-while
:eval (seq-take-while #'cl-evenp [2 4 9 6 5]))
(seq-uniq
@@ -1206,17 +1275,54 @@ There can be any number of :example/:result elements."
(text-property-search-backward
:no-eval (text-property-search-backward 'face nil t)))
+(define-short-documentation-group keymaps
+ "Defining keymaps"
+ (define-keymap
+ :no-eval (define-keymap "C-c C-c" #'quit-buffer))
+ (defvar-keymap
+ :no-eval (defvar-keymap my-keymap "C-c C-c" #'quit-buffer))
+ "Setting keys"
+ (keymap-set
+ :no-eval (keymap-set map "C-c C-c" #'quit-buffer))
+ (keymap-local-set
+ :no-eval (keymap-local-set "C-c C-c" #'quit-buffer))
+ (keymap-global-set
+ :no-eval (keymap-global-set "C-c C-c" #'quit-buffer))
+ (keymap-unset
+ :no-eval (keymap-unset map "C-c C-c"))
+ (keymap-local-unset
+ :no-eval (keymap-local-unset "C-c C-c"))
+ (keymap-global-unset
+ :no-eval (keymap-global-unset "C-c C-c"))
+ (keymap-substitute
+ :no-eval (keymap-substitute map "C-c C-c" "M-a"))
+ (keymap-set-after
+ :no-eval (keymap-set-after map "<separator-2>" menu-bar-separator))
+ "Predicates"
+ (keymapp
+ :eval (keymapp (define-keymap)))
+ (key-valid-p
+ :eval (key-valid-p "C-c C-c")
+ :eval (key-valid-p "C-cC-c"))
+ "Lookup"
+ (keymap-lookup
+ :eval (keymap-lookup (current-global-map) "C-x x g")))
+
;;;###autoload
-(defun shortdoc-display-group (group &optional function)
+(defun shortdoc-display-group (group &optional function same-window)
"Pop to a buffer with short documentation summary for functions in GROUP.
-If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
+If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
+If SAME-WINDOW, don't pop to a new window."
(interactive (list (completing-read "Show summary for functions in: "
(mapcar #'car shortdoc--groups))))
(when (stringp group)
(setq group (intern group)))
(unless (assq group shortdoc--groups)
(error "No such documentation group %s" group))
- (pop-to-buffer (format "*Shortdoc %s*" group))
+ (funcall (if same-window
+ #'pop-to-buffer-same-window
+ #'pop-to-buffer)
+ (format "*Shortdoc %s*" group))
(let ((inhibit-read-only t)
(prev nil))
(erase-buffer)
@@ -1245,6 +1351,9 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
(text-property-search-forward 'shortdoc-function function t)
(beginning-of-line)))
+;;;###autoload
+(defalias 'shortdoc #'shortdoc-display-group)
+
(defun shortdoc--display-function (data)
(let ((function (pop data))
(start-section (point))
@@ -1258,15 +1367,15 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
'action (lambda (_)
(describe-function function))
'follow-link t
- 'help-echo (purecopy "mouse-1, RET: describe function"))
+ 'help-echo "mouse-1, RET: describe function")
(insert-text-button
(symbol-name function)
'face 'button
'action (lambda (_)
(info-lookup-symbol function 'emacs-lisp-mode))
'follow-link t
- 'help-echo (purecopy "mouse-1, RET: show \
-function's documentation in the Info manual")))
+ 'help-echo "mouse-1, RET: show \
+function's documentation in the Info manual"))
(setq arglist-start (point))
(insert ")\n")
;; Doc string.
@@ -1351,11 +1460,14 @@ function's documentation in the Info manual")))
If GROUP doesn't exist, it will be created.
If SECTION doesn't exist, it will be added.
+ELEM is a Lisp form. See `define-short-documentation-group' for
+details.
+
Example:
(shortdoc-add-function
- 'file \"Predicates\"
- '(file-locked-p :no-eval (file-locked-p \"/tmp\")))"
+ \\='file \"Predicates\"
+ \\='(file-locked-p :no-eval (file-locked-p \"/tmp\")))"
(let ((glist (assq group shortdoc--groups)))
(unless glist
(setq glist (list group))
@@ -1369,14 +1481,12 @@ Example:
(setq slist (cdr slist)))
(setcdr slist (cons elem (cdr slist))))))
-(defvar shortdoc-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "n") 'shortdoc-next)
- (define-key map (kbd "p") 'shortdoc-previous)
- (define-key map (kbd "C-c C-n") 'shortdoc-next-section)
- (define-key map (kbd "C-c C-p") 'shortdoc-previous-section)
- map)
- "Keymap for `shortdoc-mode'.")
+(defvar-keymap shortdoc-mode-map
+ :doc "Keymap for `shortdoc-mode'."
+ "n" #'shortdoc-next
+ "p" #'shortdoc-previous
+ "C-c C-n" #'shortdoc-next-section
+ "C-c C-p" #'shortdoc-previous-section)
(define-derived-mode shortdoc-mode special-mode "shortdoc"
"Mode for shortdoc."
diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el
index a9e4343715c..ffd3856db6c 100644
--- a/lisp/emacs-lisp/shorthands.el
+++ b/lisp/emacs-lisp/shorthands.el
@@ -61,8 +61,7 @@
(defun shorthands-font-lock-shorthands (limit)
(when read-symbol-shorthands
(while (re-search-forward
- (eval-when-compile
- (concat "\\_<\\(" lisp-mode-symbol-regexp "\\)\\_>"))
+ (concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>")
limit t)
(let* ((existing (get-text-property (match-beginning 1) 'face))
(probe (and (not (memq existing '(font-lock-comment-face
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index b2283e66e4f..61d52026b38 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1301,9 +1301,9 @@ Only meaningful when called from within `smie-rules-function'."
(let ((afterpos (save-excursion
(let ((tok (funcall smie-forward-token-function)))
(unless tok
- (with-demoted-errors
- (error "smie-rule-separator: Can't skip token %s"
- smie--token))))
+ (funcall (if debug-on-error #'error #'message)
+ "smie-rule-separator: Can't skip token %s"
+ smie--token)))
(skip-chars-forward " ")
(unless (eolp) (point)))))
(or (and afterpos
@@ -1820,7 +1820,7 @@ to which that point should be aligned, if we were to reindent it.")
"Indent current line using the SMIE indentation engine."
(interactive)
(let* ((savep (point))
- (indent (or (with-demoted-errors
+ (indent (or (with-demoted-errors "SMIE Error: %S"
(save-excursion
(forward-line 0)
(skip-chars-forward " \t")
@@ -1846,7 +1846,9 @@ to which that point should be aligned, if we were to reindent it.")
(move-to-column fc)
(syntax-ppss))))
(while
- (and (with-demoted-errors
+ ;; We silence the error completely since errors are "normal" in
+ ;; some cases and an error message would be annoying (bug#19342).
+ (and (ignore-error scan-error
(save-excursion
(let ((end (point))
(bsf nil) ;Best-so-far.
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 9529d51e40b..5037ae47e83 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -81,134 +81,26 @@ Note how the single `-' got converted into a list before
threading."
(declare (indent 0) (debug thread-first))
`(internal--thread-argument nil ,@forms))
-
-(defsubst internal--listify (elt)
- "Wrap ELT in a list if it is not one.
-If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol."
- (cond
- ((symbolp elt) (list elt elt))
- ((null (cdr elt))
- (list (make-symbol "s") (car elt)))
- (t elt)))
-
-(defsubst internal--check-binding (binding)
- "Check BINDING is properly formed."
- (when (> (length binding) 2)
- (signal
- 'error
- (cons "`let' bindings can have only one value-form" binding)))
- binding)
-
-(defsubst internal--build-binding-value-form (binding prev-var)
- "Build the conditional value form for BINDING using PREV-VAR."
- (let ((var (car binding)))
- `(,var (and ,prev-var ,(cadr binding)))))
-
-(defun internal--build-binding (binding prev-var)
- "Check and build a single BINDING with PREV-VAR."
- (thread-first
- binding
- internal--listify
- internal--check-binding
- (internal--build-binding-value-form prev-var)))
-
-(defun internal--build-bindings (bindings)
- "Check and build conditional value forms for BINDINGS."
- (let ((prev-var t))
- (mapcar (lambda (binding)
- (let ((binding (internal--build-binding binding prev-var)))
- (setq prev-var (car binding))
- binding))
- bindings)))
-
-(defmacro if-let* (varlist then &rest else)
- "Bind variables according to VARLIST and evaluate THEN or ELSE.
-This is like `if-let' but doesn't handle a VARLIST of the form
-\(SYMBOL SOMETHING) specially."
- (declare (indent 2)
- (debug ((&rest [&or symbolp (symbolp form) (form)])
- body)))
- (if varlist
- `(let* ,(setq varlist (internal--build-bindings varlist))
- (if ,(caar (last varlist))
- ,then
- ,@else))
- `(let* () ,then)))
-
-(defmacro when-let* (varlist &rest body)
- "Bind variables according to VARLIST and conditionally evaluate BODY.
-This is like `when-let' but doesn't handle a VARLIST of the form
-\(SYMBOL SOMETHING) specially."
- (declare (indent 1) (debug if-let*))
- (list 'if-let* varlist (macroexp-progn body)))
-
-(defmacro and-let* (varlist &rest body)
- "Bind variables according to VARLIST and conditionally evaluate BODY.
-Like `when-let*', except if BODY is empty and all the bindings
-are non-nil, then the result is non-nil."
- (declare (indent 1) (debug if-let*))
- (let (res)
- (if varlist
- `(let* ,(setq varlist (internal--build-bindings varlist))
- (when ,(setq res (caar (last varlist)))
- ,@(or body `(,res))))
- `(let* () ,@(or body '(t))))))
-
-;;;###autoload
-(defmacro if-let (spec then &rest else)
- "Bind variables according to SPEC and evaluate THEN or ELSE.
-Evaluate each binding in turn, as in `let*', stopping if a
-binding value is nil. If all are non-nil return the value of
-THEN, otherwise the last form in ELSE.
-
-Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
-SYMBOL to the value of VALUEFORM. An element can additionally be
-of the form (VALUEFORM), which is evaluated and checked for nil;
-i.e. SYMBOL can be omitted if only the test result is of
-interest. It can also be of the form SYMBOL, then the binding of
-SYMBOL is checked for nil.
-
-As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
-like \((SYMBOL SOMETHING)). This exists for backward compatibility
-with an old syntax that accepted only one binding."
- (declare (indent 2)
- (debug ([&or (symbolp form) ; must be first, Bug#48489
- (&rest [&or symbolp (symbolp form) (form)])]
- body)))
- (when (and (<= (length spec) 2)
- (not (listp (car spec))))
- ;; Adjust the single binding case
- (setq spec (list spec)))
- (list 'if-let* spec then (macroexp-progn else)))
-
-;;;###autoload
-(defmacro when-let (spec &rest body)
- "Bind variables according to SPEC and conditionally evaluate BODY.
-Evaluate each binding in turn, stopping if a binding value is nil.
-If all are non-nil, return the value of the last form in BODY.
-
-The variable list SPEC is the same as in `if-let'."
- (declare (indent 1) (debug if-let))
- (list 'if-let spec (macroexp-progn body)))
-
(defsubst hash-table-empty-p (hash-table)
"Check whether HASH-TABLE is empty (has 0 elements)."
(zerop (hash-table-count hash-table)))
(defsubst hash-table-keys (hash-table)
"Return a list of keys in HASH-TABLE."
- (cl-loop for k being the hash-keys of hash-table collect k))
+ (let ((keys nil))
+ (maphash (lambda (k _) (push k keys)) hash-table)
+ keys))
(defsubst hash-table-values (hash-table)
"Return a list of values in HASH-TABLE."
- (cl-loop for v being the hash-values of hash-table collect v))
-
-(defsubst string-empty-p (string)
- "Check whether STRING is empty."
- (string= string ""))
+ (let ((values nil))
+ (maphash (lambda (_ v) (push v values)) hash-table)
+ values))
(defsubst string-join (strings &optional separator)
- "Join all STRINGS using SEPARATOR."
+ "Join all STRINGS using SEPARATOR.
+Optional argument SEPARATOR must be a string, a vector, or a list of
+characters; nil stands for the empty string."
(mapconcat #'identity strings separator))
(define-obsolete-function-alias 'string-reverse 'reverse "25.1")
@@ -275,9 +167,13 @@ non-nil, return the last LENGTH characters instead.
If CODING-SYSTEM is non-nil, STRING will be encoded before
limiting, and LENGTH is interpreted as the number of bytes to
limit the string to. The result will be a unibyte string that is
-shorter than LENGTH, but will not contain \"partial\" characters,
-even if CODING-SYSTEM encodes characters with several bytes per
-character.
+shorter than LENGTH, but will not contain \"partial\"
+characters (or glyphs), even if CODING-SYSTEM encodes characters
+with several bytes per character. If the coding system specifies
+prefix like the byte order mark (aka \"BOM\") or a shift-in sequence,
+their bytes will be normally counted as part of LENGTH. This is
+the case, for instance, with `utf-16'. If this isn't desired, use a
+coding system that doesn't specify a BOM, like `utf-16le' or `utf-16be'.
When shortening strings for display purposes,
`truncate-string-to-width' is almost always a better alternative
@@ -285,45 +181,60 @@ than this function."
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(if coding-system
- (let ((result nil)
- (result-length 0)
- (index (if end (1- (length string)) 0)))
- ;; FIXME: This implementation, which uses encode-coding-char
- ;; to encode the string one character at a time, is in general
- ;; incorrect: coding-systems that produce prefix or suffix
- ;; bytes, such as ISO-2022-based or UTF-8/16 with BOM, will
- ;; produce those bytes for each character, instead of just
- ;; once for the entire string. encode-coding-char attempts to
- ;; remove those extra bytes at least in some situations, but
- ;; it cannot do that in all cases. And in any case, producing
- ;; what is supposed to be a UTF-16 or ISO-2022-CN encoded
- ;; string which lacks the BOM bytes at the beginning and the
- ;; charset designation sequences at the head and tail of the
- ;; result will definitely surprise the callers in some cases.
- (while (let ((encoded (encode-coding-char
- (aref string index) coding-system)))
- (and (<= (+ (length encoded) result-length) length)
- (progn
- (push encoded result)
- (cl-incf result-length (length encoded))
- (setq index (if end (1- index)
- (1+ index))))
- (if end (> index -1)
- (< index (length string)))))
- ;; No body.
- )
- (apply #'concat (if end result (nreverse result))))
+ ;; The previous implementation here tried to encode char by
+ ;; char, and then adding up the length of the encoded octets,
+ ;; but that's not reliably in the presence of BOM marks and
+ ;; ISO-2022-CN which may add charset designations at the
+ ;; start/end of each encoded char (which we don't want). So
+ ;; iterate (with a binary search) instead to find the desired
+ ;; length.
+ (let* ((glyphs (string-glyph-split string))
+ (nglyphs (length glyphs))
+ (too-long (1+ nglyphs))
+ (stop (max (/ nglyphs 2) 1))
+ (gap stop)
+ candidate encoded found candidate-stop)
+ ;; We're returning the end of the string.
+ (when end
+ (setq glyphs (nreverse glyphs)))
+ (while (and (not found)
+ (< stop too-long))
+ (setq encoded
+ (encode-coding-string (string-join (seq-take glyphs stop))
+ coding-system))
+ (cond
+ ((= (length encoded) length)
+ (setq found encoded
+ candidate-stop stop))
+ ;; Too long; try shortening.
+ ((> (length encoded) length)
+ (setq too-long stop
+ stop (max (- stop gap) 1)))
+ ;; Too short; try lengthening.
+ (t
+ (setq candidate encoded
+ candidate-stop stop)
+ (setq stop
+ (if (>= stop nglyphs)
+ too-long
+ (min (+ stop gap) nglyphs)))))
+ (setq gap (max (/ gap 2) 1)))
+ (cond
+ ((not (or found candidate))
+ "")
+ ;; We're returning the end, so redo the encoding.
+ (end
+ (encode-coding-string
+ (string-join (nreverse (seq-take glyphs candidate-stop)))
+ coding-system))
+ (t
+ (or found candidate))))
+ ;; Char-based version.
(cond
((<= (length string) length) string)
(end (substring string (- (length string) length)))
(t (substring string 0 length)))))
-;;;###autoload
-(defun string-lines (string &optional omit-nulls)
- "Split STRING into a list of lines.
-If OMIT-NULLS, empty lines will be removed from the results."
- (split-string string "\n" omit-nulls))
-
(defun string-pad (string length &optional padding start)
"Pad STRING to LENGTH using PADDING.
If PADDING is nil, the space character is used. If not nil, it
@@ -379,6 +290,7 @@ it makes no sense to convert it to a string using
(set-buffer source-buffer)
(replace-buffer-contents tmp-buffer max-secs max-costs)))))))))
+;;;###autoload
(defmacro named-let (name bindings &rest body)
"Looping construct taken from Scheme.
Like `let', bind variables in BINDINGS and then evaluate BODY,
@@ -400,6 +312,159 @@ as the new values of the bound variables in the recursive invocation."
(cl-labels ((,name ,fargs . ,body)) #',name)
. ,aargs)))
+;;;###autoload
+(defun string-pixel-width (string)
+ "Return the width of STRING in pixels."
+ (if (zerop (length string))
+ 0
+ ;; Keeping a work buffer around is more efficient than creating a
+ ;; new temporary buffer.
+ (with-current-buffer (get-buffer-create " *string-pixel-width*")
+ (delete-region (point-min) (point-max))
+ (insert string)
+ (car (buffer-text-pixel-size nil nil t)))))
+
+;;;###autoload
+(defun string-glyph-split (string)
+ "Split STRING into a list of strings representing separate glyphs.
+This takes into account combining characters and grapheme clusters."
+ (let ((result nil)
+ (start 0)
+ comp)
+ (while (< start (length string))
+ (if (setq comp (find-composition-internal
+ start
+ ;; Don't search backward in the string for the
+ ;; start of the composition.
+ (min (length string) (1+ start))
+ string nil))
+ (progn
+ (push (substring string (car comp) (cadr comp)) result)
+ (setq start (cadr comp)))
+ (push (substring string start (1+ start)) result)
+ (setq start (1+ start))))
+ (nreverse result)))
+
+;;;###autoload
+(defun add-display-text-property (start end prop value
+ &optional object)
+ "Add display property PROP with VALUE to the text from START to END.
+If any text in the region has a non-nil `display' property, those
+properties are retained.
+
+If OBJECT is non-nil, it should be a string or a buffer. If nil,
+this defaults to the current buffer."
+ (let ((sub-start start)
+ (sub-end 0)
+ disp)
+ (while (< sub-end end)
+ (setq sub-end (next-single-property-change sub-start 'display object
+ (if (stringp object)
+ (min (length object) end)
+ (min end (point-max)))))
+ (if (not (setq disp (get-text-property sub-start 'display object)))
+ ;; No old properties in this range.
+ (put-text-property sub-start sub-end 'display (list prop value))
+ ;; We have old properties.
+ (let ((vector nil))
+ ;; Make disp into a list.
+ (setq disp
+ (cond
+ ((vectorp disp)
+ (setq vector t)
+ (seq-into disp 'list))
+ ((not (consp (car disp)))
+ (list disp))
+ (t
+ disp)))
+ ;; Remove any old instances.
+ (when-let ((old (assoc prop disp)))
+ (setq disp (delete old disp)))
+ (setq disp (cons (list prop value) disp))
+ (when vector
+ (setq disp (seq-into disp 'vector)))
+ ;; Finally update the range.
+ (put-text-property sub-start sub-end 'display disp)))
+ (setq sub-start sub-end))))
+
+;;;###autoload
+(defun read-process-name (prompt)
+ "Query the user for a process and return the process object."
+ ;; Currently supports only the PROCESS argument.
+ ;; Must either return a list containing a process, or signal an error.
+ ;; (Returning `nil' would mean the current buffer's process.)
+ (unless (fboundp 'process-list)
+ (error "Asynchronous subprocesses are not supported on this system"))
+ ;; Local function to return cons of a complete-able name, and the
+ ;; associated process object, for use with `completing-read'.
+ (cl-flet ((procitem
+ (p) (when (process-live-p p)
+ (let ((pid (process-id p))
+ (procname (process-name p))
+ (procbuf (process-buffer p)))
+ (and (eq (process-type p) 'real)
+ (cons (if procbuf
+ (format "%s (%s) in buffer %s"
+ procname pid
+ (buffer-name procbuf))
+ (format "%s (%s)" procname pid))
+ p))))))
+ ;; Perform `completing-read' for a process.
+ (let* ((currproc (get-buffer-process (current-buffer)))
+ (proclist (or (process-list)
+ (error "No processes found")))
+ (collection (delq nil (mapcar #'procitem proclist)))
+ (selection (completing-read
+ (format-prompt prompt
+ (and currproc
+ (eq (process-type currproc) 'real)
+ (procitem currproc)))
+ collection nil :require-match nil nil
+ (car (seq-find (lambda (proc)
+ (eq currproc (cdr proc)))
+ collection))))
+ (process (and selection
+ (cdr (assoc selection collection)))))
+ (unless process
+ (error "No process selected"))
+ process)))
+
+(defmacro with-buffer-unmodified-if-unchanged (&rest body)
+ "Like `progn', but change buffer-modified status only if buffer text changes.
+If the buffer was unmodified before execution of BODY, and
+buffer text after execution of BODY is identical to what it was
+before, ensure that buffer is still marked unmodified afterwards.
+For example, the following won't change the buffer's modification
+status:
+
+ (with-buffer-unmodified-if-unchanged
+ (insert \"a\")
+ (delete-char -1))
+
+Note that only changes in the raw byte sequence of the buffer text,
+as stored in the internal representation, are monitored for the
+purpose of detecting the lack of changes in buffer text. Any other
+changes that are normally perceived as \"buffer modifications\", such
+as changes in text properties, `buffer-file-coding-system', buffer
+multibyteness, etc. -- will not be noticed, and the buffer will still
+be marked unmodified, effectively ignoring those changes."
+ (declare (debug t) (indent 0))
+ (let ((hash (gensym))
+ (buffer (gensym)))
+ `(let ((,hash (and (not (buffer-modified-p))
+ (buffer-hash)))
+ (,buffer (current-buffer)))
+ (prog1
+ (progn
+ ,@body)
+ ;; If we didn't change anything in the buffer (and the buffer
+ ;; was previously unmodified), then flip the modification status
+ ;; back to "unchanged".
+ (when (and ,hash (buffer-live-p ,buffer))
+ (with-current-buffer ,buffer
+ (when (and (buffer-modified-p)
+ (equal ,hash (buffer-hash)))
+ (restore-buffer-modified-p nil))))))))
(provide 'subr-x)
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 7cc076cd806..e1be3015838 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -124,15 +124,49 @@ When the last position scanned holds the first character of a
otherwise nil. That construct can be a two character comment
delimiter or an Escaped or Char-quoted character."))
-(defun syntax-propertize-wholelines (start end)
- "Extend the region delimited by START and END to whole lines.
+(defvar syntax-wholeline-max 10000
+ "Maximum line length for syntax operations.
+If lines are longer than that, syntax operations will treat them as chunks
+of this size. Misfontification may then occur.
+This is a tradeoff between correctly applying the syntax rules,
+and avoiding major slowdown on pathologically long lines.")
+
+(defun syntax--lbp (&optional arg)
+ "Like `line-beginning-position' but obeying `syntax-wholeline-max'."
+ (let ((pos (point))
+ (res (line-beginning-position arg)))
+ (cond
+ ((< (abs (- pos res)) syntax-wholeline-max) res)
+ ;; For lines that are too long, round to the nearest multiple of
+ ;; `syntax-wholeline-max'. We use rounding rather than just
+ ;; (min res (+ pos syntax-wholeline-max)) so that repeated calls
+ ;; to `syntax-propertize-wholelines' don't keep growing the bounds,
+ ;; i.e. it really behaves like additional line-breaks.
+ ((< res pos)
+ (let ((max syntax-wholeline-max))
+ (max (point-min) (* max (truncate pos max)))))
+ (t
+ (let ((max syntax-wholeline-max))
+ (min (point-max) (* max (ceiling pos max))))))))
+
+(defun syntax-propertize-wholelines (beg end)
+ "Extend the region delimited by BEG and END to whole lines.
This function is useful for
`syntax-propertize-extend-region-functions';
see Info node `(elisp) Syntax Properties'."
- (goto-char start)
- (cons (line-beginning-position)
- (progn (goto-char end)
- (if (bolp) (point) (line-beginning-position 2)))))
+ ;; This let-binding was taken from
+ ;; `font-lock-extend-region-wholelines' where it was used to avoid
+ ;; inf-looping (Bug#21615) but for some reason it was not applied
+ ;; here in syntax.el and was used only for the "beg" side.
+ (let ((inhibit-field-text-motion t))
+ (let ((new-beg (progn (goto-char beg)
+ (if (bolp) beg
+ (syntax--lbp))))
+ (new-end (progn (goto-char end)
+ (if (bolp) end
+ (syntax--lbp 2)))))
+ (unless (and (eql beg new-beg) (eql end new-end))
+ (cons new-beg new-end)))))
(defun syntax-propertize-multiline (beg end)
"Let `syntax-propertize' pay attention to the syntax-multiline property."
@@ -345,10 +379,16 @@ END) suitable for `syntax-propertize-function'."
(defvar-local syntax-ppss-table nil
"Syntax-table to use during `syntax-ppss', if any.")
-(defvar-local syntax-propertize--inhibit-flush nil
- "If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache.
-Otherwise it flushes both the ppss cache and the properties
-set by `syntax-propertize'")
+(defun syntax-propertize--in-process-p ()
+ "Non-nil if we're inside `syntax-propertize'.
+This is used to avoid infinite recursion as well as to handle cases where
+`syntax-ppss' is called when the final `syntax-table' properties have not
+yet been setup, in which case we may end up putting invalid info into the cache.
+It's also used so that `syntax-ppss-flush-cache' can be used from within
+`syntax-propertize' without ruining the `syntax-table' already set."
+ (eq syntax-propertize--done most-positive-fixnum))
+
+(defvar-local syntax-ppss--updated-cache nil)
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS (a buffer point)."
@@ -370,21 +410,24 @@ set by `syntax-propertize'")
(with-silent-modifications
(with-syntax-table (or syntax-ppss-table (syntax-table))
(make-local-variable 'syntax-propertize--done) ;Just in case!
+ ;; Make sure we let-bind it only buffer-locally.
+ (make-local-variable 'syntax-ppss--updated-cache)
(let* ((start (max (min syntax-propertize--done (point-max))
(point-min)))
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
(first t)
- (repeat t))
+ (repeat t)
+ (syntax-ppss--updated-cache nil))
(while repeat
(setq repeat nil)
(run-hook-wrapped
'syntax-propertize-extend-region-functions
(lambda (f)
- (let ((new (funcall f start end))
- ;; Avoid recursion!
- (syntax-propertize--done most-positive-fixnum))
+ ;; Bind `syntax-propertize--done' to avoid recursion!
+ (let* ((syntax-propertize--done most-positive-fixnum)
+ (new (funcall f start end)))
(if (or (null new)
(and (>= (car new) start) (<= (cdr new) end)))
nil
@@ -399,20 +442,26 @@ set by `syntax-propertize'")
;; Flush ppss cache between the original value of `start' and that
;; set above by syntax-propertize-extend-region-functions.
(syntax-ppss-flush-cache start)
- ;; Move the limit before calling the function, so the function
- ;; can use syntax-ppss.
+ ;; Move the limit before calling the function, so it's
+ ;; done in case of errors.
(setq syntax-propertize--done end)
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
- ;; Make sure we only let-bind it buffer-locally.
- (make-local-variable 'syntax-propertize--inhibit-flush)
- ;; Let-bind `syntax-propertize--done' to avoid infinite recursion!
- (let ((syntax-propertize--done most-positive-fixnum)
- ;; Let `syntax-propertize-function' call
- ;; `syntax-ppss-flush-cache' without worries.
- (syntax-propertize--inhibit-flush t))
- (funcall syntax-propertize-function start end)))))))))
+ ;; Bind `syntax-propertize--done' to avoid recursion!
+ (let ((syntax-propertize--done most-positive-fixnum))
+ (funcall syntax-propertize-function start end)
+ (when syntax-ppss--updated-cache
+ ;; `syntax-ppss' was called and updated the cache while we
+ ;; were propertizing so we need to flush the part of the
+ ;; cache that may have been rendered out-of-date by the new
+ ;; properties.
+ ;; We used to require syntax-propertize-functions to do that
+ ;; manually when applicable, but nowadays the `syntax-ppss'
+ ;; cache can be updated by too many functions, so the author
+ ;; of the syntax-propertize-function may not be aware it
+ ;; can happen.
+ (syntax-ppss-flush-cache start))))))))))
;;; Link syntax-propertize with syntax.c.
@@ -487,10 +536,10 @@ These are valid when the buffer has no restriction.")
(define-obsolete-function-alias 'syntax-ppss-after-change-function
#'syntax-ppss-flush-cache "27.1")
-(defun syntax-ppss-flush-cache (beg &rest ignored)
+(defun syntax-ppss-flush-cache (beg &rest _ignored)
"Flush the cache of `syntax-ppss' starting at position BEG."
;; Set syntax-propertize to refontify anything past beg.
- (unless syntax-propertize--inhibit-flush
+ (unless (syntax-propertize--in-process-p)
(setq syntax-propertize--done (min beg syntax-propertize--done)))
;; Flush invalid cache entries.
(dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
@@ -517,10 +566,16 @@ These are valid when the buffer has no restriction.")
(setcdr cell cache)))
))
-;;; FIXME: Explain this variable. Currently only its last (5th) slot is used.
-;;; Perhaps the other slots should be removed?
+;; FIXME: Explain this variable. Currently only its last (5th) slot is used.
+;; Perhaps the other slots should be removed?
+;; This variable is only used when `syntax-begin-function' is used and
+;; will hence be removed together with `syntax-begin-function'.
(defvar syntax-ppss-stats
- [(0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (2 . 2500)])
+ [(0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (2 . 2500)]
+ "Statistics about which case is more/less frequent in `syntax-ppss'.
+The 5th slot drives the heuristic to use `syntax-begin-function'.
+The rest is only useful if you're interested in tweaking the algorithm.")
+
(defun syntax-ppss-stats ()
(mapcar (lambda (x)
(condition-case nil
@@ -545,10 +600,11 @@ These are valid when the buffer has no restriction.")
(defun syntax-ppss (&optional pos)
"Parse-Partial-Sexp State at POS, defaulting to point.
+If POS is given, this function moves point to POS.
+
The returned value is the same as that of `parse-partial-sexp'
run from `point-min' to POS except that values at positions 2 and 6
in the returned list (counting from 0) cannot be relied upon.
-Point is at POS when this function returns.
It is necessary to call `syntax-ppss-flush-cache' explicitly if
this function is called while `before-change-functions' is
@@ -657,6 +713,7 @@ running the hook."
;; populate the cache so we won't need to do it again soon.
(t
(syntax-ppss--update-stats 3 pt-min pos)
+ (setq syntax-ppss--updated-cache t)
;; If `pt-min' is too far, add a few intermediate entries.
(while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
@@ -691,6 +748,7 @@ running the hook."
(push pair ppss-cache)
(setcar ppss-cache pair)))))))))
+ (setq syntax-ppss--updated-cache t)
(setq ppss-last (cons pos ppss))
(setcar cell ppss-last)
(setcdr cell ppss-cache)
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 3d944bf5e16..9868d8c4ec0 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -115,16 +115,25 @@ where:
This should be either a function, or a list.
If a list, each element has the form (ID [DESC1 ... DESCN]),
where:
+
- ID is nil, or a Lisp object uniquely identifying this entry,
which is used to keep the cursor on the \"same\" entry when
rearranging the list. Comparison is done with `equal'.
- Each DESC is a column descriptor, one for each column
- specified in `tabulated-list-format'. A descriptor is either
- a string, which is printed as-is, or a list (LABEL . PROPS),
- which means to use `insert-text-button' to insert a text
- button with label LABEL and button properties PROPS.
- The string, or button label, must not contain any newline.
+ specified in `tabulated-list-format'. The descriptor DESC is
+ one of:
+
+ - A string, which is printed as-is, and must not contain any
+ newlines.
+
+ - An image descriptor (a list), which is used to insert an
+ image (see Info node `(elisp) Image Descriptors').
+
+ - A list (LABEL . PROPS), which means to use
+ `insert-text-button' to insert a text button with label
+ LABEL and button properties PROPS. LABEL must not contain
+ any newlines.
If `tabulated-list-entries' is a function, it is called with no
arguments and must return a list of the above form.")
@@ -207,33 +216,28 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(while (re-search-forward re nil 'noerror)
(tabulated-list-put-tag empty)))))
-(defvar tabulated-list-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map (make-composed-keymap
- button-buffer-map
- special-mode-map))
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map (kbd "M-<left>") 'tabulated-list-previous-column)
- (define-key map (kbd "M-<right>") 'tabulated-list-next-column)
- (define-key map "S" 'tabulated-list-sort)
- (define-key map "}" 'tabulated-list-widen-current-column)
- (define-key map "{" 'tabulated-list-narrow-current-column)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'mouse-select-window)
- map)
- "Local keymap for `tabulated-list-mode' buffers.")
-
-(defvar tabulated-list-sort-button-map
- (let ((map (make-sparse-keymap)))
- (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
- (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
- (define-key map [mouse-1] 'tabulated-list-col-sort)
- (define-key map [mouse-2] 'tabulated-list-col-sort)
- (define-key map "\C-m" 'tabulated-list-sort)
- (define-key map [follow-link] 'mouse-face)
- map)
- "Local keymap for `tabulated-list-mode' sort buttons.")
+(defvar-keymap tabulated-list-mode-map
+ :doc "Local keymap for `tabulated-list-mode' buffers."
+ :parent (make-composed-keymap button-buffer-map
+ special-mode-map)
+ "n" #'next-line
+ "p" #'previous-line
+ "M-<left>" #'tabulated-list-previous-column
+ "M-<right>" #'tabulated-list-next-column
+ "S" #'tabulated-list-sort
+ "}" #'tabulated-list-widen-current-column
+ "{" #'tabulated-list-narrow-current-column
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'mouse-select-window)
+
+(defvar-keymap tabulated-list-sort-button-map
+ :doc "Local keymap for `tabulated-list-mode' sort buttons."
+ "<header-line> <mouse-1>" #'tabulated-list-col-sort
+ "<header-line> <mouse-2>" #'tabulated-list-col-sort
+ "<mouse-1>" #'tabulated-list-col-sort
+ "<mouse-2>" #'tabulated-list-col-sort
+ "RET" #'tabulated-list-sort
+ "<follow-link>" 'mouse-face)
(defun tabulated-list-make-glyphless-char-display-table ()
"Make the `glyphless-char-display' table used for text-mode frames.
@@ -255,18 +259,14 @@ variables `tabulated-list-tty-sort-indicator-asc' and
Populated by `tabulated-list-init-header'.")
(defvar tabulated-list--header-overlay nil)
-(defun tabulated-list-line-number-width ()
- "Return the width taken by `display-line-numbers' in the current buffer."
- ;; line-number-display-width returns the value for the selected
- ;; window, which might not be the window in which the current buffer
- ;; is displayed.
- (if (not display-line-numbers)
- 0
- (let ((cbuf-window (get-buffer-window (current-buffer) t)))
- (if (window-live-p cbuf-window)
- (with-selected-window cbuf-window
- (line-number-display-width 'columns))
- 4))))
+(define-obsolete-function-alias 'tabulated-list-line-number-width
+ 'header-line-indent--line-number-width "29.1")
+(define-obsolete-function-alias 'tabulated-list-watch-line-number-width
+ 'header-line-indent--watch-line-number-width "29.1")
+(define-obsolete-function-alias 'tabulated-list-watch-line-number-width
+ 'header-line-indent--watch-line-number-width "29.1")
+(define-obsolete-function-alias 'tabulated-list-window-scroll-function
+ 'header-line-indent--window-scroll-function "29.1")
(defun tabulated-list-init-header ()
"Set up header line for the Tabulated List buffer."
@@ -280,9 +280,9 @@ Populated by `tabulated-list-init-header'.")
(hcols (mapcar #'car tabulated-list-format))
(tabulated-list--near-rows (list hcols hcols))
(cols nil))
- (if display-line-numbers
- (setq x (+ x (tabulated-list-line-number-width))))
- (push (propertize " " 'display `(space :align-to ,x)) cols)
+ (push (propertize " " 'display
+ `(space :align-to (+ header-line-indent-width ,x)))
+ cols)
(dotimes (n len)
(let* ((col (aref tabulated-list-format n))
(not-last-col (< n (1- len)))
@@ -333,20 +333,25 @@ Populated by `tabulated-list-init-header'.")
(when (> shift 0)
(setq cols
(cons (car cols)
- (cons (propertize (make-string shift ?\s)
- 'display
- `(space :align-to ,(+ x shift)))
- (cdr cols))))
+ (cons
+ (propertize
+ (make-string shift ?\s)
+ 'display
+ `(space :align-to
+ (+ header-line-indent-width ,(+ x shift))))
+ (cdr cols))))
(setq x (+ x shift)))))
(if (>= pad-right 0)
- (push (propertize " "
- 'display `(space :align-to ,next-x)
- 'face 'fixed-pitch)
+ (push (propertize
+ " "
+ 'display `(space :align-to
+ (+ header-line-indent-width ,next-x))
+ 'face 'fixed-pitch)
cols))
(setq x next-x)))
(setq cols (apply 'concat (nreverse cols)))
(if tabulated-list-use-header-line
- (setq header-line-format cols)
+ (setq header-line-format (list "" 'header-line-indent cols))
(setq-local tabulated-list--header-string cols))))
(defun tabulated-list-print-fake-header ()
@@ -547,7 +552,9 @@ Return the column number after insertion."
(props (nthcdr 3 format))
(pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
- (label (if (stringp col-desc) col-desc (car col-desc)))
+ (label (cond ((stringp col-desc) col-desc)
+ ((eq (car col-desc) 'image) " ")
+ (t (car col-desc))))
(label-width (string-width label))
(help-echo (concat (car format) ": " label))
(opoint (point))
@@ -571,11 +578,15 @@ Return the column number after insertion."
'display `(space :align-to ,(+ x shift))))
(setq width (- width shift))
(setq x (+ x shift))))
- (if (stringp col-desc)
- (insert (if (get-text-property 0 'help-echo label)
- label
- (propertize label 'help-echo help-echo)))
- (apply 'insert-text-button label (cdr col-desc)))
+ (cond ((stringp col-desc)
+ (insert (if (get-text-property 0 'help-echo label)
+ label
+ (propertize label 'help-echo help-echo))))
+ ((eq (car col-desc) 'image)
+ (insert (propertize " "
+ 'display col-desc
+ 'help-echo help-echo)))
+ ((apply 'insert-text-button label (cdr col-desc))))
(let ((next-x (+ x pad-right width)))
;; No need to append any spaces if this is the last column.
(when not-last-col
@@ -668,6 +679,10 @@ With a numeric prefix argument N, sort the Nth column.
If the numeric prefix is -1, restore order the list was
originally displayed in."
(interactive "P")
+ (when (and n
+ (or (>= n (length tabulated-list-format))
+ (< n -1)))
+ (user-error "Invalid column number"))
(if (equal n -1)
;; Restore original order.
(progn
@@ -712,6 +727,7 @@ Interactively, N is the prefix numeric argument, and defaults to
1."
(interactive "p")
(let ((start (current-column))
+ (entry (tabulated-list-get-entry))
(nb-cols (length tabulated-list-format))
(col-nb 0)
(total-width 0)
@@ -719,14 +735,25 @@ Interactively, N is the prefix numeric argument, and defaults to
col-width)
(while (and (not found)
(< col-nb nb-cols))
- (if (> start
- (setq total-width
- (+ total-width
- (setq col-width
- (cadr (aref tabulated-list-format
- col-nb))))))
+ (if (>= start
+ (setq total-width
+ (+ total-width
+ (max (setq col-width
+ (cadr (aref tabulated-list-format
+ col-nb)))
+ (let ((desc (aref entry col-nb)))
+ (string-width (if (stringp desc)
+ desc
+ (car desc)))))
+ (or (plist-get (nthcdr 3 (aref tabulated-list-format
+ col-nb))
+ :pad-right)
+ 1))))
(setq col-nb (1+ col-nb))
(setq found t)
+ ;; `tabulated-list-format' may be a constant (sharing list
+ ;; structures), so copy it before mutating.
+ (setq tabulated-list-format (copy-tree tabulated-list-format t))
(setf (cadr (aref tabulated-list-format col-nb))
(max 1 (+ col-width n)))
(tabulated-list-print t)
@@ -739,23 +766,6 @@ Interactively, N is the prefix numeric argument, and defaults to
(interactive "p")
(tabulated-list-widen-current-column (- n)))
-(defvar tabulated-list--current-lnum-width nil)
-(defun tabulated-list-watch-line-number-width (_window)
- (if display-line-numbers
- (let ((lnum-width (tabulated-list-line-number-width)))
- (when (not (= tabulated-list--current-lnum-width lnum-width))
- (setq-local tabulated-list--current-lnum-width lnum-width)
- (tabulated-list-init-header)))))
-
-(defun tabulated-list-window-scroll-function (window _start)
- (if display-line-numbers
- (let ((lnum-width
- (with-selected-window window
- (line-number-display-width 'columns))))
- (when (not (= tabulated-list--current-lnum-width lnum-width))
- (setq-local tabulated-list--current-lnum-width lnum-width)
- (tabulated-list-init-header)))))
-
(defun tabulated-list-next-column (&optional arg)
"Go to the start of the next column after point on the current line.
If ARG is provided, move that many columns."
@@ -826,15 +836,7 @@ as the ewoc pretty-printer."
;; Avoid messing up the entries' display just because the first
;; column of the first entry happens to begin with a R2L letter.
(setq bidi-paragraph-direction 'left-to-right)
- ;; This is for if/when they turn on display-line-numbers
- (add-hook 'display-line-numbers-mode-hook #'tabulated-list-revert nil t)
- ;; This is for if/when they customize the line-number face or when
- ;; the line-number width needs to change due to scrolling.
- (setq-local tabulated-list--current-lnum-width 0)
- (add-hook 'pre-redisplay-functions
- #'tabulated-list-watch-line-number-width nil t)
- (add-hook 'window-scroll-functions
- #'tabulated-list-window-scroll-function nil t))
+ (header-line-indent-mode))
(put 'tabulated-list-mode 'mode-class 'special)
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 33628d8f47f..cd2e388ce42 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -65,7 +65,6 @@
(eval-when-compile (require 'cl-lib))
(require 'edebug)
-(provide 'testcover)
;;;==========================================================================
@@ -677,4 +676,6 @@ The list is 1valued if all of its constituent elements are also 1valued."
(testcover-analyze-coverage (cadr form)))
(t (testcover-analyze-coverage-backquote form))))
+(provide 'testcover)
+
;;; testcover.el ends here
diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el
index 9f86a28eb64..d11980f4f45 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -47,7 +47,7 @@ match if is not `equal' to VALUE. Furthermore, a nil PREDICATE
means that the match region is ended if the value changes. For
instance, this means that if you loop with
- (while (setq prop (text-property-search-forward 'face))
+ (while (setq prop (text-property-search-forward \\='face))
...)
you will get all distinct regions with non-nil `face' values in
@@ -166,7 +166,6 @@ and if a matching region is found, place point at the start of the region."
(let ((origin (point))
(ended nil)
pos)
- (forward-char -1)
;; Find the previous candidate.
(while (not ended)
(setq pos (previous-single-property-change (point) property))
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index c93a50cabfe..d48698234fc 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -62,7 +62,7 @@
((numberp repeat)
(propertize
(format "%12s" (format-seconds
- "%dd %hh %mm %z%,1ss" repeat))
+ "%x%dd %hh %mm %z%,1ss" repeat))
'help-echo "Repeat interval"))
((null repeat)
(propertize " -" 'help-echo "Runs once"))
@@ -81,13 +81,12 @@
;; doing. Kids, don't try this at home!
;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
-(defvar timer-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "c" 'timer-list-cancel)
- (easy-menu-define nil map ""
- '("Timers"
- ["Cancel" timer-list-cancel t]))
- map))
+(defvar-keymap timer-list-mode-map
+ "c" #'timer-list-cancel
+ :menu
+ '("Timers"
+ ["Cancel" timer-list-cancel t]
+ ["Quit" quit-window]))
(define-derived-mode timer-list-mode tabulated-list-mode "Timer-List"
"Mode for listing and controlling timers."
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 27359dfbfce..fd29abf40a3 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -314,7 +314,7 @@ This function is called, by name, directly by the C code."
(not (timer--idle-delay timer)))
(setf (timer--time timer)
(timer-next-integral-multiple-of-time
- (current-time) (timer--repeat-delay timer))))
+ nil (timer--repeat-delay timer))))
;; Place it back on the timer-list before running
;; timer--function, so it can cancel-timer itself.
(timer-activate timer t cell)
@@ -351,19 +351,27 @@ This function is called, by name, directly by the C code."
Repeat the action every REPEAT seconds, if REPEAT is non-nil.
REPEAT may be an integer or floating point number.
TIME should be one of:
+
- a string giving today's time like \"11:23pm\"
(the acceptable formats are HHMM, H:MM, HH:MM, HHam, HHAM,
HHpm, HHPM, HH:MMam, HH:MMAM, HH:MMpm, or HH:MMPM;
a period `.' can be used instead of a colon `:' to separate
the hour and minute parts);
+
- a string giving a relative time like \"90\" or \"2 hours 35 minutes\"
(the acceptable forms are a number of seconds without units
or some combination of values using units in `timer-duration-words');
+
- nil, meaning now;
+
- a number of seconds from now;
+
- a value from `encode-time';
-- or t (with non-nil REPEAT) meaning the next integral
- multiple of REPEAT.
+
+- or t (with non-nil REPEAT) meaning the next integral multiple
+ of REPEAT. This is handy when you want the function to run at
+ a certain \"round\" number. For instance, (run-at-time t 60 ...)
+ will run at 11:04:00, 11:05:00, etc.
The action is to call FUNCTION with arguments ARGS.
@@ -383,7 +391,7 @@ This function returns a timer object which you can use in
;; Special case: t means the next integral multiple of REPEAT.
(when (and (eq time t) repeat)
- (setq time (timer-next-integral-multiple-of-time (current-time) repeat))
+ (setq time (timer-next-integral-multiple-of-time nil repeat))
(setf (timer--integral-multiple timer) t))
;; Handle numbers as relative times in seconds.
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 71eca5a3230..c2f6c162269 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -172,9 +172,10 @@ You can call this function to add internal values in the trace buffer."
LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
and CONTEXT is a string describing the dynamic context (e.g. values of
some global variables)."
- (let ((print-circle t))
+ (let ((print-circle t)
+ (print-escape-newlines t))
(format "%s%s%d -> %S%s\n"
- (mapconcat 'char-to-string (make-string (max 0 (1- level)) ?|) " ")
+ (mapconcat #'char-to-string (make-string (max 0 (1- level)) ?|) " ")
(if (> level 1) " " "")
level
;; FIXME: Make it so we can click the function name to jump to its
@@ -187,7 +188,8 @@ some global variables)."
LEVEL is the trace level, VALUE value returned by FUNCTION,
and CONTEXT is a string describing the dynamic context (e.g. values of
some global variables)."
- (let ((print-circle t))
+ (let ((print-circle t)
+ (print-escape-newlines t))
(format "%s%s%d <- %s: %S%s\n"
(mapconcat 'char-to-string (make-string (1- level) ?|) " ")
(if (> level 1) " " "")
@@ -271,14 +273,14 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
(if default (symbol-name default)))))
(when current-prefix-arg
(list
- (read-buffer (format-prompt "Output to buffer" trace-buffer))
+ (read-buffer "Output to buffer" trace-buffer)
(let ((exp
- (let ((minibuffer-completing-symbol t))
- (read-from-minibuffer "Context expression: "
- nil read-expression-map t
- 'read-expression-history))))
+ (read-from-minibuffer "Context expression: "
+ nil read-expression-map t
+ 'read-expression-history)))
(lambda ()
- (let ((print-circle t))
+ (let ((print-circle t)
+ (print-escape-newlines t))
(concat " [" (prin1-to-string (eval exp t)) "]"))))))))
;;;###autoload
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
new file mode 100644
index 00000000000..61265c97c28
--- /dev/null
+++ b/lisp/emacs-lisp/vtable.el
@@ -0,0 +1,976 @@
+;;; vtable.el --- Displaying data in tables -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'text-property-search)
+(require 'mule-util)
+
+(defface vtable
+ '((t :inherit variable-pitch))
+ "Face used (by default) for vtables."
+ :version "29.1"
+ :group 'faces)
+
+(cl-defstruct vtable-column
+ "A vtable column."
+ name
+ width
+ min-width
+ max-width
+ primary
+ align
+ getter
+ formatter
+ displayer
+ -numerical)
+
+(defclass vtable ()
+ ((columns :initarg :columns :accessor vtable-columns)
+ (objects :initarg :objects :accessor vtable-objects)
+ (objects-function :initarg :objects-function
+ :accessor vtable-objects-function)
+ (getter :initarg :getter :accessor vtable-getter)
+ (formatter :initarg :formatter :accessor vtable-formatter)
+ (displayer :initarg :displayer :accessor vtable-displayer)
+ (use-header-line :initarg :use-header-line
+ :accessor vtable-use-header-line)
+ (face :initarg :face :accessor vtable-face)
+ (actions :initarg :actions :accessor vtable-actions)
+ (keymap :initarg :keymap :accessor vtable-keymap)
+ (separator-width :initarg :separator-width :accessor vtable-separator-width)
+ (divider :initarg :divider :accessor vtable-divider :initform nil)
+ (sort-by :initarg :sort-by :accessor vtable-sort-by)
+ (ellipsis :initarg :ellipsis :accessor vtable-ellipsis)
+ (column-colors :initarg :column-colors :accessor vtable-column-colors)
+ (row-colors :initarg :row-colors :accessor vtable-row-colors)
+ (-cached-colors :initform nil)
+ (-cache :initform (make-hash-table :test #'equal))
+ (-cached-keymap :initform nil)
+ (-has-column-spec :initform nil))
+ "An object to hold the data for a table.")
+
+(defvar-keymap vtable-map
+ "S" #'vtable-sort-by-current-column
+ "{" #'vtable-narrow-current-column
+ "}" #'vtable-widen-current-column
+ "g" #'vtable-revert-command
+ "M-<left>" #'vtable-previous-column
+ "M-<right>" #'vtable-next-column)
+
+(defvar-keymap vtable-header-line-map
+ :parent vtable-map
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'vtable-header-line-sort)
+
+(cl-defun make-vtable (&key columns objects objects-function
+ getter
+ formatter
+ displayer
+ (use-header-line t)
+ (face 'vtable)
+ actions keymap
+ (separator-width 1)
+ divider
+ divider-width
+ sort-by
+ (ellipsis t)
+ (insert t)
+ row-colors
+ column-colors)
+ "Create and insert a vtable at point.
+The vtable object is returned. If INSERT is nil, the table won't
+be inserted.
+
+See info node `(vtable)Top' for vtable documentation."
+ (when objects-function
+ (setq objects (funcall objects-function)))
+ ;; We'll be altering the list, so create a copy.
+ (setq objects (copy-sequence objects))
+ (let ((table
+ (make-instance
+ 'vtable
+ :objects objects
+ :objects-function objects-function
+ :getter getter
+ :formatter formatter
+ :displayer displayer
+ :use-header-line use-header-line
+ :face face
+ :actions actions
+ :keymap keymap
+ :separator-width separator-width
+ :sort-by sort-by
+ :row-colors row-colors
+ :column-colors column-colors
+ :ellipsis ellipsis)))
+ ;; Store whether the user has specified columns or not.
+ (setf (slot-value table '-has-column-spec) (not (not columns)))
+ ;; Auto-generate the columns.
+ (unless columns
+ (unless objects
+ (error "Can't auto-generate columns; no objects"))
+ (setq columns (make-list (length (car objects)) "")))
+ (setf (vtable-columns table)
+ (mapcar (lambda (column)
+ (cond
+ ;; We just have the name (as a string).
+ ((stringp column)
+ (make-vtable-column :name column))
+ ;; A plist of keywords/values.
+ ((listp column)
+ (apply #'make-vtable-column column))
+ ;; A full `vtable-column' object.
+ (t
+ column)))
+ columns))
+ ;; Compute missing column data.
+ (setf (vtable-columns table) (vtable--compute-columns table))
+ ;; Compute the colors.
+ (when (or row-colors column-colors)
+ (setf (slot-value table '-cached-colors)
+ (vtable--compute-colors row-colors column-colors)))
+ ;; Compute the divider.
+ (when (or divider divider-width)
+ (setf (vtable-divider table)
+ (propertize
+ (or (copy-sequence divider)
+ (propertize
+ " " 'display
+ (list 'space :width
+ (list (vtable--compute-width table divider-width)))))
+ 'mouse-face 'highlight
+ 'keymap
+ (define-keymap
+ "<drag-mouse-1>" #'vtable--drag-resize-column
+ "<down-mouse-1>" #'ignore))))
+ ;; Compute the keymap.
+ (setf (slot-value table '-cached-keymap) (vtable--make-keymap table))
+ (unless sort-by
+ (seq-do-indexed (lambda (column index)
+ (when (vtable-column-primary column)
+ (push (cons index (vtable-column-primary column))
+ (vtable-sort-by table))))
+ (vtable-columns table)))
+ (when insert
+ (vtable-insert table))
+ table))
+
+(defun vtable--compute-colors (row-colors column-colors)
+ (cond
+ ((null column-colors)
+ (mapcar #'vtable--make-color-face row-colors))
+ ((null row-colors)
+ (mapcar #'vtable--make-color-face column-colors))
+ (t
+ (cl-loop for row in row-colors
+ collect (cl-loop for column in column-colors
+ collect (vtable--face-blend
+ (vtable--make-color-face row)
+ (vtable--make-color-face column)))))))
+
+(defun vtable--make-color-face (object)
+ (if (stringp object)
+ (list :background object)
+ object))
+
+(defun vtable--face-blend (face1 face2)
+ (let ((foreground (vtable--face-color face1 face2 #'face-foreground
+ :foreground))
+ (background (vtable--face-color face1 face2 #'face-background
+ :background)))
+ `(,@(and foreground (list :foreground foreground))
+ ,@(and background (list :background background)))))
+
+(defun vtable--face-color (face1 face2 accessor slot)
+ (let ((col1 (if (facep face1)
+ (funcall accessor face1)
+ (plist-get face1 slot)))
+ (col2 (if (facep face2)
+ (funcall accessor face2)
+ (plist-get face2 slot))))
+ (if (and col1 col2)
+ (vtable--color-blend col1 col2)
+ (or col1 col2))))
+
+;;; FIXME: This is probably not the right way to blend two colors, is
+;;; it?
+(defun vtable--color-blend (color1 color2)
+ (cl-destructuring-bind (r g b)
+ (mapcar (lambda (n) (* (/ n 2) 255.0))
+ (cl-mapcar #'+ (color-name-to-rgb color1)
+ (color-name-to-rgb color2)))
+ (format "#%02X%02X%02X" r g b)))
+
+;;; Interface utility functions.
+
+(defun vtable-current-table ()
+ "Return the table under point."
+ (get-text-property (point) 'vtable))
+
+(defun vtable-current-object ()
+ "Return the object under point."
+ (get-text-property (point) 'vtable-object))
+
+(defun vtable-current-column ()
+ "Return the index of the column under point."
+ (get-text-property (point) 'vtable-column))
+
+(defun vtable-beginning-of-table ()
+ "Go to the start of the current table."
+ (if (text-property-search-backward 'vtable (vtable-current-table))
+ (point)
+ (goto-char (point-min))))
+
+(defun vtable-end-of-table ()
+ "Go to the end of the current table."
+ (if (text-property-search-forward 'vtable (vtable-current-table))
+ (point)
+ (goto-char (point-max))))
+
+(defun vtable-goto-object (object)
+ "Go to OBJECT in the current table.
+Return the position of the object if found, and nil if not."
+ (let ((start (point)))
+ (vtable-beginning-of-table)
+ (save-restriction
+ (narrow-to-region (point) (save-excursion (vtable-end-of-table)))
+ (if (text-property-search-forward 'vtable-object object #'eq)
+ (progn
+ (forward-line -1)
+ (point))
+ (goto-char start)
+ nil))))
+
+(defun vtable-goto-table (table)
+ "Go to TABLE in the current buffer.
+If TABLE is found, return the position of the start of the table.
+If it can't be found, return nil and don't move point."
+ (let ((start (point)))
+ (goto-char (point-min))
+ (if-let ((match (text-property-search-forward 'vtable table t)))
+ (goto-char (prop-match-beginning match))
+ (goto-char start)
+ nil)))
+
+(defun vtable-goto-column (column)
+ "Go to COLUMN on the current line."
+ (beginning-of-line)
+ (if-let ((match (text-property-search-forward 'vtable-column column t)))
+ (goto-char (prop-match-beginning match))
+ (end-of-line)))
+
+(defun vtable-update-object (table object old-object)
+ "Replace OLD-OBJECT in TABLE with OBJECT."
+ (let* ((objects (vtable-objects table))
+ (inhibit-read-only t))
+ ;; First replace the object in the object storage.
+ (if (eq old-object (car objects))
+ ;; It's at the head, so replace it there.
+ (setf (vtable-objects table)
+ (cons object (cdr objects)))
+ ;; Otherwise splice into the list.
+ (while (and (cdr objects)
+ (not (eq (cadr objects) old-object)))
+ (setq objects (cdr objects)))
+ (unless objects
+ (error "Can't find the old object"))
+ (setcar (cdr objects) object))
+ ;; Then update the cache...
+ (let* ((line-number (seq-position old-object (car (vtable--cache table))))
+ (line (elt (car (vtable--cache table)) line-number)))
+ (unless line
+ (error "Can't find cached object"))
+ (setcar line object)
+ (setcdr line (vtable--compute-cached-line table object))
+ ;; ... and redisplay the line in question.
+ (save-excursion
+ (vtable-goto-object old-object)
+ (let ((keymap (get-text-property (point) 'keymap))
+ (start (point)))
+ (delete-line)
+ (vtable--insert-line table line line-number
+ (nth 1 (vtable--cache table))
+ (vtable--spacer table))
+ (add-text-properties start (point) (list 'keymap keymap
+ 'vtable table))))
+ ;; We may have inserted a non-numerical value into a previously
+ ;; all-numerical table, so recompute.
+ (vtable--recompute-numerical table (cdr line)))))
+
+(defun vtable-remove-object (table object)
+ "Remove OBJECT from TABLE.
+This will also remove the displayed line."
+ ;; First remove from the objects.
+ (setf (vtable-objects table) (delq object (vtable-objects table)))
+ ;; Then adjust the cache and display.
+ (let ((cache (vtable--cache table))
+ (inhibit-read-only t))
+ (setcar cache (delq (assq object (car cache)) (car cache)))
+ (save-excursion
+ (vtable-goto-table table)
+ (when (vtable-goto-object object)
+ (delete-line)))))
+
+(defun vtable-insert-object (table object &optional after-object)
+ "Insert OBJECT into TABLE after AFTER-OBJECT.
+If AFTER-OBJECT is nil (or doesn't exist in the table), insert
+OBJECT at the end.
+This also updates the displayed table."
+ ;; First insert into the objects.
+ (let (pos)
+ (if (and after-object
+ (setq pos (memq after-object (vtable-objects table))))
+ ;; Splice into list.
+ (setcdr pos (cons object (cdr pos)))
+ ;; Append.
+ (nconc (vtable-objects table) (list object))))
+ ;; Then adjust the cache and display.
+ (save-excursion
+ (vtable-goto-table table)
+ (let* ((cache (vtable--cache table))
+ (inhibit-read-only t)
+ (keymap (get-text-property (point) 'keymap))
+ (elem (and after-object
+ (assq after-object (car cache))))
+ (line (cons object (vtable--compute-cached-line table object))))
+ (if (not elem)
+ ;; Append.
+ (progn
+ (setcar cache (nconc (car cache) (list line)))
+ (vtable-end-of-table))
+ ;; Splice into list.
+ (let ((pos (memq elem (car cache))))
+ (setcdr pos (cons line (cdr pos)))
+ (unless (vtable-goto-object after-object)
+ (vtable-end-of-table))))
+ (let ((start (point)))
+ ;; FIXME: We have to adjust colors in lines below this if we
+ ;; have :row-colors.
+ (vtable--insert-line table line 0
+ (nth 1 cache) (vtable--spacer table))
+ (add-text-properties start (point) (list 'keymap keymap
+ 'vtable table)))
+ ;; We may have inserted a non-numerical value into a previously
+ ;; all-numerical table, so recompute.
+ (vtable--recompute-numerical table (cdr line)))))
+
+(defun vtable-column (table index)
+ "Return the name of the INDEXth column in TABLE."
+ (vtable-column-name (elt (vtable-columns table) index)))
+
+;;; Generating the table.
+
+(defun vtable--get-value (object index column table)
+ "Compute a cell value."
+ (cond
+ ((vtable-column-getter column)
+ (funcall (vtable-column-getter column)
+ object table))
+ ((vtable-getter table)
+ (funcall (vtable-getter table)
+ object index table))
+ ;; No getter functions; standard getters.
+ ((stringp object)
+ object)
+ (t
+ (elt object index))))
+
+(defun vtable--compute-columns (table)
+ (let ((numerical (make-vector (length (vtable-columns table)) t))
+ (columns (vtable-columns table)))
+ ;; First determine whether there are any all-numerical columns.
+ (dolist (object (vtable-objects table))
+ (seq-do-indexed
+ (lambda (_elem index)
+ (unless (numberp (vtable--get-value object index (elt columns index)
+ table))
+ (setf (elt numerical index) nil)))
+ (vtable-columns table)))
+ ;; Then fill in defaults.
+ (seq-map-indexed
+ (lambda (column index)
+ ;; This is used when displaying.
+ (unless (vtable-column-align column)
+ (setf (vtable-column-align column)
+ (if (elt numerical index)
+ 'right
+ 'left)))
+ ;; This is used for sorting.
+ (setf (vtable-column--numerical column)
+ (elt numerical index))
+ column)
+ (vtable-columns table))))
+
+(defun vtable--spacer (table)
+ (vtable--compute-width table (vtable-separator-width table)))
+
+(defun vtable--recompute-cache (table)
+ (let* ((data (vtable--compute-cache table))
+ (widths (vtable--compute-widths table data)))
+ (setf (gethash (vtable--cache-key) (slot-value table '-cache))
+ (list data widths))))
+
+(defun vtable--ensure-cache (table)
+ (or (vtable--cache table)
+ (vtable--recompute-cache table)))
+
+(defun vtable-insert (table)
+ (let* ((spacer (vtable--spacer table))
+ (start (point))
+ (ellipsis (if (vtable-ellipsis table)
+ (propertize (truncate-string-ellipsis)
+ 'face (vtable-face table))
+ ""))
+ (ellipsis-width (string-pixel-width ellipsis))
+ ;; We maintain a cache per screen/window width, so that we render
+ ;; correctly if Emacs is open on two different screens (or the
+ ;; user resizes the frame).
+ (widths (nth 1 (vtable--ensure-cache table))))
+ ;; Don't insert any header or header line if the user hasn't
+ ;; specified the columns.
+ (when (slot-value table '-has-column-spec)
+ (if (vtable-use-header-line table)
+ (vtable--set-header-line table widths spacer)
+ ;; Insert the header line directly into the buffer, and put a
+ ;; keymap to be able to sort the columns there (by clicking on
+ ;; them).
+ (vtable--insert-header-line table widths spacer)
+ (add-text-properties start (point)
+ (list 'keymap vtable-header-line-map
+ 'rear-nonsticky t
+ 'vtable table))
+ (setq start (point))))
+ (vtable--sort table)
+ ;; Insert the data.
+ (let ((line-number 0))
+ (dolist (line (car (vtable--cache table)))
+ (vtable--insert-line table line line-number widths spacer
+ ellipsis ellipsis-width)
+ (setq line-number (1+ line-number))))
+ (add-text-properties start (point)
+ (list 'rear-nonsticky t
+ 'vtable table))
+ (goto-char start)))
+
+(defun vtable--insert-line (table line line-number widths spacer
+ &optional ellipsis ellipsis-width)
+ (let ((start (point))
+ (columns (vtable-columns table))
+ (column-colors
+ (and (vtable-column-colors table)
+ (if (vtable-row-colors table)
+ (elt (slot-value table '-cached-colors)
+ (mod line-number (length (vtable-row-colors table))))
+ (slot-value table '-cached-colors))))
+ (divider (vtable-divider table))
+ (keymap (slot-value table '-cached-keymap)))
+ (seq-do-indexed
+ (lambda (elem index)
+ (let ((value (nth 0 elem))
+ (column (elt columns index))
+ (pre-computed (nth 2 elem)))
+ ;; See if we have any formatters here.
+ (cond
+ ((vtable-column-formatter column)
+ (setq value (funcall (vtable-column-formatter column) value)
+ pre-computed nil))
+ ((vtable-formatter table)
+ (setq value (funcall (vtable-formatter table)
+ value index table)
+ pre-computed nil)))
+ (let ((displayed
+ ;; Allow any displayers to have their say.
+ (cond
+ ((vtable-column-displayer column)
+ (funcall (vtable-column-displayer column)
+ value (elt widths index) table))
+ ((vtable-displayer table)
+ (funcall (vtable-displayer table)
+ value index (elt widths index) table))
+ (pre-computed
+ ;; If we don't have a displayer, use the pre-made
+ ;; (cached) string value.
+ (if (> (nth 1 elem) (elt widths index))
+ (concat
+ (vtable--limit-string
+ pre-computed (- (elt widths index) ellipsis-width))
+ ellipsis)
+ pre-computed))
+ ;; Recompute widths.
+ (t
+ (if (> (string-pixel-width value) (elt widths index))
+ (concat
+ (vtable--limit-string
+ value (- (elt widths index) ellipsis-width))
+ ellipsis)
+ value))))
+ (start (point))
+ ;; Don't insert the separator after the final column.
+ (last (= index (- (length line) 2))))
+ (if (eq (vtable-column-align column) 'left)
+ (progn
+ (insert displayed)
+ (insert (propertize
+ " " 'display
+ (list 'space
+ :width (list
+ (+ (- (elt widths index)
+ (string-pixel-width displayed))
+ (if last 0 spacer)))))))
+ ;; Align to the right.
+ (insert (propertize " " 'display
+ (list 'space
+ :width (list (- (elt widths index)
+ (string-pixel-width
+ displayed)))))
+ displayed)
+ (unless last
+ (insert (propertize " " 'display
+ (list 'space
+ :width (list spacer))))))
+ (put-text-property start (point) 'vtable-column index)
+ (put-text-property start (point) 'keymap keymap)
+ (when column-colors
+ (add-face-text-property
+ start (point)
+ (elt column-colors (mod index (length column-colors)))))
+ (when divider
+ (insert divider)
+ (setq start (point))))))
+ (cdr line))
+ (insert "\n")
+ (put-text-property start (point) 'vtable-object (car line))
+ (unless column-colors
+ (when-let ((row-colors (slot-value table '-cached-colors)))
+ (add-face-text-property
+ start (point)
+ (elt row-colors (mod line-number (length row-colors))))))))
+
+(defun vtable--cache-key ()
+ (cons (frame-terminal) (window-width)))
+
+(defun vtable--cache (table)
+ (gethash (vtable--cache-key) (slot-value table '-cache)))
+
+(defun vtable--clear-cache (table)
+ (setf (gethash (vtable--cache-key) (slot-value table '-cache)) nil))
+
+(defun vtable--sort (table)
+ (pcase-dolist (`(,index . ,direction) (vtable-sort-by table))
+ (let ((cache (vtable--cache table))
+ (numerical (vtable-column--numerical
+ (elt (vtable-columns table) index)))
+ (numcomp (if (eq direction 'descend)
+ #'> #'<))
+ (stringcomp (if (eq direction 'descend)
+ #'string> #'string<)))
+ (setcar cache
+ (sort (car cache)
+ (lambda (e1 e2)
+ (let ((c1 (elt e1 (1+ index)))
+ (c2 (elt e2 (1+ index))))
+ (if numerical
+ (funcall numcomp (car c1) (car c2))
+ (funcall
+ stringcomp
+ (if (stringp (car c1))
+ (car c1)
+ (format "%s" (car c1)))
+ (if (stringp (car c2))
+ (car c2)
+ (format "%s" (car c2))))))))))))
+
+(defun vtable--indicator (table index)
+ (let ((order (car (last (vtable-sort-by table)))))
+ (if (eq index (car order))
+ ;; We're sorting by this column last, so return an indicator.
+ (catch 'found
+ (dolist (candidate (nth (if (eq (cdr order) 'ascend)
+ 1
+ 0)
+ '((?▼ ?v)
+ (?▲ ?^))))
+ (when (char-displayable-p candidate)
+ (throw 'found (string candidate)))))
+ "")))
+
+(defun vtable--insert-header-line (table widths spacer)
+ ;; Insert the header directly into the buffer.
+ (let ((start (point))
+ (divider (vtable-divider table))
+ (cmap (define-keymap
+ "<header-line> <drag-mouse-1>" #'vtable--drag-resize-column
+ "<header-line> <down-mouse-1>" #'ignore))
+ (dmap (define-keymap
+ "<header-line> <drag-mouse-1>"
+ (lambda (e)
+ (interactive "e")
+ (vtable--drag-resize-column e t))
+ "<header-line> <down-mouse-1>" #'ignore)))
+ (seq-do-indexed
+ (lambda (column index)
+ (let* ((name (propertize
+ (vtable-column-name column)
+ 'face (list 'header-line (vtable-face table))
+ 'mouse-face 'header-line-highlight
+ 'keymap cmap))
+ (start (point))
+ (indicator (vtable--indicator table index))
+ (indicator-width (string-pixel-width indicator))
+ (last (= index (1- (length (vtable-columns table)))))
+ displayed)
+ (setq displayed
+ (if (> (string-pixel-width name)
+ (- (elt widths index) indicator-width))
+ (vtable--limit-string
+ name (- (elt widths index) indicator-width))
+ name))
+ (let ((fill-width
+ (+ (- (elt widths index)
+ (string-pixel-width displayed)
+ indicator-width
+ (vtable-separator-width table)
+ ;; We want the indicator to not be quite flush
+ ;; right.
+ (/ (vtable--char-width table) 2.0))
+ (if last 0 spacer))))
+ (if (or (not last)
+ (zerop indicator-width)
+ (< (seq-reduce #'+ widths 0) (window-width nil t)))
+ ;; Normal case.
+ (insert
+ displayed
+ (propertize " " 'display
+ (list 'space :width (list fill-width)))
+ indicator)
+ ;; This is the final column, and we have a sorting
+ ;; indicator, and the table is too wide for the window.
+ (let* ((pre-indicator (string-pixel-width
+ (buffer-substring (point-min) (point))))
+ (pre-fill
+ (- (window-width nil t)
+ pre-indicator
+ (string-pixel-width displayed))))
+ (insert
+ displayed
+ (propertize " " 'display
+ (list 'space :width (list pre-fill)))
+ indicator
+ (propertize " " 'display
+ (list 'space :width
+ (list (- fill-width pre-fill))))))))
+ (when (and divider (not last))
+ (insert (propertize divider 'keymap dmap)))
+ (insert (propertize
+ " " 'display
+ (list 'space :width (list
+ (/ (vtable--char-width table) 2.0)))))
+ (put-text-property start (point) 'vtable-column index)))
+ (vtable-columns table))
+ (insert "\n")
+ (add-face-text-property start (point) 'header-line)))
+
+(defun vtable--drag-resize-column (e &optional next)
+ "Resize the column by dragging.
+If NEXT, do the next column."
+ (interactive "e")
+ (let* ((pos-start (event-start e))
+ (obj (posn-object pos-start)))
+ (with-current-buffer (window-buffer (posn-window pos-start))
+ (let ((column
+ ;; In the header line we have a text property on the
+ ;; divider.
+ (or (get-text-property (if obj (cdr obj)
+ (posn-point pos-start))
+ 'vtable-column
+ (car obj))
+ ;; For reasons of efficiency, we don't have that in
+ ;; the buffer itself, so find the column.
+ (save-excursion
+ (goto-char (posn-point pos-start))
+ (1+
+ (get-text-property
+ (prop-match-beginning
+ (text-property-search-backward 'vtable-column))
+ 'vtable-column)))))
+ (start-x (car (posn-x-y pos-start)))
+ (end-x (car (posn-x-y (event-end e)))))
+ (when (or (> column 0) next)
+ (vtable--alter-column-width (vtable-current-table)
+ (if next
+ column
+ (1- column))
+ (- end-x start-x)))))))
+
+(defun vtable--recompute-numerical (table line)
+ "Recompute numericalness of columns if necessary."
+ (let ((columns (vtable-columns table))
+ (recompute nil))
+ (seq-do-indexed
+ (lambda (elem index)
+ (when (and (vtable-column--numerical (elt columns index))
+ (not (numberp elem)))
+ (setq recompute t)))
+ line)
+ (when recompute
+ (vtable--compute-columns table))))
+
+(defun vtable--set-header-line (table widths spacer)
+ (setq header-line-format
+ (string-replace
+ "%" "%%"
+ (with-temp-buffer
+ (insert " ")
+ (vtable--insert-header-line table widths spacer)
+ ;; Align the header with the (possibly) fringed buffer text.
+ (put-text-property
+ (point-min) (1+ (point-min))
+ 'display '(space :align-to 0))
+ (buffer-substring (point-min) (1- (point-max))))))
+ (vtable-header-mode 1))
+
+(defun vtable--limit-string (string pixels)
+ (while (and (length> string 0)
+ (> (string-pixel-width string) pixels))
+ (setq string (substring string 0 (1- (length string)))))
+ string)
+
+(defun vtable--char-width (table)
+ (string-pixel-width (propertize "x" 'face (vtable-face table))))
+
+(defun vtable--compute-width (table spec)
+ (cond
+ ((numberp spec)
+ (* spec (vtable--char-width table)))
+ ((string-match "\\([0-9.]+\\)ex" spec)
+ (* (string-to-number (match-string 1 spec)) (vtable--char-width table)))
+ ((string-match "\\([0-9.]+\\)px" spec)
+ (string-to-number (match-string 1 spec)))
+ ((string-match "\\([0-9.]+\\)%" spec)
+ (* (string-to-number (match-string 1 spec)) (window-width nil t)))
+ (t
+ (error "Invalid spec: %s" spec))))
+
+(defun vtable--compute-widths (table cache)
+ "Compute the display widths for TABLE."
+ (seq-into
+ (seq-map-indexed
+ (lambda (column index)
+ (let ((width
+ (or
+ ;; Explicit widths.
+ (and (vtable-column-width column)
+ (vtable--compute-width table (vtable-column-width column)))
+ ;; Compute based on the displayed widths of
+ ;; the data.
+ (seq-max (seq-map (lambda (elem)
+ (nth 1 (elt (cdr elem) index)))
+ cache)))))
+ ;; Let min-width/max-width specs have their say.
+ (when-let ((min-width (and (vtable-column-min-width column)
+ (vtable--compute-width
+ table (vtable-column-min-width column)))))
+ (setq width (max width min-width)))
+ (when-let ((max-width (and (vtable-column-max-width column)
+ (vtable--compute-width
+ table (vtable-column-max-width column)))))
+ (setq width (min width max-width)))
+ width))
+ (vtable-columns table))
+ 'vector))
+
+(defun vtable--compute-cache (table)
+ (seq-map
+ (lambda (object)
+ (cons object (vtable--compute-cached-line table object)))
+ (vtable-objects table)))
+
+(defun vtable--compute-cached-line (table object)
+ (seq-map-indexed
+ (lambda (column index)
+ (let* ((value (vtable--get-value object index column table))
+ (string (if (stringp value)
+ (copy-sequence value)
+ (format "%s" value))))
+ (add-face-text-property 0 (length string)
+ (vtable-face table)
+ t string)
+ ;; We stash the computed width and string here -- if there are
+ ;; no formatters/displayers, we'll be using the string, and
+ ;; then won't have to recreate it.
+ (list value (string-pixel-width string) string)))
+ (vtable-columns table)))
+
+(defun vtable--make-keymap (table)
+ (let ((map (if (or (vtable-actions table)
+ (vtable-keymap table))
+ (copy-keymap vtable-map)
+ vtable-map)))
+ (when-let ((actions (vtable-actions table)))
+ (while actions
+ (funcall (lambda (key binding)
+ (keymap-set map key
+ (lambda (object)
+ (interactive (list (vtable-current-object)))
+ (funcall binding object))))
+ (car actions) (cadr actions))
+ (setq actions (cddr actions))))
+ (if (vtable-keymap table)
+ (progn
+ (setf (vtable-keymap table)
+ (copy-keymap (vtable-keymap table)))
+ ;; Respect any previously set parent keymaps.
+ (set-keymap-parent (vtable-keymap table)
+ (if (keymap-parent (vtable-keymap table))
+ (append (ensure-list
+ (vtable-keymap table))
+ (list map))
+ map))
+ (vtable-keymap table))
+ map)))
+
+(defun vtable-revert ()
+ "Regenerate the table under point."
+ (let ((table (vtable-current-table))
+ (object (vtable-current-object))
+ (column (vtable-current-column))
+ (inhibit-read-only t))
+ (unless table
+ (user-error "No table under point"))
+ (delete-region (vtable-beginning-of-table) (vtable-end-of-table))
+ (vtable-insert table)
+ (when object
+ (vtable-goto-object object))
+ (when column
+ (vtable-goto-column column))))
+
+(defun vtable--widths (table)
+ (nth 1 (vtable--ensure-cache table)))
+
+;;; Commands.
+
+(defvar-keymap vtable-header-mode-map
+ "<header-line> <mouse-1>" 'vtable-header-line-sort
+ "<header-line> <mouse-2>" 'vtable-header-line-sort)
+
+(define-minor-mode vtable-header-mode
+ "Minor mode for buffers with vtables with headers."
+ :keymap vtable-header-mode-map)
+
+(defun vtable-narrow-current-column (&optional n)
+ "Narrow the current column by N characters.
+If N isn't given, N defaults to 1.
+
+Interactively, N is the prefix argument."
+ (interactive "p")
+ (let* ((table (vtable-current-table))
+ (column (vtable-current-column)))
+ (unless column
+ (user-error "No column under point"))
+ (vtable--alter-column-width table column
+ (- (* (vtable--char-width table) (or n 1))))))
+
+(defun vtable--alter-column-width (table column delta)
+ (let ((widths (vtable--widths table)))
+ (setf (aref widths column)
+ (max (* (vtable--char-width table) 2)
+ (+ (aref widths column) delta)))
+ ;; Store the width so it'll be respected on a revert.
+ (setf (vtable-column-width (elt (vtable-columns table) column))
+ (format "%dpx" (aref widths column)))
+ (vtable-revert)))
+
+(defun vtable-widen-current-column (&optional n)
+ "Widen the current column by N characters.
+If N isn't given, N defaults to 1.
+
+Interactively, N is the prefix argument."
+ (interactive "p")
+ (vtable-narrow-current-column (- n)))
+
+(defun vtable-previous-column ()
+ "Go to the previous column."
+ (interactive)
+ (vtable-goto-column
+ (max 0 (1- (or (vtable-current-column)
+ (length (vtable--widths (vtable-current-table))))))))
+
+(defun vtable-next-column ()
+ "Go to the next column."
+ (interactive)
+ (when (vtable-current-column)
+ (vtable-goto-column
+ (min (1- (length (vtable--widths (vtable-current-table))))
+ (1+ (vtable-current-column))))))
+
+(defun vtable-revert-command ()
+ "Re-query data and regenerate the table under point."
+ (interactive)
+ (let ((table (vtable-current-table)))
+ (when (vtable-objects-function table)
+ (setf (vtable-objects table) (funcall (vtable-objects-function table))))
+ (vtable--clear-cache table))
+ (vtable-revert))
+
+(defun vtable-sort-by-current-column ()
+ "Sort the table under point by the column under point."
+ (interactive)
+ (unless (vtable-current-column)
+ (user-error "No current column"))
+ (let* ((table (vtable-current-table))
+ (last (car (last (vtable-sort-by table))))
+ (index (vtable-current-column)))
+ ;; First prune any previous appearance of this column.
+ (setf (vtable-sort-by table)
+ (delq (assq index (vtable-sort-by table))
+ (vtable-sort-by table)))
+ ;; Then insert this as the last sort key.
+ (setf (vtable-sort-by table)
+ (append (vtable-sort-by table)
+ (list (cons index
+ (if (eq (car last) index)
+ (if (eq (cdr last) 'ascend)
+ 'descend
+ 'ascend)
+ 'ascend))))))
+ (vtable-revert))
+
+(defun vtable-header-line-sort (e)
+ "Sort a vtable from the header line."
+ (interactive "e")
+ (let* ((pos (event-start e))
+ (obj (posn-object pos)))
+ (with-current-buffer (window-buffer (posn-window pos))
+ (goto-char (point-min))
+ (vtable-goto-column
+ (get-text-property (if obj (cdr obj) (posn-point pos))
+ 'vtable-column
+ (car obj)))
+ (vtable-sort-by-current-column))))
+
+(provide 'vtable)
+
+;;; vtable.el ends here
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 55adb9c8b91..23e20c3b10c 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -307,7 +307,9 @@ entirely by setting `warning-suppress-types' or
'type 'warning-suppress-log-warning
'warning-type type))
(funcall newline)
- (when (and warning-fill-prefix (not (string-search "\n" message)))
+ (when (and warning-fill-prefix
+ (not (string-search "\n" message))
+ (not noninteractive))
(let ((fill-prefix warning-fill-prefix)
(fill-column warning-fill-column))
(fill-region start (point))))
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 3d2eda99a9c..1818e22a923 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -88,9 +88,6 @@ The functions get one argument, the first locked buffer found."
:group 'emacs-lock
:version "24.3")
-(define-obsolete-variable-alias 'emacs-lock-from-exiting
- 'emacs-lock-mode "24.1")
-
(defvar-local emacs-lock-mode nil
"If non-nil, the current buffer is locked.
It can be one of the following values:
@@ -247,14 +244,6 @@ some major modes from being locked under some circumstances."
;; continue standard unloading
nil))
-;;; Compatibility
-
-(defun toggle-emacs-lock ()
- "Toggle `emacs-lock-from-exiting' for the current buffer."
- (declare (obsolete emacs-lock-mode "24.1"))
- (interactive)
- (call-interactively 'emacs-lock-mode))
-
(provide 'emacs-lock)
;;; emacs-lock.el ends here
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 6e10c36e77a..162d1bb641b 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -396,17 +396,17 @@ and after the region marked by the rectangle to search."
(defcustom cua-rectangle-mark-key [(control return)]
"Global key used to toggle the cua rectangle mark."
- :set #'(lambda (symbol value)
- (set symbol value)
- (when (and (boundp 'cua--keymaps-initialized)
- cua--keymaps-initialized)
- (define-key cua-global-keymap value
- #'cua-set-rectangle-mark)
- (when (boundp 'cua--rectangle-keymap)
- (define-key cua--rectangle-keymap value
- #'cua-clear-rectangle-mark)
- (define-key cua--region-keymap value
- #'cua-toggle-rectangle-mark))))
+ :set (lambda (symbol value)
+ (set symbol value)
+ (when (and (boundp 'cua--keymaps-initialized)
+ cua--keymaps-initialized)
+ (define-key cua-global-keymap value
+ #'cua-set-rectangle-mark)
+ (when (boundp 'cua--rectangle-keymap)
+ (define-key cua--rectangle-keymap value
+ #'cua-clear-rectangle-mark)
+ (define-key cua--region-keymap value
+ #'cua-toggle-rectangle-mark))))
:type 'key-sequence)
(defcustom cua-rectangle-modifier-key 'meta
@@ -699,6 +699,11 @@ Repeating prefix key when region is active works as a single prefix key."
(interactive)
(cua--prefix-override-replay 0))
+;; These aliases are so that we can look up the commands and find the
+;; correct keys when generating menus.
+(defalias 'cua-cut-handler #'cua--prefix-override-handler)
+(defalias 'cua-copy-handler #'cua--prefix-override-handler)
+
(defun cua--prefix-repeat-handler ()
"Repeating prefix key when region is active works as a single prefix key."
(interactive)
@@ -1258,10 +1263,8 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(define-key cua--cua-keys-keymap [(meta v)]
#'delete-selection-repeat-replace-region))
- (define-key cua--prefix-override-keymap [(control x)]
- #'cua--prefix-override-handler)
- (define-key cua--prefix-override-keymap [(control c)]
- #'cua--prefix-override-handler)
+ (define-key cua--prefix-override-keymap [(control x)] #'cua-cut-handler)
+ (define-key cua--prefix-override-keymap [(control c)] #'cua-copy-handler)
(define-key cua--prefix-repeat-keymap [(control x) (control x)]
#'cua--prefix-repeat-handler)
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 2d69ef9d246..a7f3d5fe14c 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -486,10 +486,8 @@ Activates the region if needed. Only lasts until the region is deactivated."
(cua--deactivate t))
(setq cua--last-rectangle nil)
(mouse-set-point event)
- ;; FIX ME -- need to calculate virtual column.
- (cua-set-rectangle-mark)
- (setq cua--buffer-and-point-before-command nil)
- (setq cua--mouse-last-pos nil))
+ (activate-mark)
+ (cua-rectangle-mark-mode))
(defun cua-mouse-save-then-kill-rectangle (event arg)
"Expand rectangle to mouse click position and copy rectangle.
@@ -574,7 +572,7 @@ Only call fct for visible lines if VISIBLE==t.
Set undo boundary if UNDO is non-nil.
Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
Perform auto-tabify after operation if TABIFY is non-nil.
-Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear."
+Mark is kept if keep-clear is `keep' and cleared if keep-clear is `clear'."
(declare (indent 4))
(let* ((inhibit-field-text-motion t)
(start (cua--rectangle-top))
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index e08d19c6115..ddb49609d40 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -35,9 +35,7 @@
(defvar viper--key-maps)
(defvar viper--intercept-key-maps)
(defvar iso-accents-mode)
-(defvar quail-mode)
(defvar quail-current-str)
-(defvar mark-even-if-inactive)
(defvar viper--init-message)
(defvar viper-initial)
(defvar undo-beg-posn)
@@ -69,8 +67,7 @@
(nm-p (intern (concat snm "-p")))
(nms (intern (concat snm "s"))))
`(defun ,nm-p (com)
- (consp (viper-memq-char com ,nms)
- ))))
+ (consp (memq com ,nms)))))
;; Variables for defining VI commands
@@ -1035,23 +1032,23 @@ as a Meta key and any number of multiple escapes are allowed."
cmd-info
cmd-to-exec-at-end)
(while (and cont
- (viper-memq-char char
- (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\"
- viper-buffer-search-char)))
+ (memq char
+ (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\"
+ viper-buffer-search-char)))
(if com
;; this means that we already have a command character, so we
;; construct a com list and exit while. however, if char is "
;; it is an error.
(progn
;; new com is (CHAR . OLDCOM)
- (if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell))
+ (if (memq char '(?# ?\")) (user-error viper-ViperBell))
(setq com (cons char com))
(setq cont nil))
;; If com is nil we set com as char, and read more. Again, if char is
;; ", we read the name of register and store it in viper-use-register.
;; if char is !, =, or #, a complete com is formed so we exit the while
;; loop.
- (cond ((viper-memq-char char '(?! ?=))
+ (cond ((memq char '(?! ?=))
(setq com char)
(setq char (read-char))
(setq cont nil))
@@ -1091,7 +1088,7 @@ as a Meta key and any number of multiple escapes are allowed."
`(key-binding (char-to-string ,char)))))
;; as com is non-nil, this means that we have a command to execute
- (if (viper-memq-char (car com) '(?r ?R))
+ (if (memq (car com) '(?r ?R))
;; execute appropriate region command.
(let ((char (car com)) (com (cdr com)))
(setq prefix-arg (cons value com))
@@ -2321,7 +2318,6 @@ problems."
(viper-downgrade-to-insert))
(defun viper-start-R-mode ()
- ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
(overwrite-mode 1)
(add-hook
'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local)
@@ -2610,12 +2606,12 @@ On reaching beginning of line, stop and signal error."
(let ((prev-char (viper-char-at-pos 'backward))
(saved-point (point)))
;; skip non-newline separators backward
- (while (and (not (viper-memq-char prev-char '(nil \n)))
+ (while (and (not (memq prev-char '(nil \n)))
(< lim (point))
;; must be non-newline separator
(if (eq viper-syntax-preference 'strict-vi)
- (viper-memq-char prev-char '(?\ ?\t))
- (viper-memq-char (char-syntax prev-char) '(?\ ?-))))
+ (memq prev-char '(?\ ?\t))
+ (memq (char-syntax prev-char) '(?\ ?-))))
(viper-backward-char-carefully)
(setq prev-char (viper-char-at-pos 'backward)))
@@ -2629,12 +2625,12 @@ On reaching beginning of line, stop and signal error."
;; skip again, but make sure we don't overshoot the limit
(if twice
- (while (and (not (viper-memq-char prev-char '(nil \n)))
+ (while (and (not (memq prev-char '(nil \n)))
(< lim (point))
;; must be non-newline separator
(if (eq viper-syntax-preference 'strict-vi)
- (viper-memq-char prev-char '(?\ ?\t))
- (viper-memq-char (char-syntax prev-char) '(?\ ?-))))
+ (memq prev-char '(?\ ?\t))
+ (memq (char-syntax prev-char) '(?\ ?-))))
(viper-backward-char-carefully)
(setq prev-char (viper-char-at-pos 'backward))))
@@ -2652,10 +2648,10 @@ On reaching beginning of line, stop and signal error."
(viper-forward-word-kernel val)
(if com
(progn
- (cond ((viper-char-equal com ?c)
+ (cond ((eq com ?c)
(viper-separator-skipback-special 'twice viper-com-point))
;; Yank words including the whitespace, but not newline
- ((viper-char-equal com ?y)
+ ((eq com ?y)
(viper-separator-skipback-special nil viper-com-point))
((viper-dotable-command-p com)
(viper-separator-skipback-special nil viper-com-point)))
@@ -2673,10 +2669,10 @@ On reaching beginning of line, stop and signal error."
(viper-skip-nonseparators 'forward)
(viper-skip-separators t))
(if com (progn
- (cond ((viper-char-equal com ?c)
+ (cond ((eq com ?c)
(viper-separator-skipback-special 'twice viper-com-point))
;; Yank words including the whitespace, but not newline
- ((viper-char-equal com ?y)
+ ((eq com ?y)
(viper-separator-skipback-special nil viper-com-point))
((viper-dotable-command-p com)
(viper-separator-skipback-special nil viper-com-point)))
@@ -4726,15 +4722,15 @@ Please, specify your level now: "))
(defun viper-submit-report ()
"Submit bug report on Viper."
(interactive)
- (defvar viper-color-display-p)
+ (defvar x-display-color-p)
(defvar viper-frame-parameters)
(defvar viper-minibuffer-emacs-face)
(defvar viper-minibuffer-vi-face)
(defvar viper-minibuffer-insert-face)
(let ((reporter-prompt-for-summary-p t)
- (viper-color-display-p (if (viper-window-display-p)
- (viper-color-display-p)
- 'non-x))
+ (x-display-color-p (if (viper-window-display-p)
+ (x-display-color-p)
+ 'non-x))
(viper-frame-parameters (frame-parameters (selected-frame)))
(viper-minibuffer-emacs-face (if (viper-has-face-support-p)
(facep
@@ -4792,7 +4788,7 @@ Please, specify your level now: "))
'viper-expert-level
'major-mode
'window-system
- 'viper-color-display-p
+ 'x-display-color-p
'viper-frame-parameters
'viper-minibuffer-vi-face
'viper-minibuffer-insert-face
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 0427e8ae774..d1bf5e38d53 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -25,7 +25,6 @@
;;; Code:
;; Compiler pacifier
-(defvar read-file-name-map)
(defvar viper-use-register)
(defvar viper-s-string)
(defvar viper-shift-width)
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 7eac6a413ad..5430cd700bd 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -25,16 +25,12 @@
;;; Code:
;; compiler pacifier
-(defvar mark-even-if-inactive)
-(defvar quail-mode)
(defvar iso-accents-mode)
(defvar viper-current-state)
(defvar viper-version)
(defvar viper-expert-level)
(defvar current-input-method)
(defvar default-input-method)
-(defvar describe-current-input-method-function)
-(defvar bar-cursor)
(defvar cursor-type)
;; end pacifier
@@ -48,12 +44,6 @@
(define-obsolete-function-alias 'viper-device-type #'window-system "27.1")
-(defun viper-color-display-p ()
- (condition-case nil
- (display-color-p)
- (error nil)))
-
-;; in XEmacs: device-type is tty on tty and stream in batch.
(defun viper-window-display-p ()
(and window-system (not (memq window-system '(tty stream pc)))))
@@ -81,7 +71,7 @@ In all likelihood, you don't need to bother with this setting."
(defun viper-has-face-support-p ()
(cond ((viper-window-display-p))
(viper-force-faces)
- ((viper-color-display-p))
+ ((x-display-color-p))
(t (memq window-system '(pc)))))
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index c4eb183ce44..06130afa7da 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -105,7 +105,8 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
#'viper-end-mapping-kbd-macro)
(define-key viper-emacs-intercept-map "\C-x)"
#'viper-end-mapping-kbd-macro)
- (message "Mapping %S in %s state. Type macro definition followed by `C-x )'"
+ (message (substitute-command-keys "Mapping %S in %s state. \
+Type macro definition followed by \\[kmacro-end-macro]")
(viper-display-macro macro-name)
(if ins "Insert" "Vi")))
))
@@ -886,8 +887,9 @@ mistakes in macro names to be passed to this function is to use
(if (get-register reg)
(if (y-or-n-p "Register contains data. Overwrite? ")
()
- (error
- "Macro not saved in register. Can still be invoked via `C-x e'")))
+ (error
+ (substitute-command-keys
+ "Macro not saved in register. Can still be invoked via \\[kmacro-end-and-call-macro]"))))
(set-register reg last-kbd-macro))
(defun viper-register-macro (count)
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index 21580996049..1a90cab7674 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -26,7 +26,6 @@
;; compiler pacifier
(defvar double-click-time)
-(defvar mouse-track-multi-click-time)
(defvar viper-search-start-marker)
(defvar viper-local-search-start-marker)
(defvar viper-search-history)
@@ -63,8 +62,8 @@ or a triple-click."
;; time interval in millisecond within which successive clicks are
;; considered related
(defcustom viper-multiclick-timeout (if (viper-window-display-p)
- double-click-time
- 500)
+ (mouse-double-click-time)
+ 500)
"Time interval in milliseconds for mouse clicks to be considered related."
:type 'integer)
@@ -76,8 +75,8 @@ or a triple-click."
;; remembers prefix argument to pass along to commands invoked by second
;; click.
-;; This is needed because in Emacs (not XEmacs), assigning to prefix-arg
-;; causes Emacs to count the second click as if it was a single click
+;; This is needed because assigning to prefix-arg causes Emacs to
+;; count the second click as if it was a single click
(defvar viper-global-prefix-argument nil)
@@ -199,8 +198,7 @@ is ignored."
(setq result (buffer-substring word-beg (point))))
) ; if
- ;; XEmacs doesn't have set-text-properties, but there buffer-substring
- ;; doesn't return properties together with the string, so it's not needed.
+ ;; FIXME: Use `buffer-substring-no-properties' above instead?
(set-text-properties 0 (length result) nil result)
result))
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index df33496fd8d..6d23ae9a0fd 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -29,9 +29,6 @@
;; Compiler pacifier
(defvar viper-minibuffer-current-face)
-(defvar viper-minibuffer-insert-face)
-(defvar viper-minibuffer-vi-face)
-(defvar viper-minibuffer-emacs-face)
(defvar viper-replace-overlay-face)
(defvar viper-fast-keyseq-timeout)
(defvar ex-unix-type-shell)
@@ -64,22 +61,8 @@
(define-obsolete-function-alias 'viper-iconify
#'iconify-or-deiconify-frame "27.1")
-
-;; CHAR is supposed to be a char or an integer (positive or negative)
-;; LIST is a list of chars, nil, and negative numbers
-;; Check if CHAR is a member by trying to convert in characters, if necessary.
-;; Introduced for compatibility with XEmacs, where integers are not the same as
-;; chars.
-(defun viper-memq-char (char list)
- (cond ((and (integerp char) (>= char 0))
- (memq char list))
- ((memq char list))))
-
-;; Check if char-or-int and char are the same as characters
-(defun viper-char-equal (char-or-int char)
- (cond ((and (integerp char-or-int) (>= char-or-int 0))
- (= char-or-int char))
- ((eq char-or-int char))))
+(define-obsolete-function-alias 'viper-memq-char #'memq "29.1")
+(define-obsolete-function-alias 'viper-char-equal #'eq "29.1")
;; Like =, but accommodates null and also is t for eq-objects
(defun viper= (char char1)
@@ -88,8 +71,7 @@
(= char char1))
(t nil)))
-(defsubst viper-color-display-p ()
- (x-display-color-p))
+(define-obsolete-function-alias 'viper-color-display-p #'x-display-color-p "29.1")
(defun viper-get-cursor-color (&optional _frame)
(cdr (assoc 'cursor-color (frame-parameters))))
@@ -97,9 +79,6 @@
(defmacro viper-frame-value (variable)
"Return the value of VARIABLE local to the current frame, if there is one.
Otherwise return the normal value."
- ;; Frame-local variables are obsolete from Emacs 22.2 onwards,
- ;; so we do it by hand instead.
- ;; Buffer-local values take precedence over frame-local ones.
`(if (local-variable-p ',variable)
,variable
;; Distinguish between no frame parameter and a frame parameter
@@ -110,7 +89,7 @@ Otherwise return the normal value."
;; cursor colors
(defun viper-change-cursor-color (new-color &optional frame)
- (if (and (viper-window-display-p) (viper-color-display-p)
+ (if (and (viper-window-display-p) (x-display-color-p)
(stringp new-color) (x-color-defined-p new-color)
(not (string= new-color (viper-get-cursor-color))))
(modify-frame-parameters
@@ -142,7 +121,7 @@ Otherwise return the normal value."
;; By default, saves current frame cursor color before changing viper state
(defun viper-save-cursor-color (before-which-mode)
- (if (and (viper-window-display-p) (viper-color-display-p))
+ (if (and (viper-window-display-p) (x-display-color-p))
(let ((color (viper-get-cursor-color)))
(if (and (stringp color) (x-color-defined-p color)
;; there is something fishy in that the color is not saved if
@@ -1183,25 +1162,23 @@ This option is appropriate if you like Emacs-style words."
(looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]"))
(or
;; or one of the additional chars being asked to include
- (viper-memq-char char (viper-string-to-list addl-chars))
+ (memq char (viper-string-to-list addl-chars))
(and
;; not one of the excluded word chars (note:
;; viper-non-word-characters is a list)
- (not (viper-memq-char char viper-non-word-characters))
+ (not (memq char viper-non-word-characters))
;; char of the Viper-word syntax class
- (viper-memq-char (char-syntax char)
- (viper-string-to-list viper-ALPHA-char-class))))))
- ))
+ (memq (char-syntax char)
+ (viper-string-to-list viper-ALPHA-char-class))))))))
(defun viper-looking-at-separator ()
(let ((char (char-after (point))))
(if char
(if (eq viper-syntax-preference 'strict-vi)
- (viper-memq-char char (viper-string-to-list viper-strict-SEP-chars))
+ (memq char (viper-string-to-list viper-strict-SEP-chars))
(or (eq char ?\n) ; RET is always a separator in Vi
- (viper-memq-char (char-syntax char)
- (viper-string-to-list viper-SEP-char-class)))))
- ))
+ (memq (char-syntax char)
+ (viper-string-to-list viper-SEP-char-class)))))))
(defsubst viper-looking-at-alphasep (&optional addl-chars)
(or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars)))
@@ -1327,8 +1304,7 @@ This option is appropriate if you like Emacs-style words."
;; of the excluded characters
(if (and (eq syntax-of-char-looked-at ?w)
(not negated-syntax))
- (not (viper-memq-char
- char-looked-at viper-non-word-characters))
+ (not (memq char-looked-at viper-non-word-characters))
t))
(funcall skip-syntax-func 1)
0)
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 51c1bf7d623..be87d788e92 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -304,7 +304,6 @@
;; compiler pacifier
(defvar mark-even-if-inactive)
-(defvar quail-mode)
(defvar viper-expert-level)
(defvar viper-mode-string)
(defvar viper-major-mode-modifier-list)
@@ -560,10 +559,10 @@ and improving upon much of it.
2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they
do not cause Emacs to quit, except at user level 1 (for a novice).
3. ^X^C EXITS EMACS.
- 4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat
- undo. Another `u' changes direction.
+ 4. Viper supports multiple undo: \\`u' will undo. Typing \\`.' will repeat
+ undo. Another \\`u' changes direction.
- 6. Emacs Meta key is `C-\\' (in all modes) or `\\ ESC' (in Vi command mode).
+ 6. Emacs Meta key is \\`C-\\' (in all modes) or \\`\\ ESC' (in Vi command mode).
On a window system, the best way is to use the Meta-key on your keyboard.
7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,if
something funny happens. This would abort the current editing command.
@@ -574,12 +573,12 @@ For more information on Viper:
b. Print Viper manual, found in ./etc/viper.dvi
c. Print the Quick Reference, found in ./etc/viperCard.dvi
-To submit a bug report or to contact the author, type :submitReport in Vi
+To submit a bug report or to contact the author, type \\`:submitReport' in Vi
command mode. To shoo Viper away and return to pure Emacs (horror!), type:
\\[viper-go-away]
-This startup message appears whenever you load Viper, unless you type `y' now."
+This startup message appears whenever you load Viper, unless you type \\`y' now."
))
(goto-char (point-min))
(if (y-or-n-p "Inhibit Viper startup message? ")
diff --git a/lisp/env.el b/lisp/env.el
index a630bf120f8..a35383a13b1 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -225,7 +225,7 @@ VARIABLES is a list of variable settings of the form (VAR VALUE),
where VAR is the name of the variable (a string) and VALUE
is its value (also a string).
-The previous values will be be restored upon exit."
+The previous values will be restored upon exit."
(declare (indent 1) (debug (sexp body)))
(unless (consp variables)
(error "Invalid VARIABLES: %s" variables))
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index 85b0e35d7be..18e47c682e8 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -56,15 +56,15 @@ through Custom does that automatically."
May either be a string or a list of strings.")
(put 'epa-file-encrypt-to 'safe-local-variable
- #'(lambda (val)
- (or (stringp val)
- (and (listp val)
- (catch 'safe
- (mapc (lambda (elt)
- (unless (stringp elt)
- (throw 'safe nil)))
- val)
- t)))))
+ (lambda (val)
+ (or (stringp val)
+ (and (listp val)
+ (catch 'safe
+ (mapc (lambda (elt)
+ (unless (stringp elt)
+ (throw 'safe nil)))
+ val)
+ t)))))
(put 'epa-file-encrypt-to 'permanent-local t)
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el
index 8ece09d1488..f41429f7734 100644
--- a/lisp/epa-ks.el
+++ b/lisp/epa-ks.el
@@ -210,7 +210,8 @@ KEYS is a list of `epa-ks-key' structures, as parsed by
(with-current-buffer buf
(setq tabulated-list-entries entries)
(tabulated-list-print t t))
- (message "Press `f' to mark a key, `x' to fetch all marked keys."))))
+ (message (substitute-command-keys
+ "Press \\`f' to mark a key, \\`x' to fetch all marked keys.")))))
(defun epa-ks--restart-search ()
(when epa-ks-last-query
@@ -294,12 +295,12 @@ enough, since keyservers have strict timeout settings."
:created
(and (match-string 4)
(not (string-empty-p (match-string 4)))
- (seconds-to-time
+ (time-convert
(string-to-number (match-string 4))))
:expires
(and (match-string 5)
(not (string-empty-p (match-string 5)))
- (seconds-to-time
+ (time-convert
(string-to-number (match-string 5))))
:flags
(mapcar (lambda (flag)
@@ -318,15 +319,11 @@ enough, since keyservers have strict timeout settings."
:created
(and (match-string 2)
(not (string-empty-p (match-string 2)))
- (decode-time (seconds-to-time
- (string-to-number
- (match-string 2)))))
+ (decode-time (string-to-number (match-string 2))))
:expires
(and (match-string 3)
(not (string-empty-p (match-string 3)))
- (decode-time (seconds-to-time
- (string-to-number
- (match-string 3)))))
+ (decode-time (string-to-number (match-string 3))))
:flags
(mapcar (lambda (flag)
(cdr (assq flag '((?r revoked)
@@ -341,4 +338,6 @@ enough, since keyservers have strict timeout settings."
(forward-line))
keys))
+(provide 'epa-ks)
+
;;; epa-ks.el ends here
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 6170dcb6116..bb34ca72d6b 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -30,21 +30,19 @@
;;; Local Mode
-(defvar epa-mail-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
- (define-key keymap "\C-c\C-ev" 'epa-mail-verify)
- (define-key keymap "\C-c\C-es" 'epa-mail-sign)
- (define-key keymap "\C-c\C-ee" 'epa-mail-encrypt)
- (define-key keymap "\C-c\C-ei" 'epa-mail-import-keys)
- (define-key keymap "\C-c\C-eo" 'epa-insert-keys)
- (define-key keymap "\C-c\C-e\C-d" 'epa-mail-decrypt)
- (define-key keymap "\C-c\C-e\C-v" 'epa-mail-verify)
- (define-key keymap "\C-c\C-e\C-s" 'epa-mail-sign)
- (define-key keymap "\C-c\C-e\C-e" 'epa-mail-encrypt)
- (define-key keymap "\C-c\C-e\C-i" 'epa-mail-import-keys)
- (define-key keymap "\C-c\C-e\C-o" 'epa-insert-keys)
- keymap))
+(defvar-keymap epa-mail-mode-map
+ "C-c C-e d" #'epa-mail-decrypt
+ "C-c C-e v" #'epa-mail-verify
+ "C-c C-e s" #'epa-mail-sign
+ "C-c C-e e" #'epa-mail-encrypt
+ "C-c C-e i" #'epa-mail-import-keys
+ "C-c C-e o" #'epa-insert-keys
+ "C-c C-e C-d" #'epa-mail-decrypt
+ "C-c C-e C-v" #'epa-mail-verify
+ "C-c C-e C-s" #'epa-mail-sign
+ "C-c C-e C-e" #'epa-mail-encrypt
+ "C-c C-e C-i" #'epa-mail-import-keys
+ "C-c C-e C-o" #'epa-insert-keys)
(defvar epa-mail-mode-hook nil)
(defvar epa-mail-mode-on-hook nil)
diff --git a/lisp/epa.el b/lisp/epa.el
index d4ff3d1ee73..742c37d085b 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -235,11 +235,6 @@ You should bind this variable with `let', but do not set it globally.")
(define-key keymap "q" 'epa-exit-buffer)
keymap))
-(defvar epa-info-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "q" 'delete-window)
- keymap))
-
(defvar epa-exit-buffer-function #'quit-window)
(defun epa--button-key-text (key)
@@ -607,7 +602,11 @@ If SECRET is non-nil, list secret keys instead of public keys."
(_ "Error while executing \"%s\":\n\n"))
(epg-context-program context))
"\n\n"
- (epg-context-error-output context)))
+ (epg-context-error-output context)
+ (if (string-search "Unexpected error"
+ (epg-context-error-output context))
+ "\n(File possibly not an encrypted file, but is perhaps a key ring file?)\n"
+ "")))
(epa-info-mode)
(goto-char (point-min)))
(display-buffer buffer)))))
@@ -648,7 +647,7 @@ If SECRET is non-nil, list secret keys instead of public keys."
(setq input (file-name-sans-extension (expand-file-name input)))
(expand-file-name
(read-file-name
- (concat "To file (default " (file-name-nondirectory input) ") ")
+ (format-prompt "To file" (file-name-nondirectory input))
(file-name-directory input)
input)))
@@ -1236,9 +1235,7 @@ If no one is selected, symmetric encryption will be performed. ")
(list keys
(expand-file-name
(read-file-name
- (concat "To file (default "
- (file-name-nondirectory default-name)
- ") ")
+ (format-prompt "To file" (file-name-nondirectory default-name))
(file-name-directory default-name)
default-name)))))
(let ((context (epg-make-context epa-protocol)))
diff --git a/lisp/epg.el b/lisp/epg.el
index 4f161938307..c5d946cb76c 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -334,6 +334,7 @@ callback data (if any)."
(cl-defstruct (epg-key
(:constructor nil)
+ (:copier epg--copy-key)
(:constructor epg-make-key (owner-trust))
(:predicate nil))
(owner-trust nil :read-only t)
@@ -1389,7 +1390,7 @@ NAME is either a string or a list of strings."
(if (seq-find (lambda (user)
(eq (epg-user-id-validity user) 'revoked))
(epg-key-user-id-list key))
- (let ((copy (copy-epg-key key)))
+ (let ((copy (epg--copy-key key)))
(setf (epg-key-user-id-list copy)
(seq-remove (lambda (user)
(eq (epg-user-id-validity user) 'revoked))
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index 979f93f693c..8d970bd6b96 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcAutoAway
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9e85d285d5c..bc7a7d14dc2 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -4,7 +4,7 @@
;; Filename: erc-backend.el
;; Author: Lawrence Mitchell <wence@gmx.li>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Created: 2004-05-7
;; Keywords: comm, IRC, chat, client, internet
@@ -102,7 +102,6 @@
;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
;; reverse is true:
-(provide 'erc-backend)
(require 'erc)
;;;; Variables and options
@@ -124,6 +123,14 @@
"Nickname on the current server.
Use `erc-current-nick' to access this.")
+(defvar-local erc-session-user-full-name nil
+ "Real name used for the current session.
+Sent as the last argument to the USER command.")
+
+(defvar-local erc-session-username nil
+ "Username used for the current session.
+Sent as the first argument of the USER command.")
+
;;; Server attributes
(defvar-local erc-server-process nil
@@ -178,27 +185,38 @@ SILENCE=10 - supports the SILENCE command, maximum allowed number of entries
TOPICLEN=160 - maximum allowed topic length
WALLCHOPS - supports sending messages to all operators in a channel")
+(defvar-local erc--isupport-params nil
+ "Hash map of \"ISUPPORT\" params.
+Keys are symbols. Values are lists of zero or more strings with hex
+escapes removed.")
+
;;; Server and connection state
(defvar erc-server-ping-timer-alist nil
"Mapping of server buffers to their specific ping timer.")
(defvar-local erc-server-connected nil
- "Non-nil if the current buffer has been used by ERC to establish
-an IRC connection.
-
-If you wish to determine whether an IRC connection is currently
-active, use the `erc-server-process-alive' function instead.")
+ "Non-nil if the current buffer belongs to an active IRC connection.
+To determine whether an underlying transport is connected, use the
+function `erc-server-process-alive' instead.")
(defvar-local erc-server-reconnect-count 0
"Number of times we have failed to reconnect to the current server.")
+(defvar-local erc--server-last-reconnect-count 0
+ "Snapshot of reconnect count when the connection was established.")
+
(defvar-local erc-server-quitting nil
"Non-nil if the user requests a quit.")
(defvar-local erc-server-reconnecting nil
"Non-nil if the user requests an explicit reconnect, and the
current IRC process is still alive.")
+(make-obsolete-variable 'erc-server-reconnecting
+ "see `erc--server-reconnecting'" "29.1")
+
+(defvar-local erc--server-reconnecting nil
+ "Non-nil when reconnecting.")
(defvar-local erc-server-timed-out nil
"Non-nil if the IRC server failed to respond to a ping.")
@@ -310,8 +328,7 @@ This will only be consulted if the coding system in
:version "24.1"
:type '(repeat coding-system))
-(defcustom erc-server-coding-system (if (and (fboundp 'coding-system-p)
- (coding-system-p 'undecided)
+(defcustom erc-server-coding-system (if (and (coding-system-p 'undecided)
(coding-system-p 'utf-8))
'(utf-8 . undecided)
nil)
@@ -459,7 +476,7 @@ If POS is out of range, the value is nil."
(defun erc-bounds-of-word-at-point ()
"Return the bounds of word at point, or nil if we're not at a word.
If no `subword-mode' is active, then this is
-\(bounds-of-thing-at-point 'word)."
+\(bounds-of-thing-at-point \\='word)."
(if (or (erc-word-at-arg-p (point))
(erc-word-at-arg-p (1- (point))))
(save-excursion
@@ -531,9 +548,11 @@ TLS (see `erc-session-client-certificate' for more details)."
(error "Connection attempt failed"))
;; Misc server variables
(with-current-buffer buffer
+ (setq erc-server-filter-data nil)
(setq erc-server-process process)
(setq erc-server-quitting nil)
- (setq erc-server-reconnecting nil)
+ (setq erc-server-reconnecting nil
+ erc--server-reconnecting nil)
(setq erc-server-timed-out nil)
(setq erc-server-banned nil)
(setq erc-server-error-occurred nil)
@@ -579,7 +598,13 @@ Make sure you are in an ERC buffer when running this."
(let ((erc-server-connect-function (or erc-session-connector
#'erc-open-network-stream)))
(erc-open erc-session-server erc-session-port erc-server-current-nick
- erc-session-user-full-name t erc-session-password)))))
+ erc-session-user-full-name t erc-session-password
+ nil nil nil erc-session-client-certificate
+ erc-session-username
+ (erc-networks--id-given erc-networks--id))
+ (unless (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ (cl-assert (not (eq buffer (current-buffer)))))))))
(defun erc-server-delayed-reconnect (buffer)
(if (buffer-live-p buffer)
@@ -616,36 +641,42 @@ Make sure you are in an ERC buffer when running this."
(erc-log-irc-protocol line nil)
(erc-parse-server-response process line)))))))
-(define-inline erc-server-reconnect-p (event)
+(defun erc--server-reconnect-p (event)
+ "Return non-nil when ERC should attempt to reconnect.
+EVENT is the message received from the closed connection process."
+ (and erc-server-auto-reconnect
+ (not erc-server-banned)
+ ;; make sure we don't infinitely try to reconnect, unless the
+ ;; user wants that
+ (or (eq erc-server-reconnect-attempts t)
+ (and (integerp erc-server-reconnect-attempts)
+ (< erc-server-reconnect-count
+ erc-server-reconnect-attempts)))
+ (or erc-server-timed-out
+ (not (string-match "^deleted" event)))
+ ;; open-network-stream-nowait error for connection refused
+ (if (string-match "^failed with code 111" event) 'nonblocking t)))
+
+(defun erc-server-reconnect-p (event)
"Return non-nil if ERC should attempt to reconnect automatically.
EVENT is the message received from the closed connection process."
- (inline-letevals (event)
- (inline-quote
- (or erc-server-reconnecting
- (and erc-server-auto-reconnect
- (not erc-server-banned)
- ;; make sure we don't infinitely try to reconnect, unless the
- ;; user wants that
- (or (eq erc-server-reconnect-attempts t)
- (and (integerp erc-server-reconnect-attempts)
- (< erc-server-reconnect-count
- erc-server-reconnect-attempts)))
- (or erc-server-timed-out
- (not (string-match "^deleted" ,event)))
- ;; open-network-stream-nowait error for connection refused
- (if (string-match "^failed with code 111" ,event) 'nonblocking t))))))
+ (declare (obsolete "see `erc--server-reconnect-p'" "29.1"))
+ (or (with-suppressed-warnings ((obsolete erc-server-reconnecting))
+ erc-server-reconnecting)
+ (erc--server-reconnect-p event)))
(defun erc-process-sentinel-2 (event buffer)
"Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
(if (not (buffer-live-p buffer))
(erc-update-mode-line)
(with-current-buffer buffer
- (let ((reconnect-p (erc-server-reconnect-p event)) message delay)
+ (let ((reconnect-p (erc--server-reconnect-p event)) message delay)
(setq message (if reconnect-p 'disconnected 'disconnected-noreconnect))
(erc-display-message nil 'error (current-buffer) message)
(if (not reconnect-p)
;; terminate, do not reconnect
(progn
+ (setq erc--server-reconnecting nil)
(erc-display-message nil 'error (current-buffer)
'terminated ?e event)
;; Update mode line indicators
@@ -654,7 +685,8 @@ EVENT is the message received from the closed connection process."
;; reconnect
(condition-case nil
(progn
- (setq erc-server-reconnecting nil
+ (setq erc-server-reconnecting nil
+ erc--server-reconnecting t
erc-server-reconnect-count (1+ erc-server-reconnect-count))
(setq delay erc-server-reconnect-timeout)
(run-at-time delay nil
@@ -683,6 +715,39 @@ Conditionally try to reconnect and take appropriate action."
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
+(defun erc--unhide-prompt ()
+ (remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t)
+ (when (and (marker-position erc-insert-marker)
+ (marker-position erc-input-marker))
+ (with-silent-modifications
+ (remove-text-properties erc-insert-marker erc-input-marker
+ '(display nil)))))
+
+(defun erc--unhide-prompt-on-self-insert ()
+ (when (and (eq this-command #'self-insert-command)
+ (or (eobp) (= (point) erc-input-marker)))
+ (erc--unhide-prompt)))
+
+(defun erc--hide-prompt (proc)
+ (erc-with-all-buffers-of-server
+ proc nil ; sorta wish this was indent 2
+ (when (and erc-hide-prompt
+ (or (eq erc-hide-prompt t)
+ ;; FIXME use `erc--target' after bug#48598
+ (memq (if (erc-default-target)
+ (if (erc-channel-p (car erc-default-recipients))
+ 'channel
+ 'query)
+ 'server)
+ erc-hide-prompt))
+ (marker-position erc-insert-marker)
+ (marker-position erc-input-marker)
+ (get-text-property erc-insert-marker 'erc-prompt))
+ (with-silent-modifications
+ (add-text-properties erc-insert-marker (1- erc-input-marker)
+ `(display ,erc-prompt-hidden)))
+ (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 0 t))))
+
(defun erc-process-sentinel (cproc event)
"Sentinel function for ERC process."
(let ((buf (process-buffer cproc)))
@@ -705,11 +770,8 @@ Conditionally try to reconnect and take appropriate action."
(dolist (buf (erc-buffer-filter (lambda () (boundp 'erc-channel-users)) cproc))
(with-current-buffer buf
(setq erc-channel-users (make-hash-table :test 'equal))))
- ;; Remove the prompt
- (goto-char (or (marker-position erc-input-marker) (point-max)))
- (forward-line 0)
- (erc-remove-text-properties-region (point) (point-max))
- (delete-region (point) (point-max))
+ ;; Hide the prompt
+ (erc--hide-prompt cproc)
;; Decide what to do with the buffer
;; Restart if disconnected
(erc-process-sentinel-1 event buf))))))
@@ -760,11 +822,12 @@ Use DISPLAY-FN to show the results."
(erc-split-line text)))
;; From Circe, with modifications
-(defun erc-server-send (string &optional forcep target)
+(defun erc-server-send (string &optional force target)
"Send STRING to the current server.
-If FORCEP is non-nil, no flood protection is done - the string is
-sent directly. This might cause the messages to arrive in a wrong
-order.
+When FORCE is non-nil, bypass flood protection so that STRING is
+sent directly without modifying the queue. When FORCE is the
+symbol `no-penalty', exempt this round from accumulating a
+timeout penalty.
If TARGET is specified, look up encoding information for that
channel in `erc-encoding-coding-alist' or
@@ -780,11 +843,11 @@ protection algorithm."
(if (erc-server-process-alive)
(erc-with-server-buffer
(let ((str (concat string "\r\n")))
- (if forcep
+ (if force
(progn
- (setq erc-server-flood-last-message
- (+ erc-server-flood-penalty
- erc-server-flood-last-message))
+ (unless (eq force 'no-penalty)
+ (cl-incf erc-server-flood-last-message
+ erc-server-flood-penalty))
(erc-log-irc-protocol str 'outbound)
(condition-case nil
(progn
@@ -1169,7 +1232,8 @@ Would expand to:
\(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)"
(declare (debug (&define [&name "erc-response-handler@"
(symbolp &rest symbolp)]
- &optional sexp sexp def-body)))
+ &optional sexp sexp def-body))
+ (indent defun))
(if (numberp name) (setq name (intern (format "%03i" name))))
(setq aliases (mapcar (lambda (a)
(if (numberp a)
@@ -1178,7 +1242,7 @@ Would expand to:
aliases))
(let* ((hook-name (intern (format "erc-server-%s-functions" name)))
(fn-name (intern (format "erc-server-%s" name)))
- (hook-doc (format-message "\
+ (hook-doc (format "\
%sHook called upon receiving a %%s server response.
Each function is called with two arguments, the process associated
with the response and the parsed response. If the function returns
@@ -1189,7 +1253,7 @@ See also `%s'."
(concat extra-var-doc "\n\n")
"")
fn-name))
- (fn-doc (format-message "\
+ (fn-doc (format "\
%sHandler for a %s server response.
PROC is the server process which returned the response.
PARSED is the actual response as an `erc-response' struct.
@@ -1270,14 +1334,11 @@ add things to `%s' instead."
(let* ((str (cond
;; If I have joined a channel
((erc-current-nick-p nick)
- (setq buffer (erc-open erc-session-server erc-session-port
- nick erc-session-user-full-name
- nil nil
- (list chnl) chnl
- erc-server-process))
- (when buffer
+ (when (setq buffer (erc--open-target chnl))
(set-buffer buffer)
- (erc-add-default-channel chnl)
+ (with-suppressed-warnings
+ ((obsolete erc-add-default-channel))
+ (erc-add-default-channel chnl))
(erc-server-send (format "MODE %s" chnl)))
(erc-with-buffer (chnl proc)
(erc-channel-begin-receiving-names))
@@ -1314,7 +1375,8 @@ add things to `%s' instead."
(erc-with-buffer
(buffer)
(erc-remove-channel-users))
- (erc-delete-default-channel ch buffer)
+ (with-suppressed-warnings ((obsolete erc-delete-default-channel))
+ (erc-delete-default-channel ch buffer))
(erc-update-mode-line buffer))
((string= nick (erc-current-nick))
(erc-display-message
@@ -1362,19 +1424,27 @@ add things to `%s' instead."
;; sent to the correct nick. also add to bufs, since the user will want
;; to see the nick change in the query, and if it's a newly begun query,
;; erc-channel-users won't contain it
- (erc-buffer-filter
- (lambda ()
- (when (equal (erc-default-target) nick)
- (setq erc-default-recipients
- (cons nn (cdr erc-default-recipients)))
- (rename-buffer nn t) ; bug#12002
- (erc-update-mode-line)
- (cl-pushnew (current-buffer) bufs))))
+ ;;
+ ;; Possibly still relevant: bug#12002
+ (when-let ((buf (erc-get-buffer nick erc-server-process))
+ (tgt (erc--target-from-string nn)))
+ (with-current-buffer buf
+ (setq erc-default-recipients (cons nn (cdr erc-default-recipients))
+ erc--target tgt))
+ (with-current-buffer (erc-get-buffer-create erc-session-server
+ erc-session-port nil tgt
+ (erc-networks--id-given
+ erc-networks--id))
+ ;; Current buffer is among bufs
+ (erc-update-mode-line)))
(erc-update-user-nick nick nn host nil nil login)
(cond
((string= nick (erc-current-nick))
(cl-pushnew (erc-server-buffer) bufs)
(erc-set-current-nick nn)
+ ;; Rename session, possibly rename server buf and all targets
+ (when (erc-network)
+ (erc-networks--id-reload erc-networks--id proc parsed))
(erc-update-mode-line)
(setq erc-nick-change-attempt-count 0)
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
@@ -1403,7 +1473,8 @@ add things to `%s' instead."
(erc-with-buffer
(buffer)
(erc-remove-channel-users))
- (erc-delete-default-channel chnl buffer)
+ (with-suppressed-warnings ((obsolete erc-delete-default-channel))
+ (erc-delete-default-channel chnl buffer))
(erc-update-mode-line buffer)
(when erc-kill-buffer-on-part
(kill-buffer buffer))))))
@@ -1413,7 +1484,7 @@ add things to `%s' instead."
(let ((pinger (car (erc-response.command-args parsed))))
(erc-log (format "PING: %s" pinger))
;; ping response to the server MUST be forced, or you can lose big
- (erc-server-send (format "PONG :%s" pinger) t)
+ (erc-server-send (format "PONG :%s" pinger) 'no-penalty)
(when erc-verbose-server-ping
(erc-display-message
parsed 'error proc
@@ -1454,8 +1525,16 @@ add things to `%s' instead."
fnick)
(setf (erc-response.contents parsed) msg)
(setq buffer (erc-get-buffer (if privp nick tgt) proc))
+ ;; Even worth checking for empty target here? (invalid anyway)
+ (unless (or buffer noticep (string-empty-p tgt) (eq ?$ (aref tgt 0)))
+ (if (and privp msgp (not (erc-is-message-ctcp-and-not-action-p msg)))
+ (when erc-auto-query
+ (let ((erc-join-buffer erc-auto-query))
+ (setq buffer (erc--open-target nick))))
+ (setq buffer (erc--open-target tgt))))
(when buffer
(with-current-buffer buffer
+ (when privp (erc--unhide-prompt))
;; update the chat partner info. Add to the list if private
;; message. We will accumulate private identities indefinitely
;; at this point.
@@ -1488,13 +1567,7 @@ add things to `%s' instead."
s parsed buffer nick)
(run-hook-with-args-until-success
'erc-echo-notice-hook s parsed buffer nick))
- (erc-display-message parsed nil buffer s)))
- (when (string= cmd "PRIVMSG")
- (erc-auto-query proc parsed))))))
-
-;; FIXME: need clean way of specifying extra hooks in
-;; define-erc-response-handler.
-(add-hook 'erc-server-PRIVMSG-functions #'erc-auto-query)
+ (erc-display-message parsed nil buffer s)))))))
(define-erc-response-handler (QUIT)
"Another user has quit IRC." nil
@@ -1567,6 +1640,70 @@ Then display the welcome message."
?U (nth 3 (erc-response.command-args parsed))
?C (nth 4 (erc-response.command-args parsed)))))
+(defun erc--parse-isupport-value (value)
+ "Return list of unescaped components from an \"ISUPPORT\" VALUE."
+ ;; https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-2
+ ;;
+ ;; > The server SHOULD send "X", not "X="; this is the normalised form.
+ ;;
+ ;; Note: for now, assume the server will only send non-empty values,
+ ;; possibly with printable ASCII escapes. Though in practice, the
+ ;; only two escapes we're likely to see are backslash and space,
+ ;; meaning the pattern is too liberal.
+ (let (case-fold-search)
+ (mapcar
+ (lambda (v)
+ (let ((start 0)
+ m
+ c)
+ (while (and (< start (length v))
+ (string-match "[\\]x[0-9A-F][0-9A-F]" v start))
+ (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0))
+ c (string-to-number m 16))
+ (if (<= ?\ c ?~)
+ (setq v (concat (substring v 0 (match-beginning 0))
+ (string c)
+ (substring v (match-end 0)))
+ start (- (match-end 0) 3))
+ (setq start (match-end 0))))
+ v))
+ (if (if (>= emacs-major-version 28)
+ (string-search "," value)
+ (string-match-p "," value))
+ (split-string value ",")
+ (list value)))))
+
+(defmacro erc--with-memoization (table &rest forms)
+ "Adapter to be migrated to erc-compat."
+ (declare (indent defun))
+ `(cond
+ ((fboundp 'with-memoization)
+ (with-memoization ,table ,@forms)) ; 29.1
+ ((fboundp 'cl--generic-with-memoization)
+ (cl--generic-with-memoization ,table ,@forms))
+ (t ,@forms)))
+
+(defun erc--get-isupport-entry (key &optional single)
+ "Return an item for \"ISUPPORT\" token KEY, a symbol.
+When a lookup fails return nil. Otherwise return a list whose
+CAR is KEY and whose CDR is zero or more strings. With SINGLE,
+just return the first value, if any. The latter is potentially
+ambiguous and only useful for tokens supporting a single
+primitive value."
+ (if-let* ((table (or erc--isupport-params
+ (erc-with-server-buffer erc--isupport-params)))
+ (value (erc--with-memoization (gethash key table)
+ (when-let ((v (assoc (symbol-name key)
+ erc-server-parameters)))
+ (if (cdr v)
+ (erc--parse-isupport-value (cdr v))
+ '--empty--)))))
+ (pcase value
+ ('--empty-- (unless single (list key)))
+ (`(,head . ,_) (if single head (cons key value))))
+ (when table
+ (remhash key table))))
+
(define-erc-response-handler (005)
"Set the variable `erc-server-parameters' and display the received message.
@@ -1578,21 +1715,25 @@ certain commands are accepted and more. See documentation for
A server may send more than one 005 message."
nil
- (let ((line (mapconcat #'identity
- (setf (erc-response.command-args parsed)
- (cdr (erc-response.command-args parsed)))
- " ")))
- (while (erc-response.command-args parsed)
- (let ((section (pop (erc-response.command-args parsed))))
- ;; fill erc-server-parameters
- (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\([A-Z]+\\)$"
+ (unless erc--isupport-params
+ (setq erc--isupport-params (make-hash-table)))
+ (let* ((args (cdr (erc-response.command-args parsed)))
+ (line (string-join args " ")))
+ (while args
+ (let ((section (pop args))
+ key
+ value
+ negated)
+ (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\(-\\)?\\([A-Z]+\\)$"
section)
- (add-to-list 'erc-server-parameters
- `(,(or (match-string 1 section)
- (match-string 3 section))
- .
- ,(match-string 2 section))))))
- (erc-display-message parsed 'notice proc line)))
+ (setq key (or (match-string 1 section) (match-string 4 section))
+ value (match-string 2 section)
+ negated (and (match-string 3 section) '-))
+ (setf (alist-get key erc-server-parameters '- 'remove #'equal)
+ (or value negated))
+ (remhash (intern key) erc--isupport-params))))
+ (erc-display-message parsed 'notice proc line)
+ nil))
(define-erc-response-handler (221)
"Display the current user modes." nil
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 680de6d5aab..bccf0e6f1f5 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1996-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm, irc, button, url, regexp
;; URL: https://www.emacswiki.org/emacs/ErcButton
@@ -71,7 +71,7 @@
"Face used for highlighting buttons in ERC buffers.
A button is a piece of text that you can activate by pressing
-`RET' or `mouse-2' above it. See also `erc-button-keymap'."
+\\`RET' or `mouse-2' above it. See also `erc-button-keymap'."
:type 'face
:group 'erc-faces)
@@ -125,7 +125,7 @@ longer than `erc-fill-column'."
;; a button, it makes no sense to optimize performance by
;; bytecompiling lambdas in this alist. On the other hand, it makes
;; things hard to maintain.
- '(('nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
+ '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
(erc-button-url-regexp 0 t browse-url-button-open-url 0)
("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
@@ -158,12 +158,12 @@ REGEXP is the string matching text around the button or a symbol
strings, or an alist with the strings in the car. Note that
entries in lists or alists are considered to be nicks or other
complete words. Therefore they are enclosed in \\< and \\>
- while searching. REGEXP can also be the quoted symbol
- \\='nicknames, which matches the nickname of any user on the
+ while searching. REGEXP can also be the symbol
+ `nicknames', which matches the nickname of any user on the
current server.
BUTTON is the number of the regexp grouping actually matching the
- button. This is ignored if REGEXP is \\='nicknames.
+ button. This is ignored if REGEXP is `nicknames'.
FORM is a Lisp expression which must eval to true for the button to
be added.
@@ -174,17 +174,15 @@ CALLBACK is the function to call when the user push this button.
PAR is a number of a regexp grouping whose text will be passed to
CALLBACK. There can be several PAR arguments. If REGEXP is
- \\='nicknames, these are ignored, and CALLBACK will be called with
+ `nicknames', these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
- :version "24.1" ; remove finger (bug#4443)
+ :version "29.1"
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
regexp
(variable :tag "Variable containing regexp")
- ;; FIXME It really does mean 'nicknames
- ;; rather than just nicknames.
- (const :tag "Nicknames" 'nicknames))
+ (const :tag "Nicknames" nicknames))
(integer :tag "Number of the regexp section that matches")
(choice :tag "When to buttonize"
(const :tag "Always" t)
@@ -256,7 +254,9 @@ specified by `erc-button-alist'."
regexp)
(erc-button-remove-old-buttons)
(dolist (entry alist)
- (if (equal (car entry) (quote (quote nicknames)))
+ (if (or (eq (car entry) 'nicknames)
+ ;; Old form retained for backward compatibility.
+ (equal (car entry) (quote 'nicknames)))
(erc-button-add-nickname-buttons entry)
(progn
(setq regexp (or (and (stringp (car entry)) (car entry))
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 7b7773d5e13..c590b45fd21 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -2,9 +2,9 @@
;; Copyright (C) 2006-2022 Free Software Foundation, Inc.
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
-; This file is part of GNU Emacs.
+;; 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
@@ -137,7 +137,7 @@ These arguments are sent to this function when called as a hook in
;; could possibly check for '("IRCD" . "dancer") in
;; `erc-server-parameters' instead of looking for a specific name
;; in `erc-server-version'
- (assoc "CAPAB" erc-server-parameters))
+ (erc--get-isupport-entry 'CAPAB))
(erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP")
(erc-server-send "CAPAB IDENTIFY-MSG")
(erc-server-send "CAPAB IDENTIFY-CTCP")
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 0541d1604cb..16cfb15a5ae 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2003, 2005-2022 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ERC
;; This file is part of GNU Emacs.
@@ -27,8 +27,6 @@
;;; Code:
-(require 'format-spec)
-
;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(define-obsolete-function-alias 'erc-define-minor-mode
#'define-minor-mode "28.1")
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 399e5fb114c..d0e1848e0eb 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -1,12 +1,11 @@
;;; erc-dcc.el --- CTCP DCC module for ERC -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1993-2022 Free Software Foundation, Inc.
;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
;; Noah Friedman <friedman@prep.ai.mit.edu>
;; Per Persson <pp@sno.pp.se>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; Created: 1994-01-23
@@ -44,7 +43,7 @@
;; /dcc chat nick - Either accept pending chat offer from nick, or offer
;; DCC chat to nick
;; /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick
-;; /dcc get nick [file] - Accept DCC offer from nick
+;; /dcc get [-t][-s] nick [file] - Accept DCC offer from nick
;; /dcc list - List all DCC offers/connections
;; /dcc send nick file - Offer DCC SEND to nick
@@ -106,7 +105,11 @@ Looks like:
:file - for outgoing sends, the full path to the file. For incoming sends,
the suggested filename or vetted filename
- :size - size of the file, may be nil on incoming DCCs")
+ :size - size of the file, may be nil on incoming DCCs
+
+ :secure - optional item indicating sender support for TLS
+
+ :turbo - optional item indicating sender support for TSEND")
(defun erc-dcc-list-add (type nick peer parent &rest args)
"Add a new entry of type TYPE to `erc-dcc-list' and return it."
@@ -120,12 +123,13 @@ Looks like:
;; more: the entry data from erc-dcc-list for this particular process.
(defvar erc-dcc-connect-function 'erc-dcc-open-network-stream)
-(defun erc-dcc-open-network-stream (procname buffer addr port _entry)
+(defun erc-dcc-open-network-stream (procname buffer addr port entry)
;; FIXME: Time to try activating this again!?
(if nil; (fboundp 'open-network-stream-nowait) ;; this currently crashes
;; cvs emacs
(open-network-stream-nowait procname buffer addr port)
- (open-network-stream procname buffer addr port)))
+ (open-network-stream procname buffer addr port
+ :type (and (plist-get entry :secure) 'tls))))
(erc-define-catalog
'english
@@ -145,13 +149,14 @@ Looks like:
(dcc-get-bytes-received . "DCC: %f: %b bytes received")
(dcc-get-complete
. "DCC: file %f transfer complete (%s bytes in %t seconds)")
+ (dcc-get-failed . "DCC: file %f transfer failed at %s of %v in %t seconds")
(dcc-get-cmd-aborted . "DCC: Aborted getting %f from %n")
(dcc-get-file-too-long
. "DCC: %f: File longer than sender claimed; aborting transfer")
(dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer")
- (dcc-list-head . "DCC: From Type Active Size Filename")
- (dcc-list-line . "DCC: -------- ---- ------ -------------- --------")
- (dcc-list-item . "DCC: %-8n %-4t %-6a %-14s %f")
+ (dcc-list-head . "DCC: From Type Active Size Filename")
+ (dcc-list-line . "DCC: -------- ---- ------ ----------------- --------")
+ (dcc-list-item . "DCC: %-8n %-4t %-6a %-17s %f%u")
(dcc-list-end . "DCC: End of list.")
(dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q")
(dcc-privileged-port
@@ -183,9 +188,7 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive."
(let ((prop (car prem))
(val (cadr prem)))
(setq prem (cddr prem)
- ;; plist-member is a predicate in xemacs
- test (and (plist-member elt prop)
- (plist-get elt prop)))
+ test (cadr (plist-member elt prop)))
;; if the property exists and is equal, we continue, else, try the
;; next element of the list
(or (and (eq prop :nick) (if (>= emacs-major-version 28)
@@ -198,7 +201,7 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive."
(erc-extract-nick test)
(erc-extract-nick val)))
;; not a nick
- (eq test val)
+ (equal test val)
(setq cont nil))))
(if cont
(setq result elt)
@@ -388,7 +391,7 @@ the accepted connection."
(defcustom erc-dcc-get-default-directory nil
"Default directory for incoming DCC file transfers.
If this is nil, then the current value of `default-directory' is used."
- :type '(choice (const nil :tag "Default directory") directory))
+ :type '(choice (const :value nil :tag "Default directory") directory))
;;;###autoload
(defun erc-cmd-DCC (cmd &rest args)
@@ -508,8 +511,12 @@ At least one of TYPE and NICK must be provided."
FILE is the filename. If FILE is split into multiple arguments,
re-join the arguments, separated by a space.
PROC is the server process."
- (setq file (and file (mapconcat #'identity file " ")))
- (let* ((elt (erc-dcc-member :nick nick :type 'GET))
+ (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file)))
+ (flags (prog1 (cdr (assq t args))
+ (setq args (cdr (assq nil args))
+ nick (pop args)
+ file (and args (mapconcat #'identity args " ")))))
+ (elt (erc-dcc-member :nick nick :type 'GET :file file))
(filename (or file (plist-get elt :file) "unknown")))
(if elt
(let* ((file (read-file-name
@@ -529,7 +536,13 @@ PROC is the server process."
'dcc-get-cmd-aborted
?n nick ?f filename)))
(t
- (erc-dcc-get-file elt file proc))))
+ (erc-dcc-get-file elt file proc)))
+ (when (member "-s" flags)
+ (setq erc-dcc-list (cons (plist-put elt :secure t)
+ (delq elt erc-dcc-list))))
+ (when (member "-t" flags)
+ (setq erc-dcc-list (cons (plist-put elt :turbo t)
+ (delq elt erc-dcc-list)))))
(erc-display-message
nil '(notice error) 'active
'dcc-get-notfound ?n nick ?f filename))))
@@ -567,6 +580,7 @@ It lists the current state of `erc-dcc-list' in an easy to read manner."
(process-status (plist-get elt :peer))
"no")
?s (concat size
+ ;; FIXME consider uniquified names, e.g., foo.bin<2>
(if (and (eq 'GET (plist-get elt :type))
(plist-member elt :file)
(buffer-live-p (get-buffer (plist-get elt :file)))
@@ -578,7 +592,12 @@ It lists the current state of `erc-dcc-list' in an easy to read manner."
(format " (%d%%)"
(floor (* 100.0 byte-count)
(plist-get elt :size))))))
- ?f (or (and (plist-member elt :file) (plist-get elt :file)) "")))
+ ?f (or (and (plist-member elt :file) (plist-get elt :file)) "")
+ ?u (if-let* ((flags (concat (and (plist-get elt :turbo) "t")
+ (and (plist-get elt :secure) "s")))
+ ((not (string-empty-p flags))))
+ (concat " (" flags ")")
+ "")))
(erc-display-message
nil 'notice 'active
'dcc-list-end)
@@ -605,6 +624,10 @@ separated by a space."
(defvar erc-dcc-query-handler-alist
'(("SEND" . erc-dcc-handle-ctcp-send)
+ ("TSEND" . erc-dcc-handle-ctcp-send)
+ ("SSEND" . erc-dcc-handle-ctcp-send)
+ ("TSSEND" . erc-dcc-handle-ctcp-send)
+ ("STSEND" . erc-dcc-handle-ctcp-send)
("CHAT" . erc-dcc-handle-ctcp-chat)))
;;;###autoload
@@ -623,12 +646,16 @@ that subcommand."
?q query ?n nick ?u login ?h host))))
(defconst erc-dcc-ctcp-query-send-regexp
- (concat "^DCC SEND \\(?:"
+ (rx bot "DCC " (group-n 6 (: (** 0 2 (any "TS")) "SEND")) " "
;; Following part matches either filename without spaces
;; or filename enclosed in double quotes with any number
;; of escaped double quotes inside.
- "\"\\(\\(?:\\\\\"\\|[^\"\\]\\)+\\)\"\\|\\([^ ]+\\)"
- "\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)"))
+ (: (or (: ?\" (group-n 1 (+ (or (: ?\\ ?\") (not (any ?\" ?\\))))) ?\")
+ (group-n 2 (+ (not " ")))))
+ (: " " (group-n 3 (+ digit))
+ " " (group-n 4 (+ digit))
+ (* " ") (group-n 5 (* digit)))
+ eot))
(define-inline erc-dcc-unquote-filename (filename)
(inline-quote
@@ -653,12 +680,14 @@ It extracts the information about the dcc request and adds it to
'dcc-request-bogus
?r "SEND" ?n nick ?u login ?h host))
((string-match erc-dcc-ctcp-query-send-regexp query)
- (let ((filename
- (or (match-string 2 query)
- (erc-dcc-unquote-filename (match-string 1 query))))
- (ip (erc-decimal-to-ip (match-string 3 query)))
- (port (match-string 4 query))
- (size (match-string 5 query)))
+ (let* ((filename (or (match-string 2 query)
+ (erc-dcc-unquote-filename (match-string 1 query))))
+ (ip (erc-decimal-to-ip (match-string 3 query)))
+ (port (match-string 4 query))
+ (size (match-string 5 query))
+ (sub (substring (match-string 6 query) 0 -4))
+ (secure (seq-contains-p sub ?S #'eq))
+ (turbo (seq-contains-p sub ?T #'eq)))
;; FIXME: a warning really should also be sent
;; if the ip address != the host the dcc sender is on.
(erc-display-message
@@ -675,7 +704,9 @@ It extracts the information about the dcc request and adds it to
'GET (format "%s!%s@%s" nick login host)
nil proc
:ip ip :port port :file filename
- :size (string-to-number size))
+ :size (string-to-number size)
+ :turbo (and turbo t)
+ :secure (and secure t))
(if (and (eq erc-dcc-send-request 'auto)
(erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host)))
(erc-dcc-get-file (car erc-dcc-list) filename proc))))
@@ -771,7 +802,7 @@ the matching regexp, or nil if none found."
PROC is the process-object of the DCC connection. Returns the number of
bytes sent."
(let* ((elt (erc-dcc-member :peer proc))
- (confirmed-marker (plist-get elt :sent))
+ (confirmed-marker (plist-get elt :confirmed))
(sent-marker (plist-get elt :sent)))
(with-current-buffer (process-buffer proc)
(when erc-dcc-verbose
@@ -923,8 +954,7 @@ and making the connection."
(inhibit-file-name-operation 'write-region))
(write-region (point) (point) erc-dcc-file-name nil 'nomessage))
- (setq erc-server-process parent-proc
- erc-dcc-entry-data entry)
+ (setq erc-server-process parent-proc)
(setq erc-dcc-byte-count 0)
(setq proc
(funcall erc-dcc-connect-function
@@ -938,8 +968,8 @@ and making the connection."
(set-process-filter proc #'erc-dcc-get-filter)
(set-process-sentinel proc #'erc-dcc-get-sentinel)
- (setq entry (plist-put entry :start-time (erc-current-time)))
- (setq entry (plist-put entry :peer proc)))))
+ (setq erc-dcc-entry-data (plist-put (plist-put entry :peer proc)
+ :start-time (erc-current-time))))))
(defun erc-dcc-append-contents (buffer _file)
"Append the contents of BUFFER to FILE.
@@ -955,6 +985,16 @@ The contents of the BUFFER will then be erased."
(setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count))
(erase-buffer))))
+;; If people really need this, we can convert it into a proper option.
+
+(defvar erc-dcc--X-send-final-turbo-ack nil
+ "Workaround for maverick turbo senders that only require a final ACK.
+The only known culprit is WeeChat, with its xfer.network.fast_send
+option, which is on by default. Leaving this set to nil and calling
+/DCC GET -t works just fine, but WeeChat sees it as a failure even
+though the file arrives in its entirety. Setting this to t may
+alleviate such problems.")
+
(defun erc-dcc-get-filter (proc str)
"This is the process filter for transfers from other clients to this one.
It reads incoming bytes from the network and stores them in the DCC
@@ -989,31 +1029,43 @@ rather than every 1024 byte block, but nobody seems to care."
'dcc-get-file-too-long
?f (file-name-nondirectory (buffer-name)))
(delete-process proc))
- (t
- (process-send-string
- proc (erc-pack-int received-bytes)))))))
-
+ ;; Some senders want us to hang up. Only observed w. TSEND.
+ ((and (plist-get erc-dcc-entry-data :turbo)
+ (= received-bytes (plist-get erc-dcc-entry-data :size)))
+ (when erc-dcc--X-send-final-turbo-ack
+ (process-send-string proc (erc-pack-int received-bytes)))
+ (delete-process proc))
+ ((not (or (plist-get erc-dcc-entry-data :turbo)
+ (process-get proc :reportingp)))
+ (process-put proc :reportingp t)
+ (process-send-string proc (erc-pack-int received-bytes))
+ (process-put proc :reportingp nil))))))
-(defun erc-dcc-get-sentinel (proc _event)
+(defun erc-dcc-get-sentinel (proc event)
"This is the process sentinel for CTCP DCC SEND connections.
It shuts down the connection and notifies the user that the
transfer is complete."
;; FIXME, we should look at EVENT, and also check size.
+ (unless (member event '("connection broken by remote peer\n"
+ "deleted\n"))
+ (lwarn 'erc :warning "Unexpected sentinel event %S for %s"
+ (string-trim-right event) proc))
(with-current-buffer (process-buffer proc)
(delete-process proc)
(setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list))
(unless (= (point-min) (point-max))
(erc-dcc-append-contents (current-buffer) erc-dcc-file-name))
- (erc-display-message
- nil 'notice erc-server-process
- 'dcc-get-complete
- ?f erc-dcc-file-name
- ?s (number-to-string erc-dcc-byte-count)
- ?t (format "%.0f"
- (erc-time-diff (plist-get erc-dcc-entry-data :start-time)
- nil))))
- (kill-buffer (process-buffer proc))
- (delete-process proc))
+ (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size))))
+ (erc-display-message
+ nil (if done 'notice '(notice error)) erc-server-process
+ (if done 'dcc-get-complete 'dcc-get-failed)
+ ?v (plist-get erc-dcc-entry-data :size)
+ ?f erc-dcc-file-name
+ ?s (number-to-string erc-dcc-byte-count)
+ ?t (format "%.0f"
+ (erc-time-diff (plist-get erc-dcc-entry-data :start-time)
+ nil))))
+ (kill-buffer)))
;;; CHAT handling
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 8ece765ef0d..1897f53dc16 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 8f46a1c8dd1..958783f2394 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 492830c3e13..140e7fdfc61 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -4,7 +4,7 @@
;; Author: Andreas Fuchs <asf@void.at>
;; Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcFilling
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 677f077c2ee..8fef23945d4 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2001-2022 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Most code is taken verbatim from erc.el, see there for the original
;; authors.
@@ -137,7 +137,7 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
(goto-char (point-max))))
(defun erc-move-to-prompt-setup ()
- "Initialize the move-to-prompt module for XEmacs."
+ "Initialize the move-to-prompt module."
(add-hook 'pre-command-hook #'erc-move-to-prompt nil t))
;;; Keep place in unvisited channels
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index f1184ff5eb2..417c0b898a7 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el
index eab219f4c1e..5c0a2c1a481 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2003, 2006-2022 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el
index f9713032e92..64a8f82b2a9 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -1,10 +1,9 @@
;;; erc-imenu.el --- Imenu support for ERC -*- lexical-binding: t; -*-
-;; Copyright (C) 2001-2002, 2004, 2006-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 2001-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcImenu
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index 175e83f3c90..b4044548e84 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm, irc
;; URL: https://www.emacswiki.org/emacs/ErcAutoJoin
@@ -33,8 +33,6 @@
;;; Code:
(require 'erc)
-(require 'auth-source)
-(require 'erc-networks)
(defgroup erc-autojoin nil
"Enable autojoining."
@@ -57,11 +55,16 @@
Every element in the alist has the form (SERVER . CHANNELS).
SERVER is a regexp matching the server, and channels is the list
of channels to join. SERVER can also be a symbol, in which case
-it is matched against the value of `erc-network' instead of
+it's matched against a non-nil `:id' passed to `erc' or `erc-tls'
+when connecting or the value of the current `erc-network' instead of
`erc-server-announced-name' or `erc-session-server' (this can be
useful when connecting to an IRC proxy that relays several
networks under the same server).
+Note that for historical reasons, this option is mutated at runtime,
+which is regrettable but here to stay. Please double check the value
+before saving it to a `custom-file'.
+
If the channel(s) require channel keys for joining, the passwords
are found via auth-source. For instance, if you use ~/.authinfo
as your auth-source backend, then put something like the
@@ -123,33 +126,32 @@ This is called from a timer set up by `erc-autojoin-channels'."
(erc-autojoin-channels server nick))))
(defun erc-autojoin-server-match (candidate)
- "Match the current network or server against CANDIDATE.
-This should be a key from `erc-autojoin-channels-alist'."
- (or (eq candidate (erc-network))
- (and (stringp candidate)
- (string-match-p candidate
- (or erc-server-announced-name
- erc-session-server)))))
+ "Match the current network ID or server against CANDIDATE.
+CANDIDATE is a key from `erc-autojoin-channels-alist'. Return the
+matching entity, either a string or a non-nil symbol (in the case of a
+network or a network ID). Return nil on failure."
+ (if (symbolp candidate)
+ (eq (or (erc-networks--id-given erc-networks--id) (erc-network))
+ candidate)
+ (when (stringp candidate)
+ (string-match-p candidate (or erc-server-announced-name
+ erc-session-server)))))
+
+(defun erc-autojoin--join ()
+ ;; This is called in the server buffer
+ (pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist)
+ (when-let ((match (erc-autojoin-server-match name)))
+ (dolist (chan channels)
+ (let ((buf (erc-get-buffer chan erc-server-process)))
+ (unless (and buf (with-current-buffer buf
+ (erc--current-buffer-joined-p)))
+ (erc-server-join-channel nil chan)))))))
(defun erc-autojoin-after-ident (_network _nick)
"Autojoin channels in `erc-autojoin-channels-alist'.
This function is run from `erc-nickserv-identified-hook'."
- (if erc--autojoin-timer
- (setq erc--autojoin-timer
- (cancel-timer erc--autojoin-timer)))
(when (eq erc-autojoin-timing 'ident)
- (let ((server (or erc-session-server erc-server-announced-name))
- (joined (mapcar (lambda (buf)
- (with-current-buffer buf (erc-default-target)))
- (erc-channel-list erc-server-process))))
- ;; We may already be in these channels, e.g. because the
- ;; autojoin timer went off.
- (dolist (l erc-autojoin-channels-alist)
- (when (erc-autojoin-server-match (car l))
- (dolist (chan (cdr l))
- (unless (erc-member-ignore-case chan joined)
- (erc-server-join-channel server chan)))))))
- nil)
+ (erc-autojoin--join)))
(defun erc-autojoin-channels (server nick)
"Autojoin channels in `erc-autojoin-channels-alist'."
@@ -162,24 +164,7 @@ This function is run from `erc-nickserv-identified-hook'."
#'erc-autojoin-channels-delayed
server nick (current-buffer))))
;; `erc-autojoin-timing' is `connect':
- (let ((server (or erc-session-server erc-server-announced-name)))
- (dolist (l erc-autojoin-channels-alist)
- (when (erc-autojoin-server-match (car l))
- (dolist (chan (cdr l))
- (let ((buffer
- (car (erc-buffer-filter
- (lambda ()
- (let ((current (erc-default-target)))
- (and (stringp current)
- (erc-autojoin-server-match (car l))
- (string-equal (erc-downcase chan)
- (erc-downcase current)))))))))
- (when (or (not buffer)
- (not (with-current-buffer buffer
- (erc-server-process-alive))))
- (erc-server-join-channel server chan))))))))
- ;; Return nil to avoid stomping on any other hook funcs.
- nil)
+ (erc-autojoin--join)))
(defun erc-autojoin-current-server ()
"Compute the current server for lookup in `erc-autojoin-channels-alist'.
@@ -190,24 +175,29 @@ Respects `erc-autojoin-domain-only'."
(match-string 1 server)
server)))
+(defun erc-autojoin--mutate (proc parsed remove)
+ (when-let* ((nick (car (erc-parse-user (erc-response.sender parsed))))
+ ((erc-current-nick-p nick))
+ (chnl (car (erc-response.command-args parsed)))
+ (elem (or (and (erc--valid-local-channel-p chnl)
+ (regexp-quote erc-server-announced-name))
+ (erc-networks--id-given erc-networks--id)
+ (erc-network)
+ (with-current-buffer (process-buffer proc)
+ (erc-autojoin-current-server))))
+ (test (if (symbolp elem) #'eq #'equal)))
+ (if remove
+ (let ((cs (delete chnl (assoc-default elem erc-autojoin-channels-alist
+ test))))
+ (setf (alist-get elem erc-autojoin-channels-alist nil (null cs) test)
+ cs))
+ (cl-pushnew chnl
+ (alist-get elem erc-autojoin-channels-alist nil nil test)
+ :test #'equal))))
+
(defun erc-autojoin-add (proc parsed)
"Add the channel being joined to `erc-autojoin-channels-alist'."
- (let* ((chnl (erc-response.contents parsed))
- (nick (car (erc-parse-user (erc-response.sender parsed))))
- (server (with-current-buffer (process-buffer proc)
- (erc-autojoin-current-server))))
- (when (erc-current-nick-p nick)
- (let ((elem (or (assoc (erc-network) erc-autojoin-channels-alist)
- (assoc server erc-autojoin-channels-alist))))
- (if elem
- (unless (member chnl (cdr elem))
- (setcdr elem (cons chnl (cdr elem))))
- ;; This always keys on server, not network -- user can
- ;; override by simply adding a network to
- ;; `erc-autojoin-channels-alist'
- (setq erc-autojoin-channels-alist
- (cons (list server chnl)
- erc-autojoin-channels-alist))))))
+ (erc-autojoin--mutate proc parsed nil)
;; We must return nil to tell ERC to continue running the other
;; functions.
nil)
@@ -216,18 +206,7 @@ Respects `erc-autojoin-domain-only'."
(defun erc-autojoin-remove (proc parsed)
"Remove the channel being left from `erc-autojoin-channels-alist'."
- (let* ((chnl (car (erc-response.command-args parsed)))
- (nick (car (erc-parse-user (erc-response.sender parsed))))
- (server (with-current-buffer (process-buffer proc)
- (erc-autojoin-current-server))))
- (when (erc-current-nick-p nick)
- (let ((elem (or (assoc (erc-network) erc-autojoin-channels-alist)
- (assoc server erc-autojoin-channels-alist))))
- (when elem
- (setcdr elem (delete chnl (cdr elem)))
- (unless (cdr elem)
- (setq erc-autojoin-channels-alist
- (delete elem erc-autojoin-channels-alist)))))))
+ (erc-autojoin--mutate proc parsed 'remove)
;; We must return nil to tell ERC to continue running the other
;; functions.
nil)
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index 354203aa090..d059caf5a32 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Old-Version: 1.0.0
;; URL: https://www.emacswiki.org/emacs/ErcLang
;; Keywords: comm
@@ -32,10 +32,8 @@
(require 'erc)
-;; FIXME: It's ISO 639-1, not ISO 638. ISO 638 is for paper, board and pulps.
-;; The Lisp variable should be renamed.
-
-(defvar iso-638-languages
+(define-obsolete-variable-alias 'iso-638-languages 'iso-639-1-languages "29.1")
+(defvar iso-639-1-languages
'(("aa" . "Afar")
("ab" . "Abkhazian")
("af" . "Afrikaans")
@@ -197,12 +195,12 @@ Normungsinstitut (ON), Postfach 130, A-1021 Vienna, Austria.")
(defun language (code)
"Return the language name for the ISO CODE."
(interactive (list (completing-read "ISO language code: "
- iso-638-languages)))
- (message "%s" (cdr (assoc code iso-638-languages))))
+ iso-639-1-languages)))
+ (message "%s" (cdr (assoc code iso-639-1-languages))))
(defun erc-cmd-LANG (language)
"Display the language name for the language code given by LANGUAGE."
- (let ((lang (cdr (assoc language iso-638-languages))))
+ (let ((lang (cdr (assoc language iso-639-1-languages))))
(erc-display-message
nil 'notice 'active
(or lang (concat language ": No such domain"))))
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index c7cd0ceba83..5266b680c38 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2008-2022 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Old-Version: 0.1
;; URL: https://www.emacswiki.org/emacs/ErcList
;; Keywords: comm
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 056701d6200..57093d3fc6c 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2003-2022 Free Software Foundation, Inc.
;; Author: Lawrence Mitchell <wence@gmx.li>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcLogging
;; Keywords: comm, IRC, chat, client, Internet, logging
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index aa78590539b..7c9174ff66a 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2022 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcMatch
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index fd14d8b0ad8..455a7c3cd2f 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2001-2002, 2004-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm, menu
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index 30bb18344d7..17ed881b12b 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 9377e701c39..091b8aa92d7 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002, 2004-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -731,6 +731,466 @@ MATCHER is used to find a corresponding network to a server while
(defvar-local erc-network nil
"The name of the network you are connected to (a symbol).")
+
+;;;; Identifying session context
+
+;; This section is concerned with identifying and managing the
+;; relationship between an IRC connection and its unique identity on a
+;; given network (as seen by that network's nick-granting system).
+;; This relationship is quasi-permanent and transcends IRC connections
+;; and Emacs sessions. As of mid 2022, only nicknames matter, and
+;; whether a user is authenticated does not directly impact network
+;; identity from a client's perspective. However, ERC must be
+;; equipped to adapt should this ever change. And while a connection
+;; is normally associated with exactly one nick, some networks (or
+;; intermediaries) may allow multiple clients to control the same nick
+;; by combining instance activity into a single logical client. ERC
+;; must be limber enough to handle such situations.
+
+(defvar-local erc-networks--id nil
+ "Server-local instance of its namesake struct.
+Also shared among all target buffers for a given connection. See
+\\[describe-symbol] `erc-networks--id' for more.")
+
+(cl-defstruct erc-networks--id
+ "Persistent identifying info for a network presence.
+
+Here, \"presence\" refers to some local state representing a
+client's existence on a network. Some clients refer to this as a
+\"context\" or a \"net-id\". The management of this state
+involves tracking associated buffers and what they're displaying.
+Since a presence can outlast physical connections and survive
+changes in back-end transports (and even outlive Emacs sessions),
+its identity must be resilient.
+
+Essential to this notion of an enduring existence on a network is
+ensuring recovery from the loss of a server buffer. Thus, any
+useful identifier must be shared among server and target buffers
+to allow for reassociation. Beyond that, it must ideally be
+derivable from the same set of connection parameters. See the
+constructor `erc-networks--id-create' for more info."
+ (ts nil :type float :read-only t :documentation "Creation timestamp.")
+ (symbol nil :type symbol :documentation "ID as a symbol."))
+
+(cl-defstruct (erc-networks--id-fixed
+ (:include erc-networks--id)
+ (:constructor erc-networks--id-fixed-create
+ (given &aux (ts (float-time)) (symbol given)))))
+
+(cl-defstruct (erc-networks--id-qualifying
+ (:include erc-networks--id)
+ (:constructor erc-networks--id-qualifying-create
+ (&aux
+ (ts (float-time))
+ (parts (erc-networks--id-qualifying-init-parts))
+ (symbol (erc-networks--id-qualifying-init-symbol
+ parts))
+ (len 1))))
+ "A session context composed of hierarchical connection parameters.
+Two identifiers are considered equivalent when their non-empty
+`parts' slots compare equal. Related identifiers share a common
+prefix of `parts' taken from connection parameters (given or
+discovered). An identifier's unique `symbol', intended for
+display purposes, is created by concatenating the shortest common
+prefix among its relatives. For example, related presences [b a
+r d o] and [b a z a r] would have symbols b/a/r and b/a/z
+respectively. The separator is given by `erc-networks--id-sep'."
+ (parts nil :type sequence ; a vector of atoms
+ :documentation "Sequence of identifying components.")
+ (len 0 :type integer
+ :documentation "Length of active `parts' interval."))
+
+;; For now, please use this instead of `erc-networks--id-fixed-p'.
+(cl-defgeneric erc-networks--id-given (net-id)
+ "Return the preassigned identifier for a network presence, if any.
+This may have originated from an `:id' arg to entry-point commands
+`erc-tls' or `erc'.")
+
+(cl-defmethod erc-networks--id-given ((_ erc-networks--id))
+ nil)
+
+(cl-defmethod erc-networks--id-given ((nid erc-networks--id-fixed))
+ (erc-networks--id-symbol nid))
+
+(cl-generic-define-context-rewriter erc-obsolete-var (var spec)
+ `((with-suppressed-warnings ((obsolete ,var)) ,var) ,spec))
+
+;; As a catch-all, derive the symbol from the unquoted printed repr.
+(cl-defgeneric erc-networks--id-create (id)
+ "Invoke an appropriate constructor for an `erc-networks--id' object."
+ (erc-networks--id-fixed-create (intern (format "%s" id))))
+
+;; When a given ID is a symbol, trust it unequivocally.
+(cl-defmethod erc-networks--id-create ((id symbol))
+ (erc-networks--id-fixed-create id))
+
+;; Otherwise, use an adaptive name derived from network params.
+(cl-defmethod erc-networks--id-create ((_ null))
+ (erc-networks--id-qualifying-create))
+
+;; But honor an explicitly set `erc-rename-buffers' (compat).
+(cl-defmethod erc-networks--id-create
+ ((_ null) &context (erc-obsolete-var erc-rename-buffers null))
+ (erc-networks--id-fixed-create (intern (buffer-name))))
+
+;; But honor an explicitly set `erc-reuse-buffers' (compat).
+(cl-defmethod erc-networks--id-create
+ ((_ null) &context (erc-obsolete-var erc-reuse-buffers null))
+ (erc-networks--id-fixed-create (intern (buffer-name))))
+
+(cl-defmethod erc-networks--id-create
+ ((_ symbol) &context (erc-obsolete-var erc-reuse-buffers null))
+ (erc-networks--id-fixed-create (intern (buffer-name))))
+
+(cl-defgeneric erc-networks--id-on-connect (net-id)
+ "Update NET-ID `erc-networks--id' after connection params known.
+This is typically during or just after MOTD.")
+
+(cl-defmethod erc-networks--id-on-connect ((_ erc-networks--id))
+ nil)
+
+(cl-defmethod erc-networks--id-on-connect ((id erc-networks--id-qualifying))
+ (erc-networks--id-qualifying-update id (erc-networks--id-qualifying-create)))
+
+(cl-defgeneric erc-networks--id-equal-p (self other)
+ "Return non-nil when two network identities exhibit underlying equality.
+SELF and OTHER are `erc-networks--id' struct instances. This
+should normally be used only for ID recovery or merging, after
+which no two identities should be `equal' (timestamps aside) that
+aren't also `eq'.")
+
+(cl-defmethod erc-networks--id-equal-p ((self erc-networks--id)
+ (other erc-networks--id))
+ (eq self other))
+
+(cl-defmethod erc-networks--id-equal-p ((a erc-networks--id-fixed)
+ (b erc-networks--id-fixed))
+ (or (eq a b) (eq (erc-networks--id-symbol a) (erc-networks--id-symbol b))))
+
+(cl-defmethod erc-networks--id-equal-p ((a erc-networks--id-qualifying)
+ (b erc-networks--id-qualifying))
+ (or (eq a b) (equal (erc-networks--id-qualifying-parts a)
+ (erc-networks--id-qualifying-parts b))))
+
+;; ERASE-ME: if some future extension were to come along offering
+;; additional members, e.g., [Libera.Chat "bob" laptop], it'd likely
+;; be cleaner to create a new struct type descending from
+;; `erc-networks--id-qualifying' than to convert this function into a
+;; generic. However, the latter would be simpler because it'd just
+;; require something like &context (erc-v3-device erc-v3--device-t).
+
+(defun erc-networks--id-qualifying-init-parts ()
+ "Return opaque list of atoms to serve as canonical identifier."
+ (when-let ((network (erc-network))
+ (nick (erc-current-nick)))
+ (vector network (erc-downcase nick))))
+
+(defvar erc-networks--id-sep "/"
+ "Separator for joining `erc-networks--id-qualifying-parts' into a net ID.")
+
+(defun erc-networks--id-qualifying-init-symbol (elts &optional len)
+ "Return symbol appropriate for network context identified by ELTS.
+Use leading interval of length LEN as contributing components.
+Combine them with string separator `erc-networks--id-sep'."
+ (when elts
+ (unless len
+ (setq len 1))
+ (intern (mapconcat (lambda (s) (prin1-to-string s t))
+ (seq-subseq elts 0 len)
+ erc-networks--id-sep))))
+
+(defun erc-networks--id-qualifying-grow-id (nid)
+ "Grow NID by one component or return nil when at capacity."
+ (unless (= (length (erc-networks--id-qualifying-parts nid))
+ (erc-networks--id-qualifying-len nid))
+ (setf (erc-networks--id-symbol nid)
+ (erc-networks--id-qualifying-init-symbol
+ (erc-networks--id-qualifying-parts nid)
+ (cl-incf (erc-networks--id-qualifying-len nid))))))
+
+(defun erc-networks--id-qualifying-reset-id (nid)
+ "Restore NID to its initial state."
+ (setf (erc-networks--id-qualifying-len nid) 1
+ (erc-networks--id-symbol nid)
+ (erc-networks--id-qualifying-init-symbol
+ (erc-networks--id-qualifying-parts nid))))
+
+(defun erc-networks--id-qualifying-prefix-length (nid-a nid-b)
+ "Return length of common initial prefix of NID-A and NID-B.
+Return nil when no such sequence exists (instead of zero)."
+ (when-let* ((a (erc-networks--id-qualifying-parts nid-a))
+ (b (erc-networks--id-qualifying-parts nid-b))
+ (n (min (length a) (length b)))
+ ((> n 0))
+ ((equal (elt a 0) (elt b 0)))
+ (i 1))
+ (while (and (< i n)
+ (equal (elt a i)
+ (elt b i)))
+ (cl-incf i))
+ i))
+
+(defun erc-networks--id-qualifying-update (dest source &rest overrides)
+ "Update DEST from SOURCE in place.
+Copy slots into DEST from SOURCE and recompute ID. Both SOURCE
+and DEST must be `erc-networks--id' objects. OVERRIDES is an
+optional plist of SLOT VAL pairs."
+ (setf (erc-networks--id-qualifying-parts dest)
+ (or (plist-get overrides :parts)
+ (erc-networks--id-qualifying-parts source))
+ (erc-networks--id-qualifying-len dest)
+ (or (plist-get overrides :len)
+ (erc-networks--id-qualifying-len source))
+ (erc-networks--id-symbol dest)
+ (or (plist-get overrides :symbol)
+ (erc-networks--id-qualifying-init-symbol
+ (erc-networks--id-qualifying-parts dest)
+ (erc-networks--id-qualifying-len dest)))))
+
+(cl-defgeneric erc-networks--id-reload (_nid &optional _proc _parsed)
+ "Handle an update to the current network identity.
+If provided, PROC should be the current `erc-server-process' and
+PARSED the current `erc-response'. NID is an `erc-networks--id'
+object."
+ nil)
+
+(cl-defmethod erc-networks--id-reload ((nid erc-networks--id-qualifying)
+ &optional proc parsed)
+ "Refresh identity after an `erc-networks--id-qualifying-parts'update."
+ (erc-networks--id-qualifying-update nid (erc-networks--id-qualifying-create)
+ :len
+ (erc-networks--id-qualifying-len nid))
+ (erc-networks--rename-server-buffer (or proc erc-server-process) parsed)
+ (erc-networks--shrink-ids-and-buffer-names-any)
+ (erc-with-all-buffers-of-server
+ erc-server-process #'erc--default-target
+ (when-let* ((new-name (erc-networks--reconcile-buffer-names erc--target
+ nid))
+ ((not (equal (buffer-name) new-name))))
+ (rename-buffer new-name 'unique))))
+
+(cl-defgeneric erc-networks--id-ensure-comparable (self other)
+ "Take measures to ensure two net identities are in comparable states.")
+
+(cl-defmethod erc-networks--id-ensure-comparable ((_ erc-networks--id)
+ (_ erc-networks--id))
+ nil)
+
+(cl-defmethod erc-networks--id-ensure-comparable
+ ((nid erc-networks--id-qualifying) (other erc-networks--id-qualifying))
+ "Grow NID along with that of the current buffer.
+Rename the current buffer if its NID has grown."
+ (when-let ((n (erc-networks--id-qualifying-prefix-length other nid)))
+ (while (and (<= (erc-networks--id-qualifying-len nid) n)
+ (erc-networks--id-qualifying-grow-id nid)))
+ ;; Grow and rename a visited buffer and all its targets
+ (when (and (> (erc-networks--id-qualifying-len nid)
+ (erc-networks--id-qualifying-len other))
+ (erc-networks--id-qualifying-grow-id other))
+ ;; Rename NID's buffers using current ID
+ (erc-buffer-filter (lambda ()
+ (when (eq erc-networks--id other)
+ (erc-networks--maybe-update-buffer-name)))))))
+
+(defun erc-networks--id-sort-buffers (buffers)
+ "Return a list of target BUFFERS, newest to oldest."
+ (sort buffers
+ (lambda (a b)
+ (> (with-current-buffer a (erc-networks--id-ts erc-networks--id))
+ (with-current-buffer b (erc-networks--id-ts erc-networks--id))))))
+
+
+;;;; Buffer association
+
+(cl-defgeneric erc-networks--shrink-ids-and-buffer-names ()
+ nil) ; concrete default implementation for non-eliding IDs
+
+(defun erc-networks--refresh-buffer-names (identity &optional omit)
+ "Ensure all colliding buffers for network IDENTITY have suffixes.
+Then rename current buffer appropriately. Don't consider buffer OMIT
+when determining collisions."
+ (if (erc-networks--examine-targets identity erc--target
+ #'ignore
+ (lambda ()
+ (unless (or (not omit) (eq (current-buffer) omit))
+ (erc-networks--ensure-unique-target-buffer-name)
+ t)))
+ (erc-networks--ensure-unique-target-buffer-name)
+ (rename-buffer (erc--target-string erc--target) 'unique)))
+
+;; This currently doesn't equalize related identities that may have
+;; become mismatched because that shouldn't happen after a connection
+;; is up (other than for a brief moment while renicking or similar,
+;; when states are inconsistent).
+(defun erc-networks--shrink-ids-and-buffer-names-any (&rest omit)
+ (let (grown)
+ ;; Gather all grown identities.
+ (erc-buffer-filter
+ (lambda ()
+ (when (and erc-networks--id
+ (erc-networks--id-qualifying-p erc-networks--id)
+ (not (memq (current-buffer) omit))
+ (not (memq erc-networks--id grown))
+ (> (erc-networks--id-qualifying-len erc-networks--id) 1))
+ (push erc-networks--id grown))))
+ ;; Check for other identities with shared prefix. If none exists,
+ ;; and an identity is overlong, shrink it.
+ (dolist (nid grown)
+ (let ((skip (not (null omit))))
+ (catch 'found
+ (if (cdr grown)
+ (dolist (other grown)
+ (unless (eq nid other)
+ (setq skip nil)
+ (when (erc-networks--id-qualifying-prefix-length nid other)
+ (throw 'found (setq skip t)))))
+ (setq skip nil)))
+ (unless (or skip (< (erc-networks--id-qualifying-len nid) 2))
+ (erc-networks--id-qualifying-reset-id nid)
+ (erc-buffer-filter
+ (lambda ()
+ (when (and (eq erc-networks--id nid)
+ (not (memq (current-buffer) omit)))
+ (if erc--target
+ (erc-networks--refresh-buffer-names nid omit)
+ (erc-networks--maybe-update-buffer-name))))))))))
+
+(cl-defmethod erc-networks--shrink-ids-and-buffer-names
+ (&context (erc-networks--id erc-networks--id-qualifying))
+ (erc-networks--shrink-ids-and-buffer-names-any (current-buffer)))
+
+(defun erc-networks-rename-surviving-target-buffer ()
+ "Maybe drop qualifying suffix from fellow target-buffer's name.
+But only do so when there's a single survivor with a target
+matching that of the dying buffer."
+ (when-let*
+ (((with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ (target erc--target)
+ ;; Buffer name includes ID suffix
+ ((not (string= (erc--target-symbol target) ; string= t "t" -> t
+ (erc-downcase (buffer-name)))))
+ (buf (current-buffer))
+ ;; All buffers, not just those belonging to same process
+ (others (erc-buffer-filter
+ (lambda ()
+ (and-let* ((erc--target)
+ ((not (eq buf (current-buffer))))
+ ((eq (erc--target-symbol target)
+ (erc--target-symbol erc--target))))))))
+ ((not (cdr others))))
+ (with-current-buffer (car others)
+ (rename-buffer (erc--target-string target)))))
+
+(defun erc-networks-shrink-ids-and-buffer-names ()
+ "Recompute network IDs and buffer names, ignoring the current buffer.
+Only do so when an IRC connection's context supports qualified
+naming. Do not discriminate based on whether a buffer's
+connection is active."
+ (erc-networks--shrink-ids-and-buffer-names))
+
+(defun erc-networks--examine-targets (identity target on-dupe on-collision)
+ "Visit all ERC target buffers with the same TARGET.
+Call ON-DUPE when a buffer's identity belongs to a network
+IDENTITY or \"should\" after reconciliation. Call ON-COLLISION
+otherwise. Neither function should accept any args. Expect
+TARGET to be an `erc--target' object."
+ (declare (indent 2))
+ (let ((announced erc-server-announced-name))
+ (erc-buffer-filter
+ (lambda ()
+ (when (and erc--target (eq (erc--target-symbol erc--target)
+ (erc--target-symbol target)))
+ (let ((oursp (if (erc--target-channel-local-p target)
+ (equal announced erc-server-announced-name)
+ (erc-networks--id-equal-p identity erc-networks--id))))
+ (funcall (if oursp on-dupe on-collision))))))))
+
+(defconst erc-networks--qualified-sep "@"
+ "Separator used for naming a target buffer.")
+
+(defun erc-networks--construct-target-buffer-name (target)
+ "Return TARGET@suffix."
+ (concat (erc--target-string target)
+ (if (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ erc-networks--qualified-sep "/")
+ (cond
+ ((not (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ (cadr (split-string
+ (symbol-name (erc-networks--id-symbol erc-networks--id))
+ "/")))
+ ((erc--target-channel-local-p target) erc-server-announced-name)
+ (t (symbol-name (erc-networks--id-symbol erc-networks--id))))))
+
+(defun erc-networks--ensure-unique-target-buffer-name ()
+ (when-let* ((new-name (erc-networks--construct-target-buffer-name
+ erc--target))
+ ((not (equal (buffer-name) new-name))))
+ (rename-buffer new-name 'unique)))
+
+(defun erc-networks--ensure-unique-server-buffer-name ()
+ (when-let* ((new-name (symbol-name (erc-networks--id-symbol
+ erc-networks--id)))
+ ((not (equal (buffer-name) new-name))))
+ (rename-buffer new-name 'unique)))
+
+(defun erc-networks--maybe-update-buffer-name ()
+ "Update current buffer name to reflect display ID if necessary."
+ (if erc--target
+ (erc-networks--ensure-unique-target-buffer-name)
+ (erc-networks--ensure-unique-server-buffer-name)))
+
+(defun erc-networks--reconcile-buffer-names (target nid)
+ "Reserve preferred buffer name for TARGET and network identifier.
+Expect TARGET to be an `erc--target' instance. Guarantee that at
+most one existing buffer has the same `erc-networks--id' and a
+case-mapped target, i.e., `erc--target-symbol'. If other buffers
+with equivalent targets exist, rename them to TARGET@their-NID
+and return TARGET@our-NID. Otherwise return TARGET as a string.
+When multiple buffers for TARGET exist for the current NID,
+rename them with <n> suffixes going from newest to oldest."
+ (let* (existing ; Former selves or unexpected dupes (for now allow > 1)
+ ;; Renamed ERC buffers on other networks matching target
+ (namesakes (erc-networks--examine-targets nid target
+ (lambda () (push (current-buffer) existing) nil)
+ ;; Append network ID as TARGET@NID,
+ ;; possibly qualifying to achieve uniqueness.
+ (lambda ()
+ (unless (erc--target-channel-local-p erc--target)
+ (erc-networks--id-ensure-comparable
+ nid erc-networks--id))
+ (erc-networks--ensure-unique-target-buffer-name)
+ t)))
+ ;; Must follow ^ because NID may have been modified
+ (name (if (or namesakes (not (with-suppressed-warnings
+ ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)))
+ (erc-networks--construct-target-buffer-name target)
+ (erc--target-string target)))
+ placeholder)
+ ;; If we don't exist, claim name temporarily while renaming others
+ (when-let* (namesakes
+ (ex (get-buffer name))
+ ((not (memq ex existing)))
+ (temp-name (generate-new-buffer-name (format "*%s*" name))))
+ (setq existing (remq ex existing))
+ (with-current-buffer ex
+ (rename-buffer temp-name)
+ (setq placeholder (get-buffer-create name))
+ (rename-buffer name 'unique)))
+ (unless (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ (when (string-suffix-p ">" name)
+ (setq name (substring name 0 -3))))
+ (dolist (ex (erc-networks--id-sort-buffers existing))
+ (with-current-buffer ex
+ (rename-buffer name 'unique)))
+ (when placeholder (kill-buffer placeholder))
+ name))
+
+
;; Functions:
;;;###autoload
@@ -739,6 +1199,7 @@ MATCHER is used to find a corresponding network to a server while
Use the server parameter NETWORK if provided, otherwise parse the
server name and search for a match in `erc-networks-alist'."
;; The server made it easy for us and told us the name of the NETWORK
+ (declare (obsolete "maybe see `erc-networks--determine'" "29.1"))
(let ((network-name (cdr (assoc "NETWORK" erc-server-parameters))))
(if network-name
(intern network-name)
@@ -753,7 +1214,7 @@ server name and search for a match in `erc-networks-alist'."
(defun erc-network ()
"Return the value of `erc-network' for the current server."
- (erc-with-server-buffer erc-network))
+ (or erc-network (erc-with-server-buffer erc-network)))
(defun erc-network-name ()
"Return the name of the current network as a string."
@@ -761,23 +1222,242 @@ server name and search for a match in `erc-networks-alist'."
(defun erc-set-network-name (_proc _parsed)
"Set `erc-network' to the value returned by `erc-determine-network'."
+ (declare (obsolete "maybe see `erc-networks--set-name'" "29.1"))
(unless erc-server-connected
- (setq erc-network (erc-determine-network)))
+ (setq erc-network (with-suppressed-warnings
+ ((obsolete erc-determine-network))
+ (erc-determine-network))))
+ nil)
+
+(defconst erc-networks--name-missing-sentinel (gensym "Unknown ")
+ "Value to cover rare case of a literal NETWORK=nil.")
+
+(defun erc-networks--determine ()
+ "Return the name of the network as a symbol.
+Search `erc-networks-alist' for a known entity matching
+`erc-server-announced-name'. If that fails, use the display name
+given by the `RPL_ISUPPORT' NETWORK parameter."
+ (or (cl-loop for (name matcher) in erc-networks-alist
+ when (and matcher (string-match (concat matcher "\\'")
+ erc-server-announced-name))
+ return name)
+ (and-let* ((vanity (erc--get-isupport-entry 'NETWORK 'single))
+ ((intern vanity))))
+ erc-networks--name-missing-sentinel))
+
+(defun erc-networks--set-name (_proc parsed)
+ "Set `erc-network' to the value returned by `erc-networks--determine'.
+Signal an error when the network cannot be determined."
+ ;; Always update (possibly clobber) current value, if any.
+ (let ((name (erc-networks--determine)))
+ (when (eq name erc-networks--name-missing-sentinel)
+ ;; This can happen theoretically, e.g., if you're editing some
+ ;; settings interactively on a proxy service that impersonates IRC
+ ;; but aren't being proxied through to a real network. The
+ ;; service may send a 422 but no NETWORK param (or *any* 005s).
+ (let ((m (concat "Failed to determine network. Please set entry for "
+ erc-server-announced-name " in `erc-network-alist'.")))
+ (erc-display-error-notice parsed m)
+ (erc-error "Failed to determine network"))) ; beep
+ (setq erc-network name))
+ nil)
+
+;; This lives here in this file because all the other "on connect"
+;; MOTD stuff ended up here (but perhaps that needs to change).
+
+(defun erc-networks--ensure-announced (_ parsed)
+ "Set a fallback `erc-server-announced-name' if still unset.
+Copy source (prefix) from MOTD-ish message as a last resort."
+ ;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log
+ (unless erc-server-announced-name
+ (erc-display-error-notice parsed "Failed to determine server name.")
+ (erc-display-error-notice
+ parsed (concat "If this was unexpected, consider reporting it via "
+ (substitute-command-keys "\\[erc-bug]") "."))
+ (setq erc-server-announced-name (erc-response.sender parsed)))
nil)
(defun erc-unset-network-name (_nick _ip _reason)
"Set `erc-network' to nil."
+ (declare (obsolete "`erc-network' is now effectively read-only" "29.1"))
(setq erc-network nil)
nil)
+;; TODO add note in Commentary saying that this module is considered a
+;; core module and that it's as much about buffer naming and network
+;; identity as anything else.
+
+(defun erc-networks--insert-transplanted-content (content)
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (insert-before-markers content)))))
+
+;; This should run whenever a network identity is updated.
+
+(defun erc-networks--reclaim-orphaned-target-buffers (new-proc nid announced)
+ "Visit disowned buffers for same NID and associate with NEW-PROC.
+ANNOUNCED is the server's reported host name."
+ (erc-buffer-filter
+ (lambda ()
+ (when (and erc--target
+ (not erc-server-connected)
+ (erc-networks--id-equal-p erc-networks--id nid)
+ (or (not (erc--target-channel-local-p erc--target))
+ (string= erc-server-announced-name announced)))
+ ;; If a target buffer exists for the current process, kill this
+ ;; stale one after transplanting its content; else reinstate.
+ (if-let ((existing (erc-get-buffer
+ (erc--target-string erc--target) new-proc)))
+ (progn
+ (widen)
+ (let ((content (buffer-substring (point-min)
+ erc-insert-marker)))
+ (kill-buffer) ; allow target-buf renaming hook to run
+ (with-current-buffer existing
+ (erc-networks--ensure-unique-target-buffer-name)
+ (erc-networks--insert-transplanted-content content))))
+ (setq erc-server-process new-proc
+ erc-server-connected t
+ erc-networks--id nid))))))
+
+(defun erc-networks--copy-over-server-buffer-contents (existing name)
+ "Kill off existing server buffer after copying its contents.
+Must be called from the replacement buffer."
+ ;; ERC expects `erc-open' to be idempotent when setting up local
+ ;; vars and other context properties for a new identity. Thus, it's
+ ;; unlikely we'll have to copy anything else over besides text. And
+ ;; no reconciling of user tables, etc. happens during a normal
+ ;; reconnect, so we should be fine just sticking to text. (Right?)
+ (let ((text (with-current-buffer existing
+ ;; This `erc-networks--id' should be
+ ;; `erc-networks--id-equal-p' to caller's network
+ ;; identity and older if not eq.
+ ;;
+ ;; `erc-server-process' should be set but dead
+ ;; and eq `get-buffer-process' unless latter nil
+ (delete-process erc-server-process)
+ (buffer-substring (point-min) erc-insert-marker)))
+ erc-kill-server-hook
+ erc-kill-buffer-hook)
+ (erc-networks--insert-transplanted-content text)
+ (kill-buffer name)))
+
+;; This stands alone for testing purposes
+
+(defun erc-networks--update-server-identity ()
+ "Maybe grow or replace the current network identity.
+If a dupe is found, adopt its identity by overwriting ours.
+Otherwise, take steps to ensure it can effectively be compared to
+ours, now and into the future. Note that target buffers are
+considered as well because server buffers are often killed."
+ (let* ((identity erc-networks--id)
+ (buffer (current-buffer))
+ (f (lambda ()
+ (unless (or (eq (current-buffer) buffer)
+ (eq erc-networks--id identity))
+ (if (erc-networks--id-equal-p identity erc-networks--id)
+ (throw 'buffer erc-networks--id)
+ (erc-networks--id-ensure-comparable identity
+ erc-networks--id)
+ nil))))
+ (found (catch 'buffer (erc-buffer-filter f))))
+ (when found
+ (setq erc-networks--id found))))
+
+;; These steps should only run when initializing a newly connected
+;; server buffer, whereas `erc-networks--rename-server-buffer' can run
+;; mid-session, after an identity's core components have changed.
+
+(defun erc-networks--init-identity (_proc _parsed)
+ "Update identity with real network name."
+ ;; Initialize identity for real now that we know the network
+ (cl-assert erc-network)
+ (unless (erc-networks--id-symbol erc-networks--id) ; unless just reconnected
+ (erc-networks--id-on-connect erc-networks--id))
+ ;; Find duplicate identities or other conflicting ones and act
+ ;; accordingly.
+ (erc-networks--update-server-identity)
+ ;;
+ nil)
+
+(defun erc-networks--rename-server-buffer (new-proc &optional _parsed)
+ "Rename a server buffer based on its network identity.
+Assume that the current buffer is a server buffer, either one
+with a newly established connection whose identity has just been
+fully fleshed out, or an existing one whose identity has just
+been updated. Either way, assume the current identity is ready
+to serve as a canonical identifier.
+
+When a server buffer already exists with the chosen name, copy
+over its contents and kill it. However, when its process is
+still alive, kill off the current buffer. This can happen, for
+example, after a perceived loss in network connectivity turns out
+to be a false alarm. If `erc-reuse-buffers' is nil, let
+`generate-new-buffer-name' do the actual renaming."
+ (cl-assert (eq new-proc erc-server-process))
+ (cl-assert (erc-networks--id-symbol erc-networks--id))
+ ;; Always look for targets to reassociate because original server
+ ;; buffer may have been deleted.
+ (erc-networks--reclaim-orphaned-target-buffers new-proc erc-networks--id
+ erc-server-announced-name)
+ (let* ((name (symbol-name (erc-networks--id-symbol erc-networks--id)))
+ ;; When this ends up being the current buffer, either we have
+ ;; a "given" ID or the buffer was reused on reconnecting.
+ (existing (get-buffer name)))
+ (cond ((or (not existing)
+ (erc-networks--id-given erc-networks--id)
+ (eq existing (current-buffer)))
+ (rename-buffer name))
+ ;; Abort on accidental reconnect or failure to pass :id param for
+ ;; avoidable collisions.
+ ((erc-server-process-alive existing)
+ (kill-local-variable 'erc-network)
+ (delete-process new-proc)
+ (erc-display-error-notice nil (format "Buffer %s still connected"
+ name))
+ (erc-set-active-buffer existing))
+ ;; Copy over old buffer's contents and kill it
+ ((with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ (erc-networks--copy-over-server-buffer-contents existing name)
+ (rename-buffer name))
+ (t (rename-buffer (generate-new-buffer-name name)))))
+ nil)
+
+;; Soju v0.4.0 only sends ISUPPORT on upstream reconnect, so this
+;; doesn't apply. ZNC 1.8.2, however, still sends the entire burst.
+(defconst erc-networks--bouncer-targets '(*status bouncerserv)
+ "Case-mapped symbols matching known bouncer service-bot targets.")
+
+(defun erc-networks-on-MOTD-end (proc parsed)
+ "Call on-connect functions with server PROC and PARSED message.
+This must run before `erc-server-connected' is set."
+ (when erc-server-connected
+ (unless (erc-buffer-filter (lambda ()
+ (and erc--target
+ (memq (erc--target-symbol erc--target)
+ erc-networks--bouncer-targets)))
+ proc)
+ (let ((m (concat "Unexpected state detected. Please report via "
+ (substitute-command-keys "\\[erc-bug]") ".")))
+ (erc-display-error-notice parsed m))))
+
+ ;; For now, retain compatibility with erc-server-NNN-functions.
+ (or (erc-networks--ensure-announced proc parsed)
+ (erc-networks--set-name proc parsed)
+ (erc-networks--init-identity proc parsed)
+ (erc-networks--rename-server-buffer proc parsed)))
+
(define-erc-module networks nil
"Provide data about IRC networks."
- ((add-hook 'erc-server-375-functions #'erc-set-network-name)
- (add-hook 'erc-server-422-functions #'erc-set-network-name)
- (add-hook 'erc-disconnected-hook #'erc-unset-network-name))
- ((remove-hook 'erc-server-375-functions #'erc-set-network-name)
- (remove-hook 'erc-server-422-functions #'erc-set-network-name)
- (remove-hook 'erc-disconnected-hook #'erc-unset-network-name)))
+ ((add-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end)
+ (add-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end))
+ ((remove-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end)
+ (remove-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end)))
(defun erc-ports-list (ports)
"Return a list of PORTS.
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index a3fe04d392c..911a574b17e 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcNotify
;; Keywords: comm
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index e53178ce63a..087e5a67d07 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc.
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 384be500ad7..af8528dbc38 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Sacha Chua <sacha@free.net.ph>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcCompletion
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index 03153c69988..e46862d6a64 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -1,10 +1,9 @@
;;; erc-replace.el --- wash and massage messages inserted into the buffer -*- lexical-binding: t; -*-
-;; Copyright (C) 2001-2002, 2004, 2006-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 2001-2022 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcReplace
;; Keywords: comm, IRC, client, Internet
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index 0f6851a98a3..9dd1fab6403 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2001-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcHistory
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index dcd786411f2..fe9cb5b5f17 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc.
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcNickserv
;; This file is part of GNU Emacs.
@@ -174,6 +174,18 @@ function `erc-nickserv-get-password'."
:version "28.1"
:type 'boolean)
+(defcustom erc-auth-source-services-function #'erc-auth-source-search
+ "Function to retrieve NickServ password from auth-source.
+Called with a subset of keyword parameters known to
+`auth-source-search' and relevant to authenticating to nickname
+services. In return, ERC expects a string to send as the
+password, or nil, to fall through to the next method, such as
+prompting. See info node `(erc) Connecting' for details."
+ :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA
+ :type '(choice (const erc-auth-source-search)
+ (const nil)
+ function))
+
(defcustom erc-nickserv-passwords nil
"Passwords used when identifying to NickServ automatically.
`erc-prompt-for-nickserv-password' must be nil for these
@@ -202,7 +214,7 @@ Example of use:
(const QuakeNet)
(const Rizon)
(const SlashNET)
- (symbol :tag "Network name"))
+ (symbol :tag "Network name or session ID"))
(repeat :tag "Nickname and password"
(cons :tag "Identity"
(string :tag "Nick")
@@ -431,34 +443,20 @@ As soon as some source returns a password, the sequence of
lookups stops and this function returns it (or returns nil if it
is empty). Otherwise, no corresponding password was found, and
it returns nil."
- (let (network server port)
- ;; Fill in local vars, switching to the server buffer once only
- (erc-with-server-buffer
- (setq network erc-network
- server erc-session-server
- port erc-session-port))
- (let ((ret
- (or
- (when erc-nickserv-passwords
- (cdr (assoc nick
- (cl-second (assoc network
- erc-nickserv-passwords)))))
- (when erc-use-auth-source-for-nickserv-password
- (let ((secret (cl-first (auth-source-search
- :max 1 :require '(:secret)
- :host server
- ;; Ensure a string for :port
- :port (format "%s" port)
- :user nick))))
- (when secret
- (let ((passwd (plist-get secret :secret)))
- (if (functionp passwd) (funcall passwd) passwd)))))
- (when erc-prompt-for-nickserv-password
- (read-passwd
- (format "NickServ password for %s on %s (RET to cancel): "
- nick network))))))
- (when (and ret (not (string= ret "")))
- ret))))
+ (when-let*
+ ((nid (erc-networks--id-symbol erc-networks--id))
+ (ret (or (when erc-nickserv-passwords
+ (assoc-default nick
+ (cadr (assq nid erc-nickserv-passwords))))
+ (when (and erc-use-auth-source-for-nickserv-password
+ erc-auth-source-services-function)
+ (funcall erc-auth-source-services-function :user nick))
+ (when erc-prompt-for-nickserv-password
+ (read-passwd
+ (format "NickServ password for %s on %s (RET to cancel): "
+ nick nid)))))
+ ((not (string-empty-p ret))))
+ ret))
(defvar erc-auto-discard-away)
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index 86978f9d794..5cae64572f0 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2002-2003, 2006-2022 Free Software Foundation, Inc.
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcSound
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index ead0d374b18..5b06c21612f 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Contributor: Eric M. Ludlam <zappo@gnu.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcSpeedbar
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index d9cfc9bc985..91e6777b7c0 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm, irc
;; URL: https://www.emacswiki.org/emacs/ErcSpelling
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index d74a53bc71e..cdab3241c12 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm, timestamp
;; URL: https://www.emacswiki.org/emacs/ErcStamp
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
index 39430ee6598..8997be00ae0 100644
--- a/lisp/erc/erc-status-sidebar.el
+++ b/lisp/erc/erc-status-sidebar.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2017, 2020-2022 Free Software Foundation, Inc.
;; Author: Andrew Barbarello
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://github.com/drewbarbs/erc-status-sidebar
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 2196c5411eb..ef9a8c243e9 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcChannelTracking
@@ -46,7 +46,7 @@
(defcustom erc-track-enable-keybindings 'ask
"Whether to enable the ERC track keybindings, namely:
-`C-c C-SPC' and `C-c C-@', which both do the same thing.
+\\`C-c C-SPC' and \\`C-c C-@', which both do the same thing.
The default is to check to see whether these keys are used
already: if not, then enable the ERC track minor mode, which
@@ -353,8 +353,6 @@ of `erc-track-shorten-start' characters."
(> (length s) erc-track-shorten-cutoff))
erc-track-shorten-start))
-(defvar erc-default-recipients)
-
(defun erc-all-buffer-names ()
"Return all channel or query buffer names.
Note that we cannot use `erc-channel-list' with a nil argument,
@@ -455,12 +453,12 @@ START is the minimum length of the name used."
;; Play nice with other IRC clients (and Emacs development rules) by
;; making this a minor mode
-(defvar erc-track-minor-mode-map (make-sparse-keymap)
- "Keymap for rcirc track minor mode.")
-
-(define-key erc-track-minor-mode-map (kbd "C-c C-@") #'erc-track-switch-buffer)
-(define-key erc-track-minor-mode-map (kbd "C-c C-SPC")
- #'erc-track-switch-buffer)
+(defvar erc-track-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-@") #'erc-track-switch-buffer)
+ (define-key map (kbd "C-c C-SPC") #'erc-track-switch-buffer)
+ map)
+ "Keymap for ERC track minor mode.")
;;;###autoload
(define-minor-mode erc-track-minor-mode
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 8a8842bc484..d998718a8fc 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2003-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; URL: https://www.emacswiki.org/emacs/ErcTruncation
;; Keywords: IRC, chat, client, Internet, logging
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index ee2a8c936f7..ca8ff6c080b 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2003-2004, 2006-2022 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 635228e7f55..0a16831fba3 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Alexander L. Belikoff (alexander@belikoff.net)
-;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu),
;; Mario Lang (mlang@delysid.org),
;; Alex Schroeder (alex@gnu.org)
@@ -12,7 +12,7 @@
;; David Edmondson (dme@dme.org)
;; Michael Olson (mwolson@gnu.org)
;; Kelvin White (kwhite@gnu.org)
-;; Version: 5.4
+;; Version: 5.4.1
;; Package-Requires: ((emacs "27.1"))
;; Keywords: IRC, chat, client, Internet
;; URL: https://www.gnu.org/software/emacs/erc.html
@@ -69,7 +69,7 @@
(require 'iso8601)
(eval-when-compile (require 'subr-x))
-(defconst erc-version "5.4"
+(defconst erc-version "5.4.1"
"This version of ERC.")
(defvar erc-official-location
@@ -83,7 +83,8 @@
'customize-package-emacs-version-alist
'(ERC ("5.2" . "22.1")
("5.3" . "23.1")
- ("5.4" . "28.1")))
+ ("5.4" . "28.1")
+ ("5.4.1" . "29.1")))
(defgroup erc nil
"Emacs Internet Relay Chat client."
@@ -129,7 +130,29 @@
"Running scripts at startup and with /LOAD."
:group 'erc)
-(require 'erc-backend)
+;; Defined in erc-backend
+(defvar erc--server-last-reconnect-count)
+(defvar erc--server-reconnecting)
+(defvar erc-channel-members-changed-hook)
+(defvar erc-network)
+(defvar erc-networks--id)
+(defvar erc-server-367-functions)
+(defvar erc-server-announced-name)
+(defvar erc-server-connect-function)
+(defvar erc-server-connected)
+(defvar erc-server-current-nick)
+(defvar erc-server-lag)
+(defvar erc-server-last-sent-time)
+(defvar erc-server-process)
+(defvar erc-server-quitting)
+(defvar erc-server-reconnect-count)
+(defvar erc-server-reconnecting)
+(defvar erc-session-client-certificate)
+(defvar erc-session-connector)
+(defvar erc-session-port)
+(defvar erc-session-server)
+(defvar erc-session-user-full-name)
+(defvar erc-session-username)
;; tunable connection and authentication parameters
@@ -189,16 +212,30 @@ parameters and authentication."
:set (lambda (sym val)
(set sym (if (functionp val) (funcall val) val))))
-(defcustom erc-rename-buffers nil
+(defcustom erc-rename-buffers t
"Non-nil means rename buffers with network name, if available."
:version "24.5"
:group 'erc
:type 'boolean)
+;; For the sake of compatibility, an ID will be created on the user's
+;; behalf when `erc-rename-buffers' is nil and one wasn't provided.
+;; The name will simply be that of the buffer, usually SERVER:PORT.
+;; This violates the policy of treating provided IDs as gospel, but
+;; it'll have to do for now.
+
+(make-obsolete-variable 'erc-rename-buffers
+ "old behavior when t now permanent" "29.1")
+
(defvar erc-password nil
- "Password to use when authenticating to an IRC server.
-It is not strictly necessary to provide this, since ERC will
-prompt you for it.")
+ "Password to use when authenticating to an IRC server interactively.
+
+This variable only exists for legacy reasons. It's not customizable and
+is limited to a single server password. Users looking for similar
+functionality should consider auth-source instead. See info
+node `(auth) Top' and info node `(erc) Connecting'.")
+
+(make-obsolete-variable 'erc-password "use auth-source instead" "29.1")
(defcustom erc-user-mode "+i"
;; +i "Invisible". Hides user from global /who and /names.
@@ -209,7 +246,7 @@ prompt you for it.")
(defcustom erc-prompt-for-password t
- "Asks before using the default password, or whether to enter a new one."
+ "Ask for a server password when invoking `erc-tls' interactively."
:group 'erc
:type 'boolean)
@@ -223,13 +260,49 @@ prompt you for it.")
:group 'erc
:type 'boolean)
-(defcustom erc-hide-prompt nil
- "If non-nil, do not display the prompt for commands.
+(defcustom erc-inhibit-multiline-input nil
+ "When non-nil, conditionally disallow input consisting of multiple lines.
+Issue an error when the number of input lines submitted for
+sending exceeds this value. The value t means disallow more
+than 1 line of input."
+ :package-version '(ERC . "5.4.1") ; FIXME match to next release
+ :group 'erc
+ :type '(choice integer boolean))
-\(A command is any input starting with a `/').
+(defcustom erc-ask-about-multiline-input nil
+ "Whether to ask to ignore `erc-inhibit-multiline-input' when tripped."
+ :package-version '(ERC . "5.4.1") ; FIXME match to next release
+ :group 'erc
+ :type 'boolean)
+
+(defcustom erc-prompt-hidden ">"
+ "Text to show in lieu of the prompt when hidden."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
+ :group 'erc-display
+ :type 'string)
-See also the variables `erc-prompt' and `erc-command-indicator'."
+(defcustom erc-hide-prompt t
+ "If non-nil, hide input prompt upon disconnecting.
+To unhide, type something in the input area. Once revealed, a
+prompt remains unhidden until the next disconnection. Channel
+prompts are unhidden upon rejoining. See
+`erc-unhide-query-prompt' for behavior concerning query prompts."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
+ :group 'erc-display
+ :type '(choice (const :tag "Always hide prompt" t)
+ (set (const server)
+ (const query)
+ (const channel))))
+
+(defcustom erc-unhide-query-prompt nil
+ "When non-nil, always reveal query prompts upon reconnecting.
+Otherwise, prompts in a connection's query buffers remain hidden
+until the user types in the input area or a new message arrives
+from the target."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
:group 'erc-display
+ ;; Extensions may one day offer a way to discover whether a target
+ ;; is online. When that happens, this can be expanded accordingly.
:type 'boolean)
;; tunable GUI stuff
@@ -351,18 +424,30 @@ erc-channel-user struct.")
"Hash table of users on the current server.
It associates nicknames with `erc-server-user' struct instances.")
+(defconst erc--casemapping-rfc1459
+ (make-translation-table
+ '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|) (?~ . ?^))
+ (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
+
+(defconst erc--casemapping-rfc1459-strict
+ (make-translation-table
+ '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|))
+ (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
+
(defun erc-downcase (string)
- "Convert STRING to IRC standard conforming downcase."
- (let ((s (downcase string))
- (c '((?\[ . ?\{)
- (?\] . ?\})
- (?\\ . ?\|)
- (?~ . ?^))))
- (save-match-data
- (while (string-match "[]\\[~]" s)
- (aset s (match-beginning 0)
- (cdr (assq (aref s (match-beginning 0)) c)))))
- s))
+ "Return a downcased copy of STRING with properties.
+Use the CASEMAPPING ISUPPORT parameter to determine the style."
+ (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single))
+ (inhibit-read-only t))
+ (if (equal mapping "ascii")
+ (downcase string)
+ (with-temp-buffer
+ (insert string)
+ (translate-region (point-min) (point-max)
+ (if (equal mapping "rfc1459-strict")
+ erc--casemapping-rfc1459-strict
+ erc--casemapping-rfc1459))
+ (buffer-string)))))
(defmacro erc-with-server-buffer (&rest body)
"Execute BODY in the current ERC server buffer.
@@ -871,8 +956,8 @@ See `erc-server-flood-margin' for other flood-related parameters.")
;; Script parameters
(defcustom erc-startup-file-list
- (list (concat user-emacs-directory ".ercrc.el")
- (concat user-emacs-directory ".ercrc")
+ (list (locate-user-emacs-file ".ercrc.el")
+ (locate-user-emacs-file ".ercrc")
"~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
"List of files to try for a startup script.
The first existent and readable one will get executed.
@@ -1053,6 +1138,29 @@ The struct has three slots:
:type 'hook
:version "27.1")
+;; This is being auditioned for possible exporting (as a custom hook
+;; option). Likewise for (public versions of) `erc--input-split' and
+;; `erc--discard-trailing-multiline-nulls'. If unneeded, we'll just
+;; run the latter on the input after `erc-pre-send-functions', and
+;; remove this hook and the struct completely. IOW, if you need this,
+;; please say so.
+
+(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls)
+ "Special hook for modifying individual lines in multiline prompt input.
+The functions are called with one argument, an `erc--input-split'
+struct, which they can optionally modify.
+
+The struct has five slots:
+
+ `string': the input string delivered by `erc-pre-send-functions'
+ `insertp': whether to insert the lines into the buffer
+ `sendp': whether the lines should be sent to the IRC server
+ `lines': a list of lines to be sent, each one a `string'
+ `cmdp': whether to interpret input as a command, like /ignore
+
+The `string' field is effectively read-only. When `cmdp' is
+non-nil, all but the first line will be discarded.")
+
(defvar erc-insert-this t
"Insert the text into the target buffer or not.
Functions on `erc-insert-pre-hook' can set this variable to nil
@@ -1291,7 +1399,7 @@ Example:
#\\='erc-replace-insert))
((remove-hook \\='erc-insert-modify-hook
#\\='erc-replace-insert)))"
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
(group (intern (format "erc-%s" (downcase sn))))
@@ -1337,6 +1445,45 @@ if ARG is omitted or nil.
(put ',enable 'definition-name ',name)
(put ',disable 'definition-name ',name))))
+;; The rationale for favoring inheritance here (nicer dispatch) is
+;; kinda flimsy since there aren't yet any actual methods.
+
+(cl-defstruct erc--target
+ (string "" :type string :documentation "Received name of target.")
+ (symbol nil :type symbol :documentation "Case-mapped name as symbol."))
+
+;; These should probably take on a `joined' field to track joinedness,
+;; which should be toggled by `erc-server-JOIN', `erc-server-PART',
+;; etc. Functions like `erc--current-buffer-joined-p' (bug#48598) may
+;; find it useful.
+
+(cl-defstruct (erc--target-channel (:include erc--target)))
+
+(cl-defstruct (erc--target-channel-local (:include erc--target-channel)))
+
+;; At some point, it may make sense to add a query type with an
+;; account field, which may help support reassociation across
+;; reconnects and nick changes (likely requires v3 extensions).
+
+(defun erc--target-from-string (string)
+ "Construct an `erc--target' variant from STRING."
+ (funcall (if (erc-channel-p string)
+ (if (erc--valid-local-channel-p string)
+ #'make-erc--target-channel-local
+ #'make-erc--target-channel)
+ #'make-erc--target)
+ :string string :symbol (intern (erc-downcase string))))
+
+(defvar-local erc--target nil
+ "Info about a buffer's target, if any.")
+
+;; Temporary internal getter to ease transition to `erc--target'
+;; everywhere. Will be replaced by updated `erc-default-target'.
+(defun erc--default-target ()
+ "Return target string or nil."
+ (when erc--target
+ (erc--target-string erc--target)))
+
(defun erc-once-with-server-event (event f)
"Run function F the next time EVENT occurs in the `current-buffer'.
@@ -1478,6 +1625,7 @@ Defaults to the server buffer."
(define-derived-mode erc-mode fundamental-mode "ERC"
"Major mode for Emacs IRC."
+ :interactive nil
(setq local-abbrev-table erc-mode-abbrev-table)
(setq-local next-line-add-newlines nil)
(setq line-move-ignore-invisible t)
@@ -1486,6 +1634,7 @@ Defaults to the server buffer."
(setq-local paragraph-start
(concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
(setq-local completion-ignore-case t)
+ (add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t)
(add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
;; activation
@@ -1519,6 +1668,22 @@ The available choices are:
(const :tag "Use current buffer" buffer)
(const :tag "Use current buffer" t)))
+(defcustom erc-reconnect-display nil
+ "How (and whether) to display a channel buffer upon reconnecting.
+
+This only affects automatic reconnections and is ignored when
+issuing a /reconnect command or reinvoking `erc-tls' with the
+same args (assuming success, of course). See `erc-join-buffer'
+for a description of possible values."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :group 'erc-buffers
+ :type '(choice (const :tag "Use value of `erc-join-buffer'" nil)
+ (const :tag "Split window and select" window)
+ (const :tag "Split window, don't select" window-noselect)
+ (const :tag "New frame" frame)
+ (const :tag "Bury in new buffer" bury)
+ (const :tag "Use current buffer" buffer)))
+
(defcustom erc-frame-alist nil
"Alist of frame parameters for creating erc frames.
A value of nil means to use `default-frame-alist'."
@@ -1550,6 +1715,14 @@ effect when `erc-join-buffer' is set to `frame'."
(erc-channel-p (erc-default-target))))
(t nil)))
+;; For the sake of compatibility, a historical quirk concerning this
+;; option, when nil, has been preserved: all buffers are suffixed with
+;; the original dialed host name, which is usually something like
+;; irc.libera.chat. Collisions are handled by adding a uniquifying
+;; numeric suffix of the form <N>. Note that channel reassociation
+;; behavior involving this option (when nil) was inverted in 28.1 (ERC
+;; 5.4 and 5.4.1). This was regrettable and has since been undone.
+
(defcustom erc-reuse-buffers t
"If nil, create new buffers on joining a channel/query.
If non-nil, a new buffer will only be created when you join
@@ -1559,6 +1732,9 @@ the existing buffers will be reused."
:group 'erc-buffers
:type 'boolean)
+(make-obsolete-variable 'erc-reuse-buffers
+ "old behavior when t now permanent" "29.1")
+
(defun erc-normalize-port (port)
"Normalize the port specification PORT to integer form.
PORT may be an integer, a string or a symbol. If it is a string or a
@@ -1594,55 +1770,61 @@ symbol, it may have these values:
"Check whether ports A and B are equal."
(= (erc-normalize-port a) (erc-normalize-port b)))
-(defun erc-generate-new-buffer-name (server port target)
- "Create a new buffer name based on the arguments."
- (when (numberp port) (setq port (number-to-string port)))
- (let* ((buf-name (or target
- (let ((name (concat server ":" port)))
- (when (> (length name) 1)
- name))
- ;; This fallback should in fact never happen.
- "*erc-server-buffer*"))
- (full-buf-name (concat buf-name "/" server))
- (dup-buf-name (buffer-name (car (erc-channel-list nil))))
- buffer-name)
- ;; Reuse existing buffers, but not if the buffer is a connected server
- ;; buffer and not if its associated with a different server than the
- ;; current ERC buffer.
- ;; If buf-name is taken by a different connection (or by something !erc)
- ;; then see if "buf-name/server" meets the same criteria.
- (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name))
- (setq buffer-name full-buf-name) ; ERC buffer with full name already exists.
- (dolist (candidate (list buf-name full-buf-name))
- (if (and (not buffer-name)
- erc-reuse-buffers
- (or (not (get-buffer candidate))
- ;; Looking for a server buffer, so there's no target.
- (and (not target)
- (with-current-buffer (get-buffer candidate)
- (and (erc-server-buffer-p)
- (not (erc-server-process-alive)))))
- ;; Channel buffer; check that it's from the right server.
- (and target
- (with-current-buffer (get-buffer candidate)
- (and (string= erc-session-server server)
- (erc-port-equal erc-session-port port))))))
- (setq buffer-name candidate)
- (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers)
- ;; A new buffer will be created with the name buf-name/server, rename
- ;; the existing name-duplicated buffer with the same format as well.
- (with-current-buffer (get-buffer buf-name)
- (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer
- (rename-buffer
- (concat buf-name "/" (or erc-session-server erc-server-announced-name)))))))))
- ;; If buffer-name is unset, neither candidate worked out for us,
- ;; fallback to the old <N> uniquification method:
- (or buffer-name (generate-new-buffer-name full-buf-name))))
-
-(defun erc-get-buffer-create (server port target)
+(defun erc-generate-new-buffer-name (server port target &optional tgt-info id)
+ "Determine the name of an ERC buffer.
+When TGT-INFO is nil, assume this is a server buffer. If ID is non-nil,
+return ID as a string unless a buffer already exists with a live server
+process, in which case signal an error. When ID is nil, return a
+temporary name based on SERVER and PORT to be replaced with the network
+name when discovered (see `erc-networks--rename-server-buffer'). Allow
+either SERVER or PORT (but not both) to be nil to accommodate oddball
+`erc-server-connect-function's.
+
+When TGT-INFO is non-nil, expect its string field to match the redundant
+param TARGET (retained for compatibility). Whenever possibly, prefer
+returning TGT-INFO's string unmodified. But when a case-insensitive
+collision prevents that, return target@ID when ID is non-nil or
+target@network otherwise after renaming the conflicting buffer in the
+same manner."
+ (when target ; compat
+ (setq tgt-info (erc--target-from-string target)))
+ (if tgt-info
+ (let* ((esid (erc-networks--id-symbol erc-networks--id))
+ (name (if esid
+ (erc-networks--reconcile-buffer-names tgt-info
+ erc-networks--id)
+ (erc--target-string tgt-info))))
+ (if (and esid (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ name
+ (generate-new-buffer-name name)))
+ (if (and (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ id)
+ (progn
+ (when-let* ((buf (get-buffer (symbol-name id)))
+ ((erc-server-process-alive buf)))
+ (user-error "Session with ID %S already exists" id))
+ (symbol-name id))
+ (generate-new-buffer-name (if (and server port)
+ (if (with-suppressed-warnings
+ ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ (format "%s:%s" server port)
+ (format "%s:%s/%s" server port server))
+ (or server port))))))
+
+(defun erc-get-buffer-create (server port target &optional tgt-info id)
"Create a new buffer based on the arguments."
- (get-buffer-create (erc-generate-new-buffer-name server port target)))
-
+ (when target ; compat
+ (setq tgt-info (erc--target-from-string target)))
+ (if (and erc--server-reconnecting
+ (not tgt-info)
+ (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ (current-buffer)
+ (get-buffer-create
+ (erc-generate-new-buffer-name server port nil tgt-info id))))
(defun erc-member-ignore-case (string list)
"Return non-nil if STRING is a member of LIST.
@@ -1759,12 +1941,7 @@ nil."
(lambda (bufname)
(let ((buf (if (consp bufname)
(cdr bufname) (get-buffer bufname))))
- (when buf
- (erc--buffer-p buf (lambda () t) proc)
- (with-current-buffer buf
- (and (derived-mode-p 'erc-mode)
- (or (null proc)
- (eq proc erc-server-process))))))))))
+ (and buf (erc--buffer-p buf (lambda () t) proc)))))))
(defun erc-switch-to-buffer (&optional arg)
"Prompt for an ERC buffer to switch to.
When invoked with prefix argument, use all ERC buffers. Without
@@ -1802,12 +1979,24 @@ all channel buffers on all servers."
;; Some local variables
+;; TODO eventually deprecate this variable
+;;
+;; In the ancient, pre-CVS days (prior to June 2001), this list may
+;; have been used for supporting the changing of a buffer's target on
+;; the fly (mid-session). Such usage, which allowed cons cells like
+;; (QUERY . bob) to serve as the list's head, was either never fully
+;; integrated or was partially clobbered prior to the introduction of
+;; version control. But vestiges remain (see `erc-dcc-chat-mode').
+;; And despite appearances, no evidence has emerged that ERC ever
+;; supported one-to-many target buffers. If such a thing was aspired
+;; to, it was never realized.
+;;
+;; New library code should use the `erc--target' struct instead.
+;; Third-party code can continue to use this until a getter for
+;; `erc--target' (or whatever replaces it) is exported.
(defvar-local erc-default-recipients nil
"List of default recipients of the current buffer.")
-(defvar-local erc-session-user-full-name nil
- "Full name of the user on the current server.")
-
(defvar-local erc-channel-user-limit nil
"Limit of users per channel.")
@@ -1948,7 +2137,10 @@ removed from the list will be disabled."
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."
- (pcase erc-join-buffer
+ (pcase (if (zerop (erc-with-server-buffer
+ erc--server-last-reconnect-count))
+ erc-join-buffer
+ (or erc-reconnect-display erc-join-buffer))
('window
(if (active-minibuffer-window)
(display-buffer buffer)
@@ -1974,8 +2166,8 @@ removed from the list will be disabled."
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
- client-certificate)
- "Connect to SERVER on PORT as NICK with FULL-NAME.
+ client-certificate user id)
+ "Connect to SERVER on PORT as NICK with USER and FULL-NAME.
If CONNECT is non-nil, connect to the server. Otherwise assume
already connected and just create a separate buffer for the new
@@ -1991,15 +2183,17 @@ of the client certificate itself to use when connecting over TLS,
or t, which means that `auth-source' will be queried for the
private key and the certificate.
+When non-nil, ID should be a symbol for identifying the connection.
+
Returns the buffer for the given server or channel."
- (let ((server-announced-name (when (and (boundp 'erc-session-server)
- (string= server erc-session-server))
- erc-server-announced-name))
- (connected-p (unless connect erc-server-connected))
- (buffer (erc-get-buffer-create server port channel))
- (old-buffer (current-buffer))
- old-point
- continued-session)
+ (let* ((target (and channel (erc--target-from-string channel)))
+ (buffer (erc-get-buffer-create server port nil target id))
+ (old-buffer (current-buffer))
+ old-point
+ (continued-session (and erc--server-reconnecting
+ (with-suppressed-warnings
+ ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(erc-update-modules)
(set-buffer buffer)
@@ -2007,8 +2201,9 @@ Returns the buffer for the given server or channel."
(let ((old-recon-count erc-server-reconnect-count))
(erc-mode)
(setq erc-server-reconnect-count old-recon-count))
- (setq erc-server-announced-name server-announced-name)
- (setq erc-server-connected connected-p)
+ (when (setq erc-server-connected (not connect))
+ (setq erc-server-announced-name
+ (buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
(setq erc-insert-marker (make-marker))
@@ -2017,7 +2212,7 @@ Returns the buffer for the given server or channel."
;; (the buffer may have existed)
(goto-char (point-max))
(forward-line 0)
- (when (get-text-property (point) 'erc-prompt)
+ (when (or continued-session (get-text-property (point) 'erc-prompt))
(setq continued-session t)
(set-marker erc-input-marker
(or (next-single-property-change (point) 'erc-prompt)
@@ -2028,6 +2223,9 @@ Returns the buffer for the given server or channel."
(set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
+ (when target
+ (setq erc--target target
+ erc-network (erc-network)))
(setq erc-server-current-nick nil)
;; Initialize erc-server-users and erc-channel-users
(if connect
@@ -2039,8 +2237,6 @@ Returns the buffer for the given server or channel."
(setq erc-server-users nil)
(setq erc-channel-users
(make-hash-table :test 'equal))))
- ;; clear last incomplete line read
- (setq erc-server-filter-data nil)
(setq erc-channel-topic "")
;; limit on the number of users on the channel (mode +l)
(setq erc-channel-user-limit nil)
@@ -2057,24 +2253,12 @@ Returns the buffer for the given server or channel."
(setq erc-logged-in nil)
;; The local copy of `erc-nick' - the list of nicks to choose
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
- ;; password stuff
- (setq erc-session-password
- (or passwd
- (let ((secret
- (plist-get
- (nth 0
- (auth-source-search :host server
- :max 1
- :user nick
- ;; secrets.el wouldn’t accept a number
- :port (if (numberp port) (number-to-string port) port)
- :require '(:secret)))
- :secret)))
- (if (functionp secret)
- (funcall secret)
- secret))))
;; client certificate (only useful if connecting over TLS)
(setq erc-session-client-certificate client-certificate)
+ (setq erc-networks--id (if connect
+ (erc-networks--id-create id)
+ (buffer-local-value 'erc-networks--id
+ old-buffer)))
;; debug output buffer
(setq erc-dbuf
(when erc-log-p
@@ -2084,12 +2268,13 @@ Returns the buffer for the given server or channel."
(goto-char (point-max))
(insert "\n"))
(if continued-session
- (goto-char old-point)
+ (progn (goto-char old-point)
+ (erc--unhide-prompt))
(set-marker erc-insert-marker (point))
(erc-display-prompt)
(goto-char (point-max)))
- (erc-determine-parameters server port nick full-name)
+ (erc-determine-parameters server port nick full-name user passwd)
;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer)
@@ -2187,11 +2372,9 @@ parameters SERVER and NICK."
(setq server user-input)
(setq passwd (if erc-prompt-for-password
- (if (and erc-password
- (y-or-n-p "Use the default password? "))
- erc-password
- (read-passwd "Password: "))
- erc-password))
+ (read-passwd "Server password: ")
+ (with-suppressed-warnings ((obsolete erc-password))
+ erc-password)))
(when (and passwd (string= "" passwd))
(setq passwd nil))
@@ -2210,8 +2393,10 @@ parameters SERVER and NICK."
(cl-defun erc (&key (server (erc-compute-server))
(port (erc-compute-port))
(nick (erc-compute-nick))
+ (user (erc-compute-user))
password
- (full-name (erc-compute-full-name)))
+ (full-name (erc-compute-full-name))
+ id)
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
@@ -2221,8 +2406,10 @@ Non-interactively, it takes the keyword arguments
(server (erc-compute-server))
(port (erc-compute-port))
(nick (erc-compute-nick))
+ (user (erc-compute-user))
password
(full-name (erc-compute-full-name))
+ id
That is, if called with
@@ -2230,9 +2417,13 @@ That is, if called with
then the server and full-name will be set to those values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of the other parameters."
+for the values of the other parameters.
+
+When present, ID should be an opaque object used to identify the
+connection unequivocally. This is rarely needed and not available
+interactively."
(interactive (erc-select-read-args))
- (erc-open server port nick full-name t password))
+ (erc-open server port nick full-name t password nil nil nil nil user id))
;;;###autoload
(defalias 'erc-select #'erc)
@@ -2242,9 +2433,11 @@ for the values of the other parameters."
(cl-defun erc-tls (&key (server (erc-compute-server))
(port (erc-compute-port))
(nick (erc-compute-nick))
+ (user (erc-compute-user))
password
(full-name (erc-compute-full-name))
- client-certificate)
+ client-certificate
+ id)
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC over TLS.
@@ -2258,6 +2451,7 @@ Non-interactively, it takes the keyword arguments
password
(full-name (erc-compute-full-name))
client-certificate
+ id
That is, if called with
@@ -2279,13 +2473,19 @@ Example usage:
(erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
- '(\"/home/bandali/my-cert.key\"
- \"/home/bandali/my-cert.crt\"))"
+ \\='(\"/home/bandali/my-cert.key\"
+ \"/home/bandali/my-cert.crt\"))
+
+When present, ID should be an opaque object for identifying the
+connection unequivocally. (In most cases, this would be a string or a
+symbol composed of letters from the Latin alphabet.) This option is
+generally unneeded, however. See info node `(erc) Connecting' for use
+cases. Not available interactively."
(interactive (let ((erc-default-port erc-default-port-tls))
(erc-select-read-args)))
(let ((erc-server-connect-function 'erc-open-tls-stream))
(erc-open server port nick full-name t password
- nil nil nil client-certificate)))
+ nil nil nil client-certificate user id)))
(defun erc-open-tls-stream (name buffer host port &rest parameters)
"Open an TLS stream to an IRC server.
@@ -2341,8 +2541,6 @@ but you won't see it.
WARNING: Do not set this variable directly! Instead, use the
function `erc-toggle-debug-irc-protocol' to toggle its value.")
-(declare-function erc-network-name "erc-networks" ())
-
(defun erc-log-irc-protocol (string &optional outbound)
"Append STRING to the buffer *erc-protocol*.
@@ -2352,15 +2550,20 @@ The buffer is created if it doesn't exist.
If OUTBOUND is non-nil, STRING is being sent to the IRC server and
appears in face `erc-input-face' in the buffer. Lines must already
-contain CRLF endings. Peer is identified by the most precise label
-available at run time, starting with the network name, followed by the
-announced host name, and falling back to the dialed <server>:<port>."
+contain CRLF endings. A peer is identified by the most precise label
+available, starting with the session ID followed by the server-reported
+hostname, and falling back to the dialed <server>:<port> pair.
+
+When capturing logs for multiple peers and sorting them into buckets,
+such inconsistent labeling may pose a problem until the MOTD is
+received. Setting a fixed `erc-networks--id' can serve as a
+workaround."
(when erc-debug-irc-protocol
- (let ((esid (or (and (fboundp 'erc-network)
- (erc-network)
- (erc-network-name))
- erc-server-announced-name
- (format "%s:%s" erc-session-server erc-session-port)))
+ (let ((esid (if-let ((erc-networks--id)
+ (esid (erc-networks--id-symbol erc-networks--id)))
+ (symbol-name esid)
+ (or erc-server-announced-name
+ (format "%s:%s" erc-session-server erc-session-port))))
(ts (when erc-debug-irc-protocol-time-format
(format-time-string erc-debug-irc-protocol-time-format))))
(with-current-buffer (get-buffer-create "*erc-protocol*")
@@ -2403,7 +2606,8 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(concat "This buffer displays all IRC protocol "
"traffic exchanged with servers."))
(erc-make-notice "Kill it to disable logging.")
- (erc-make-notice "Press `t' to toggle."))))
+ (erc-make-notice (substitute-command-keys
+ "Press \\`t' to toggle.")))))
(insert (string-join msg "\r\n")))
(use-local-map (make-sparse-keymap))
(local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
@@ -2760,7 +2964,7 @@ returns non-nil."
(let* ((command (erc-response.command parsed))
(sender (car (erc-parse-user (erc-response.sender parsed))))
(channel (car (erc-response.command-args parsed)))
- (network (or (and (fboundp 'erc-network-name) (erc-network-name))
+ (network (or (and (erc-network) (erc-network-name))
(erc-shorten-server-name
(or erc-server-announced-name
erc-session-server))))
@@ -2816,20 +3020,19 @@ present."
(let ((prop-val (erc-get-parsed-vector position)))
(and prop-val (member (erc-response.command prop-val) list))))
-(defvar-local erc-send-input-line-function 'erc-send-input-line)
+(defvar-local erc-send-input-line-function 'erc-send-input-line
+ "Function for sending lines lacking a leading user command.
+When a line typed into a buffer contains an explicit command, like /msg,
+a corresponding handler (here, erc-cmd-MSG) is called. But lines typed
+into a channel or query buffer already have an implicit target and
+command (PRIVMSG). This function is called on such occasions and also
+for special purposes (see erc-dcc.el).")
(defun erc-send-input-line (target line &optional force)
- "Send LINE to TARGET.
-
-See also `erc-server-send'."
- (setq line (format "PRIVMSG %s :%s"
- target
- ;; If the line is empty, we still want to
- ;; send it - i.e. an empty pasted line.
- (if (string= line "\n")
- " \n"
- line)))
- (erc-server-send line force target))
+ "Send LINE to TARGET."
+ (when (string= line "\n")
+ (setq line " \n"))
+ (erc-message "PRIVMSG" (concat target " " line) force))
(defun erc-get-arglist (fun)
"Return the argument list of a function without the parens."
@@ -2967,7 +3170,7 @@ Commands for which no erc-cmd-xxx exists, are tunneled through
this function. LINE is sent to the server verbatim, and
therefore has to contain the command itself as well."
(erc-log (format "cmd: DEFAULT: %s" line))
- (erc-server-send (substring line 1))
+ (erc-server-send (string-trim-right (substring line 1) "[\r\n]"))
t)
(defvar erc--read-time-period-history nil)
@@ -3186,22 +3389,139 @@ For a list of user commands (/join /part, ...):
(defalias 'erc-cmd-H #'erc-cmd-HELP)
(put 'erc-cmd-HELP 'process-not-needed t)
+(defcustom erc-auth-source-server-function #'erc-auth-source-search
+ "Function to query auth-source for a server password.
+Called with a subset of keyword parameters known to
+`auth-source-search' and relevant to an opening \"PASS\" command,
+if any. In return, ERC expects a string to send as the server
+password, or nil, to skip the \"PASS\" command completely. An
+explicit `:password' argument to entry-point commands `erc' and
+`erc-tls' also inhibits lookup, as does setting this option to
+nil. See info node `(erc) Connecting' for details."
+ :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA
+ :group 'erc
+ :type '(choice (const erc-auth-source-search)
+ (const nil)
+ function))
+
+(defcustom erc-auth-source-join-function #'erc-auth-source-search
+ "Function to query auth-source on joining a channel.
+Called with a subset of keyword arguments known to
+`auth-source-search' and relevant to joining a password-protected
+channel. In return, ERC expects a string to use as the channel
+\"key\", or nil to just join the channel normally. Setting the
+option itself to nil tells ERC to always forgo consulting
+auth-source for channel keys. For more information, see info
+node `(erc) Connecting'."
+ :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA
+ :group 'erc
+ :type '(choice (const erc-auth-source-search)
+ (const nil)
+ function))
+
+(defun erc--auth-source-determine-params-defaults ()
+ (let* ((net (and-let* ((esid (erc-networks--id-symbol erc-networks--id))
+ ((symbol-name esid)))))
+ (localp (and erc--target (erc--target-channel-local-p erc--target)))
+ (hosts (if localp
+ (list erc-server-announced-name erc-session-server net)
+ (list net erc-server-announced-name erc-session-server)))
+ (ports (list (cl-typecase erc-session-port
+ (integer (number-to-string erc-session-port))
+ (string (and (string= erc-session-port "irc")
+ erc-session-port)) ; or nil
+ (t erc-session-port))
+ "irc")))
+ (list (cons :host (delq nil hosts))
+ (cons :port (delq nil ports))
+ (cons :require '(:secret)))))
+
+(defun erc--auth-source-determine-params-merge (&rest plist)
+ "Return a plist of merged keyword args to pass to `auth-source-search'.
+Combine items in PLIST with others derived from the current connection
+context, but prioritize the former. For keys not present in PLIST,
+favor a network ID over an announced server unless `erc--target' is a
+local channel. And treat the dialed server address as a fallback for
+the announced name in both cases."
+ (let ((defaults (erc--auth-source-determine-params-defaults)))
+ `(,@(cl-loop for (key value) on plist by #'cddr
+ for default = (assq key defaults)
+ do (when default (setq defaults (delq default defaults)))
+ append `(,key ,(delete-dups
+ `(,@(if (consp value) value (list value))
+ ,@(cdr default)))))
+ ,@(cl-loop for (k . v) in defaults append (list k v)))))
+
+(defun erc--auth-source-search (&rest defaults)
+ "Ask auth-source for a secret and return it if found.
+Use DEFAULTS as keyword arguments for querying auth-source and as a
+guide for narrowing results. Return a string if found or nil otherwise.
+The ordering of DEFAULTS influences how results are filtered, as does
+the ordering of the members of any individual composite values. If
+necessary, the former takes priority. For example, if DEFAULTS were to
+contain
+
+ :host (\"foo\" \"bar\") :port (\"123\" \"456\")
+
+the secret from an auth-source entry of host foo and port 456 would be
+chosen over another of host bar and port 123. However, if DEFAULTS
+looked like
+
+ :port (\"123\" \"456\") :host (\"foo\" \"bar\")
+
+the opposite would be true. In both cases, two entries with the same
+host but different ports would result in the one with port 123 getting
+the nod. Much the same would happen for entries sharing only a port:
+the one with host foo would win."
+ (when-let*
+ ((priority (map-keys defaults))
+ (test (lambda (a b)
+ (catch 'done
+ (dolist (key priority)
+ (let* ((d (plist-get defaults key))
+ (defval (if (listp d) d (list d)))
+ ;; featurep 'seq via auth-source > json > map
+ (p (seq-position defval (plist-get a key)))
+ (q (seq-position defval (plist-get b key))))
+ (unless (eql p q)
+ (throw 'done (when p (or (not q) (< p q))))))))))
+ (plist (copy-sequence defaults)))
+ (unless (plist-get plist :max)
+ (setq plist (plist-put plist :max 5000))) ; `auth-source-netrc-parse'
+ (unless (plist-get defaults :require)
+ (setq plist (plist-put plist :require '(:secret))))
+ (when-let* ((sorted (sort (apply #'auth-source-search plist) test))
+ (secret (plist-get (car sorted) :secret)))
+ (if (functionp secret) (funcall secret) secret))))
+
+(defun erc-auth-source-search (&rest plist)
+ "Call `auth-source-search', possibly with keyword params in PLIST."
+ ;; These exist as separate helpers in case folks should find them
+ ;; useful. If that's you, please request that they be exported.
+ (apply #'erc--auth-source-search
+ (apply #'erc--auth-source-determine-params-merge plist)))
+
(defun erc-server-join-channel (server channel &optional secret)
- (let* ((secret (or secret
- (plist-get (nth 0 (auth-source-search
- :max 1
- :host server
- :port "irc"
- :user channel))
- :secret)))
- (password (if (functionp secret)
- (funcall secret)
- secret)))
- (erc-log (format "cmd: JOIN: %s" channel))
- (erc-server-send (concat "JOIN " channel
- (if password
- (concat " " password)
- "")))))
+ "Join CHANNEL, optionally with SECRET.
+Without SECRET, consult auth-source, possibly passing SERVER as the
+`:host' query parameter."
+ (unless (or secret (not erc-auth-source-join-function))
+ (unless server
+ (when (and erc-server-announced-name
+ (erc--valid-local-channel-p channel))
+ (setq server erc-server-announced-name)))
+ (setq secret (apply erc-auth-source-join-function
+ `(,@(and server (list :host server)) :user ,channel))))
+ (erc-log (format "cmd: JOIN: %s" channel))
+ (erc-server-send (concat "JOIN " channel (and secret (concat " " secret)))))
+
+(defun erc--valid-local-channel-p (channel)
+ "Non-nil when channel is server-local on a network that allows them."
+ (and-let* (((eq ?& (aref channel 0)))
+ (chan-types (erc--get-isupport-entry 'CHANTYPES 'single))
+ ((if (>= emacs-major-version 28)
+ (string-search "&" chan-types)
+ (string-match-p "&" chan-types))))))
(defun erc-cmd-JOIN (channel &optional key)
"Join the channel given in CHANNEL, optionally with KEY.
@@ -3215,18 +3535,12 @@ were most recently invited. See also `invitation'."
(setq chnl (erc-ensure-channel-name channel)))
(when chnl
;; Prevent double joining of same channel on same server.
- (let* ((joined-channels
- (mapcar (lambda (chanbuf)
- (with-current-buffer chanbuf (erc-default-target)))
- (erc-channel-list erc-server-process)))
- (server (with-current-buffer (process-buffer erc-server-process)
- (or erc-session-server erc-server-announced-name)))
- (chnl-name (car (erc-member-ignore-case chnl joined-channels))))
- (if chnl-name
- (switch-to-buffer (if (get-buffer chnl-name)
- chnl-name
- (concat chnl-name "/" server)))
- (erc-server-join-channel server chnl key)))))
+ (if-let* ((existing (erc-get-buffer chnl erc-server-process))
+ ((with-current-buffer existing
+ (erc-get-channel-user (erc-current-nick)))))
+ (switch-to-buffer existing)
+ (setq erc--server-last-reconnect-count 0)
+ (erc-server-join-channel nil chnl key))))
t)
(defalias 'erc-cmd-CHANNEL #'erc-cmd-JOIN)
@@ -3528,8 +3842,8 @@ The rest of LINE is the message to send."
(defun erc-cmd-NICK (nick)
"Change current nickname to NICK."
(erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick))
- (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer
- erc-server-parameters)))))
+ (let ((nicklen (erc-with-server-buffer
+ (erc--get-isupport-entry 'NICKLEN 'single))))
(and nicklen (> (length nick) (string-to-number nicklen))
(erc-display-message
nil 'notice 'active 'nick-too-long
@@ -3608,20 +3922,23 @@ other people should be displayed."
(defun erc-cmd-QUERY (&optional user)
"Open a query with USER.
-The type of query window/frame/etc will depend on the value of
-`erc-query-display'.
-
-If USER is omitted, close the current query buffer if one exists
-- except this is broken now ;-)"
+How the query is displayed (in a new window, frame, etc.) depends
+on the value of `erc-query-display'."
+ ;; FIXME: The doc string used to say at the end:
+ ;; "If USER is omitted, close the current query buffer if one exists
+ ;; - except this is broken now ;-)"
+ ;; Does it make sense to have that functionality? What's wrong with
+ ;; `kill-buffer'? If it makes sense, re-add it. -- SK @ 2021-11-11
(interactive
(list (read-string "Start a query with: ")))
- (let ((session-buffer (erc-server-buffer))
- (erc-join-buffer erc-query-display))
- (if user
- (erc-query user session-buffer)
+ (unless user
;; currently broken, evil hack to display help anyway
;(erc-delete-query))))
- (signal 'wrong-number-of-arguments ""))))
+ (signal 'wrong-number-of-arguments ""))
+ (let ((erc-join-buffer erc-query-display))
+ (erc-with-server-buffer
+ (erc--open-target user))))
+
(defalias 'erc-cmd-Q #'erc-cmd-QUERY)
(defun erc-quit/part-reason-default ()
@@ -3639,12 +3956,7 @@ If S is non-nil, it will be used as the quit reason."
"Zippy quit message.
If S is non-nil, it will be used as the quit reason."
- (or s
- (if (fboundp 'yow)
- (if (>= emacs-major-version 28)
- (string-replace "\n" "" (yow))
- (replace-regexp-in-string "\n" "" (yow)))
- (erc-quit/part-reason-default))))
+ (or s (erc-quit/part-reason-default)))
(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
@@ -3668,12 +3980,7 @@ If S is non-nil, it will be used as the part reason."
"Zippy part message.
If S is non-nil, it will be used as the quit reason."
- (or s
- (if (fboundp 'yow)
- (if (>= emacs-major-version 28)
- (string-replace "\n" "" (yow))
- (replace-regexp-in-string "\n" "" (yow)))
- (erc-quit/part-reason-default))))
+ (or s (erc-quit/part-reason-default)))
(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
@@ -3754,13 +4061,21 @@ the message given by REASON."
(setq buffer (current-buffer)))
(with-current-buffer buffer
(setq erc-server-quitting nil)
- (setq erc-server-reconnecting t)
+ (with-suppressed-warnings ((obsolete erc-server-reconnecting))
+ (setq erc-server-reconnecting t))
+ (setq erc--server-reconnecting t)
(setq erc-server-reconnect-count 0)
(setq process (get-buffer-process (erc-server-buffer)))
- (if process
- (delete-process process)
- (erc-server-reconnect))
- (setq erc-server-reconnecting nil)))
+ (when process
+ (delete-process process))
+ (erc-server-reconnect)
+ (with-suppressed-warnings ((obsolete erc-server-reconnecting)
+ ((obsolete erc-reuse-buffers)))
+ (if erc-reuse-buffers
+ (progn (cl-assert (not erc--server-reconnecting))
+ (cl-assert (not erc-server-reconnecting)))
+ (setq erc--server-reconnecting nil
+ erc-server-reconnecting nil)))))
t)
(put 'erc-cmd-RECONNECT 'process-not-needed t)
@@ -4251,8 +4566,6 @@ This places `point' just after the prompt, or at the beginning of the line."
(defun erc-complete-word-at-point ()
(run-hook-with-args-until-success 'erc-complete-functions))
-(define-obsolete-function-alias 'erc-complete-word #'completion-at-point "24.1")
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; IRC SERVER INPUT HANDLING
@@ -4299,27 +4612,30 @@ See `erc-default-server-hook'."
(nconc erc-server-vectors (list parsed))
nil)
-(defun erc-query (target server)
- "Open a query buffer on TARGET, using SERVER.
+(defun erc--open-target (target)
+ "Open an ERC buffer on TARGET."
+ (erc-open erc-session-server
+ erc-session-port
+ (erc-current-nick)
+ erc-session-user-full-name
+ nil
+ nil
+ (list target)
+ target
+ erc-server-process
+ nil
+ erc-session-username
+ (erc-networks--id-given erc-networks--id)))
+
+(defun erc-query (target server-buffer)
+ "Open a query buffer on TARGET using SERVER-BUFFER.
To change how this query window is displayed, use `let' to bind
`erc-join-buffer' before calling this."
- (unless (and server
- (buffer-live-p server)
- (set-buffer server))
+ (declare (obsolete "bind `erc-cmd-query' and call `erc-cmd-QUERY'" "29.1"))
+ (unless (buffer-live-p server-buffer)
(error "Couldn't switch to server buffer"))
- (let ((buf (erc-open erc-session-server
- erc-session-port
- (erc-current-nick)
- erc-session-user-full-name
- nil
- nil
- (list target)
- target
- erc-server-process)))
- (unless buf
- (error "Couldn't open query window"))
- (erc-update-mode-line)
- buf))
+ (with-current-buffer server-buffer
+ (erc--open-target target)))
(defcustom erc-auto-query 'window-noselect
"If non-nil, create a query buffer each time you receive a private message.
@@ -4338,6 +4654,9 @@ a new window, but not to select it. See the documentation for
(const :tag "Use current buffer" buffer)
(const :tag "Use current buffer" t)))
+;; FIXME either retire this or put it to use or more clearly explain
+;; what it's supposed to do. It's currently only used by the obsolete
+;; function `erc-auto-query'.
(defcustom erc-query-on-unjoined-chan-privmsg t
"If non-nil create query buffer on receiving any PRIVMSG at all.
This includes PRIVMSGs directed to channels. If you are using an IRC
@@ -4398,9 +4717,8 @@ See also `erc-display-error-notice'."
(format "Nickname %s is %s, try another." nick reason))
(setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
(let ((newnick (nth 1 erc-default-nicks))
- (nicklen (cdr (assoc "NICKLEN"
- (erc-with-server-buffer
- erc-server-parameters)))))
+ (nicklen (erc-with-server-buffer
+ (erc--get-isupport-entry 'NICKLEN 'single))))
(setq erc-bad-nick t)
;; try to use a different nick
(if erc-default-nicks
@@ -4461,6 +4779,8 @@ and as second argument the event parsed as a vector."
(erc-cmd-QUERY query))
nil))))
+(make-obsolete 'erc-auto-query "try erc-cmd-QUERY instead" "29.1")
+
(defun erc-is-message-ctcp-p (message)
"Check if MESSAGE is a CTCP message or not."
(string-match "^\C-a\\([^\C-a]*\\)\C-a?$" message))
@@ -4717,11 +5037,19 @@ Set user modes and run `erc-after-connect' hook."
(nick (car (erc-response.command-args parsed)))
(buffer (process-buffer proc)))
(setq erc-server-connected t)
- (setq erc-server-reconnect-count 0)
+ (setq erc--server-last-reconnect-count erc-server-reconnect-count
+ erc-server-reconnect-count 0)
(erc-update-mode-line)
(erc-set-initial-user-mode nick buffer)
(erc-server-setup-periodical-ping buffer)
- (run-hook-with-args 'erc-after-connect server nick)))))
+ (run-hook-with-args 'erc-after-connect server nick))))
+
+ (when erc-unhide-query-prompt
+ (erc-with-all-buffers-of-server proc
+ nil ; FIXME use `erc--target' after bug#48598
+ (when (and (erc-default-target)
+ (not (erc-channel-p (car erc-default-recipients))))
+ (erc--unhide-prompt)))))
(defun erc-set-initial-user-mode (nick buffer)
"If `erc-user-mode' is non-nil for NICK, set the user modes.
@@ -5003,8 +5331,7 @@ See also `erc-channel-begin-receiving-names'."
(defun erc-parse-prefix ()
"Return an alist of valid prefix character types and their representations.
Example: (operator) o => @, (voiced) v => +."
- (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer
- erc-server-parameters)))
+ (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t))
;; provide a sane default
"(qaohv)~&@%+"))
types chars)
@@ -5544,7 +5871,7 @@ Specifically, return the position of `erc-insert-marker'."
(point-max))
(defvar erc-last-input-time 0
- "Time of last call to `erc-send-current-line'.
+ "Time of last successful call to `erc-send-current-line'.
If that function has never been called, the value is 0.")
(defcustom erc-accidental-paste-threshold-seconds 0.2
@@ -5560,6 +5887,68 @@ submitted line to be intentional."
:version "26.1"
:type '(choice number (other :tag "disabled" nil)))
+(defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r)))
+
+(defun erc--blank-in-multiline-input-p (lines)
+ "Detect whether LINES contains a blank line.
+When `erc-send-whitespace-lines' is in effect, return nil if
+LINES is multiline or the first line is non-empty. When
+`erc-send-whitespace-lines' is nil, return non-nil when any line
+is empty or consists of one or more spaces, tabs, or form-feeds."
+ (catch 'return
+ (let ((multilinep (cdr lines)))
+ (dolist (line lines)
+ (when (if erc-send-whitespace-lines
+ (and (string-empty-p line) (not multilinep))
+ (string-match (rx bot (* (in " \t\f")) eot) line))
+ (throw 'return t))))))
+
+(defun erc--check-prompt-input-for-excess-lines (_ lines)
+ "Return non-nil when trying to send too many LINES."
+ (when erc-inhibit-multiline-input
+ ;; Assume `erc--discard-trailing-multiline-nulls' is set to run
+ (let ((reversed (seq-drop-while #'string-empty-p (reverse lines)))
+ (max (if (eq erc-inhibit-multiline-input t)
+ 2
+ erc-inhibit-multiline-input))
+ (seen 0)
+ msg)
+ (while (and (pop reversed) (< (cl-incf seen) max)))
+ (when (= seen max)
+ (setq msg (format "(exceeded by %d)" (1+ (length reversed))))
+ (unless (and erc-ask-about-multiline-input
+ (y-or-n-p (concat "Send input " msg "?")))
+ (concat "Too many lines " msg))))))
+
+(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
+ "Return non-nil when multiline prompt input has blank LINES."
+ (when (erc--blank-in-multiline-input-p lines)
+ (if erc-warn-about-blank-lines
+ "Blank line - ignoring..."
+ 'invalid)))
+
+(defun erc--check-prompt-input-for-point-in-bounds (_ _)
+ "Return non-nil when point is before prompt."
+ (when (< (point) (erc-beg-of-input-line))
+ "Point is not in the input area"))
+
+(defun erc--check-prompt-input-for-running-process (string _)
+ "Return non-nil unless in an active ERC server buffer."
+ (unless (or (erc-server-buffer-live-p)
+ (erc-command-no-process-p string))
+ "ERC: No process running"))
+
+(defvar erc--check-prompt-input-functions
+ '(erc--check-prompt-input-for-point-in-bounds
+ erc--check-prompt-input-for-multiline-blanks
+ erc--check-prompt-input-for-running-process
+ erc--check-prompt-input-for-excess-lines)
+ "Validators for user input typed at prompt.
+Called with latest input string submitted by user and the list of
+lines produced by splitting it. If any member function returns
+non-nil, processing is abandoned and input is left untouched.
+When the returned value is a string, pass it to `erc-error'.")
+
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
(interactive)
@@ -5573,20 +5962,21 @@ submitted line to be intentional."
(eolp))
(expand-abbrev))
(widen)
- (if (< (point) (erc-beg-of-input-line))
- (erc-error "Point is not in the input area")
+ (if-let* ((str (erc-user-input))
+ (msg (run-hook-with-args-until-success
+ 'erc--check-prompt-input-functions str
+ (split-string str erc--input-line-delim-regexp))))
+ (when (stringp msg)
+ (erc-error msg))
(let ((inhibit-read-only t)
- (str (erc-user-input))
(old-buf (current-buffer)))
- (if (and (not (erc-server-buffer-live-p))
- (not (erc-command-no-process-p str)))
- (erc-error "ERC: No process running")
+ (progn ; unprogn this during next major surgery
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
(delete-region (erc-beg-of-input-line)
(erc-end-of-input-line))
(unwind-protect
- (erc-send-input str)
+ (erc-send-input str 'skip-ws-chk)
;; Fix the buffer if the command didn't kill it
(when (buffer-live-p old-buf)
(with-current-buffer old-buf
@@ -5601,8 +5991,8 @@ submitted line to be intentional."
(set-buffer-modified-p buffer-modified))))))
;; Only when last hook has been run...
- (run-hook-with-args 'erc-send-completed-hook str))))
- (setq erc-last-input-time now))
+ (run-hook-with-args 'erc-send-completed-hook str)))
+ (setq erc-last-input-time now)))
(switch-to-buffer "*ERC Accidental Paste Overflow*")
(lwarn 'erc :warning
"You seem to have accidentally pasted some text!"))))
@@ -5619,21 +6009,31 @@ submitted line to be intentional."
(cl-defstruct erc-input
string insertp sendp)
-(defun erc-send-input (input)
+(cl-defstruct (erc--input-split (:include erc-input))
+ lines cmdp)
+
+(defun erc--discard-trailing-multiline-nulls (state)
+ "Ensure last line of STATE's string is non-null.
+But only when `erc-send-whitespace-lines' is non-nil. STATE is
+an `erc--input-split' object."
+ (when (and erc-send-whitespace-lines (erc--input-split-lines state))
+ (let ((reversed (nreverse (erc--input-split-lines state))))
+ (when (string-empty-p (car reversed))
+ (pop reversed)
+ (setf (erc--input-split-cmdp state) nil))
+ (nreverse (seq-drop-while #'string-empty-p reversed)))))
+
+(defun erc-send-input (input &optional skip-ws-chk)
"Treat INPUT as typed in by the user.
It is assumed that the input and the prompt is already deleted.
Return non-nil only if we actually send anything."
;; Handle different kinds of inputs
- (cond
- ;; Ignore empty input
- ((if erc-send-whitespace-lines
- (string= input "")
- (string-match "\\`[ \t\r\f\n]*\\'" input))
- (when erc-warn-about-blank-lines
- (message "Blank line - ignoring...")
- (beep))
- nil)
- (t
+ (if (and (not skip-ws-chk)
+ (erc--check-prompt-input-for-multiline-blanks
+ input (split-string input erc--input-line-delim-regexp)))
+ (when erc-warn-about-blank-lines
+ (message "Blank line - ignoring...") ; compat
+ (beep))
;; This dynamic variable is used by `erc-send-pre-hook'. It's
;; obsolete, and when it's finally removed, this binding should
;; also be removed.
@@ -5653,48 +6053,28 @@ Return non-nil only if we actually send anything."
:insertp erc-insert-this
:sendp erc-send-this))
(run-hook-with-args 'erc-pre-send-functions state)
+ (setq state (make-erc--input-split
+ :string (erc-input-string state)
+ :insertp (erc-input-insertp state)
+ :sendp (erc-input-sendp state)
+ :lines (split-string (erc-input-string state)
+ erc--input-line-delim-regexp)
+ :cmdp (string-match erc-command-regexp
+ (erc-input-string state))))
+ (run-hook-with-args 'erc--pre-send-split-functions state)
(when (and (erc-input-sendp state)
- erc-send-this)
- (let ((string (erc-input-string state)))
- (if (or (if (>= emacs-major-version 28)
- (string-search "\n" string)
- (string-match "\n" string))
- (not (string-match erc-command-regexp string)))
- (mapc
- (lambda (line)
- (mapc
- (lambda (line)
- ;; Insert what has to be inserted for this.
- (when (erc-input-insertp state)
- (erc-display-msg line))
- (erc-process-input-line (concat line "\n")
- (null erc-flood-protect) t))
- (or (and erc-flood-protect (erc-split-line line))
- (list line))))
- (split-string string "\n"))
- (erc-process-input-line (concat string "\n") t nil))
- t))))))
-
-;; (defun erc-display-command (line)
-;; (when erc-insert-this
-;; (let ((insert-position (point)))
-;; (unless erc-hide-prompt
-;; (erc-display-prompt nil nil (erc-command-indicator)
-;; (and (erc-command-indicator)
-;; 'erc-command-indicator-face)))
-;; (let ((beg (point)))
-;; (insert line)
-;; (erc-put-text-property beg (point)
-;; 'font-lock-face 'erc-command-indicator-face)
-;; (insert "\n"))
-;; (when (processp erc-server-process)
-;; (set-marker (process-mark erc-server-process) (point)))
-;; (set-marker erc-insert-marker (point))
-;; (save-excursion
-;; (save-restriction
-;; (narrow-to-region insert-position (point))
-;; (run-hooks 'erc-send-modify-hook)
-;; (run-hooks 'erc-send-post-hook))))))
+ erc-send-this)
+ (let ((lines (erc--input-split-lines state)))
+ (if (and (erc--input-split-cmdp state) (not (cdr lines)))
+ (erc-process-input-line (concat (car lines) "\n") t nil)
+ (dolist (line lines)
+ (dolist (line (or (and erc-flood-protect (erc-split-line line))
+ (list line)))
+ (when (erc-input-insertp state)
+ (erc-display-msg line))
+ (erc-process-input-line (concat line "\n")
+ (null erc-flood-protect) t))))
+ t)))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at point."
@@ -5786,6 +6166,27 @@ See also `erc-downcase'."
;; default target handling
+(defun erc--current-buffer-joined-p ()
+ "Return whether the current target buffer is joined."
+ ;; This may be a reliable means of detecting subscription status,
+ ;; but it's also roundabout and awkward. Perhaps it's worth
+ ;; discussing adding a joined slot to `erc--target' for this.
+ (cl-assert erc--target)
+ (and (erc--target-channel-p erc--target)
+ (erc-get-channel-user (erc-current-nick)) t))
+
+;; This function happens to return nil in channel buffers previously
+;; parted or those from which a user had been kicked. While this
+;; "works" for detecting whether a channel is currently subscribed to,
+;; new code should consider using
+;;
+;; (erc-get-channel-user (erc-current-nick))
+;;
+;; instead. For retrieving a target regardless of subscription or
+;; connection status, use replacements based on `erc--target'.
+;; (Coming soon.)
+;;
+;; TODO deprecate this
(defun erc-default-target ()
"Return the current default target (as a character string) or nil if none."
(let ((tgt (car erc-default-recipients)))
@@ -5796,12 +6197,14 @@ See also `erc-downcase'."
(defun erc-add-default-channel (channel)
"Add CHANNEL to the default channel list."
+ (declare (obsolete "use `erc-cmd-JOIN' or similar instead" "29.1"))
(let ((chl (downcase channel)))
(setq erc-default-recipients
(cons chl erc-default-recipients))))
(defun erc-delete-default-channel (channel &optional buffer)
"Delete CHANNEL from the default channel list."
+ (declare (obsolete "use `erc-cmd-PART' or similar instead" "29.1"))
(with-current-buffer (if (and buffer
(bufferp buffer))
buffer
@@ -5813,6 +6216,7 @@ See also `erc-downcase'."
"Add QUERY'd NICKNAME to the default channel list.
The previous default target of QUERY type gets removed."
+ (declare (obsolete "use `erc-cmd-QUERY' or similar instead" "29.1"))
(let ((d1 (car erc-default-recipients))
(d2 (cdr erc-default-recipients))
(qt (cons 'QUERY (downcase nickname))))
@@ -5823,7 +6227,7 @@ The previous default target of QUERY type gets removed."
(defun erc-delete-query ()
"Delete the topmost target if it is a QUERY."
-
+ (declare (obsolete "use one query buffer per target instead" "29.1"))
(let ((d1 (car erc-default-recipients))
(d2 (cdr erc-default-recipients)))
(if (and (listp d1)
@@ -6151,20 +6555,20 @@ user input."
erc-session-server
erc-session-user-full-name))
(if erc-session-password
- (erc-server-send (format "PASS %s" erc-session-password))
+ (erc-server-send (concat "PASS :" erc-session-password))
(message "Logging in without password"))
(erc-server-send (format "NICK %s" (erc-current-nick)))
(erc-server-send
(format "USER %s %s %s :%s"
;; hacked - S.B.
- (if erc-anonymous-login erc-email-userid (user-login-name))
+ erc-session-username
"0" "*"
erc-session-user-full-name))
(erc-update-mode-line))
;; connection properties' heuristics
-(defun erc-determine-parameters (&optional server port nick name)
+(defun erc-determine-parameters (&optional server port nick name user passwd)
"Determine the connection and authentication parameters.
Sets the buffer local variables:
@@ -6172,11 +6576,15 @@ Sets the buffer local variables:
- `erc-session-server'
- `erc-session-port'
- `erc-session-user-full-name'
+- `erc-session-username'
+- `erc-session-password'
- `erc-server-current-nick'"
(setq erc-session-connector erc-server-connect-function
erc-session-server (erc-compute-server server)
erc-session-port (or port erc-default-port)
- erc-session-user-full-name (erc-compute-full-name name))
+ erc-session-user-full-name (erc-compute-full-name name)
+ erc-session-username (erc-compute-user user)
+ erc-session-password (erc--compute-server-password passwd nick))
(erc-set-current-nick (erc-compute-nick nick)))
(defun erc-compute-server (&optional server)
@@ -6194,6 +6602,10 @@ non-nil value is found.
(getenv "IRCSERVER")
erc-default-server))
+(defun erc-compute-user (&optional user)
+ "Return a suitable value for the session user name."
+ (or user (if erc-anonymous-login erc-email-userid (user-login-name))))
+
(defun erc-compute-nick (&optional nick)
"Return user's IRC nick.
@@ -6209,6 +6621,12 @@ non-nil value is found.
(getenv "IRCNICK")
(user-login-name)))
+(defun erc--compute-server-password (password nick)
+ "Maybe provide a PASSWORD argument for the IRC \"PASS\" command.
+When `erc-auth-source-server-function' is non-nil, call it with NICK for
+the user field and use whatever it returns as the server password."
+ (or password (and erc-auth-source-server-function
+ (funcall erc-auth-source-server-function :user nick))))
(defun erc-compute-full-name (&optional full-name)
"Return user's full name.
@@ -6493,30 +6911,19 @@ This should be a string with substitution variables recognized by
(defun erc-format-network ()
"Return the name of the network we are currently on."
- (let ((network (and (fboundp 'erc-network-name) (erc-network-name))))
- (if (and network (symbolp network))
- (symbol-name network)
- "")))
+ (erc-network-name))
(defun erc-format-target-and/or-network ()
"Return the network or the current target and network combined.
If the name of the network is not available, then use the
shortened server name instead."
- (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name))
- (erc-shorten-server-name
- (or erc-server-announced-name
- erc-session-server)))))
- (when (and network-name (symbolp network-name))
- (setq network-name (symbol-name network-name)))
- (cond ((erc-default-target)
- (concat (erc-string-no-properties (erc-default-target))
- "@" network-name))
- ((and network-name
- (not (get-buffer network-name)))
- (when erc-rename-buffers
- (rename-buffer network-name))
- network-name)
- (t (buffer-name (current-buffer))))))
+ (if-let ((erc--target)
+ (name (if-let ((esid (erc-networks--id-symbol erc-networks--id)))
+ (symbol-name esid)
+ (erc-shorten-server-name (or erc-server-announced-name
+ erc-session-server)))))
+ (concat (erc--target-string erc--target) "@" name)
+ (buffer-name)))
(defun erc-format-away-status ()
"Return a formatted `erc-mode-line-away-status-format' if `erc-away' is non-nil."
@@ -6933,23 +7340,29 @@ See also `format-spec'."
;;; Various hook functions
-;; FIXME: Don't set the hook globally!
-(add-hook 'kill-buffer-hook #'erc-kill-buffer-function)
-
-(defcustom erc-kill-server-hook '(erc-kill-server)
- "Invoked whenever a server buffer is killed via `kill-buffer'."
+(defcustom erc-kill-server-hook '(erc-kill-server
+ erc-networks-shrink-ids-and-buffer-names)
+ "Invoked whenever a live server buffer is killed via `kill-buffer'."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
:group 'erc-hooks
:type 'hook)
-(defcustom erc-kill-channel-hook '(erc-kill-channel)
+(defcustom erc-kill-channel-hook
+ '(erc-kill-channel
+ erc-networks-shrink-ids-and-buffer-names
+ erc-networks-rename-surviving-target-buffer)
"Invoked whenever a channel-buffer is killed via `kill-buffer'."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
:group 'erc-hooks
:type 'hook)
-(defcustom erc-kill-buffer-hook nil
- "Hook run whenever a non-server or channel buffer is killed.
+(defcustom erc-kill-buffer-hook
+ '(erc-networks-shrink-ids-and-buffer-names
+ erc-networks-rename-surviving-target-buffer)
+ "Hook run whenever a query buffer is killed.
See also `kill-buffer'."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
:group 'erc-hooks
:type 'hook)
@@ -7022,6 +7435,7 @@ This function should be on `erc-kill-channel-hook'."
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
+;; FIXME change user to nick, and use API to find server buffer
;;;###autoload
(defun erc-handle-irc-url (host port channel user password)
"Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
@@ -7043,9 +7457,12 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
(provide 'erc)
+(require 'erc-backend)
+
;; Deprecated. We might eventually stop requiring the goodies automatically.
;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to
;; avoid a recursive require error when byte-compiling the entire package.
(require 'erc-goodies)
+(require 'erc-networks)
;;; erc.el ends here
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
index ecac9d2a30e..a2f8a58220c 100644
--- a/lisp/eshell/em-banner.el
+++ b/lisp/eshell/em-banner.el
@@ -61,10 +61,9 @@ modules may have a simple template to begin with."
"The banner message to be displayed when Eshell is loaded.
This can be any sexp, and should end with at least two newlines."
:type 'sexp
+ :risky t
:group 'eshell-banner)
-(put 'eshell-banner-message 'risky-local-variable t)
-
(defcustom eshell-banner-load-hook nil
"A list of functions to run when `eshell-banner' is loaded."
:version "24.1" ; removed eshell-banner-initialize
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index 27b343ad398..448b6787ee7 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -82,7 +82,11 @@ equivalent of `echo' can always be achieved by using `identity'."
It returns a formatted value that should be passed to `eshell-print'
or `eshell-printn' for display."
(if eshell-plain-echo-behavior
- (concat (apply 'eshell-flatten-and-stringify args) "\n")
+ (progn
+ ;; If the output does not end in a newline, do not emit one.
+ (setq eshell-ensure-newline-p nil)
+ (concat (apply #'eshell-flatten-and-stringify args)
+ (when output-newline "\n")))
(let ((value
(cond
((= (length args) 0) "")
@@ -109,18 +113,33 @@ or `eshell-printn' for display."
"Implementation of `echo'. See `eshell-plain-echo-behavior'."
(eshell-eval-using-options
"echo" args
- '((?n nil nil output-newline "terminate with a newline")
- (?h "help" nil nil "output this help screen")
+ '((?n nil (nil) output-newline
+ "do not output the trailing newline")
+ (?N nil (t) output-newline
+ "terminate with a newline")
+ (?E nil nil _disable-escapes
+ "don't interpret backslash escapes (default)")
+ (?h "help" nil nil
+ "output this help screen")
:preserve-args
- :usage "[-n] [object]")
- (eshell-echo args output-newline)))
+ :usage "[OPTION]... [OBJECT]...")
+ (if eshell-plain-echo-behavior
+ (eshell-echo args (if output-newline (car output-newline) t))
+ ;; In Emacs 28.1 and earlier, "-n" was used to add a newline to
+ ;; non-plain echo in Eshell. This caused confusion due to "-n"
+ ;; generally having the opposite meaning for echo. Retain this
+ ;; compatibility for the time being. For more info, see
+ ;; bug#27361.
+ (when (equal output-newline '(nil))
+ (display-warning
+ :warning "To terminate with a newline, you should use -N instead."))
+ (eshell-echo args output-newline))))
(defun eshell/printnl (&rest args)
- "Print out each of the arguments, separated by newlines."
+ "Print out each of the arguments as strings, separated by newlines."
(let ((elems (flatten-tree args)))
- (while elems
- (eshell-printn (eshell-echo (list (car elems))))
- (setq elems (cdr elems)))))
+ (dolist (elem elems)
+ (eshell-printn (eshell-stringify elem)))))
(defun eshell/listify (&rest args)
"Return the argument(s) as a single list."
@@ -136,39 +155,37 @@ or `eshell-printn' for display."
"umask" args
'((?S "symbolic" nil symbolic-p "display umask symbolically")
(?h "help" nil nil "display this usage message")
+ :preserve-args
:usage "[-S] [mode]")
- (if (or (not args) symbolic-p)
- (let ((modstr
- (concat "000"
- (format "%o"
- (logand (lognot (default-file-modes))
- 511)))))
- (setq modstr (substring modstr (- (length modstr) 3)))
- (when symbolic-p
- (let ((mode (default-file-modes)))
- (setq modstr
- (format
- "u=%s,g=%s,o=%s"
- (concat (and (= (logand mode 64) 64) "r")
- (and (= (logand mode 128) 128) "w")
- (and (= (logand mode 256) 256) "x"))
- (concat (and (= (logand mode 8) 8) "r")
- (and (= (logand mode 16) 16) "w")
- (and (= (logand mode 32) 32) "x"))
- (concat (and (= (logand mode 1) 1) "r")
- (and (= (logand mode 2) 2) "w")
- (and (= (logand mode 4) 4) "x"))))))
- (eshell-printn modstr))
- (setcar args (eshell-convert (car args)))
- (if (numberp (car args))
- (set-default-file-modes
- (- 511 (car (read-from-string
- (concat "?\\" (number-to-string (car args)))))))
- (error "Setting umask symbolically is not yet implemented"))
+ (cond
+ (symbolic-p
+ (let ((mode (default-file-modes)))
+ (eshell-printn
+ (format "u=%s,g=%s,o=%s"
+ (concat (and (= (logand mode 64) 64) "r")
+ (and (= (logand mode 128) 128) "w")
+ (and (= (logand mode 256) 256) "x"))
+ (concat (and (= (logand mode 8) 8) "r")
+ (and (= (logand mode 16) 16) "w")
+ (and (= (logand mode 32) 32) "x"))
+ (concat (and (= (logand mode 1) 1) "r")
+ (and (= (logand mode 2) 2) "w")
+ (and (= (logand mode 4) 4) "x"))))))
+ ((not args)
+ (eshell-printn (format "%03o" (logand (lognot (default-file-modes))
+ #o777))))
+ (t
+ (when (stringp (car args))
+ (if (string-match "^[0-7]+$" (car args))
+ (setcar args (string-to-number (car args) 8))
+ (error "Setting umask symbolically is not yet implemented")))
+ (set-default-file-modes (- #o777 (car args)))
(eshell-print
- "Warning: umask changed for all new files created by Emacs.\n"))
+ "Warning: umask changed for all new files created by Emacs.\n")))
nil))
+(put 'eshell/umask 'eshell-no-numeric-conversions t)
+
(provide 'em-basic)
;; Local Variables:
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 706eb8aede0..822cc941491 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -158,14 +158,6 @@ to writing a completion function."
(eshell-cmpl--custom-variable-docstring 'pcomplete-autolist)
:type (get 'pcomplete-autolist 'custom-type))
-(defcustom eshell-cmpl-suffix-list (list ?/ ?:)
- (eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list)
- :type (get 'pcomplete-suffix-list 'custom-type)
- :group 'pcomplete)
-;; Only labeled obsolete in 26.1, but all it does it set
-;; pcomplete-suffix-list, which is itself obsolete since 24.1.
-(make-obsolete-variable 'eshell-cmpl-suffix-list nil "24.1")
-
(defcustom eshell-cmpl-recexact nil
(eshell-cmpl--custom-variable-docstring 'pcomplete-recexact)
:type (get 'pcomplete-recexact 'custom-type))
@@ -226,19 +218,17 @@ to writing a completion function."
(let ((completion-at-point-functions '(elisp-completion-at-point)))
(completion-at-point)))
-(defvar eshell-cmpl-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(control ?i)] #'completion-at-point)
- ;; jww (1999-10-19): Will this work on anything but X?
- (define-key map [backtab] #'pcomplete-reverse)
- (define-key map [(meta ??)] #'completion-help-at-point)
- (define-key map [(meta control ?i)] #'eshell-complete-lisp-symbol)
- ;; C-c prefix:
- (define-key map (kbd "C-c M-h") #'eshell-completion-help)
- (define-key map (kbd "C-c TAB") #'pcomplete-expand-and-complete)
- (define-key map (kbd "C-c C-i") #'pcomplete-expand-and-complete)
- (define-key map (kbd "C-c SPC") #'pcomplete-expand)
- map))
+(defvar-keymap eshell-cmpl-mode-map
+ "C-i" #'completion-at-point
+ ;; jww (1999-10-19): Will this work on anything but X?
+ "<backtab>" #'pcomplete-reverse
+ "M-?" #'completion-help-at-point
+ "C-M-i" #'eshell-complete-lisp-symbol
+ ;; C-c prefix:
+ "C-c M-h" #'eshell-completion-help
+ "C-c TAB" #'pcomplete-expand-and-complete
+ "C-c C-i" #'pcomplete-expand-and-complete
+ "C-c SPC" #'pcomplete-expand)
(define-minor-mode eshell-cmpl-mode
"Minor mode that provides a keymap when `eshell-cmpl' active.
@@ -264,9 +254,6 @@ to writing a completion function."
eshell-cmpl-ignore-case)
(setq-local pcomplete-autolist
eshell-cmpl-autolist)
- (if (boundp 'pcomplete-suffix-list)
- (setq-local pcomplete-suffix-list
- eshell-cmpl-suffix-list))
(setq-local pcomplete-recexact
eshell-cmpl-recexact)
(setq-local pcomplete-man-function
@@ -313,18 +300,24 @@ to writing a completion function."
(describe-prefix-bindings)
(call-interactively 'pcomplete-help)))
+(defun eshell--pcomplete-insert-tab ()
+ (if (not pcomplete-allow-modifications)
+ (throw 'pcompleted nil)
+ (insert-and-inherit "\t")
+ (throw 'pcompleted t)))
+
(defun eshell-complete-parse-arguments ()
"Parse the command line arguments for `pcomplete-argument'."
(when (and eshell-no-completion-during-jobs
- (eshell-interactive-process))
- (insert-and-inherit "\t")
- (throw 'pcompleted t))
+ (eshell-interactive-process-p))
+ (eshell--pcomplete-insert-tab))
(let ((end (point-marker))
(begin (save-excursion (eshell-bol) (point)))
(posns (list t))
args delim)
- (when (memq this-command '(pcomplete-expand
- pcomplete-expand-and-complete))
+ (when (and pcomplete-allow-modifications
+ (memq this-command '(pcomplete-expand
+ pcomplete-expand-and-complete)))
(run-hook-with-args 'eshell-expand-input-functions begin end)
(if (= begin end)
(end-of-line))
@@ -337,14 +330,11 @@ to writing a completion function."
(setq begin (1+ (cadr delim))
args (eshell-parse-arguments begin end)))
((eq (car delim) ?\()
- (eshell-complete-lisp-symbol)
- (throw 'pcompleted t))
+ (throw 'pcompleted (elisp-completion-at-point)))
(t
- (insert-and-inherit "\t")
- (throw 'pcompleted t))))
+ (eshell--pcomplete-insert-tab))))
(when (get-text-property (1- end) 'comment)
- (insert-and-inherit "\t")
- (throw 'pcompleted t))
+ (eshell--pcomplete-insert-tab))
(let ((pos begin))
(while (< pos end)
(if (get-text-property pos 'arg-begin)
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 893cad7b4fb..5396044d8ca 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -313,7 +313,7 @@ With the following piece of advice, you can make this functionality
available in most of Emacs, with the exception of filename completion
in the minibuffer:
- (advice-add 'expand-file-name :around #'my-expand-multiple-dots)
+ (advice-add \\='expand-file-name :around #\\='my-expand-multiple-dots)
(defun my-expand-multiple-dots (orig-fun filename &rest args)
(apply orig-fun (eshell-expand-multiple-dots filename) args))"
(while (string-match "\\(?:\\`\\|/\\)\\.\\.\\(\\.+\\)\\(?:\\'\\|/\\)"
@@ -391,6 +391,10 @@ in the minibuffer:
(unless (equal curdir newdir)
(eshell-add-to-dir-ring curdir))
(let ((result (cd newdir)))
+ ;; If we're in "/" and cd to ".." or the like, make things
+ ;; less confusing by changing "/.." to "/".
+ (when (equal (file-truename result) "/")
+ (setq result (cd "/")))
(and eshell-cd-shows-directory
(eshell-printn result)))
(run-hooks 'eshell-directory-change-hook)
diff --git a/lisp/eshell/em-elecslash.el b/lisp/eshell/em-elecslash.el
new file mode 100644
index 00000000000..091acb9a861
--- /dev/null
+++ b/lisp/eshell/em-elecslash.el
@@ -0,0 +1,120 @@
+;;; em-elecslash.el --- electric forward slashes -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Sean Whitton <spwhitton@spwhitton.name>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Electric forward slash in remote Eshells.
+
+;;; Code:
+
+(require 'tramp)
+(require 'thingatpt)
+(require 'esh-cmd)
+(require 'esh-ext)
+(require 'esh-mode)
+
+;; This makes us an option when customizing `eshell-modules-list'.
+;;;###autoload
+(progn
+(defgroup eshell-elecslash nil
+ "Electric forward slash in remote Eshells.
+
+This module helps with supplying absolute file name arguments to
+remote commands. After enabling it, typing a forward slash as
+the first character of a command line argument will automatically
+insert the Tramp prefix, /method:host:. The automatic insertion
+applies only when `default-directory' is remote and the command
+is a Lisp function.
+
+The result is that in most cases of supplying absolute file name
+arguments to commands you should see the Tramp prefix inserted
+automatically only when that's what you'd reasonably expect.
+This frees you from having to keep track of whether commands are
+Lisp functions or external when typing command line arguments."
+ :tag "Electric forward slash"
+ :group 'eshell-module))
+
+;;; Functions:
+
+(defun eshell-elecslash-initialize () ;Called from `eshell-mode' via intern-soft!
+ "Initialize remote Eshell electric forward slash support."
+ (add-hook 'post-self-insert-hook
+ #'eshell-electric-forward-slash nil t))
+
+(defun eshell-electric-forward-slash ()
+ "Implementation of electric forward slash in remote Eshells.
+
+Initializing the `eshell-elecslash' module adds this function to
+`post-self-insert-hook'. Typing / or ~/ as the first character
+of a command line argument automatically inserts the Tramp prefix
+in the case that `default-directory' is remote and the command is
+a Lisp function. Typing a second forward slash undoes the
+insertion."
+ (when (eq ?/ (char-before))
+ (delete-char -1)
+ (let ((tilde-before (eq ?~ (char-before)))
+ (command (save-excursion
+ (eshell-bol)
+ (skip-syntax-forward " ")
+ (thing-at-point 'sexp))))
+ (if (and (file-remote-p default-directory)
+ ;; We can't formally parse the input. But if there is
+ ;; one of these operators behind us, then looking at
+ ;; the first command would not be sensible. So be
+ ;; conservative: don't insert the Tramp prefix if there
+ ;; are any of these operators behind us.
+ (not (looking-back (regexp-opt '("&&" "|" ";"))
+ eshell-last-output-end))
+ (or (= (point) eshell-last-output-end)
+ (and tilde-before
+ (= (1- (point)) eshell-last-output-end))
+ (and (or tilde-before
+ (eq ?\s (char-syntax (char-before))))
+ (or (eshell-find-alias-function command)
+ (and (fboundp (intern-soft command))
+ (or eshell-prefer-lisp-functions
+ (not (eshell-search-path command))))))))
+ (let ((map (make-sparse-keymap))
+ (start (if tilde-before (1- (point)) (point)))
+ (localname
+ (tramp-file-name-localname
+ (tramp-dissect-file-name default-directory))))
+ (when tilde-before (delete-char -1))
+ (insert
+ (substring default-directory 0
+ (string-search localname default-directory)))
+ (unless tilde-before (insert "/"))
+ ;; Typing a second slash undoes the insertion, for when
+ ;; you really do want to type a local absolute file name.
+ (define-key map "/" (lambda ()
+ (interactive)
+ (delete-region start (point))
+ (insert (if tilde-before "~/" "/"))))
+ (set-transient-map map))
+ (insert "/")))))
+
+(provide 'em-elecslash)
+
+;; Local Variables:
+;; generated-autoload-file: "esh-groups.el"
+;; End:
+
+;;; esh-elecslash.el ends here
diff --git a/lisp/eshell/em-extpipe.el b/lisp/eshell/em-extpipe.el
new file mode 100644
index 00000000000..3db1dea5955
--- /dev/null
+++ b/lisp/eshell/em-extpipe.el
@@ -0,0 +1,204 @@
+;;; em-extpipe.el --- external shell pipelines -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Sean Whitton <spwhitton@spwhitton.name>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; When constructing shell pipelines that will move a lot of data, it
+;; is a good idea to bypass Eshell's own pipelining support and use
+;; the operating system shell's instead. This module tries to make
+;; that easy to do.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'esh-arg)
+(require 'esh-cmd)
+(require 'esh-io)
+(require 'esh-util)
+
+(eval-when-compile (require 'files-x))
+
+;;; Functions:
+
+(defun eshell-extpipe-initialize () ;Called from `eshell-mode' via intern-soft!
+ "Initialize external pipelines support."
+ (when (boundp 'eshell-special-chars-outside-quoting)
+ (setq-local
+ eshell-special-chars-outside-quoting
+ (append eshell-special-chars-outside-quoting (list ?\*))))
+ (add-hook 'eshell-parse-argument-hook
+ #'eshell-parse-external-pipeline -20 t)
+ (add-hook 'eshell-pre-rewrite-command-hook
+ #'eshell-rewrite-external-pipeline -20 t))
+
+(defmacro em-extpipe--or-with-catch (&rest disjuncts)
+ "Evaluate DISJUNCTS like `or' but catch `eshell-incomplete'.
+
+If `eshell-incomplete' is thrown during the evaluation of a
+disjunct, that disjunct yields nil."
+ (let ((result (gensym)))
+ `(let (,result)
+ (or ,@(cl-loop for disjunct in disjuncts collect
+ `(if (catch 'eshell-incomplete
+ (ignore (setq ,result ,disjunct)))
+ nil
+ ,result))))))
+
+(defun eshell-parse-external-pipeline ()
+ "Parse a pipeline intended for execution by the external shell.
+
+A sequence of arguments is rewritten to use the operating system
+shell when it contains `*|', `*<' or `*>', where the asterisk is
+preceded by whitespace or located at the start of input.
+
+The command extends to the next `|' character which is not
+preceded by an unescaped asterisk following whitespace, or the
+end of input, except that any Eshell-specific output redirections
+occurring at the end are excluded. Any other `<' or `>'
+appearing before the end of the command are treated as though
+preceded by (whitespace and) an asterisk.
+
+For example,
+
+ foo <bar *| baz >#<buffer quux>
+
+is equivalent to
+
+ sh -c \"foo <bar | baz\" >#<buffer quux>
+
+when `shell-file-name' is `sh' and `shell-command-switch' is
+`-c', but in
+
+ foo >#<buffer quux> *| baz
+
+and
+
+ foo *| baz >#<buffer quux> --some-argument
+
+the Eshell-specific redirect will be passed on to the operating
+system shell, probably leading to undesired results.
+
+This function must appear early in `eshell-parse-argument-hook'
+to ensure that operating system shell syntax is not interpreted
+as though it were Eshell syntax."
+ ;; Our goal is to wrap the external command to protect it from the
+ ;; other members of `eshell-parse-argument-hook'. We must avoid
+ ;; misinterpreting a quoted `*|', `*<' or `*>' as indicating an
+ ;; external pipeline, hence the structure of the loop in `findbeg1'.
+ (cl-flet
+ ((findbeg1 (pat &optional go (bound (point-max)))
+ (let* ((start (point))
+ (result
+ (catch 'found
+ (while (> bound (point))
+ (let* ((found
+ (save-excursion
+ (re-search-forward
+ "\\(?:#?'\\|\"\\|\\\\\\)" bound t)))
+ (next (or (and found (match-beginning 0))
+ bound)))
+ (if (re-search-forward pat next t)
+ (throw 'found (match-beginning 1))
+ (goto-char next)
+ (while (em-extpipe--or-with-catch
+ (eshell-parse-lisp-argument)
+ (eshell-parse-backslash)
+ (eshell-parse-double-quote)
+ (eshell-parse-literal-quote)))
+ ;; Guard against an infinite loop if none of
+ ;; the parsers moved us forward.
+ (unless (or (> (point) next) (eobp))
+ (forward-char 1))))))))
+ (goto-char (if (and result go) (match-end 0) start))
+ result)))
+ (unless (or eshell-current-argument eshell-current-quoted)
+ (let ((beg (point)) end
+ (next-marked (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)"))
+ (next-unmarked
+ (or (findbeg1 "\\(?:\\=\\|[^*]\\|\\S-\\*\\)\\(|\\)")
+ (point-max))))
+ (when (and next-marked (> next-unmarked next-marked)
+ (or (> next-marked (point))
+ (looking-back "\\`\\|\\s-" nil)))
+ ;; Skip to the final segment of the external pipeline.
+ (while (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*|\\)" t))
+ ;; Find output redirections.
+ (while (findbeg1
+ "\\([0-9]?>+&?[0-9]?\\s-*\\S-\\)" t next-unmarked)
+ ;; Is the output redirection Eshell-specific? We have our
+ ;; own logic, rather than calling `eshell-parse-argument',
+ ;; to avoid specifying here all the possible cars of
+ ;; parsed special references -- `get-buffer-create' etc.
+ (forward-char -1)
+ (let ((this-end
+ (save-match-data
+ (cond ((looking-at "#<")
+ (forward-char 1)
+ (1+ (eshell-find-delimiter ?\< ?\>)))
+ ((and (looking-at "/\\S-+")
+ (assoc (match-string 0)
+ eshell-virtual-targets))
+ (match-end 0))))))
+ (cond ((and this-end end)
+ (goto-char this-end))
+ (this-end
+ (goto-char this-end)
+ (setq end (match-beginning 0)))
+ (t
+ (setq end nil)))))
+ ;; We've moved past all Eshell-specific output redirections
+ ;; we could find. If there is only whitespace left, then
+ ;; `end' is right before redirections we should exclude;
+ ;; otherwise, we must include everything.
+ (unless (and end (skip-syntax-forward "\s" next-unmarked)
+ (= next-unmarked (point)))
+ (setq end next-unmarked))
+ (let ((cmd (string-trim
+ (buffer-substring-no-properties beg end))))
+ (goto-char end)
+ ;; We must now drop the asterisks, unless quoted/escaped.
+ (with-temp-buffer
+ (insert cmd)
+ (goto-char (point-min))
+ (cl-loop
+ for next = (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)" t)
+ while next do (forward-char -2) (delete-char 1))
+ (eshell-finish-arg
+ `(eshell-external-pipeline ,(buffer-string))))))))))
+
+(defun eshell-rewrite-external-pipeline (terms)
+ "Rewrite an external pipeline in TERMS as parsed by
+`eshell-parse-external-pipeline', which see."
+ (while terms
+ (when (and (listp (car terms))
+ (eq (caar terms) 'eshell-external-pipeline))
+ (with-connection-local-variables
+ (setcdr terms (cl-list*
+ shell-command-switch (cadar terms) (cdr terms)))
+ (setcar terms shell-file-name)))
+ (setq terms (cdr terms))))
+
+(defsubst eshell-external-pipeline (&rest _args)
+ "Stub to generate an error if a pipeline is not rewritten."
+ (error "Unhandled external pipeline in input text"))
+
+(provide 'em-extpipe)
+;;; esh-extpipe.el ends here
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 842f27a4920..58b7a83c091 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -183,6 +183,10 @@ interpretation."
(defvar eshell-glob-matches)
(defvar message-shown)
+(defvar eshell-glob-recursive-alist
+ '(("**/" . recurse)
+ ("***/" . recurse-symlink)))
+
(defun eshell-glob-regexp (pattern)
"Convert glob-pattern PATTERN to a regular expression.
The basic syntax is:
@@ -232,8 +236,86 @@ resulting regular expression."
(regexp-quote (substring pattern matched-in-pattern))
"\\'")))
+(defun eshell-glob-convert-1 (glob &optional last)
+ "Convert a GLOB matching a single element of a file name to regexps.
+If LAST is non-nil, this glob is the last element of a file name.
+
+The result is a pair of regexps, the first for file names to
+include, and the second for ones to exclude."
+ (let ((len (length glob)) (index 1) (incl glob) excl)
+ ;; We can't use `directory-file-name' because it strips away text
+ ;; properties in the string.
+ (let ((last (1- (length incl))))
+ (when (eq (aref incl last) ?/)
+ (setq incl (substring incl 0 last))))
+ ;; Split the glob if it contains a negation like x~y.
+ (while (and (eq incl glob)
+ (setq index (string-search "~" glob index)))
+ (if (or (get-text-property index 'escaped glob)
+ (or (= (1+ index) len)))
+ (setq index (1+ index))
+ (setq incl (substring glob 0 index)
+ excl (substring glob (1+ index)))))
+ (setq incl (eshell-glob-regexp incl)
+ excl (and excl (eshell-glob-regexp excl)))
+ ;; Exclude dot files if requested.
+ (if (or eshell-glob-include-dot-files
+ (eq (aref glob 0) ?.))
+ (unless (or eshell-glob-include-dot-dot
+ (not last))
+ (setq excl (if excl
+ (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
+ "\\`\\.\\.?\\'")))
+ (setq excl (if excl
+ (concat "\\(\\`\\.\\|" excl "\\)")
+ "\\`\\.")))
+ (cons incl excl)))
+
+(defun eshell-glob-convert (glob)
+ "Convert an Eshell glob-pattern GLOB to regexps.
+The result is a list of three elements:
+
+1. The base directory to search in.
+
+2. A list containing elements of the following forms:
+
+ * Regexp pairs as generated by `eshell-glob-convert-1'.
+
+ * `recurse', indicating that searches should recurse into
+ subdirectories.
+
+ * `recurse-symlink', like `recurse', but also following
+ symlinks.
+
+3. A boolean indicating whether to match directories only."
+ (let ((globs (eshell-split-path glob))
+ (isdir (eq (aref glob (1- (length glob))) ?/))
+ start-dir result last-saw-recursion)
+ (if (and (cdr globs)
+ (file-name-absolute-p (car globs)))
+ (setq start-dir (car globs)
+ globs (cdr globs))
+ (setq start-dir "."))
+ (while globs
+ (if-let ((recurse (cdr (assoc (car globs)
+ eshell-glob-recursive-alist))))
+ (if last-saw-recursion
+ (setcar result recurse)
+ (push recurse result)
+ (setq last-saw-recursion t))
+ (push (eshell-glob-convert-1 (car globs) (null (cdr globs)))
+ result)
+ (setq last-saw-recursion nil))
+ (setq globs (cdr globs)))
+ (list (file-name-as-directory start-dir)
+ (nreverse result)
+ isdir)))
+
(defun eshell-extended-glob (glob)
- "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
+ "Return a list of files matched by GLOB.
+If no files match, signal an error (if `eshell-error-if-no-glob'
+is non-nil), or otherwise return GLOB itself.
+
This function almost fully supports zsh style filename generation
syntax. Things that are not supported are:
@@ -243,20 +325,11 @@ syntax. Things that are not supported are:
foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list
Mainly they are not supported because file matching is done with Emacs
-regular expressions, and these cannot support the above constructs.
-
-If this routine fails, it returns nil. Otherwise, it returns a list
-the form:
-
- (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
- (let ((paths (eshell-split-path glob))
+regular expressions, and these cannot support the above constructs."
+ (let ((globs (eshell-glob-convert glob))
eshell-glob-matches message-shown)
(unwind-protect
- (if (and (cdr paths)
- (file-name-absolute-p (car paths)))
- (eshell-glob-entries (file-name-as-directory (car paths))
- (cdr paths))
- (eshell-glob-entries (file-name-as-directory ".") paths))
+ (apply #'eshell-glob-entries globs)
(if message-shown
(message nil)))
(or (and eshell-glob-matches (sort eshell-glob-matches #'string<))
@@ -265,94 +338,60 @@ the form:
glob))))
;; FIXME does this really need to abuse eshell-glob-matches, message-shown?
-(defun eshell-glob-entries (path globs &optional recurse-p)
- "Glob the entries in PATH, possibly recursing if RECURSE-P is non-nil."
+(defun eshell-glob-entries (path globs only-dirs)
+ "Match the entries in PATH against GLOBS.
+GLOBS is a list of globs as converted by `eshell-glob-convert',
+which see.
+
+If ONLY-DIRS is non-nil, only match directories; otherwise, match
+directories and files."
(let* ((entries (ignore-errors
- (file-name-all-completions "" path)))
- (case-fold-search eshell-glob-case-insensitive)
- (glob (car globs))
- (len (length glob))
- dirs rdirs
- incl excl
- name isdir pathname)
- (while (cond
- ((and (= len 3) (equal glob "**/"))
- (setq recurse-p 2
- globs (cdr globs)
- glob (car globs)
- len (length glob)))
- ((and (= len 4) (equal glob "***/"))
- (setq recurse-p 3
- globs (cdr globs)
- glob (car globs)
- len (length glob)))))
- (if (and recurse-p (not glob))
- (error "`**' cannot end a globbing pattern"))
- (let ((index 1))
- (setq incl glob)
- (while (and (eq incl glob)
- (setq index (string-search "~" glob index)))
- (if (or (get-text-property index 'escaped glob)
- (or (= (1+ index) len)))
- (setq index (1+ index))
- (setq incl (substring glob 0 index)
- excl (substring glob (1+ index))))))
- ;; can't use `directory-file-name' because it strips away text
- ;; properties in the string
- (let ((len (1- (length incl))))
- (if (eq (aref incl len) ?/)
- (setq incl (substring incl 0 len)))
- (when excl
- (setq len (1- (length excl)))
- (if (eq (aref excl len) ?/)
- (setq excl (substring excl 0 len)))))
- (setq incl (eshell-glob-regexp incl)
- excl (and excl (eshell-glob-regexp excl)))
- (if (or eshell-glob-include-dot-files
- (eq (aref glob 0) ?.))
- (unless (or eshell-glob-include-dot-dot
- (cdr globs))
- (setq excl (if excl
- (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
- "\\`\\.\\.?\\'")))
- (setq excl (if excl
- (concat "\\(\\`\\.\\|" excl "\\)")
- "\\`\\.")))
+ (file-name-all-completions "" path)))
+ (case-fold-search eshell-glob-case-insensitive)
+ glob glob-remainder recurse-p)
+ (if (rassq (car globs) eshell-glob-recursive-alist)
+ (setq recurse-p (car globs)
+ glob (or (cadr globs)
+ (eshell-glob-convert-1 "*" t))
+ glob-remainder (cddr globs))
+ (setq glob (car globs)
+ glob-remainder (cdr globs)))
(when (and recurse-p eshell-glob-show-progress)
(message "Building file list...%d so far: %s"
- (length eshell-glob-matches) path)
+ (length eshell-glob-matches) path)
(setq message-shown t))
- (if (equal path "./") (setq path ""))
- (while entries
- (setq name (car entries)
- len (length name)
- isdir (eq (aref name (1- len)) ?/))
- (if (let ((fname (directory-file-name name)))
- (and (not (and excl (string-match excl fname)))
- (string-match incl fname)))
- (if (cdr globs)
- (if isdir
- (setq dirs (cons (concat path name) dirs)))
- (setq eshell-glob-matches
- (cons (concat path name) eshell-glob-matches))))
- (if (and recurse-p isdir
- (or (> len 3)
- (not (or (and (= len 2) (equal name "./"))
- (and (= len 3) (equal name "../")))))
- (setq pathname (concat path name))
- (not (and (= recurse-p 2)
- (file-symlink-p
- (directory-file-name pathname)))))
- (setq rdirs (cons pathname rdirs)))
- (setq entries (cdr entries)))
- (setq dirs (nreverse dirs)
- rdirs (nreverse rdirs))
- (while dirs
- (eshell-glob-entries (car dirs) (cdr globs))
- (setq dirs (cdr dirs)))
- (while rdirs
- (eshell-glob-entries (car rdirs) globs recurse-p)
- (setq rdirs (cdr rdirs)))))
+ (when (equal path "./") (setq path ""))
+ (let ((incl (car glob))
+ (excl (cdr glob))
+ dirs rdirs)
+ (dolist (name entries)
+ (let* ((len (length name))
+ (isdir (eq (aref name (1- len)) ?/))
+ pathname)
+ (when (let ((fname (directory-file-name name)))
+ (and (not (and excl (string-match excl fname)))
+ (string-match incl fname)))
+ (if glob-remainder
+ (when isdir
+ (push (concat path name) dirs))
+ (when (or (not only-dirs)
+ (and isdir
+ (not (and (eq recurse-p 'recurse)
+ (file-symlink-p
+ (directory-file-name
+ (concat path name)))))))
+ (push (concat path name) eshell-glob-matches))))
+ (when (and recurse-p isdir
+ (not (member name '("./" "../")))
+ (setq pathname (concat path name))
+ (not (and (eq recurse-p 'recurse)
+ (file-symlink-p
+ (directory-file-name pathname)))))
+ (push pathname rdirs))))
+ (dolist (dir (nreverse dirs))
+ (eshell-glob-entries dir glob-remainder only-dirs))
+ (dolist (rdir (nreverse rdirs))
+ (eshell-glob-entries rdir globs only-dirs)))))
(provide 'em-glob)
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 49b811eae37..1877749c5cf 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -104,7 +104,7 @@ in bash, and any other non-nil value mirrors the \"ignoredups\"
value."
:type '(choice (const :tag "Don't ignore anything" nil)
(const :tag "Ignore consecutive duplicates" t)
- (const :tag "Only keep last duplicate" 'erase)))
+ (const :tag "Only keep last duplicate" erase)))
(defcustom eshell-save-history-on-exit t
"Determine if history should be automatically saved.
@@ -125,16 +125,34 @@ the input history list. Default is to save anything that isn't all
whitespace."
:type '(radio (function-item eshell-input-filter-default)
(function-item eshell-input-filter-initial-space)
- (function :tag "Other function")))
-
-(put 'eshell-input-filter 'risky-local-variable t)
+ (function :tag "Other function"))
+ :risky t)
+
+(defun eshell-hist--update-keymap (symbol value)
+ "Update `eshell-hist-mode-map' for `eshell-hist-match-partial'."
+ ;; Don't try to set this before it is bound. See below.
+ (when (and (boundp 'eshell-hist-mode-map)
+ (eq symbol 'eshell-hist-match-partial))
+ (dolist (keyb
+ (if value
+ `(("M-p" . ,#'eshell-previous-matching-input-from-input)
+ ("M-n" . ,#'eshell-next-matching-input-from-input)
+ ("C-c M-p" . ,#'eshell-previous-input)
+ ("C-c M-n" . ,#'eshell-next-input))
+ `(("M-p" . ,#'eshell-previous-input)
+ ("M-n" . ,#'eshell-next-input)
+ ("C-c M-p" . ,#'eshell-previous-matching-input-from-input)
+ ("C-c M-n" . ,#'eshell-next-matching-input-from-input))))
+ (keymap-set eshell-hist-mode-map (car keyb) (cdr keyb))))
+ (set-default symbol value))
(defcustom eshell-hist-match-partial t
"If non-nil, movement through history is constrained by current input.
-Otherwise, typing <M-p> and <M-n> will always go to the next history
+Otherwise, typing \\`M-p' and \\`M-n' will always go to the next history
element, regardless of any text on the command line. In that case,
-<C-c M-r> and <C-c M-s> still offer that functionality."
- :type 'boolean)
+\\`C-c M-r' and \\`C-c M-s' still offer that functionality."
+ :type 'boolean
+ :set 'eshell-hist--update-keymap)
(defcustom eshell-hist-move-to-end t
"If non-nil, move to the end of the buffer before cycling history."
@@ -180,43 +198,31 @@ element, regardless of any text on the command line. In that case,
(defvar eshell-matching-input-from-input-string "")
(defvar eshell-save-history-index nil)
-(defvar eshell-isearch-map
- (let ((map (copy-keymap isearch-mode-map)))
- (define-key map [(control ?m)] 'eshell-isearch-return)
- (define-key map [(control ?r)] 'eshell-isearch-repeat-backward)
- (define-key map [(control ?s)] 'eshell-isearch-repeat-forward)
- (define-key map [(control ?g)] 'eshell-isearch-abort)
- (define-key map [backspace] 'eshell-isearch-delete-char)
- (define-key map [delete] 'eshell-isearch-delete-char)
- (define-key map "\C-c\C-c" 'eshell-isearch-cancel)
- map)
- "Keymap used in isearch in Eshell.")
-
-(defvar eshell-hist-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [up] #'eshell-previous-matching-input-from-input)
- (define-key map [down] #'eshell-next-matching-input-from-input)
- (define-key map [(control up)] #'eshell-previous-input)
- (define-key map [(control down)] #'eshell-next-input)
- (define-key map [(meta ?r)] #'eshell-previous-matching-input)
- (define-key map [(meta ?s)] #'eshell-next-matching-input)
- (define-key map (kbd "C-c M-r") #'eshell-previous-matching-input-from-input)
- (define-key map (kbd "C-c M-s") #'eshell-next-matching-input-from-input)
- ;; FIXME: Relies on `eshell-hist-match-partial' being set _before_
- ;; em-hist is loaded and won't respect changes.
- (if eshell-hist-match-partial
- (progn
- (define-key map [(meta ?p)] 'eshell-previous-matching-input-from-input)
- (define-key map [(meta ?n)] 'eshell-next-matching-input-from-input)
- (define-key map (kbd "C-c M-p") #'eshell-previous-input)
- (define-key map (kbd "C-c M-n") #'eshell-next-input))
- (define-key map [(meta ?p)] #'eshell-previous-input)
- (define-key map [(meta ?n)] #'eshell-next-input)
- (define-key map (kbd "C-c M-p") #'eshell-previous-matching-input-from-input)
- (define-key map (kbd "C-c M-n") #'eshell-next-matching-input-from-input))
- (define-key map (kbd "C-c C-l") #'eshell-list-history)
- (define-key map (kbd "C-c C-x") #'eshell-get-next-from-history)
- map))
+(defvar-keymap eshell-isearch-map
+ :doc "Keymap used in isearch in Eshell."
+ :parent isearch-mode-map
+ "C-m" #'eshell-isearch-return
+ "C-r" #'eshell-isearch-repeat-backward
+ "C-s" #'eshell-isearch-repeat-forward
+ "C-g" #'eshell-isearch-abort
+ "<backspace>" #'eshell-isearch-delete-char
+ "<delete>" #'eshell-isearch-delete-char
+ "C-c C-c" #'eshell-isearch-cancel)
+
+(defvar-keymap eshell-hist-mode-map
+ "<up>" #'eshell-previous-matching-input-from-input
+ "<down>" #'eshell-next-matching-input-from-input
+ "C-<up>" #'eshell-previous-input
+ "C-<down>" #'eshell-next-input
+ "M-r" #'eshell-previous-matching-input
+ "M-s" #'eshell-next-matching-input
+ "C-c M-r" #'eshell-previous-matching-input-from-input
+ "C-c M-s" #'eshell-next-matching-input-from-input
+ "C-c C-l" #'eshell-list-history
+ "C-c C-x" #'eshell-get-next-from-history)
+;; Update `eshell-hist-mode-map' for `eshell-hist-match-partial'.
+(eshell-hist--update-keymap 'eshell-hist-match-partial
+ eshell-hist-match-partial)
(defvar eshell-rebind-keys-alist)
@@ -335,7 +341,7 @@ unless a different file is specified on the command line.")
(error "No history"))
(let (length file)
(when (and args (string-match "^[0-9]+$" (car args)))
- (setq length (min (eshell-convert (car args))
+ (setq length (min (string-to-number (car args))
(ring-length eshell-history-ring))
args (cdr args)))
(and length
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 846f3d5e290..bebb0d81b5b 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -100,15 +100,14 @@ faster and conserves more memory."
:type 'boolean)
(defface eshell-ls-directory
- '((((class color) (background light)) (:foreground "Blue" :weight bold))
- (((class color) (background dark)) (:foreground "SkyBlue" :weight bold))
- (t (:weight bold)))
- "The face used for highlighting directories.")
+ '((t (:inherit font-lock-function-name-face)))
+ "The face used for highlighting directories."
+ :version "29.1")
(defface eshell-ls-symlink
- '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold))
- (((class color) (background dark)) (:foreground "Cyan" :weight bold)))
- "The face used for highlighting symbolic links.")
+ '((t (:inherit font-lock-keyword-face)))
+ "The face used for highlighting symbolic links."
+ :version "29.1")
(defface eshell-ls-executable
'((((class color) (background light)) (:foreground "ForestGreen" :weight bold))
@@ -801,7 +800,7 @@ to use, and each member of which is the width of that column
(+ 2 (length (car file))))
files))
;; must account for the added space...
- (max-width (+ (window-width) 2))
+ (max-width (+ (window-body-width nil 'remap) 2))
(best-width 0)
col-widths)
@@ -846,7 +845,7 @@ to use, and each member of which is the width of that column
(lambda (file)
(+ 2 (length (car file))))
files))
- (max-width (+ (window-width) 2))
+ (max-width (+ (window-body-width nil 'remap) 2))
col-widths
colw)
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 4f4e85c1a69..b4ef154f8c3 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -68,7 +68,7 @@ ordinary strings."
(defcustom eshell-predicate-alist
'((?/ . (eshell-pred-file-type ?d)) ; directories
(?. . (eshell-pred-file-type ?-)) ; regular files
- (?s . (eshell-pred-file-type ?s)) ; sockets
+ (?= . (eshell-pred-file-type ?s)) ; sockets
(?p . (eshell-pred-file-type ?p)) ; named pipes
(?@ . (eshell-pred-file-type ?l)) ; symbolic links
(?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.)
@@ -88,17 +88,17 @@ ordinary strings."
(if (file-exists-p file)
(= (file-attribute-user-id (file-attributes file))
(user-uid)))))
- ;; (?G . (lambda (file) ; owned by effective gid
- ;; (if (file-exists-p file)
- ;; (= (file-attribute-user-id (file-attributes file))
- ;; (user-uid)))))
+ (?G . (lambda (file) ; owned by effective gid
+ (if (file-exists-p file)
+ (= (file-attribute-group-id (file-attributes file))
+ (group-gid)))))
(?* . (lambda (file)
(and (file-regular-p file)
(not (file-symlink-p file))
(file-executable-p file))))
(?l . (eshell-pred-file-links))
- (?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id))
- (?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id))
+ (?u . (eshell-pred-user-or-group ?u "user" 2 #'eshell-user-id))
+ (?g . (eshell-pred-user-or-group ?g "group" 3 #'eshell-group-id))
(?a . (eshell-pred-file-time ?a "access" 4))
(?m . (eshell-pred-file-time ?m "modification" 5))
(?c . (eshell-pred-file-time ?c "change" 6))
@@ -107,33 +107,27 @@ ordinary strings."
The format of each entry is
(CHAR . PREDICATE-FUNC-SEXP)"
- :type '(repeat (cons character sexp)))
-
-(put 'eshell-predicate-alist 'risky-local-variable t)
+ :type '(repeat (cons character sexp))
+ :risky t)
(defcustom eshell-modifier-alist
- '((?E . (lambda (lst)
- (mapcar
- (lambda (str)
- (eshell-stringify
- (car (eshell-parse-argument str))))
- lst)))
+ '((?E . (lambda (lst) (mapcar #'eshell-eval-argument lst)))
(?L . (lambda (lst) (mapcar #'downcase lst)))
(?U . (lambda (lst) (mapcar #'upcase lst)))
(?C . (lambda (lst) (mapcar #'capitalize lst)))
(?h . (lambda (lst) (mapcar #'file-name-directory lst)))
- (?i . (eshell-include-members))
- (?x . (eshell-include-members t))
+ (?i . (eshell-include-members ?i))
+ (?x . (eshell-include-members ?x t))
(?r . (lambda (lst) (mapcar #'file-name-sans-extension lst)))
(?e . (lambda (lst) (mapcar #'file-name-extension lst)))
(?t . (lambda (lst) (mapcar #'file-name-nondirectory lst)))
(?q . (lambda (lst) (mapcar #'eshell-escape-arg lst)))
(?u . (lambda (lst) (seq-uniq lst)))
(?o . (lambda (lst) (sort lst #'string-lessp)))
- (?O . (lambda (lst) (nreverse (sort lst #'string-lessp))))
+ (?O . (lambda (lst) (sort lst #'string-greaterp)))
(?j . (eshell-join-members))
(?S . (eshell-split-members))
- (?R . 'reverse)
+ (?R . #'reverse)
(?g . (progn
(forward-char)
(if (eq (char-before) ?s)
@@ -143,10 +137,9 @@ The format of each entry is
"A list of modifiers than can be applied to an argument expansion.
The format of each entry is
- (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)"
- :type '(repeat (cons character sexp)))
-
-(put 'eshell-modifier-alist 'risky-local-variable t)
+ (CHAR . MODIFIER-FUNC-SEXP)"
+ :type '(repeat (cons character sexp))
+ :risky t)
(defvar eshell-predicate-help-string
"Eshell predicate quick reference:
@@ -168,6 +161,7 @@ PERMISSION BITS (for owner/group/world):
OWNERSHIP:
U owned by effective uid
+ G owned by effective gid
u(UID|\\='user\\=') owned by UID/user
g(GID|\\='group\\=') owned by GID/group
@@ -219,17 +213,31 @@ FOR LISTS OF ARGUMENTS:
i/PAT/ exclude all members not matching PAT
x/PAT/ exclude all members matching PAT
- s/pat/match/ substitute PAT with MATCH
- g/pat/match/ substitute PAT with MATCH for all occurrences
+ s/pat/match/ substitute PAT with MATCH
+ gs/pat/match/ substitute PAT with MATCH for all occurrences
EXAMPLES:
*.c(:o) sorted list of .c files")
-(defvar eshell-pred-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c M-q") #'eshell-display-predicate-help)
- (define-key map (kbd "C-c M-m") #'eshell-display-modifier-help)
- map))
+(defvar eshell-pred-delimiter-pairs
+ '((?\( . ?\))
+ (?\[ . ?\])
+ (?\< . ?\>)
+ (?\{ . ?\})
+ (?\' . ?\')
+ (?\" . ?\")
+ (?/ . ?/)
+ (?| . ?|))
+ "A list of delimiter pairs that can be used in argument predicates/modifiers.
+Each element is of the form (OPEN . CLOSE), where OPEN and CLOSE
+are characters representing the opening and closing delimiter,
+respectively.")
+
+(defvar eshell-error-if-no-glob) ; Defined in em-glob.el.
+
+(defvar-keymap eshell-pred-mode-map
+ "C-c M-q" #'eshell-display-predicate-help
+ "C-c M-m" #'eshell-display-modifier-help)
;;; Functions:
@@ -257,14 +265,19 @@ EXAMPLES:
#'eshell-parse-arg-modifier t t)
(eshell-pred-mode))
-(defun eshell-apply-modifiers (lst predicates modifiers)
- "Apply to list LST a series of PREDICATES and MODIFIERS."
+(defun eshell-apply-modifiers (lst predicates modifiers string-desc)
+ "Apply to list LST a series of PREDICATES and MODIFIERS.
+STRING-DESC is the original string defining these predicates and
+modifiers."
(let (stringified)
(if (stringp lst)
(setq lst (list lst)
stringified t))
(when (listp lst)
- (setq lst (eshell-winnow-list lst nil predicates))
+ (when lst
+ (setq lst (or (eshell-winnow-list lst nil predicates)
+ (when eshell-error-if-no-glob
+ (error "No matches found: (%s)" string-desc)))))
(while modifiers
(setq lst (funcall (car modifiers) lst)
modifiers (cdr modifiers)))
@@ -284,7 +297,8 @@ This function is specially for adding onto `eshell-parse-argument-hook'."
(when (eshell-arg-delimiter (1+ end))
(save-restriction
(narrow-to-region (point) end)
- (let* ((modifiers (eshell-parse-modifiers))
+ (let* ((modifier-string (buffer-string))
+ (modifiers (eshell-parse-modifiers))
(preds (car modifiers))
(mods (cdr modifiers)))
(if (or preds mods)
@@ -296,7 +310,7 @@ This function is specially for adding onto `eshell-parse-argument-hook'."
(list
(lambda (lst)
(eshell-apply-modifiers
- lst preds mods))))))))
+ lst preds mods modifier-string))))))))
(goto-char (1+ end))
(eshell-finish-arg))))))
@@ -372,38 +386,70 @@ resultant list of strings."
(lambda (file) (funcall pred (file-truename file))))))
(cons pred funcs))
+(defun eshell-get-comparison-modifier-argument (&optional functions)
+ "Starting at point, get the comparison modifier argument, if any.
+These are the -/+ characters, corresponding to `<' and `>',
+respectively. If no comparison modifier is at point, return `='.
+
+FUNCTIONS, if non-nil, is a list of comparison functions,
+specified as (LESS-THAN GREATER-THAN EQUAL-TO)."
+ (let ((functions (or functions (list #'< #'> #'=))))
+ (if (memq (char-after) '(?- ?+))
+ (prog1
+ (if (eq (char-after) ?-) (nth 0 functions) (nth 1 functions))
+ (forward-char))
+ (nth 2 functions))))
+
+(defun eshell-get-numeric-modifier-argument ()
+ "Starting at point, get the numeric modifier argument, if any.
+If a number is found, update point to just after the number."
+ (when (looking-at "[0-9]+")
+ (prog1
+ (string-to-number (match-string 0))
+ (goto-char (match-end 0)))))
+
+(defun eshell-get-delimited-modifier-argument (&optional chained-p)
+ "Starting at point, get the delimited modifier argument, if any.
+If the character after point is a predicate/modifier
+delimiter (see `eshell-pred-delimiter-pairs', read the value of
+the argument and update point to be just after the closing
+delimiter.
+
+If CHAINED-P is true, then another delimited modifier argument
+will immediately follow this one. In this case, when the opening
+and closing delimiters are the same, update point to be just
+before the closing delimiter. This allows modifiers like
+`:s/match/repl' to work as expected."
+ (when-let* ((open (char-after))
+ (close (cdr (assoc open eshell-pred-delimiter-pairs)))
+ (end (eshell-find-delimiter open close nil nil t)))
+ (prog1
+ (replace-regexp-in-string
+ (rx-to-string `(seq "\\" (group (or "\\" ,open ,close)))) "\\1"
+ (buffer-substring-no-properties (1+ (point)) end))
+ (goto-char (if (and chained-p (eq open close))
+ end
+ (1+ end))))))
+
(defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func)
"Return a predicate to test whether a file match a given user/group id."
- (let (ugid open close end)
- (if (looking-at "[0-9]+")
- (progn
- (setq ugid (string-to-number (match-string 0)))
- (goto-char (match-end 0)))
- (setq open (char-after))
- (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
- (setq close (car (last '(?\) ?\] ?\> ?\})
- (length close))))
- (setq close open))
- (forward-char)
- (setq end (eshell-find-delimiter open close))
- (unless end
- (error "Malformed %s name string for modifier `%c'"
- mod-type mod-char))
- (setq ugid
- (funcall get-id-func (buffer-substring (point) end)))
- (goto-char (1+ end)))
+ (let ((ugid (eshell-get-numeric-modifier-argument)))
+ (unless ugid
+ (let ((ugname (or (eshell-get-delimited-modifier-argument)
+ (error "Malformed %s name string for modifier `%c'"
+ mod-type mod-char))))
+ (setq ugid (funcall get-id-func ugname))))
(unless ugid
(error "Unknown %s name specified for modifier `%c'"
mod-type mod-char))
(lambda (file)
- (let ((attrs (file-attributes file)))
- (if attrs
- (= (nth attr-index attrs) ugid))))))
+ (when-let ((attrs (file-attributes file)))
+ (= (nth attr-index attrs) ugid)))))
(defun eshell-pred-file-time (mod-char mod-type attr-index)
"Return a predicate to test whether a file matches a certain time."
(let* ((quantum 86400)
- qual when open close end)
+ qual when)
(when (memq (char-after) '(?M ?w ?h ?m ?s))
(setq quantum (char-after))
(cond
@@ -418,36 +464,21 @@ resultant list of strings."
((eq quantum ?s)
(setq quantum 1)))
(forward-char))
- (when (memq (char-after) '(?+ ?-))
- (setq qual (char-after))
- (forward-char))
- (if (looking-at "[0-9]+")
- (progn
- (setq when (time-since (* (string-to-number (match-string 0))
- quantum)))
- (goto-char (match-end 0)))
- (setq open (char-after))
- (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
- (setq close (car (last '(?\) ?\] ?\> ?\})
- (length close))))
- (setq close open))
- (forward-char)
- (setq end (eshell-find-delimiter open close))
- (unless end
- (error "Malformed %s time modifier `%c'" mod-type mod-char))
- (let* ((file (buffer-substring (point) end))
- (attrs (file-attributes file)))
- (unless attrs
- (error "Cannot stat file `%s'" file))
- (setq when (nth attr-index attrs)))
- (goto-char (1+ end)))
- (let ((f (cond ((eq qual ?-) #'time-less-p)
- ((eq qual ?+) (lambda (a b) (time-less-p b a)))
- (#'time-equal-p))))
- (lambda (file)
- (let ((attrs (file-attributes file)))
- (if attrs
- (funcall f when (nth attr-index attrs))))))))
+ (setq qual (eshell-get-comparison-modifier-argument
+ (list #'time-less-p
+ (lambda (a b) (time-less-p b a))
+ #'time-equal-p)))
+ (if-let ((number (eshell-get-numeric-modifier-argument)))
+ (setq when (time-since (* number quantum)))
+ (let* ((file (or (eshell-get-delimited-modifier-argument)
+ (error "Malformed %s time modifier `%c'"
+ mod-type mod-char)))
+ (attrs (or (file-attributes file)
+ (error "Cannot stat file `%s'" file))))
+ (setq when (nth attr-index attrs))))
+ (lambda (file)
+ (when-let ((attrs (file-attributes file)))
+ (funcall qual when (nth attr-index attrs))))))
(defun eshell-pred-file-type (type)
"Return a test which tests that the file is of a certain TYPE.
@@ -462,36 +493,23 @@ that `ls -l' will show in the first column of its display."
'(?b ?c)
(list type))))
(lambda (file)
- (let ((attrs (eshell-file-attributes (directory-file-name file))))
- (if attrs
- (memq (aref (file-attribute-modes attrs) 0) set))))))
+ (when-let ((attrs (eshell-file-attributes (directory-file-name file))))
+ (memq (aref (file-attribute-modes attrs) 0) set)))))
(defsubst eshell-pred-file-mode (mode)
"Return a test which tests that MODE pertains to the file."
(lambda (file)
- (let ((modes (file-modes file 'nofollow)))
- (if modes
- (not (zerop (logand mode modes)))))))
+ (when-let ((modes (file-modes file 'nofollow)))
+ (not (zerop (logand mode modes))))))
(defun eshell-pred-file-links ()
"Return a predicate to test whether a file has a given number of links."
- (let (qual amount)
- (when (memq (char-after) '(?- ?+))
- (setq qual (char-after))
- (forward-char))
- (unless (looking-at "[0-9]+")
- (error "Invalid file link count modifier `l'"))
- (setq amount (string-to-number (match-string 0)))
- (goto-char (match-end 0))
- (let ((f (if (eq qual ?-)
- #'<
- (if (eq qual ?+)
- #'>
- #'=))))
- (lambda (file)
- (let ((attrs (eshell-file-attributes file)))
- (if attrs
- (funcall f (file-attribute-link-number attrs) amount)))))))
+ (let ((qual (eshell-get-comparison-modifier-argument))
+ (amount (or (eshell-get-numeric-modifier-argument)
+ (error "Invalid file link count modifier `l'"))))
+ (lambda (file)
+ (when-let ((attrs (eshell-file-attributes file)))
+ (funcall qual (file-attribute-link-number attrs) amount)))))
(defun eshell-pred-file-size ()
"Return a predicate to test whether a file is of a given size."
@@ -506,89 +524,52 @@ that `ls -l' will show in the first column of its display."
((eq qual ?p)
(setq quantum 512)))
(forward-char))
- (when (memq (char-after) '(?- ?+))
- (setq qual (char-after))
- (forward-char))
- (unless (looking-at "[0-9]+")
- (error "Invalid file size modifier `L'"))
- (setq amount (* (string-to-number (match-string 0)) quantum))
- (goto-char (match-end 0))
- (let ((f (if (eq qual ?-)
- #'<
- (if (eq qual ?+)
- #'>
- #'=))))
- (lambda (file)
- (let ((attrs (eshell-file-attributes file)))
- (if attrs
- (funcall f (file-attribute-size attrs) amount)))))))
+ (setq qual (eshell-get-comparison-modifier-argument))
+ (setq amount (* (or (eshell-get-numeric-modifier-argument)
+ (error "Invalid file size modifier `L'"))
+ quantum))
+ (lambda (file)
+ (when-let ((attrs (eshell-file-attributes file)))
+ (funcall qual (file-attribute-size attrs) amount)))))
(defun eshell-pred-substitute (&optional repeat)
"Return a modifier function that will substitute matches."
- (let ((delim (char-after))
- match replace end)
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- match (buffer-substring-no-properties (point) end))
- (goto-char (1+ end))
- (setq end (eshell-find-delimiter delim delim nil nil t)
- replace (buffer-substring-no-properties (point) end))
- (goto-char (1+ end))
- (if repeat
- (lambda (lst)
- (mapcar
- (lambda (str)
- (let ((i 0))
- (while (setq i (string-match match str i))
- (setq str (replace-match replace t nil str))))
- str)
- lst))
- (lambda (lst)
- (mapcar
- (lambda (str)
- (if (string-match match str)
- (setq str (replace-match replace t nil str))
- (error (concat str ": substitution failed")))
- str)
- lst)))))
-
-(defun eshell-include-members (&optional invert-p)
- "Include only Lisp members matching a regexp."
- (let ((delim (char-after))
- regexp end)
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- regexp (buffer-substring-no-properties (point) end))
- (goto-char (1+ end))
- (let ((predicates
- (list (if invert-p
- (lambda (elem) (not (string-match regexp elem)))
- (lambda (elem) (string-match regexp elem))))))
- (lambda (lst)
- (eshell-winnow-list lst nil predicates)))))
+ (let* ((match (or (eshell-get-delimited-modifier-argument t)
+ (error "Malformed pattern string for modifier `s'")))
+ (replace (or (eshell-get-delimited-modifier-argument)
+ (error "Malformed replace string for modifier `s'")))
+ (function (if repeat
+ (lambda (str)
+ (replace-regexp-in-string match replace str t))
+ (lambda (str)
+ (if (string-match match str)
+ (replace-match replace t nil str)
+ (error (concat str ": substitution failed")))))))
+ (lambda (lst) (mapcar function lst))))
+
+(defun eshell-include-members (mod-char &optional invert-p)
+ "Include only Lisp members matching a regexp.
+If INVERT-P is non-nil, include only members not matching a regexp."
+ (let* ((regexp (or (eshell-get-delimited-modifier-argument)
+ (error "Malformed pattern string for modifier `%c'"
+ mod-char)))
+ (predicates
+ (list (if invert-p
+ (lambda (elem) (not (string-match regexp elem)))
+ (lambda (elem) (string-match regexp elem))))))
+ (lambda (lst)
+ (eshell-winnow-list lst nil predicates))))
(defun eshell-join-members ()
"Return a modifier function that join matches."
- (let ((delim (char-after))
- str end)
- (if (not (memq delim '(?' ?/)))
- (setq delim " ")
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- str (buffer-substring-no-properties (point) end))
- (goto-char (1+ end)))
+ (let ((str (or (eshell-get-delimited-modifier-argument)
+ " ")))
(lambda (lst)
(mapconcat #'identity lst str))))
(defun eshell-split-members ()
"Return a modifier function that splits members."
- (let ((delim (char-after))
- sep end)
- (when (memq delim '(?' ?/))
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- sep (buffer-substring-no-properties (point) end))
- (goto-char (1+ end)))
+ (let ((sep (eshell-get-delimited-modifier-argument)))
(lambda (lst)
(mapcar
(lambda (str)
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 3901265e9d4..a1a91e7d634 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -96,11 +96,9 @@ arriving, or after."
:options '(eshell-show-maximum-output)
:group 'eshell-prompt)
-(defvar eshell-prompt-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-n") #'eshell-next-prompt)
- (define-key map (kbd "C-c C-p") #'eshell-previous-prompt)
- map))
+(defvar-keymap eshell-prompt-mode-map
+ "C-c C-n" #'eshell-next-prompt
+ "C-c C-p" #'eshell-previous-prompt)
;;; Functions:
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index 1919c87d4da..2b56c9e8444 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -136,10 +136,8 @@ This is default behavior of shells like bash."
:type '(repeat function)
:group 'eshell-rebind)
-(defvar eshell-rebind-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c M-l") #'eshell-lock-local-map)
- map))
+(defvar-keymap eshell-rebind-mode-map
+ "C-c M-l" #'eshell-lock-local-map)
;; Internal Variables:
@@ -240,7 +238,7 @@ lock it at that."
Sends an EOF only if point is at the end of the buffer and there is no
input."
(interactive "p")
- (let ((proc (eshell-interactive-process)))
+ (let ((proc (eshell-head-process)))
(if (eobp)
(cond
((/= (point) eshell-last-output-end)
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index e8459513f39..e0bcd8b099f 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -113,27 +113,13 @@ Comments begin with `#'."
(defun eshell/source (&rest args)
"Source a file in a subshell environment."
- (eshell-eval-using-options
- "source" args
- '((?h "help" nil nil "show this usage screen")
- :show-usage
- :usage "FILE [ARGS]
-Invoke the Eshell commands in FILE in a subshell, binding ARGS to $1,
-$2, etc.")
- (eshell-source-file (car args) (cdr args) t)))
+ (eshell-source-file (car args) (cdr args) t))
(put 'eshell/source 'eshell-no-numeric-conversions t)
(defun eshell/. (&rest args)
"Source a file in the current environment."
- (eshell-eval-using-options
- "." args
- '((?h "help" nil nil "show this usage screen")
- :show-usage
- :usage "FILE [ARGS]
-Invoke the Eshell commands in FILE within the current shell
-environment, binding ARGS to $1, $2, etc.")
- (eshell-source-file (car args) (cdr args))))
+ (eshell-source-file (car args) (cdr args)))
(put 'eshell/. 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index e34c5ae47ce..a4fa699aa90 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -56,7 +56,7 @@ which commands are considered visual in nature."
:type 'hook)
(defcustom eshell-visual-commands
- '("vi" ; what is going on??
+ '("vi" "vim" ; what is going on??
"screen" "tmux" "top" "htop" ; ok, a valid program...
"less" "more" ; M-x view-file
"lynx" "links" "ncftp" ; eww, ange-ftp
@@ -67,7 +67,7 @@ Commands listed here are run in a term buffer.
See also `eshell-visual-subcommands' and `eshell-visual-options'."
:type '(repeat string)
- :version "27.1")
+ :version "29.1")
(defcustom eshell-visual-subcommands
nil
@@ -186,8 +186,10 @@ allowed."
(set-process-sentinel proc #'eshell-term-sentinel)
(error "Failed to invoke visual command")))
(term-char-mode)
- (if eshell-escape-control-x
- (term-set-escape-char ?\C-x))))
+ (when eshell-escape-control-x
+ ;; Don't drop existing escape char.
+ (let (term-escape-char)
+ (term-set-escape-char ?\C-x)))))
nil)
;; Process sentinels receive two arguments.
@@ -224,7 +226,7 @@ the buffer."
; (defun eshell-term-send-raw-string (chars)
; (goto-char eshell-last-output-end)
-; (process-send-string (eshell-interactive-process) chars))
+; (process-send-string (eshell-head-process) chars))
; (defun eshell-term-send-raw ()
; "Send the last character typed through the terminal-emulator
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index e9018bdb934..aebbc36e71d 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -61,37 +61,33 @@
"Alias \"su\" to call TRAMP.
Uses the system su through TRAMP's su method."
- (setq args (eshell-stringify-list (flatten-tree args)))
- (let ((orig-args (copy-tree args)))
- (eshell-eval-using-options
- "su" args
- '((?h "help" nil nil "show this usage screen")
- (?l "login" nil login "provide a login environment")
- (? nil nil login "provide a login environment")
- :usage "[- | -l | --login] [USER]
+ (eshell-eval-using-options
+ "su" args
+ '((?h "help" nil nil "show this usage screen")
+ (?l "login" nil login "provide a login environment")
+ (? nil nil login "provide a login environment")
+ :usage "[- | -l | --login] [USER]
Become another USER during a login session.")
- (throw 'eshell-replace-command
- (let ((user "root")
- (host (or (file-remote-p default-directory 'host)
- "localhost"))
- (dir (file-local-name (expand-file-name default-directory)))
- (prefix (file-remote-p default-directory)))
- (dolist (arg args)
- (if (string-equal arg "-") (setq login t) (setq user arg)))
- ;; `eshell-eval-using-options' does not handle "-".
- (if (member "-" orig-args) (setq login t))
- (if login (setq dir "~/"))
- (if (and prefix
- (or
- (not (string-equal
- "su" (file-remote-p default-directory 'method)))
- (not (string-equal
- user (file-remote-p default-directory 'user)))))
- (eshell-parse-command
- "cd" (list (format "%s|su:%s@%s:%s"
- (substring prefix 0 -1) user host dir)))
- (eshell-parse-command
- "cd" (list (format "/su:%s@%s:%s" user host dir)))))))))
+ (throw 'eshell-replace-command
+ (let ((user "root")
+ (host (or (file-remote-p default-directory 'host)
+ tramp-default-host))
+ (dir (file-local-name (expand-file-name default-directory)))
+ (prefix (file-remote-p default-directory)))
+ (dolist (arg args)
+ (if (string-equal arg "-") (setq login t) (setq user arg)))
+ (when login (setq dir "~/"))
+ (if (and prefix
+ (or
+ (not (string-equal
+ "su" (file-remote-p default-directory 'method)))
+ (not (string-equal
+ user (file-remote-p default-directory 'user)))))
+ (eshell-parse-command
+ "cd" (list (format "%s|su:%s@%s:%s"
+ (substring prefix 0 -1) user host dir)))
+ (eshell-parse-command
+ "cd" (list (format "/su:%s@%s:%s" user host dir))))))))
(put 'eshell/su 'eshell-no-numeric-conversions t)
@@ -99,41 +95,35 @@ Become another USER during a login session.")
"Alias \"sudo\" to call Tramp.
Uses the system sudo through TRAMP's sudo method."
- (setq args (eshell-stringify-list (flatten-tree args)))
- (let ((orig-args (copy-tree args)))
- (eshell-eval-using-options
- "sudo" args
- '((?h "help" nil nil "show this usage screen")
- (?u "user" t user "execute a command as another USER")
- :show-usage
- :parse-leading-options-only
- :usage "[(-u | --user) USER] COMMAND
+ (eshell-eval-using-options
+ "sudo" args
+ '((?h "help" nil nil "show this usage screen")
+ (?u "user" t user "execute a command as another USER")
+ :show-usage
+ :parse-leading-options-only
+ :usage "[(-u | --user) USER] COMMAND
Execute a COMMAND as the superuser or another USER.")
- (throw 'eshell-external
- (let ((user (or user "root"))
- (host (or (file-remote-p default-directory 'host)
- "localhost"))
- (dir (file-local-name (expand-file-name default-directory)))
- (prefix (file-remote-p default-directory)))
- ;; `eshell-eval-using-options' reads options of COMMAND.
- (while (and (stringp (car orig-args))
- (member (car orig-args) '("-u" "--user")))
- (setq orig-args (cddr orig-args)))
- (let ((default-directory
- (if (and prefix
- (or
- (not
- (string-equal
- "sudo"
- (file-remote-p default-directory 'method)))
- (not
- (string-equal
- user
- (file-remote-p default-directory 'user)))))
- (format "%s|sudo:%s@%s:%s"
- (substring prefix 0 -1) user host dir)
- (format "/sudo:%s@%s:%s" user host dir))))
- (eshell-named-command (car orig-args) (cdr orig-args))))))))
+ (throw 'eshell-external
+ (let* ((user (or user "root"))
+ (host (or (file-remote-p default-directory 'host)
+ tramp-default-host))
+ (dir (file-local-name (expand-file-name default-directory)))
+ (prefix (file-remote-p default-directory))
+ (default-directory
+ (if (and prefix
+ (or
+ (not
+ (string-equal
+ "sudo"
+ (file-remote-p default-directory 'method)))
+ (not
+ (string-equal
+ user
+ (file-remote-p default-directory 'user)))))
+ (format "%s|sudo:%s@%s:%s"
+ (substring prefix 0 -1) user host dir)
+ (format "/sudo:%s@%s:%s" user host dir))))
+ (eshell-named-command (car args) (cdr args))))))
(put 'eshell/sudo 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 127a46abc39..459487f4358 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -152,10 +152,8 @@ treated as a literal character."
:type 'hook
:group 'eshell-arg)
-(defvar eshell-arg-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c M-b") #'eshell-insert-buffer-name)
- map))
+(defvar-keymap eshell-arg-mode-map
+ "C-c M-b" #'eshell-insert-buffer-name)
;;; Functions:
@@ -182,19 +180,63 @@ treated as a literal character."
(add-text-properties 0 (length string) '(escaped t) string))
string)
+(defun eshell-concat (quoted &rest rest)
+ "Concatenate all the arguments in REST and return the result.
+If QUOTED is nil, the resulting value(s) may be converted to
+numbers (see `eshell-concat-1').
+
+If each argument in REST is a non-list value, the result will be
+a single value, as if (mapconcat #'eshell-stringify REST) had been
+called, possibly converted to a number.
+
+If there is at least one (non-nil) list argument, the result will
+be a list, with \"adjacent\" elements of consecutive arguments
+concatenated as strings (again, possibly converted to numbers).
+For example, concatenating \"a\", (\"b\"), and (\"c\" \"d\")
+would produce (\"abc\" \"d\")."
+ (let (result)
+ (dolist (i rest result)
+ (when i
+ (cond
+ ((null result)
+ (setq result i))
+ ((listp result)
+ (let (curr-head curr-tail)
+ (if (listp i)
+ (setq curr-head (car i)
+ curr-tail (cdr i))
+ (setq curr-head i
+ curr-tail nil))
+ (setq result
+ (append
+ (butlast result 1)
+ (list (eshell-concat-1 quoted (car (last result))
+ curr-head))
+ curr-tail))))
+ ((listp i)
+ (setq result
+ (cons (eshell-concat-1 quoted result (car i))
+ (cdr i))))
+ (t
+ (setq result (eshell-concat-1 quoted result i))))))))
+
+(defun eshell-concat-1 (quoted first second)
+ "Concatenate FIRST and SECOND.
+If QUOTED is nil and either FIRST or SECOND are numbers, try to
+convert the result to a number as well."
+ (let ((result (concat (eshell-stringify first) (eshell-stringify second))))
+ (if (and (not quoted)
+ (or (numberp first) (numberp second)))
+ (eshell-convert-to-number result)
+ result)))
+
(defun eshell-resolve-current-argument ()
"If there are pending modifications to be made, make them now."
(when eshell-current-argument
(when eshell-arg-listified
- (let ((parts eshell-current-argument))
- (while parts
- (unless (stringp (car parts))
- (setcar parts
- (list 'eshell-to-flat-string (car parts))))
- (setq parts (cdr parts)))
- (setq eshell-current-argument
- (list 'eshell-convert
- (append (list 'concat) eshell-current-argument))))
+ (setq eshell-current-argument
+ (append (list 'eshell-concat eshell-current-quoted)
+ eshell-current-argument))
(setq eshell-arg-listified nil))
(while eshell-current-modifiers
(setq eshell-current-argument
@@ -356,6 +398,30 @@ after are both returned."
(list 'eshell-escape-arg arg))))
(goto-char (1+ end)))))))
+(defun eshell-unescape-inner-double-quote (bound)
+ "Unescape escaped characters inside a double-quoted string.
+The string to parse starts at point and ends at BOUND.
+
+If Eshell is currently parsing a quoted string and there are any
+backslash-escaped characters, this will return the unescaped
+string, updating point to BOUND. Otherwise, this returns nil and
+leaves point where it was."
+ (when eshell-current-quoted
+ (let (strings
+ (start (point))
+ (special-char
+ (rx-to-string
+ `(seq "\\" (group (any ,@eshell-special-chars-inside-quoting))))))
+ (while (re-search-forward special-char bound t)
+ (push (concat (buffer-substring start (match-beginning 0))
+ (match-string 1))
+ strings)
+ (setq start (match-end 0)))
+ (when strings
+ (push (buffer-substring start bound) strings)
+ (goto-char bound)
+ (apply #'concat (nreverse strings))))))
+
(defun eshell-parse-special-reference ()
"Parse a special syntax reference, of the form `#<args>'.
@@ -379,7 +445,9 @@ If the form has no `type', the syntax is parsed as if `type' were
(if (eshell-arg-delimiter (1+ end))
(prog1
(list (if buffer-p 'get-buffer-create 'get-process)
- (buffer-substring-no-properties (point) end))
+ (replace-regexp-in-string
+ (rx "\\" (group (or "\\" "<" ">"))) "\\1"
+ (buffer-substring-no-properties (point) end)))
(goto-char (1+ end)))
(ignore (goto-char here)))))))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 554e3a5c1d9..775e4c1057e 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -107,6 +107,7 @@
(require 'esh-module)
(require 'esh-io)
(require 'esh-ext)
+(require 'generator)
(eval-when-compile
(require 'cl-lib)
@@ -255,12 +256,12 @@ the command."
(defcustom eshell-subcommand-bindings
'((eshell-in-subcommand-p t)
+ (eshell-in-pipeline-p nil)
(default-directory default-directory)
(process-environment (eshell-copy-environment)))
"A list of `let' bindings for subcommand environments."
- :type 'sexp)
-
-(put 'risky-local-variable 'eshell-subcommand-bindings t)
+ :type 'sexp
+ :risky t)
(defvar eshell-ensure-newline-p nil
"If non-nil, ensure that a newline is emitted after a Lisp form.
@@ -279,14 +280,33 @@ otherwise t.")
(defvar eshell-in-subcommand-p nil)
(defvar eshell-last-arguments nil)
(defvar eshell-last-command-name nil)
-(defvar eshell-last-async-proc nil
- "When this foreground process completes, resume command evaluation.")
+(defvar eshell-last-async-procs nil
+ "The currently-running foreground process(es).
+When executing a pipeline, this is a cons cell whose CAR is the
+first process (usually reading from stdin) and whose CDR is the
+last process (usually writing to stdout). Otherwise, the CAR and
+CDR are the same process.
+
+When the process in the CDR completes, resume command evaluation.")
;;; Functions:
-(defsubst eshell-interactive-process ()
- "Return currently running command process, if non-Lisp."
- eshell-last-async-proc)
+(defsubst eshell-interactive-process-p ()
+ "Return non-nil if there is a currently running command process."
+ eshell-last-async-procs)
+
+(defsubst eshell-head-process ()
+ "Return the currently running process at the head of any pipeline.
+This only returns external (non-Lisp) processes."
+ (car-safe eshell-last-async-procs))
+
+(defsubst eshell-tail-process ()
+ "Return the currently running process at the tail of any pipeline.
+This only returns external (non-Lisp) processes."
+ (cdr-safe eshell-last-async-procs))
+
+(define-obsolete-function-alias 'eshell-interactive-process
+ 'eshell-tail-process "29.1")
(defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the Eshell command processing module."
@@ -295,7 +315,7 @@ otherwise t.")
(setq-local eshell-command-arguments nil)
(setq-local eshell-last-arguments nil)
(setq-local eshell-last-command-name nil)
- (setq-local eshell-last-async-proc nil)
+ (setq-local eshell-last-async-procs nil)
(add-hook 'eshell-kill-hook #'eshell-resume-command nil t)
@@ -306,7 +326,7 @@ otherwise t.")
(add-hook 'eshell-post-command-hook
(lambda ()
(setq eshell-current-command nil
- eshell-last-async-proc nil))
+ eshell-last-async-procs nil))
nil t)
(add-hook 'eshell-parse-argument-hook
@@ -331,6 +351,39 @@ otherwise t.")
(defvar eshell--sep-terms)
+(defmacro eshell-with-temp-command (region &rest body)
+ "Narrow the buffer to REGION and execute the forms in BODY.
+
+REGION is a cons cell (START . END) that specifies the region to
+which to narrow the buffer. REGION can also be a string, in
+which case the macro temporarily inserts it into the buffer at
+point, and narrows the buffer to the inserted string. Before
+executing BODY, point is set to the beginning of the narrowed
+REGION.
+
+The value returned is the last form in BODY."
+ (declare (indent 1))
+ `(let ((reg ,region))
+ (if (stringp reg)
+ ;; Since parsing relies partly on buffer-local state
+ ;; (e.g. that of `eshell-parse-argument-hook'), we need to
+ ;; perform the parsing in the Eshell buffer.
+ (let ((begin (point)) end
+ (inhibit-point-motion-hooks t))
+ (with-silent-modifications
+ (insert reg)
+ (setq end (point))
+ (unwind-protect
+ (save-restriction
+ (narrow-to-region begin end)
+ (goto-char begin)
+ ,@body)
+ (delete-region begin end))))
+ (save-restriction
+ (narrow-to-region (car reg) (cdr reg))
+ (goto-char (car reg))
+ ,@body))))
+
(defun eshell-parse-command (command &optional args toplevel)
"Parse the COMMAND, adding ARGS if given.
COMMAND can either be a string, or a cons cell demarcating a buffer
@@ -342,15 +395,9 @@ hooks should be run before and after the command."
(append
(if (consp command)
(eshell-parse-arguments (car command) (cdr command))
- (let ((here (point))
- (inhibit-point-motion-hooks t))
- (with-silent-modifications
- ;; FIXME: Why not use a temporary buffer and avoid this
- ;; "insert&delete" business? --Stef
- (insert command)
- (prog1
- (eshell-parse-arguments here (point))
- (delete-region here (point))))))
+ (eshell-with-temp-command command
+ (goto-char (point-max))
+ (eshell-parse-arguments (point-min) (point-max))))
args))
(commands
(mapcar
@@ -764,8 +811,7 @@ This macro calls itself recursively, with NOTFIRST non-nil."
(eshell-set-output-handle ,eshell-output-handle
'append nextproc)
(eshell-set-output-handle ,eshell-error-handle
- 'append nextproc)
- (setq tailproc (or tailproc nextproc))))
+ 'append nextproc)))
,(let ((head (car pipeline)))
(if (memq (car head) '(let progn))
(setq head (car (last head))))
@@ -781,7 +827,10 @@ This macro calls itself recursively, with NOTFIRST non-nil."
,(cond ((not notfirst) (quote 'first))
((cdr pipeline) t)
(t (quote 'last)))))
- ,(car pipeline))))))
+ (let ((proc ,(car pipeline)))
+ (set headproc (or proc (symbol-value headproc)))
+ (set tailproc (or (symbol-value tailproc) proc))
+ proc))))))
(defmacro eshell-do-pipelines-synchronously (pipeline)
"Execute the commands in PIPELINE in sequence synchronously.
@@ -813,7 +862,7 @@ This is used on systems where async subprocesses are not supported."
(let ((result ,(car pipeline)))
;; tailproc gets the result of the last successful process in
;; the pipeline.
- (setq tailproc (or result tailproc))
+ (set tailproc (or result (symbol-value tailproc)))
,(if (cdr pipeline)
`(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
result))))
@@ -822,7 +871,11 @@ This is used on systems where async subprocesses are not supported."
(defmacro eshell-execute-pipeline (pipeline)
"Execute the commands in PIPELINE, connecting each to one another."
- `(let ((eshell-in-pipeline-p t) tailproc)
+ `(let ((eshell-in-pipeline-p t)
+ (headproc (make-symbol "headproc"))
+ (tailproc (make-symbol "tailproc")))
+ (set headproc nil)
+ (set tailproc nil)
(progn
,(if (fboundp 'make-process)
`(eshell-do-pipelines ,pipeline)
@@ -832,7 +885,8 @@ This is used on systems where async subprocesses are not supported."
(car (aref eshell-current-handles
,eshell-error-handle)) nil)))
(eshell-do-pipelines-synchronously ,pipeline)))
- (eshell-process-identity tailproc))))
+ (eshell-process-identity (cons (symbol-value headproc)
+ (symbol-value tailproc))))))
(defmacro eshell-as-subcommand (command)
"Execute COMMAND using a temp buffer.
@@ -854,7 +908,8 @@ This avoids the need to use `let*'."
(defmacro eshell-command-to-value (object)
"Run OBJECT synchronously, returning its result as a string.
Returns a string comprising the output from the command."
- `(let ((value (make-symbol "eshell-temp")))
+ `(let ((value (make-symbol "eshell-temp"))
+ (eshell-in-pipeline-p nil))
(eshell-do-command-to-value ,object)))
;;;_* Iterative evaluation
@@ -904,21 +959,63 @@ at the moment are:
"Completion for the `debug' command."
(while (pcomplete-here '("errors" "commands"))))
+(iter-defun eshell--find-subcommands (haystack)
+ "Recursively search for subcommand forms in HAYSTACK.
+This yields the SUBCOMMANDs when found in forms like
+\"(eshell-as-subcommand SUBCOMMAND)\"."
+ (dolist (elem haystack)
+ (cond
+ ((eq (car-safe elem) 'eshell-as-subcommand)
+ (iter-yield (cdr elem)))
+ ((listp elem)
+ (iter-yield-from (eshell--find-subcommands elem))))))
+
+(defun eshell--invoke-command-directly (command)
+ "Determine whether the given COMMAND can be invoked directly.
+COMMAND should be a non-top-level Eshell command in parsed form.
+
+A command can be invoked directly if all of the following are true:
+
+* The command is of the form
+ \"(eshell-trap-errors (eshell-named-command NAME ARGS))\",
+ where ARGS is optional.
+
+* NAME is a string referring to an alias function and isn't a
+ complex command (see `eshell-complex-commands').
+
+* Any subcommands in ARGS can also be invoked directly."
+ (when (and (eq (car command) 'eshell-trap-errors)
+ (eq (car (cadr command)) 'eshell-named-command))
+ (let ((name (cadr (cadr command)))
+ (args (cdr-safe (nth 2 (cadr command)))))
+ (and name (stringp name)
+ (not (member name eshell-complex-commands))
+ (catch 'simple
+ (dolist (pred eshell-complex-commands t)
+ (when (and (functionp pred)
+ (funcall pred name))
+ (throw 'simple nil))))
+ (eshell-find-alias-function name)
+ (catch 'indirect-subcommand
+ (iter-do (subcommand (eshell--find-subcommands args))
+ (unless (eshell--invoke-command-directly subcommand)
+ (throw 'indirect-subcommand nil)))
+ t)))))
+
(defun eshell-invoke-directly (command)
- (let ((base (cadr (nth 2 (nth 2 (cadr command))))) name)
- (if (and (eq (car base) 'eshell-trap-errors)
- (eq (car (cadr base)) 'eshell-named-command))
- (setq name (cadr (cadr base))))
- (and name (stringp name)
- (not (member name eshell-complex-commands))
- (catch 'simple
- (progn
- (dolist (pred eshell-complex-commands)
- (if (and (functionp pred)
- (funcall pred name))
- (throw 'simple nil)))
- t))
- (eshell-find-alias-function name))))
+ "Determine whether the given COMMAND can be invoked directly.
+COMMAND should be a top-level Eshell command in parsed form, as
+produced by `eshell-parse-command'."
+ (let ((base (cadr (nth 2 (nth 2 (cadr command))))))
+ (eshell--invoke-command-directly base)))
+
+(defun eshell-eval-argument (argument)
+ "Evaluate a single Eshell ARGUMENT and return the result."
+ (let* ((form (eshell-with-temp-command argument
+ (eshell-parse-argument)))
+ (result (eshell-do-eval form t)))
+ (cl-assert (eq (car result) 'quote))
+ (cadr result)))
(defun eshell-eval-command (command &optional input)
"Evaluate the given COMMAND iteratively."
@@ -958,24 +1055,24 @@ at the moment are:
(unless (or (not (stringp status))
(string= "stopped" status)
(string-match eshell-reset-signals status))
- (if (eq proc (eshell-interactive-process))
+ (if (eq proc (eshell-tail-process))
(eshell-resume-eval)))))
(defun eshell-resume-eval ()
"Destructively evaluate a form which may need to be deferred."
(eshell-condition-case err
(progn
- (setq eshell-last-async-proc nil)
+ (setq eshell-last-async-procs nil)
(when eshell-current-command
(let* (retval
- (proc (catch 'eshell-defer
+ (procs (catch 'eshell-defer
(ignore
(setq retval
(eshell-do-eval
eshell-current-command))))))
- (if (eshell-processp proc)
- (ignore (setq eshell-last-async-proc proc))
- (cadr retval)))))
+ (if (eshell-process-pair-p procs)
+ (ignore (setq eshell-last-async-procs procs))
+ (cadr retval)))))
(error
(error (error-message-string err)))))
@@ -1138,17 +1235,16 @@ be finished later after the completion of an asynchronous subprocess."
(setcar form (car new-form))
(setcdr form (cdr new-form)))
(eshell-do-eval form synchronous-p))
- (if (and (memq (car form) eshell-deferrable-commands)
- (not eshell-current-subjob-p)
- result
- (eshell-processp result))
- (if synchronous-p
- (eshell/wait result)
+ (if-let (((memq (car form) eshell-deferrable-commands))
+ ((not eshell-current-subjob-p))
+ (procs (eshell-make-process-pair result)))
+ (if synchronous-p
+ (eshell/wait (cdr procs))
(eshell-manipulate "inserting ignore form"
(setcar form 'ignore)
(setcdr form nil))
- (throw 'eshell-defer result))
- (list 'quote result))))))))))))
+ (throw 'eshell-defer procs))
+ (list 'quote result))))))))))))
;; command invocation
@@ -1238,8 +1334,9 @@ or an external command."
(defun eshell-exec-lisp (printer errprint func-or-form args form-p)
"Execute a Lisp FUNC-OR-FORM, maybe passing ARGS.
PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors. FORM-P should be non-nil if FUNC-OR-FORM
-represent a Lisp form; ARGS will be ignored in that case."
+messages and errors, respectively. FORM-P should be non-nil if
+FUNC-OR-FORM represent a Lisp form; ARGS will be ignored in that
+case."
(eshell-condition-case err
(let ((result
(save-current-buffer
@@ -1262,44 +1359,56 @@ represent a Lisp form; ARGS will be ignored in that case."
(defsubst eshell-apply* (printer errprint func args)
"Call FUNC, with ARGS, trapping errors and return them as output.
PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors."
+messages and errors, respectively."
(eshell-exec-lisp printer errprint func args nil))
(defsubst eshell-funcall* (printer errprint func &rest args)
- "Call FUNC, with ARGS, trapping errors and return them as output."
+ "Call FUNC, with ARGS, trapping errors and return them as output.
+PRINTER and ERRPRINT are functions to use for printing regular
+messages and errors, respectively."
(eshell-apply* printer errprint func args))
(defsubst eshell-eval* (printer errprint form)
- "Evaluate FORM, trapping errors and returning them."
+ "Evaluate FORM, trapping errors and returning them.
+PRINTER and ERRPRINT are functions to use for printing regular
+messages and errors, respectively."
(eshell-exec-lisp printer errprint form nil t))
(defsubst eshell-apply (func args)
"Call FUNC, with ARGS, trapping errors and return them as output.
-PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors."
- (eshell-apply* 'eshell-print 'eshell-error func args))
+Print the result using `eshell-print'; if an error occurs, print
+it via `eshell-error'."
+ (eshell-apply* #'eshell-print #'eshell-error func args))
(defsubst eshell-funcall (func &rest args)
- "Call FUNC, with ARGS, trapping errors and return them as output."
+ "Call FUNC, with ARGS, trapping errors and return them as output.
+Print the result using `eshell-print'; if an error occurs, print
+it via `eshell-error'."
(eshell-apply func args))
(defsubst eshell-eval (form)
- "Evaluate FORM, trapping errors and returning them."
- (eshell-eval* 'eshell-print 'eshell-error form))
+ "Evaluate FORM, trapping errors and returning them.
+Print the result using `eshell-print'; if an error occurs, print
+it via `eshell-error'."
+ (eshell-eval* #'eshell-print #'eshell-error form))
(defsubst eshell-applyn (func args)
"Call FUNC, with ARGS, trapping errors and return them as output.
-PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors."
- (eshell-apply* 'eshell-printn 'eshell-errorn func args))
+Print the result using `eshell-printn'; if an error occurs, print it
+via `eshell-errorn'."
+ (eshell-apply* #'eshell-printn #'eshell-errorn func args))
(defsubst eshell-funcalln (func &rest args)
- "Call FUNC, with ARGS, trapping errors and return them as output."
+ "Call FUNC, with ARGS, trapping errors and return them as output.
+Print the result using `eshell-printn'; if an error occurs, print it
+via `eshell-errorn'."
(eshell-applyn func args))
(defsubst eshell-evaln (form)
- "Evaluate FORM, trapping errors and returning them."
- (eshell-eval* 'eshell-printn 'eshell-errorn form))
+ "Evaluate FORM, trapping errors and returning them.
+Print the result using `eshell-printn'; if an error occurs, print it
+via `eshell-errorn'."
+ (eshell-eval* #'eshell-printn #'eshell-errorn form))
(defvar eshell-last-output-end) ;Defined in esh-mode.el.
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 5179947da76..c035890ddf0 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -147,9 +147,10 @@ not be added to this variable."
function
(choice (const :tag "Func returns output-func" t)
(const :tag "Func is output-func" nil))))
+ :risky t
:group 'eshell-io)
-(put 'eshell-virtual-targets 'risky-local-variable t)
+(define-error 'eshell-pipe-broken "Pipe broken")
;;; Internal Variables:
@@ -275,8 +276,20 @@ STATUS should be non-nil on successful termination of the output."
;; If we're redirecting to a process (via a pipe, or process
;; redirection), send it EOF so that it knows we're finished.
((eshell-processp target)
- (if (eq (process-status target) 'run)
- (process-send-eof target)))
+ ;; According to POSIX.1-2017, section 11.1.9, sending EOF causes
+ ;; all bytes waiting to be read to be sent to the process
+ ;; immediately. Thus, if there are any bytes waiting, we need to
+ ;; send EOF twice: once to flush the buffer, and a second time to
+ ;; cause the next read() to return a size of 0, indicating
+ ;; end-of-file to the reading process. However, some platforms
+ ;; (e.g. Solaris) actually require sending a *third* EOF. Since
+ ;; sending extra EOFs while the process is running shouldn't break
+ ;; anything, we'll just send the maximum we'd ever need. See
+ ;; bug#56025 for further details.
+ (let ((i 0))
+ (while (and (<= (cl-incf i) 3)
+ (eq (process-status target) 'run))
+ (process-send-eof target))))
;; A plain function redirection needs no additional arguments
;; passed.
@@ -376,8 +389,6 @@ it defaults to `insert'."
(error "Invalid redirection target: %s"
(eshell-stringify target)))))
-(defvar grep-null-device)
-
(defun eshell-set-output-handle (index mode &optional target)
"Set handle INDEX, using MODE, to point to TARGET."
(when target
@@ -484,24 +495,31 @@ Returns what was actually sent, or nil if nothing was sent."
(goto-char target))))))
((eshell-processp target)
- (when (eq (process-status target) 'run)
- (unless (stringp object)
- (setq object (eshell-stringify object)))
- (process-send-string target object)))
+ (unless (stringp object)
+ (setq object (eshell-stringify object)))
+ (condition-case nil
+ (process-send-string target object)
+ ;; If `process-send-string' raises an error, treat it as a broken pipe.
+ (error (signal 'eshell-pipe-broken target))))
((consp target)
(apply (car target) object (cdr target))))
object)
(defun eshell-output-object (object &optional handle-index handles)
- "Insert OBJECT, using HANDLE-INDEX specifically)."
+ "Insert OBJECT, using HANDLE-INDEX specifically.
+If HANDLE-INDEX is nil, output to `eshell-output-handle'.
+HANDLES is the set of file handles to use; if nil, use
+`eshell-current-handles'."
(let ((target (car (aref (or handles eshell-current-handles)
(or handle-index eshell-output-handle)))))
- (if (and target (not (listp target)))
- (eshell-output-object-to-target object target)
- (while target
- (eshell-output-object-to-target object (car target))
- (setq target (cdr target))))))
+ (if (listp target)
+ (while target
+ (eshell-output-object-to-target object (car target))
+ (setq target (cdr target)))
+ (eshell-output-object-to-target object target)
+ ;; Explicitly return nil to match the list case above.
+ nil)))
(provide 'esh-io)
;;; esh-io.el ends here
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index a3d9d582e58..972d4f9df00 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -146,7 +146,7 @@ See variable `eshell-scroll-to-bottom-on-output' and function
Eshell buffers are truncated from the top to be no greater than this
number, if the function `eshell-truncate-buffer' is on
`eshell-output-filter-functions'."
- :type 'integer)
+ :type 'natnum)
(defcustom eshell-output-filter-functions
'(eshell-postoutput-scroll-to-bottom
@@ -260,31 +260,28 @@ This is used by `eshell-watch-for-password-prompt'."
(standard-syntax-table))
st))
-(defvar eshell-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(control ?c)] 'eshell-command-map)
- (define-key map "\r" #'eshell-send-input)
- (define-key map "\M-\r" #'eshell-queue-input)
- (define-key map [(meta control ?l)] #'eshell-show-output)
- (define-key map [(control ?a)] #'eshell-bol)
- map))
-
-(defvar eshell-command-map
- (let ((map (define-prefix-command 'eshell-command-map)))
- (define-key map [(meta ?o)] #'eshell-mark-output)
- (define-key map [(meta ?d)] #'eshell-toggle-direct-send)
- (define-key map [(control ?a)] #'eshell-bol)
- (define-key map [(control ?b)] #'eshell-backward-argument)
- (define-key map [(control ?e)] #'eshell-show-maximum-output)
- (define-key map [(control ?f)] #'eshell-forward-argument)
- (define-key map [(control ?m)] #'eshell-copy-old-input)
- (define-key map [(control ?o)] #'eshell-kill-output)
- (define-key map [(control ?r)] #'eshell-show-output)
- (define-key map [(control ?t)] #'eshell-truncate-buffer)
- (define-key map [(control ?u)] #'eshell-kill-input)
- (define-key map [(control ?w)] #'backward-kill-word)
- (define-key map [(control ?y)] #'eshell-repeat-argument)
- map))
+(defvar-keymap eshell-mode-map
+ "C-c" 'eshell-command-map
+ "RET" #'eshell-send-input
+ "M-RET" #'eshell-queue-input
+ "C-M-l" #'eshell-show-output
+ "C-a" #'eshell-bol)
+
+(defvar-keymap eshell-command-map
+ :prefix 'eshell-command-map
+ "M-o" #'eshell-mark-output
+ "M-d" #'eshell-toggle-direct-send
+ "C-a" #'eshell-bol
+ "C-b" #'eshell-backward-argument
+ "C-e" #'eshell-show-maximum-output
+ "C-f" #'eshell-forward-argument
+ "C-m" #'eshell-copy-old-input
+ "C-o" #'eshell-kill-output
+ "C-r" #'eshell-show-output
+ "C-t" #'eshell-truncate-buffer
+ "C-u" #'eshell-kill-input
+ "C-w" #'backward-kill-word
+ "C-y" #'eshell-repeat-argument)
;;; User Functions:
@@ -308,7 +305,7 @@ and the hook `eshell-exit-hook'."
(make-local-variable 'eshell-command-running-string)
(let ((fmt (copy-sequence mode-line-format)))
(setq-local mode-line-format fmt))
- (let ((mode-line-elt (memq 'mode-line-modified mode-line-format)))
+ (let ((mode-line-elt (cdr (memq 'mode-line-front-space mode-line-format))))
(if mode-line-elt
(setcar mode-line-elt 'eshell-command-running-string))))
@@ -364,7 +361,11 @@ and the hook `eshell-exit-hook'."
(unless module-shortname
(error "Invalid Eshell module name: %s" module-fullname))
(unless (featurep (intern module-shortname))
- (load module-shortname))))
+ (condition-case nil
+ (load module-shortname)
+ (error (lwarn 'eshell :error
+ "Unable to load module `%s' (defined in `eshell-modules-list')"
+ module-fullname))))))
(unless (file-exists-p eshell-directory-name)
(eshell-make-private-directory eshell-directory-name t))
@@ -426,13 +427,13 @@ and the hook `eshell-exit-hook'."
(defun eshell-self-insert-command ()
(interactive)
(process-send-string
- (eshell-interactive-process)
+ (eshell-head-process)
(char-to-string (if (symbolp last-command-event)
(get last-command-event 'ascii-character)
last-command-event))))
(defun eshell-intercept-commands ()
- (when (and (eshell-interactive-process)
+ (when (and (eshell-interactive-process-p)
(not (and (integerp last-input-event)
(memq last-input-event '(?\C-x ?\C-c)))))
(let ((possible-events (where-is-internal this-command))
@@ -598,13 +599,13 @@ If NO-NEWLINE is non-nil, the input is sent without an implied final
newline."
(interactive "P")
;; Note that the input string does not include its terminal newline.
- (let ((proc-running-p (and (eshell-interactive-process)
+ (let ((proc-running-p (and (eshell-head-process)
(not queue-p)))
(inhibit-point-motion-hooks t)
(inhibit-modification-hooks t))
(unless (and proc-running-p
(not (eq (process-status
- (eshell-interactive-process))
+ (eshell-head-process))
'run)))
(if (or proc-running-p
(>= (point) eshell-last-output-end))
@@ -616,14 +617,22 @@ newline."
(and eshell-send-direct-to-subprocesses
proc-running-p))
(insert-before-markers-and-inherit ?\n))
+ ;; Delete and reinsert input. This seems like a no-op, except
+ ;; for the resulting entries in the undo list: undoing this
+ ;; insertion will delete the region, moving the process mark
+ ;; back to its original position.
+ (let ((text (buffer-substring eshell-last-output-end (point)))
+ (inhibit-read-only t))
+ (delete-region eshell-last-output-end (point))
+ (insert text))
(if proc-running-p
(progn
(eshell-update-markers eshell-last-output-end)
(if (or eshell-send-direct-to-subprocesses
(= eshell-last-input-start eshell-last-input-end))
(unless no-newline
- (process-send-string (eshell-interactive-process) "\n"))
- (process-send-region (eshell-interactive-process)
+ (process-send-string (eshell-head-process) "\n"))
+ (process-send-region (eshell-head-process)
eshell-last-input-start
eshell-last-input-end)))
(if (= eshell-last-output-end (point))
@@ -660,6 +669,16 @@ newline."
(run-hooks 'eshell-post-command-hook)
(insert-and-inherit input)))))))))
+(defun eshell-send-eof-to-process ()
+ "Send EOF to the currently-running \"head\" process."
+ (interactive)
+ (require 'esh-mode)
+ (declare-function eshell-send-input "esh-mode"
+ (&optional use-region queue-p no-newline))
+ (eshell-send-input nil nil t)
+ (when (eshell-head-process)
+ (process-send-eof (eshell-head-process))))
+
(defsubst eshell-kill-new ()
"Add the last input text to the kill ring."
(kill-ring-save eshell-last-input-start eshell-last-input-end))
@@ -919,9 +938,9 @@ Then send it to the process running in the current buffer."
(interactive) ; Don't pass str as argument, to avoid snooping via C-x ESC ESC
(let ((str (read-passwd
(format "%s Password: "
- (process-name (eshell-interactive-process))))))
+ (process-name (eshell-head-process))))))
(if (stringp str)
- (process-send-string (eshell-interactive-process)
+ (process-send-string (eshell-head-process)
(concat str "\n"))
(message "Warning: text will be echoed"))))
@@ -932,14 +951,21 @@ buffer's process if STRING contains a password prompt defined by
`eshell-password-prompt-regexp'.
This function could be in the list `eshell-output-filter-functions'."
- (when (eshell-interactive-process)
+ (when (eshell-interactive-process-p)
(save-excursion
(let ((case-fold-search t))
(goto-char eshell-last-output-block-begin)
(beginning-of-line)
(if (re-search-forward eshell-password-prompt-regexp
eshell-last-output-end t)
- (eshell-send-invisible))))))
+ ;; Use `run-at-time' in order not to pause execution of
+ ;; the process filter with a minibuffer
+ (run-at-time
+ 0 nil
+ (lambda (current-buf)
+ (with-current-buffer current-buf
+ (eshell-send-invisible)))
+ (current-buffer)))))))
(custom-add-option 'eshell-output-filter-functions
'eshell-watch-for-password-prompt)
@@ -1012,5 +1038,7 @@ This function could be in the list `eshell-output-filter-functions'."
(let ((default-directory (bookmark-prop-get bookmark 'location)))
(eshell)))
+(put 'eshell-bookmark-jump 'bookmark-handler-type "Eshell")
+
(provide 'esh-mode)
;;; esh-mode.el ends here
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index ade151d7cd5..14e91912d11 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -54,6 +54,7 @@ customizing the variable `eshell-modules-list'."
eshell-basic
eshell-cmpl
eshell-dirs
+ eshell-extpipe
eshell-glob
eshell-hist
eshell-ls
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index d96b77ddd37..f52b70fe7a6 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -97,10 +97,10 @@ let-bound variable `args'."
(declare (debug (form form sexp body)))
`(let* ((temp-args
,(if (memq ':preserve-args (cadr options))
- macro-args
+ (list 'copy-tree macro-args)
(list 'eshell-stringify-list
(list 'flatten-tree macro-args))))
- (processed-args (eshell--do-opts ,name ,options temp-args))
+ (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args))
,@(delete-dups
(delq nil (mapcar (lambda (opt)
(and (listp opt) (nth 3 opt)
@@ -117,7 +117,7 @@ let-bound variable `args'."
;; Documented part of the interface; see eshell-eval-using-options.
(defvar eshell--args)
-(defun eshell--do-opts (name options args)
+(defun eshell--do-opts (name options args orig-args)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
(require 'esh-ext)
@@ -135,7 +135,7 @@ This code doesn't really need to be macro expanded everywhere."
(error "%s" usage-msg))))))
(if ext-command
(throw 'eshell-external
- (eshell-external-command ext-command args))
+ (eshell-external-command ext-command orig-args))
args)))
(defun eshell-show-usage (name options)
@@ -187,49 +187,82 @@ passed to this command, the external version `%s'
will be called instead." extcmd)))))
(throw 'eshell-usage usage)))
-(defun eshell--set-option (name ai opt options opt-vals)
+(defun eshell--split-switch (switch kind)
+ "Split SWITCH into its option name and potential value, if any.
+KIND should be the integer 0 if SWITCH is a short option, or 1 if it's
+a long option."
+ (if (eq kind 0)
+ ;; Short option
+ (cons (aref switch 0)
+ (and (> (length switch) 1) (substring switch 1)))
+ ;; Long option
+ (save-match-data
+ (string-match "\\([^=]*\\)\\(?:=\\(.*\\)\\)?" switch)
+ (cons (match-string 1 switch) (match-string 2 switch)))))
+
+(defun eshell--set-option (name ai opt value options opt-vals)
"Using NAME's remaining args (index AI), set the OPT within OPTIONS.
-If the option consumes an argument for its value, the argument list
-will be modified."
+VALUE is the potential value of the OPT, coming from args like
+\"-fVALUE\" or \"--foo=VALUE\", or nil if no value was supplied. If
+OPT doesn't consume a value, return VALUE unchanged so that it can be
+processed later; otherwise, return nil.
+
+If the OPT consumes an argument for its value and VALUE is nil, the
+argument list will be modified."
(if (not (nth 3 opt))
(eshell-show-usage name options)
- (setcdr (assq (nth 3 opt) opt-vals)
- (if (eq (nth 2 opt) t)
- (if (> ai (length eshell--args))
- (error "%s: missing option argument" name)
- (pop (nthcdr ai eshell--args)))
- (or (nth 2 opt) t)))))
+ (if (eq (nth 2 opt) t)
+ (progn
+ (setcdr (assq (nth 3 opt) opt-vals)
+ (or value
+ (if (> ai (length eshell--args))
+ (error "%s: missing option argument" name)
+ (pop (nthcdr ai eshell--args)))))
+ nil)
+ (setcdr (assq (nth 3 opt) opt-vals)
+ (or (nth 2 opt) t))
+ value)))
(defun eshell--process-option (name switch kind ai options opt-vals)
"For NAME, process SWITCH (of type KIND), from args at index AI.
The SWITCH will be looked up in the set of OPTIONS.
-SWITCH should be either a string or character. KIND should be the
-integer 0 if it's a character, or 1 if it's a string.
-
-The SWITCH is then be matched against OPTIONS. If no matching handler
-is found, and an :external command is defined (and available), it will
-be called; otherwise, an error will be triggered to say that the
-switch is unrecognized."
- (let* ((opts options)
- found)
+SWITCH should be a string starting with the option to process,
+possibly followed by its value, e.g. \"u\" or \"uUSER\". KIND should
+be the integer 0 if it's a short option, or 1 if it's a long option.
+
+The SWITCH is then be matched against OPTIONS. If KIND is 0 and the
+SWITCH matches an option that doesn't take a value, return the
+remaining characters in SWITCH to be processed later as further short
+options.
+
+If no matching handler is found, and an :external command is defined
+(and available), it will be called; otherwise, an error will be
+triggered to say that the switch is unrecognized."
+ (let ((switch (eshell--split-switch switch kind))
+ (opts options)
+ found remaining)
(while opts
(if (and (listp (car opts))
- (nth kind (car opts))
- (equal switch (nth kind (car opts))))
+ (equal (car switch) (nth kind (car opts))))
(progn
- (eshell--set-option name ai (car opts) options opt-vals)
+ (setq remaining (eshell--set-option name ai (car opts)
+ (cdr switch) options opt-vals))
+ (when (and remaining (eq kind 1))
+ (error "%s: option --%s doesn't allow an argument"
+ name (car switch)))
(setq found t opts nil))
(setq opts (cdr opts))))
- (unless found
+ (if found
+ remaining
(let ((extcmd (memq ':external options)))
(when extcmd
- (setq extcmd (eshell-search-path (cadr extcmd)))
- (if extcmd
- (throw 'eshell-ext-command extcmd)
- (error (if (characterp switch) "%s: unrecognized option -%c"
- "%s: unrecognized option --%s")
- name switch)))))))
+ (setq extcmd (eshell-search-path (cadr extcmd))))
+ (if extcmd
+ (throw 'eshell-ext-command extcmd)
+ (error (if (characterp (car switch)) "%s: unrecognized option -%c"
+ "%s: unrecognized option --%s")
+ name (car switch)))))))
(defun eshell--process-args (name args options)
"Process the given ARGS using OPTIONS."
@@ -250,6 +283,9 @@ switch is unrecognized."
(memq :parse-leading-options-only options))))
(setq arg (nth ai eshell--args))
(if (not (and (stringp arg)
+ ;; A string of length 1 can't be an option; (if
+ ;; it's "-", that generally means stdin).
+ (> (length arg) 1)
(string-match "^-\\(-\\)?\\(.*\\)" arg)))
;; Positional argument found, skip
(setq ai (1+ ai)
@@ -262,12 +298,9 @@ switch is unrecognized."
(if (> (length switch) 0)
(eshell--process-option name switch 1 ai options opt-vals)
(setq ai (length eshell--args)))
- (let ((len (length switch))
- (index 0))
- (while (< index len)
- (eshell--process-option name (aref switch index)
- 0 ai options opt-vals)
- (setq index (1+ index))))))))
+ (while (> (length switch) 0)
+ (setq switch (eshell--process-option name switch 0
+ ai options opt-vals)))))))
(nconc (mapcar #'cdr opt-vals) eshell--args)))
(provide 'esh-opt)
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index c4103fbafbb..70426ccaf2a 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -101,15 +101,16 @@ information, for example."
(defvar eshell-process-list nil
"A list of the current status of subprocesses.")
-(defvar eshell-proc-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c M-i") #'eshell-insert-process)
- (define-key map (kbd "C-c C-c") #'eshell-interrupt-process)
- (define-key map (kbd "C-c C-k") #'eshell-kill-process)
- (define-key map (kbd "C-c C-d") #'eshell-send-eof-to-process)
- (define-key map (kbd "C-c C-s") #'list-processes)
- (define-key map (kbd "C-c C-\\") #'eshell-quit-process)
- map))
+(declare-function eshell-send-eof-to-process "esh-mode")
+(declare-function eshell-tail-process "esh-cmd")
+
+(defvar-keymap eshell-proc-mode-map
+ "C-c M-i" #'eshell-insert-process
+ "C-c C-c" #'eshell-interrupt-process
+ "C-c C-k" #'eshell-kill-process
+ "C-c C-d" #'eshell-send-eof-to-process
+ "C-c C-s" #'list-processes
+ "C-c C-\\" #'eshell-quit-process)
;;; Functions:
@@ -119,7 +120,9 @@ Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
PROC and STATUS to functions on the latter."
;; Was there till 24.1, but it is not optional.
(remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
- (eshell-reset-after-proc status)
+ ;; Only reset the prompt if this process is running interactively.
+ (when (eq proc (eshell-tail-process))
+ (eshell-reset-after-proc status))
(run-hook-with-args 'eshell-kill-hook proc status))
(define-minor-mode eshell-proc-mode
@@ -386,8 +389,27 @@ output."
(let ((data (nth 3 entry)))
(setcar (nthcdr 3 entry) nil)
(setcar (nthcdr 4 entry) t)
- (eshell-output-object data nil (cadr entry))
- (setcar (nthcdr 4 entry) nil)))))))))
+ (unwind-protect
+ (condition-case nil
+ (eshell-output-object data nil (cadr entry))
+ ;; FIXME: We want to send SIGPIPE to the process
+ ;; here. However, remote processes don't
+ ;; currently support that, and not all systems
+ ;; have SIGPIPE in the first place (e.g. MS
+ ;; Windows). In these cases, just delete the
+ ;; process; this is reasonably close to the
+ ;; right behavior, since the default action for
+ ;; SIGPIPE is to terminate the process. For use
+ ;; cases where SIGPIPE is truly needed, using an
+ ;; external pipe operator (`*|') may work
+ ;; instead (e.g. when working with remote
+ ;; processes).
+ (eshell-pipe-broken
+ (if (or (process-get proc 'remote-pid)
+ (eq system-type 'windows-nt))
+ (delete-process proc)
+ (signal-process proc 'SIGPIPE))))
+ (setcar (nthcdr 4 entry) nil))))))))))
(defun eshell-sentinel (proc string)
"Generic sentinel for command processes. Reports only signals.
@@ -395,7 +417,7 @@ PROC is the process that's exiting. STRING is the exit message."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(unwind-protect
- (let* ((entry (assq proc eshell-process-list)))
+ (let ((entry (assq proc eshell-process-list)))
; (if (not entry)
; (error "Sentinel called for unowned process `%s'"
; (process-name proc))
@@ -403,8 +425,13 @@ PROC is the process that's exiting. STRING is the exit message."
(unwind-protect
(progn
(unless (string= string "run")
- (unless (string-match "^\\(finished\\|exited\\)" string)
- (eshell-insertion-filter proc string))
+ ;; Write the exit message if the status is
+ ;; abnormal and the process is already writing
+ ;; to the terminal.
+ (when (and (eq proc (eshell-tail-process))
+ (not (string-match "^\\(finished\\|exited\\)"
+ string)))
+ (funcall (process-filter proc) proc string))
(let ((handles (nth 1 entry))
(str (prog1 (nth 3 entry)
(setf (nth 3 entry) nil)))
@@ -416,8 +443,12 @@ PROC is the process that's exiting. STRING is the exit message."
(lambda ()
(if (nth 4 entry)
(run-at-time 0 nil finish-io)
- (when str (eshell-output-object str nil handles))
- (eshell-close-handles status 'nil handles)))))
+ (when str
+ (ignore-error 'eshell-pipe-broken
+ (eshell-output-object
+ str nil handles)))
+ (eshell-close-handles
+ status 'nil handles)))))
(funcall finish-io)))))
(eshell-remove-process-entry entry))))
(eshell-kill-process-function proc string)))))
@@ -544,14 +575,5 @@ See the variable `eshell-kill-processes-on-exit'."
; ;; `eshell-resume-eval'.
; (eshell-kill-process-function nil "continue")))
-(defun eshell-send-eof-to-process ()
- "Send EOF to process."
- (interactive)
- (require 'esh-mode)
- (declare-function eshell-send-input "esh-mode"
- (&optional use-region queue-p no-newline))
- (eshell-send-input nil nil t)
- (eshell-process-interact 'process-send-eof))
-
(provide 'esh-proc)
;;; esh-proc.el ends here
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index bacb41eceff..5144e305121 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -63,11 +63,11 @@ has no effect."
Setting this to nil is offered as an aid to debugging only."
:type 'boolean)
-(defcustom eshell-private-file-modes 384 ; umask 177
+(defcustom eshell-private-file-modes #o600 ; umask 177
"The file-modes value to use for creating \"private\" files."
:type 'integer)
-(defcustom eshell-private-directory-modes 448 ; umask 077
+(defcustom eshell-private-directory-modes #o700 ; umask 077
"The file-modes value to use for creating \"private\" directories."
:type 'integer)
@@ -151,67 +151,98 @@ Otherwise, evaluates FORM with no error handling."
(defun eshell-find-delimiter
(open close &optional bound reverse-p backslash-p)
"From point, find the CLOSE delimiter corresponding to OPEN.
-The matching is bounded by BOUND.
-If REVERSE-P is non-nil, process the region backwards.
-If BACKSLASH-P is non-nil, and OPEN and CLOSE are the same character,
-then quoting is done by a backslash, rather than a doubled delimiter."
+The matching is bounded by BOUND. If REVERSE-P is non-nil,
+process the region backwards.
+
+If BACKSLASH-P is non-nil, or OPEN and CLOSE are different
+characters, then a backslash can be used to escape a delimiter
+(or another backslash). Otherwise, the delimiter is escaped by
+doubling it up."
(save-excursion
(let ((depth 1)
(bound (or bound (point-max))))
- (if (if reverse-p
- (eq (char-before) close)
- (eq (char-after) open))
- (forward-char (if reverse-p -1 1)))
+ (when (if reverse-p
+ (eq (char-before) close)
+ (eq (char-after) open))
+ (forward-char (if reverse-p -1 1)))
(while (and (> depth 0)
- (funcall (if reverse-p '> '<) (point) bound))
- (let ((c (if reverse-p (char-before) (char-after))) nc)
+ (funcall (if reverse-p #'> #'<) (point) bound))
+ (let ((c (if reverse-p (char-before) (char-after))))
(cond ((and (not reverse-p)
(or (not (eq open close))
backslash-p)
(eq c ?\\)
- (setq nc (char-after (1+ (point))))
- (or (eq nc open) (eq nc close)))
+ (memq (char-after (1+ (point)))
+ (list open close ?\\)))
(forward-char 1))
((and reverse-p
(or (not (eq open close))
backslash-p)
- (or (eq c open) (eq c close))
- (eq (char-before (1- (point)))
- ?\\))
+ (eq (char-before (1- (point))) ?\\)
+ (memq c (list open close ?\\)))
(forward-char -1))
((eq open close)
- (if (eq c open)
- (if (and (not backslash-p)
- (eq (if reverse-p
- (char-before (1- (point)))
- (char-after (1+ (point)))) open))
- (forward-char (if reverse-p -1 1))
- (setq depth (1- depth)))))
+ (when (eq c open)
+ (if (and (not backslash-p)
+ (eq (if reverse-p
+ (char-before (1- (point)))
+ (char-after (1+ (point))))
+ open))
+ (forward-char (if reverse-p -1 1))
+ (setq depth (1- depth)))))
((= c open)
(setq depth (+ depth (if reverse-p -1 1))))
((= c close)
(setq depth (+ depth (if reverse-p 1 -1))))))
(forward-char (if reverse-p -1 1)))
- (if (= depth 0)
- (if reverse-p (point) (1- (point)))))))
-
-(defun eshell-convert (string)
- "Convert STRING into a more native looking Lisp object."
- (if (not (stringp string))
- string
- (let ((len (length string)))
- (if (= len 0)
- string
- (if (eq (aref string (1- len)) ?\n)
+ (when (= depth 0)
+ (if reverse-p (point) (1- (point)))))))
+
+(defun eshell-convertible-to-number-p (string)
+ "Return non-nil if STRING can be converted to a number.
+If `eshell-convert-numeric-aguments', always return nil."
+ (and eshell-convert-numeric-arguments
+ (string-match
+ (concat "\\`\\s-*" eshell-number-regexp "\\s-*\\'")
+ string)))
+
+(defun eshell-convert-to-number (string)
+ "Try to convert STRING to a number.
+If STRING doesn't look like a number (or
+`eshell-convert-numeric-aguments' is nil), just return STRING
+unchanged."
+ (if (eshell-convertible-to-number-p string)
+ (string-to-number string)
+ string))
+
+(defun eshell-convert (string &optional to-string)
+ "Convert STRING into a more-native Lisp object.
+If TO-STRING is non-nil, always return a single string with
+trailing newlines removed. Otherwise, this behaves as follows:
+
+* Return non-strings as-is.
+
+* Split multiline strings by line.
+
+* If `eshell-convert-numeric-aguments' is non-nil and every line
+ of output looks like a number, convert them to numbers."
+ (cond
+ ((not (stringp string))
+ (if to-string
+ (eshell-stringify string)
+ string))
+ (to-string (string-trim-right string "\n+"))
+ (t (let ((len (length string)))
+ (if (= len 0)
+ string
+ (when (eq (aref string (1- len)) ?\n)
(setq string (substring string 0 (1- len))))
- (if (string-search "\n" string)
- (split-string string "\n")
- (if (and eshell-convert-numeric-arguments
- (string-match
- (concat "\\`\\s-*" eshell-number-regexp
- "\\s-*\\'") string))
- (string-to-number string)
- string))))))
+ (if (string-search "\n" string)
+ (let ((lines (split-string string "\n")))
+ (if (seq-every-p #'eshell-convertible-to-number-p lines)
+ (mapcar #'string-to-number lines)
+ lines))
+ (eshell-convert-to-number string)))))))
(defvar-local eshell-path-env (getenv "PATH")
"Content of $PATH.
@@ -262,6 +293,7 @@ Prepend remote identification of `default-directory', if any."
(defun eshell-to-flat-string (value)
"Make value a string. If separated by newlines change them to spaces."
+ (declare (obsolete nil "29.1"))
(let ((text (eshell-stringify value)))
(if (string-match "\n+\\'" text)
(setq text (replace-match "" t t text)))
@@ -269,16 +301,6 @@ Prepend remote identification of `default-directory', if any."
(setq text (replace-match " " t t text)))
text))
-(defmacro eshell-for (for-var for-list &rest forms)
- "Iterate through a list."
- (declare (obsolete dolist "24.1"))
- (declare (indent 2))
- `(let ((list-iter ,for-list))
- (while list-iter
- (let ((,for-var (car list-iter)))
- ,@forms)
- (setq list-iter (cdr list-iter)))))
-
(define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1")
(defun eshell-stringify (object)
@@ -589,11 +611,11 @@ list."
The optional argument ID-FORMAT specifies the preferred uid and
gid format. Valid values are `string' and `integer', defaulting to
`integer'. See `file-attributes'."
- (let* ((file (expand-file-name file))
+ (let* ((expanded-file (expand-file-name file))
entry)
- (if (string-equal (file-remote-p file 'method) "ftp")
- (let ((base (file-name-nondirectory file))
- (dir (file-name-directory file)))
+ (if (string-equal (file-remote-p expanded-file 'method) "ftp")
+ (let ((base (file-name-nondirectory expanded-file))
+ (dir (file-name-directory expanded-file)))
(if (string-equal "" base) (setq base "."))
(unless entry
(setq entry (eshell-parse-ange-ls dir))
@@ -609,6 +631,20 @@ gid format. Valid values are `string' and `integer', defaulting to
"If the `processp' function does not exist, PROC is not a process."
(and (fboundp 'processp) (processp proc)))
+(defun eshell-process-pair-p (procs)
+ "Return non-nil if PROCS is a pair of process objects."
+ (and (consp procs)
+ (eshell-processp (car procs))
+ (eshell-processp (cdr procs))))
+
+(defun eshell-make-process-pair (procs)
+ "Make a pair of process objects from PROCS if possible.
+This represents the head and tail of a pipeline of processes,
+where the head and tail may be the same process."
+ (pcase procs
+ ((pred eshell-processp) (cons procs procs))
+ ((pred eshell-process-pair-p) procs)))
+
;; (defun eshell-copy-file
;; (file newname &optional ok-if-already-exists keep-date)
;; "Copy FILE to NEWNAME. See docs for `copy-file'."
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 1d5d85debad..17add9b6685 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -39,11 +39,6 @@
;;
;; Only "MYVAR" is part of the variable name in this case.
;;
-;; $#VARIABLE
-;;
-;; Returns the length of the value of VARIABLE. This could also be
-;; done using the `length' Lisp function.
-;;
;; $(lisp)
;;
;; Returns result of Lisp evaluation. Note: Used alone like this, it
@@ -61,38 +56,35 @@
;; Evaluates an eshell subcommand, redirecting the output to a
;; temporary file, and returning the file name.
;;
-;; $ANYVAR[10]
+;; $EXPR[10]
;;
-;; Return the 10th element of ANYVAR. If ANYVAR's value is a string,
-;; it will be split in order to make it a list. The splitting will
-;; occur at whitespace.
+;; Return the 10th element of $EXPR, which can be any dollar
+;; expression. If $EXPR's value is a string, it will be split in
+;; order to make it a list. The splitting will occur at whitespace.
;;
-;; $ANYVAR[: 10]
+;; $EXPR[10 20]
;;
-;; As above, except that splitting occurs at the colon now.
+;; As above, but instead of returning a single element, it now returns a
+;; list of two elements.
;;
-;; $ANYVAR[: 10 20]
+;; $EXPR[: 10]
;;
-;; As above, but instead of returning just a string, it now returns a
-;; list of two strings. If the result is being interpolated into a
-;; larger string, this list will be flattened into one big string,
-;; with each element separated by a space.
+;; Like $EXPR[10], except that splitting occurs at the colon now.
;;
-;; $ANYVAR["\\\\" 10]
+;; $EXPR["\\\\" 10]
;;
;; Separate on backslash characters. Actually, the first argument --
-;; if it doesn't have the form of a number, or a plain variable name
-;; -- can be any regular expression. So to split on numbers, use
-;; '$ANYVAR["[0-9]+" 10 20]'.
+;; if it doesn't have the form of a number -- can be any regular
+;; expression. So to split on numbers, use '$EXPR["[0-9]+" 10 20]'.
;;
-;; $ANYVAR[hello]
+;; $EXPR[hello]
;;
-;; Calls `assoc' on ANYVAR with 'hello', expecting it to be an alist.
+;; Calls `assoc' on $EXPR with 'hello', expecting it to be an alist.
;;
-;; $#ANYVAR[hello]
+;; $#EXPR
;;
-;; Returns the length of the cdr of the element of ANYVAR who car is
-;; equal to "hello".
+;; Returns the length of the value of $EXPR. This could also be
+;; done using the `length' Lisp function.
;;
;; There are also a few special variables defined by Eshell. '$$' is
;; the value of the last command (t or nil, in the case of an external
@@ -157,8 +149,8 @@ if they are quoted with a backslash."
(defcustom eshell-variable-aliases-list
`(;; for eshell.el
- ("COLUMNS" ,(lambda (_indices) (window-width)) t)
- ("LINES" ,(lambda (_indices) (window-height)) t)
+ ("COLUMNS" ,(lambda (_indices) (window-body-width nil 'remap)) t)
+ ("LINES" ,(lambda (_indices) (window-body-height nil 'remap)) t)
;; for eshell-cmd.el
("_" ,(lambda (indices)
@@ -193,7 +185,7 @@ list of the indices that was used in the reference, and whether the
user is requesting the length of the ultimate element. For example, a
reference of `$NAME[10][20]' would result in the function for alias
`NAME' being called (assuming it were aliased to a function), and the
-arguments passed to this function would be the list '(10 20)', and
+arguments passed to this function would be the list `(10 20)', and
nil.
If the value is a string, return the value for the variable with that
@@ -211,14 +203,11 @@ Additionally, each member may specify if it should be copied to the
environment of created subprocesses."
:type '(repeat (list string sexp
(choice (const :tag "Copy to environment" t)
- (const :tag "Use only in Eshell" nil)))))
-
-(put 'eshell-variable-aliases-list 'risky-local-variable t)
+ (const :tag "Use only in Eshell" nil))))
+ :risky t)
-(defvar eshell-var-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c M-v") #'eshell-insert-envvar)
- map))
+(defvar-keymap eshell-var-mode-map
+ "C-c M-v" #'eshell-insert-envvar)
;;; Functions:
@@ -413,27 +402,34 @@ process any indices that come after the variable reference."
(let* ((get-len (when (eq (char-after) ?#)
(forward-char) t))
value indices)
- (setq value (eshell-parse-variable-ref)
+ (setq value (eshell-parse-variable-ref get-len)
indices (and (not (eobp))
(eq (char-after) ?\[)
(eshell-parse-indices))
;; This is an expression that will be evaluated by `eshell-do-eval',
;; which only support let-binding of dynamically-scoped vars
- value `(let ((indices ',indices)) ,value))
- (if get-len
- `(length ,value)
- value)))
-
-(defun eshell-parse-variable-ref ()
+ value `(let ((indices (eshell-eval-indices ',indices))) ,value))
+ (when get-len
+ (setq value `(length ,value)))
+ (when eshell-current-quoted
+ (setq value `(eshell-stringify ,value)))
+ value))
+
+(defun eshell-parse-variable-ref (&optional modifier-p)
"Eval a variable reference.
Returns a Lisp form which, if evaluated, will return the value of the
variable.
-Possible options are:
+If MODIFIER-P is non-nil, the value of the variable will be
+modified by some function. If MODIFIER-P is nil, the value will be
+used as-is; this allows optimization of some kinds of variable
+references.
+
+Possible variable references are:
NAME an environment or Lisp variable value
\"LONG-NAME\" disambiguates the length of the name
- 'LONG-NAME' as above
+ `LONG-NAME' as above
{COMMAND} result of command is variable's value
(LISP-FORM) result of Lisp form is variable's value
<COMMAND> write the output of command to a temporary file;
@@ -443,18 +439,26 @@ Possible options are:
(let ((end (eshell-find-delimiter ?\{ ?\})))
(if (not end)
(throw 'eshell-incomplete ?\{)
+ (forward-char)
(prog1
- `(eshell-convert
- (eshell-command-to-value
- (eshell-as-subcommand
- ,(eshell-parse-command (cons (1+ (point)) end)))))
+ `(eshell-apply-indices
+ (eshell-convert
+ (eshell-command-to-value
+ (eshell-as-subcommand
+ ,(let ((subcmd (or (eshell-unescape-inner-double-quote end)
+ (cons (point) end)))
+ (eshell-current-quoted nil))
+ (eshell-parse-command subcmd))))
+ ;; If this is a simple double-quoted form like
+ ;; "${COMMAND}" (i.e. no indices after the subcommand
+ ;; and no `#' modifier before), ensure we convert to a
+ ;; single string. This avoids unnecessary work
+ ;; (e.g. splitting the output by lines) when it would
+ ;; just be joined back together afterwards.
+ ,(when (and (not modifier-p) eshell-current-quoted)
+ '(not indices)))
+ indices ,eshell-current-quoted)
(goto-char (1+ end))))))
- ((memq (char-after) '(?\' ?\"))
- (let ((name (if (eq (char-after) ?\')
- (eshell-parse-literal-quote)
- (eshell-parse-double-quote))))
- (if name
- `(eshell-get-variable ,(eval name) indices))))
((eq (char-after) ?\<)
(let ((end (eshell-find-delimiter ?\< ?\>)))
(if (not end)
@@ -466,7 +470,9 @@ Possible options are:
`(let ((eshell-current-handles
(eshell-create-handles ,temp 'overwrite)))
(progn
- (eshell-as-subcommand ,(eshell-parse-command cmd))
+ (eshell-as-subcommand
+ ,(let ((eshell-current-quoted nil))
+ (eshell-parse-command cmd)))
(ignore
(nconc eshell-this-command-hook
;; Quote this lambda; it will be evaluated
@@ -475,22 +481,36 @@ Possible options are:
;; properly. See bug#54190.
(list (function (lambda ()
(delete-file ,temp))))))
- (quote ,temp)))
+ (eshell-apply-indices ,temp indices ,eshell-current-quoted)))
(goto-char (1+ end)))))))
((eq (char-after) ?\()
(condition-case nil
- `(eshell-command-to-value
- (eshell-lisp-command
- ',(read (current-buffer))))
+ `(eshell-apply-indices
+ (eshell-command-to-value
+ (eshell-lisp-command
+ ',(read (or (eshell-unescape-inner-double-quote (point-max))
+ (current-buffer)))))
+ indices ,eshell-current-quoted)
(end-of-file
(throw 'eshell-incomplete ?\())))
+ ((looking-at (rx-to-string
+ `(or "'" ,(if eshell-current-quoted "\\\"" "\""))))
+ (eshell-with-temp-command
+ (or (eshell-unescape-inner-double-quote (point-max))
+ (cons (point) (point-max)))
+ (let ((name (if (eq (char-after) ?\')
+ (eshell-parse-literal-quote)
+ (eshell-parse-double-quote))))
+ (when name
+ `(eshell-get-variable ,(eval name) indices ,eshell-current-quoted)))))
((assoc (char-to-string (char-after))
eshell-variable-aliases-list)
(forward-char)
- `(eshell-get-variable ,(char-to-string (char-before)) indices))
+ `(eshell-get-variable ,(char-to-string (char-before)) indices
+ ,eshell-current-quoted))
((looking-at eshell-variable-name-regexp)
(prog1
- `(eshell-get-variable ,(match-string 0) indices)
+ `(eshell-get-variable ,(match-string 0) indices ,eshell-current-quoted)
(goto-char (match-end 0))))
(t
(error "Invalid variable reference"))))
@@ -498,21 +518,33 @@ Possible options are:
(defvar eshell-glob-function)
(defun eshell-parse-indices ()
- "Parse and return a list of list of indices."
+ "Parse and return a list of index-lists.
+
+For example, \"[0 1][2]\" becomes:
+ ((\"0\" \"1\") (\"2\")."
(let (indices)
(while (eq (char-after) ?\[)
(let ((end (eshell-find-delimiter ?\[ ?\])))
(if (not end)
(throw 'eshell-incomplete ?\[)
(forward-char)
- (let (eshell-glob-function)
- (setq indices (cons (eshell-parse-arguments (point) end)
- indices)))
+ (eshell-with-temp-command (or (eshell-unescape-inner-double-quote end)
+ (cons (point) end))
+ (let (eshell-glob-function (eshell-current-quoted nil))
+ (setq indices (cons (eshell-parse-arguments
+ (point-min) (point-max))
+ indices))))
(goto-char (1+ end)))))
(nreverse indices)))
-(defun eshell-get-variable (name &optional indices)
- "Get the value for the variable NAME."
+(defun eshell-eval-indices (indices)
+ "Evaluate INDICES, a list of index-lists generated by `eshell-parse-indices'."
+ (mapcar (lambda (i) (mapcar #'eval i)) indices))
+
+(defun eshell-get-variable (name &optional indices quoted)
+ "Get the value for the variable NAME.
+INDICES is a list of index-lists (see `eshell-parse-indices').
+If QUOTED is non-nil, this was invoked inside double-quotes."
(let* ((alias (assoc name eshell-variable-aliases-list))
(var (if alias
(cadr alias)
@@ -533,9 +565,9 @@ Possible options are:
(symbol-value var))
(t
(error "Unknown variable `%s'" (eshell-stringify var))))
- indices))))
+ indices quoted))))
-(defun eshell-apply-indices (value indices)
+(defun eshell-apply-indices (value indices &optional quoted)
"Apply to VALUE all of the given INDICES, returning the sub-result.
The format of INDICES is:
@@ -544,12 +576,18 @@ The format of INDICES is:
Each member of INDICES represents a level of nesting. If the first
member of a sublist is not an integer or name, and the value it's
-reference is a string, that will be used as the regexp with which is
-to divide the string into sub-parts. The default is whitespace.
+referencing is a string, that will be used as the regexp with which
+is to divide the string into sub-parts. The default is whitespace.
Otherwise, each INT-OR-NAME refers to an element of the list value.
Integers imply a direct index, and names, an associate lookup using
`assoc'.
+If QUOTED is non-nil, this was invoked inside double-quotes.
+This affects the behavior of splitting strings: without quoting,
+the split values are converted to numbers via
+`eshell-convert-to-number' if possible; with quoting, they're
+left as strings.
+
For example, to retrieve the second element of a user's record in
'/etc/passwd', the variable reference would look like:
@@ -557,16 +595,14 @@ For example, to retrieve the second element of a user's record in
(while indices
(let ((refs (car indices)))
(when (stringp value)
- (let (separator)
- (if (not (or (not (stringp (caar indices)))
- (string-match
- (concat "^" eshell-variable-name-regexp "$")
- (caar indices))))
- (setq separator (caar indices)
- refs (cdr refs)))
- (setq value
- (mapcar #'eshell-convert
- (split-string value separator)))))
+ (let (separator (index (caar indices)))
+ (when (and (stringp index)
+ (not (get-text-property 0 'number index)))
+ (setq separator index
+ refs (cdr refs)))
+ (setq value (split-string value separator))
+ (unless quoted
+ (setq value (mapcar #'eshell-convert-to-number value)))))
(cond
((< (length refs) 0)
(error "Invalid array variable index: %s"
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index fbf347e55a7..2c472a2afad 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -260,7 +260,7 @@ information on Eshell, see Info node `(eshell)Top'."
(t
(get-buffer-create eshell-buffer-name)))))
(cl-assert (and buf (buffer-live-p buf)))
- (pop-to-buffer-same-window buf)
+ (pop-to-buffer buf display-comint-buffer-action)
(unless (derived-mode-p 'eshell-mode)
(eshell-mode))
buf))
@@ -332,9 +332,9 @@ With prefix ARG, insert output into the current buffer at point."
;; make the output as attractive as possible, with no
;; extraneous newlines
(when intr
- (if (eshell-interactive-process)
- (eshell-wait-for-process (eshell-interactive-process)))
- (cl-assert (not (eshell-interactive-process)))
+ (if (eshell-interactive-process-p)
+ (eshell-wait-for-process (eshell-tail-process)))
+ (cl-assert (not (eshell-interactive-process-p)))
(goto-char (point-max))
(while (and (bolp) (not (bobp)))
(delete-char -1)))
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index f1d02fe77ea..9e5a08e682f 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -45,6 +45,7 @@
(defmacro defezimage (variable imagespec docstring)
"Define VARIABLE as an image if `defimage' is not available.
IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
+ (declare (indent defun))
`(progn
(defimage ,variable ,imagespec ,docstring)
(put (quote ,variable) 'ezimage t)))
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 6221a0708c5..fd49c81ab3f 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -70,9 +70,28 @@
:foreground :background :stipple :overline :strike-through :box
:font :inherit :fontset :distant-foreground :extend :vector])
+(defun face-remap--copy-face (val)
+ "Return a copy of the `face' property value VAL."
+ ;; A `face' property can be either a face name (a symbol), or a face
+ ;; property list like (:foreground "red" :inherit default),
+ ;; or a list of such things.
+ ;; FIXME: This should probably be shared to some extent with
+ ;; `add-face-text-property'.
+ (if (or (not (listp val)) (keywordp (car val)))
+ val
+ (copy-sequence val)))
+
+(defun face-attrs--make-indirect-safe ()
+ "Deep-copy the buffer's `face-remapping-alist' upon cloning the buffer."
+ (setq-local face-remapping-alist
+ (mapcar #'face-remap--copy-face face-remapping-alist)))
+
+(add-hook 'clone-indirect-buffer-hook #'face-attrs--make-indirect-safe)
+
(defun face-attrs-more-relative-p (attrs1 attrs2)
- "Return true if ATTRS1 contains a greater number of relative
-face-attributes than ATTRS2. A face attribute is considered
+ "Return non-nil if ATTRS1 is \"more relative\" than ATTRS2.
+We define this as meaning that ATTRS1 contains a greater number of
+relative face-attributes than ATTRS2. A face attribute is considered
relative if `face-attribute-relative-p' returns non-nil.
ATTRS1 and ATTRS2 may be any value suitable for a `face' text
@@ -99,7 +118,7 @@ face lists so that more specific faces are located near the end."
"Order ENTRY so that more relative face specs are near the beginning.
The list structure of ENTRY may be destructively modified."
(setq entry (nreverse entry))
- (setcdr entry (sort (cdr entry) 'face-attrs-more-relative-p))
+ (setcdr entry (sort (cdr entry) #'face-attrs-more-relative-p))
(nreverse entry))
;;;###autoload
@@ -188,10 +207,12 @@ If SPECS is empty or a single face `eq' to FACE, call `face-remap-reset-base'
to use the normal definition of FACE as the base remapping; note that
this is different from SPECS containing a single value nil, which means
not to inherit from the global definition of FACE at all."
+ ;; Simplify the specs in the case where it's just a single face (and
+ ;; it's not a list with just a nil).
(while (and (consp specs) (not (null (car specs))) (null (cdr specs)))
(setq specs (car specs)))
(if (or (null specs)
- (and (eq (car specs) face) (null (cdr specs)))) ; default
+ (eq specs face)) ; default
;; Set entry back to default
(face-remap-reset-base face)
;; Set the base remapping
@@ -209,7 +230,8 @@ not to inherit from the global definition of FACE at all."
(defcustom text-scale-mode-step 1.2
"Scale factor used by `text-scale-mode'.
-Each positive or negative step scales the default face height by this amount."
+Each positive or negative step scales the size of the `default'
+face's font by this amount."
:group 'display
:type 'number
:version "23.1")
@@ -314,7 +336,7 @@ the same amount)."
;;;###autoload
(defun text-scale-increase (inc)
- "Increase the height of the default face in the current buffer by INC steps.
+ "Increase the font size of the default face in current buffer by INC steps.
If the new height is other than the default, `text-scale-mode' is enabled.
Each step scales the height of the default face by the variable
@@ -326,14 +348,14 @@ will remove any scaling currently active."
(new-value (if (= inc 0) 0 (+ current-value inc))))
(if (or (> new-value (text-scale-max-amount))
(< new-value (text-scale-min-amount)))
- (user-error "Cannot %s the default face height more than it already is"
+ (user-error "Cannot %s the font size any further"
(if (> inc 0) "increase" "decrease")))
(setq text-scale-mode-amount new-value))
(text-scale-mode (if (zerop text-scale-mode-amount) -1 1)))
;;;###autoload
(defun text-scale-decrease (dec)
- "Decrease the height of the default face in the current buffer by DEC steps.
+ "Decrease the font size of the default face in the current buffer by DEC steps.
See `text-scale-increase' for more details."
(interactive "p")
(text-scale-increase (- dec)))
@@ -344,19 +366,18 @@ See `text-scale-increase' for more details."
;;;###autoload (define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
;;;###autoload
(defun text-scale-adjust (inc)
- "Adjust the height of the default face by INC.
-
+ "Adjust the font size in the current buffer by INC steps.
INC may be passed as a numeric prefix argument.
The actual adjustment made depends on the final component of the
keybinding used to invoke the command, with all modifiers removed:
- +, = Increase the height of the default face by one step
- - Decrease the height of the default face by one step
- 0 Reset the height of the default face to the global default
+ \\`+', \\`=' Increase font size in current buffer by one step
+ \\`-' Decrease font size in current buffer by one step
+ \\`0' Reset the font size to the global default
After adjusting, continue to read input events and further adjust
-the face height as long as the input event read
+the font size as long as the input event read
\(with all modifiers removed) is one of the above characters.
Each step scales the height of the default face by the variable
@@ -368,7 +389,14 @@ This command is a special-purpose wrapper around the
`text-scale-increase' command which makes repetition convenient
even when it is bound in a non-top-level keymap. For binding in
a top-level keymap, `text-scale-increase' or
-`text-scale-decrease' may be more appropriate."
+`text-scale-decrease' may be more appropriate.
+
+Most faces are affected by these font size changes, but not faces
+that have an explicit `:height' setting. The two exceptions to
+this are the `default' and `header-line' faces: they will both be
+scaled even if they have an explicit `:height' setting.
+
+See also the related command `global-text-scale-adjust'."
(interactive "p")
(let ((ev last-command-event)
(echo-keystrokes nil))
@@ -380,15 +408,117 @@ a top-level keymap, `text-scale-increase' or
(?0 0)
(_ inc))))
(text-scale-increase step)
- ;; (unless (zerop step)
- (message "Use +,-,0 for further adjustment")
(set-transient-map
(let ((map (make-sparse-keymap)))
(dolist (mods '(() (control)))
- (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +.
+ (dolist (key '(?+ ?= ?- ?0)) ;; = is often unshifted +.
(define-key map (vector (append mods (list key)))
(lambda () (interactive) (text-scale-adjust (abs inc))))))
- map))))) ;; )
+ map)
+ nil nil
+ "Use %k for further adjustment"))))
+
+(defvar-local text-scale--pinch-start-scale 0
+ "The text scale at the start of a pinch sequence.")
+
+;;;###autoload (define-key global-map [pinch] 'text-scale-pinch)
+;;;###autoload
+(defun text-scale-pinch (event)
+ "Adjust the height of the default face by the scale in the pinch event EVENT."
+ (interactive "e")
+ (when (not (eq (event-basic-type event) 'pinch))
+ (error "`text-scale-pinch' bound to bad event type"))
+ (let ((window (posn-window (nth 1 event)))
+ (scale (nth 4 event))
+ (dx (nth 2 event))
+ (dy (nth 3 event))
+ (angle (nth 5 event)))
+ (with-selected-window window
+ (when (and (zerop dx)
+ (zerop dy)
+ (zerop angle))
+ (setq text-scale--pinch-start-scale
+ (if text-scale-mode text-scale-mode-amount 0)))
+ (text-scale-set
+ (+ text-scale--pinch-start-scale
+ (round (log scale text-scale-mode-step)))))))
+
+(defcustom global-text-scale-adjust-resizes-frames nil
+ "Whether `global-text-scale-adjust' resizes the frames."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t))
+ :group 'display
+ :version "29.1")
+
+(defcustom global-text-scale-adjust-limits '(10 . 500)
+ "Min/max values for `global-text-scale-adjust'.
+This is a cons cell where the `car' has the minimum font size and
+the `cdr' has the maximum font size, in units of 1/10 pt."
+ :version "29.1"
+ :group 'display
+ :type '(cons (integer :tag "Min")
+ (integer :tag "Max")))
+
+(defvar global-text-scale-adjust--default-height nil)
+
+;;;###autoload (define-key ctl-x-map [(control meta ?+)] 'global-text-scale-adjust)
+;;;###autoload (define-key ctl-x-map [(control meta ?=)] 'global-text-scale-adjust)
+;;;###autoload (define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust)
+;;;###autoload (define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust)
+;;;###autoload
+(defun global-text-scale-adjust (increment)
+ "Globally adjust the font size by INCREMENT.
+
+Interactively, INCREMENT may be passed as a numeric prefix argument.
+
+The adjustment made depends on the final component of the key binding
+used to invoke the command, with all modifiers removed:
+
+ \\`+', \\`=' Globally increase the height of the default face
+ \\`-' Globally decrease the height of the default face
+ \\`0' Globally reset the height of the default face
+
+After adjusting, further adjust the font size as long as the key,
+with all modifiers removed, is one of the above characters.
+
+Buffer-local face adjustements have higher priority than global
+face adjustments.
+
+The variable `global-text-scale-adjust-resizes-frames' controls
+whether the frames are resized to keep the same number of lines
+and characters per line when the font size is adjusted.
+
+See also the related command `text-scale-adjust'."
+ (interactive "p")
+ (when (display-graphic-p)
+ (unless global-text-scale-adjust--default-height
+ (setq global-text-scale-adjust--default-height
+ (face-attribute 'default :height)))
+ (let* ((key (event-basic-type last-command-event))
+ (echo-keystrokes nil)
+ (cur (face-attribute 'default :height))
+ (inc
+ (pcase key
+ (?- (* (- increment) 5))
+ (?0 (- global-text-scale-adjust--default-height cur))
+ (_ (* increment 5))))
+ (new (+ cur inc)))
+ (when (< (car global-text-scale-adjust-limits)
+ new
+ (cdr global-text-scale-adjust-limits))
+ (let ((frame-inhibit-implied-resize
+ (not global-text-scale-adjust-resizes-frames)))
+ (set-face-attribute 'default nil :height new)))
+ (when (characterp key)
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (mod '(() (control meta)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (define-key map (vector (append mod (list key)))
+ 'global-text-scale-adjust)))
+ map)
+ nil nil
+ "Use %k for further adjustment")))))
;; ----------------------------------------------------------------
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 196bb9e4cd4..b3e01696325 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -551,8 +551,8 @@ If the optional argument CALLBACK is non-nil, it should be a
function to call each time the user types RET or clicks on a
color. The function should accept a single argument, the color name."
(interactive)
- (when (and (null list) (> (display-color-cells) 0))
- (setq list (list-colors-duplicates (defined-colors)))
+ (when (> (display-color-cells) 0)
+ (setq list (list-colors-duplicates (or list (defined-colors))))
(when list-colors-sort
;; Schwartzian transform with `(color key1 key2 key3 ...)'.
(setq list (mapcar
diff --git a/lisp/faces.el b/lisp/faces.el
index e93d8c7af85..d104fdbc2fc 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -46,7 +46,8 @@ the terminal-initialization file to be loaded."
("vt320" . "vt200")
("vt400" . "vt200")
("vt420" . "vt200")
- ("alacritty" . "xterm"))
+ ("alacritty" . "xterm")
+ ("foot" . "xterm"))
"Alist of terminal type aliases.
Entries are of the form (TYPE . ALIAS), where both elements are strings.
This means to treat a terminal of type TYPE as if it were of type ALIAS."
@@ -88,9 +89,9 @@ a font height that isn't optimal."
:tag "Font selection order"
:type '(list symbol symbol symbol symbol)
:group 'font-selection
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (internal-set-font-selection-order value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-font-selection-order value)))
;; In the absence of Fontconfig support, Monospace and Sans Serif are
@@ -140,9 +141,9 @@ ALTERNATIVE2 etc."
:tag "Alternative font families to try"
:type '(repeat (repeat string))
:group 'font-selection
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (internal-set-alternative-font-family-alist value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-alternative-font-family-alist value)))
;; This is defined originally in xfaces.c.
@@ -167,9 +168,9 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
:type '(repeat (repeat string))
:version "21.1"
:group 'font-selection
- :set #'(lambda (symbol value)
- (set-default symbol value)
- (internal-set-alternative-font-registry-alist value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-alternative-font-registry-alist value)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -701,25 +702,30 @@ and `?' are allowed.
VALUE specifies the relative proportionate width of the font to use.
It must be one of the symbols `ultra-condensed', `extra-condensed',
-`condensed', `semi-condensed', `normal', `semi-expanded', `expanded',
-`extra-expanded', or `ultra-expanded'.
+`condensed' (a.k.a. `compressed', a.k.a. `narrow'),
+`semi-condensed' (a.k.a. `demi-condensed'), `normal' (a.k.a. `medium',
+a.k.a. `regular'), `semi-expanded' (a.k.a. `demi-expanded'),
+`expanded', `extra-expanded', or `ultra-expanded' (a.k.a. `wide').
`:height'
-VALUE specifies the relative or absolute height of the font. An
-absolute height is an integer, and specifies font height in units
-of 1/10 pt. A relative height is either a floating point number,
-which specifies a scaling factor for the underlying face height;
-or a function that takes a single argument (the underlying face
-height) and returns the new height. Note that for the `default'
-face, you must specify an absolute height (since there is nothing
-for it to be relative to).
+VALUE specifies the relative or absolute font size (height of the
+font). An absolute height is an integer, and specifies font height in
+units of 1/10 pt. A relative height is either a floating point
+number, which specifies a scaling factor for the underlying face
+height; or a function that takes a single argument (the underlying
+face height) and returns the new height. Note that for the `default'
+face, you must specify an absolute height (since there is nothing for
+it to be relative to).
`:weight'
-VALUE specifies the weight of the font to use. It must be one of the
-symbols `ultra-bold', `extra-bold', `bold', `semi-bold', `normal',
-`semi-light', `light', `extra-light', `ultra-light'.
+VALUE specifies the weight of the font to use. It must be one of
+the symbols `ultra-heavy', `heavy' (a.k.a. `black'),
+`ultra-bold' (a.k.a. `extra-bold'), `bold',
+`semi-bold' (a.k.a. `demi-bold'), `medium', `normal' (a.k.a. `regular',
+a.k.a. `book'), `semi-light' (a.k.a. `demi-light'),
+`light', `extra-light' (a.k.a. `ultra-light'), or `thin'.
`:slant'
@@ -876,8 +882,8 @@ is specified, `:italic' is ignored."
(defun make-face-bold (face &optional frame _noerror)
"Make the font of FACE be bold, if possible.
FRAME nil or not specified means change face on all frames.
-Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font weight."
+ (declare (advertised-calling-convention (face &optional frame) "29.1"))
(interactive (list (read-face-name "Make which face bold"
(face-at-point t))))
(set-face-attribute face frame :weight 'bold))
@@ -885,8 +891,8 @@ Use `set-face-attribute' for finer control of the font weight."
(defun make-face-unbold (face &optional frame _noerror)
"Make the font of FACE be non-bold, if possible.
-FRAME nil or not specified means change face on all frames.
-Argument NOERROR is ignored and retained for compatibility."
+FRAME nil or not specified means change face on all frames."
+ (declare (advertised-calling-convention (face &optional frame) "29.1"))
(interactive (list (read-face-name "Make which face non-bold"
(face-at-point t))))
(set-face-attribute face frame :weight 'normal))
@@ -895,8 +901,8 @@ Argument NOERROR is ignored and retained for compatibility."
(defun make-face-italic (face &optional frame _noerror)
"Make the font of FACE be italic, if possible.
FRAME nil or not specified means change face on all frames.
-Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font slant."
+ (declare (advertised-calling-convention (face &optional frame) "29.1"))
(interactive (list (read-face-name "Make which face italic"
(face-at-point t))))
(set-face-attribute face frame :slant 'italic))
@@ -904,8 +910,8 @@ Use `set-face-attribute' for finer control of the font slant."
(defun make-face-unitalic (face &optional frame _noerror)
"Make the font of FACE be non-italic, if possible.
-FRAME nil or not specified means change face on all frames.
-Argument NOERROR is ignored and retained for compatibility."
+FRAME nil or not specified means change face on all frames."
+ (declare (advertised-calling-convention (face &optional frame) "29.1"))
(interactive (list (read-face-name "Make which face non-italic"
(face-at-point t))))
(set-face-attribute face frame :slant 'normal))
@@ -914,8 +920,8 @@ Argument NOERROR is ignored and retained for compatibility."
(defun make-face-bold-italic (face &optional frame _noerror)
"Make the font of FACE be bold and italic, if possible.
FRAME nil or not specified means change face on all frames.
-Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of font weight and slant."
+ (declare (advertised-calling-convention (face &optional frame) "29.1"))
(interactive (list (read-face-name "Make which face bold-italic"
(face-at-point t))))
(set-face-attribute face frame :weight 'bold :slant 'italic))
@@ -1075,6 +1081,9 @@ of the default face. Value is FACE."
(defvar crm-separator) ; from crm.el
+(defconst read-face-name-sample-text "SAMPLE"
+ "Text string to display as the sample text for `read-face-name'.")
+
(defun read-face-name (prompt &optional default multiple)
"Read one or more face names, prompting with PROMPT.
PROMPT should not end in a space or a colon.
@@ -1091,54 +1100,72 @@ That is, if DEFAULT is a list and MULTIPLE is nil, the first
element of DEFAULT is returned. If DEFAULT isn't a list, but
MULTIPLE is non-nil, a one-element list containing DEFAULT is
returned. Otherwise, DEFAULT is returned verbatim."
- (unless (listp default)
- (setq default (list default)))
- (when default
- (setq default
- (if multiple
- (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
- default ", ")
- ;; If we only want one, and the default is more than one,
- ;; discard the unwanted ones.
- (setq default (car default))
- (if (symbolp default)
- (symbol-name default)
- default))))
- (when (and default (not multiple))
- (require 'crm)
- ;; For compatibility with `completing-read-multiple' use `crm-separator'
- ;; to define DEFAULT if MULTIPLE is nil.
- (setq default (car (split-string default crm-separator t))))
-
- ;; Older versions of `read-face-name' did not append ": " to the
- ;; prompt, so there are third party libraries that have that in the
- ;; prompt. If so, remove it.
- (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt))
- (let ((prompt (if default
- (format-message "%s (default `%s'): " prompt default)
- (format "%s: " prompt)))
- aliasfaces nonaliasfaces faces)
- ;; Build up the completion tables.
- (mapatoms (lambda (s)
- (if (facep s)
- (if (get s 'face-alias)
- (push (symbol-name s) aliasfaces)
- (push (symbol-name s) nonaliasfaces)))))
- (if multiple
- (progn
- (dolist (face (completing-read-multiple
- prompt
- (completion-table-in-turn nonaliasfaces aliasfaces)
- nil t nil 'face-name-history default))
- ;; Ignore elements that are not faces
- ;; (for example, because DEFAULT was "all faces")
- (if (facep face) (push (intern face) faces)))
- (nreverse faces))
- (let ((face (completing-read
- prompt
- (completion-table-in-turn nonaliasfaces aliasfaces)
- nil t nil 'face-name-history default)))
- (if (facep face) (intern face))))))
+ (let (defaults)
+ (unless (listp default)
+ (setq default (list default)))
+ (when default
+ (setq default
+ (if multiple
+ (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
+ default ", ")
+ ;; If we only want one, and the default is more than one,
+ ;; discard the unwanted ones and use them only in the
+ ;; "future history" retrieved via `M-n M-n ...'.
+ (setq defaults default default (car default))
+ (if (symbolp default)
+ (symbol-name default)
+ default))))
+ (when (and default (not multiple))
+ (require 'crm)
+ ;; For compatibility with `completing-read-multiple' use `crm-separator'
+ ;; to define DEFAULT if MULTIPLE is nil.
+ (setq default (car (split-string default crm-separator t))))
+
+ ;; Older versions of `read-face-name' did not append ": " to the
+ ;; prompt, so there are third party libraries that have that in the
+ ;; prompt. If so, remove it.
+ (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt))
+ (let ((prompt (if default
+ (format-prompt prompt default)
+ (format "%s: " prompt)))
+ (completion-extra-properties
+ '(:affixation-function
+ (lambda (faces)
+ (mapcar
+ (lambda (face)
+ (list face
+ (concat (propertize read-face-name-sample-text
+ 'face face)
+ "\t")
+ ""))
+ faces))))
+ aliasfaces nonaliasfaces faces)
+ ;; Build up the completion tables.
+ (mapatoms (lambda (s)
+ (if (facep s)
+ (if (get s 'face-alias)
+ (push (symbol-name s) aliasfaces)
+ (push (symbol-name s) nonaliasfaces)))))
+ (if multiple
+ (progn
+ (dolist (face (completing-read-multiple
+ prompt
+ (completion-table-in-turn nonaliasfaces aliasfaces)
+ nil t nil 'face-name-history default))
+ ;; Ignore elements that are not faces
+ ;; (for example, because DEFAULT was "all faces")
+ (if (facep face) (push (if (stringp face)
+ (intern face)
+ face)
+ faces)))
+ (nreverse faces))
+ (let ((face (completing-read
+ prompt
+ (completion-table-in-turn nonaliasfaces aliasfaces)
+ nil t nil 'face-name-history defaults)))
+ (when (facep face) (if (stringp face)
+ (intern face)
+ face)))))))
;; Not defined without X, but behind window-system test.
(defvar x-bitmap-file-path)
@@ -1161,42 +1188,43 @@ an integer value."
(:foundry
(list nil))
(:width
- (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-width-table))
(:weight
- (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-weight-table))
(:slant
- (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-slant-table))
((or :inverse-video :extend)
- (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (mapcar (lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute)))
((or :underline :overline :strike-through :box)
(if (window-system frame)
- (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (nconc (mapcar (lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
- (mapcar #'(lambda (c) (cons c c))
+ (mapcar (lambda (c) (cons c c))
(defined-colors frame)))
- (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (mapcar (lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
((or :foreground :background)
- (mapcar #'(lambda (c) (cons c c))
+ (mapcar (lambda (c) (cons c c))
(defined-colors frame)))
(:height
'integerp)
(:stipple
- (and (memq (window-system frame) '(x ns)) ; No stipple on w32
- (mapcar #'list
+ (and (memq (window-system frame) '(x ns pgtk haiku)) ; No stipple on w32
+ (mapcar (lambda (item)
+ (cons item item))
(apply #'nconc
(mapcar (lambda (dir)
(and (file-readable-p dir)
(file-directory-p dir)
- (directory-files dir)))
+ (directory-files dir 'full)))
x-bitmap-file-path)))))
(:inherit
(cons '("none" . nil)
- (mapcar #'(lambda (c) (cons (symbol-name c) c))
+ (mapcar (lambda (c) (cons (symbol-name c) c))
(face-list))))
(_
(error "Internal error")))))
@@ -1530,7 +1558,7 @@ If FRAME is nil, the current FRAME is used."
match (cond ((eq req 'type)
(or (memq (window-system frame) options)
(and (memq 'graphic options)
- (memq (window-system frame) '(x w32 ns)))
+ (memq (window-system frame) '(x w32 ns pgtk)))
;; FIXME: This should be revisited to use
;; display-graphic-p, provided that the
;; color selection depends on the number
@@ -1732,7 +1760,15 @@ The following sources are applied in this order:
(and tail (face-spec-set-2 face frame
(list :extend (cadr tail))))))
(setq face-attrs (face-spec-choose (get face 'face-override-spec) frame))
- (face-spec-set-2 face frame face-attrs)))
+ (face-spec-set-2 face frame face-attrs)
+ (when (and (fboundp 'set-frame-parameter) ; This isn't available
+ ; during loadup.
+ (eq face 'scroll-bar))
+ ;; Set the `scroll-bar-foreground' and `scroll-bar-background'
+ ;; frame parameters, because the face is handled by setting
+ ;; those two parameters. (bug#13476)
+ (set-frame-parameter frame 'scroll-bar-foreground (face-foreground face))
+ (set-frame-parameter frame 'scroll-bar-background (face-background face)))))
(defun face-spec-set-2 (face frame face-attrs)
"Set the face attributes of FACE on FRAME according to FACE-ATTRS.
@@ -1838,8 +1874,8 @@ on which one provides better contrast with COLOR."
"#ffffff" "black"))
(defconst color-luminance-dark-limit 0.325
- "The relative luminance below which a color is considered 'dark'.
-A 'dark' color in this sense provides better contrast with white
+ "The relative luminance below which a color is considered \"dark\".
+A \"dark\" color in this sense provides better contrast with white
than with black; see `color-dark-p'.
This value was determined experimentally.")
@@ -2306,19 +2342,19 @@ If you set `term-file-prefix' to nil, this function does nothing."
(let* (term-init-func)
;; First, load the terminal initialization file, if it is
;; available and it hasn't been loaded already.
- (tty-find-type #'(lambda (type)
- (let ((file (locate-library (concat term-file-prefix type))))
- (and file
- (or (assoc file load-history)
- (load (replace-regexp-in-string
- "\\.el\\(\\.gz\\)?\\'" ""
- file)
- t t)))))
- type)
+ (tty-find-type (lambda (type)
+ (let ((file (locate-library (concat term-file-prefix type))))
+ (and file
+ (or (assoc file load-history)
+ (load (replace-regexp-in-string
+ "\\.el\\(\\.gz\\)?\\'" ""
+ file)
+ t t)))))
+ type)
;; Next, try to find a matching initialization function, and call it.
- (tty-find-type #'(lambda (type)
- (fboundp (setq term-init-func
- (intern (concat "terminal-init-" type)))))
+ (tty-find-type (lambda (type)
+ (fboundp (setq term-init-func
+ (intern (concat "terminal-init-" type)))))
type)
(when (fboundp term-init-func)
(funcall term-init-func))
@@ -2401,6 +2437,15 @@ If you set `term-file-prefix' to nil, this function does nothing."
"The basic variable-pitch face."
:group 'basic-faces)
+(defface variable-pitch-text
+ '((t :inherit variable-pitch
+ :height 1.1))
+ "The proportional face used for longer texts.
+This is like the `variable-pitch' face, but is slightly bigger by
+default."
+ :version "29.1"
+ :group 'basic-faces)
+
(defface shadow
'((((class color grayscale) (min-colors 88) (background light))
:foreground "grey50")
@@ -2634,11 +2679,21 @@ non-nil."
:background "grey75" :foreground "black")
(t
:inverse-video t))
- "Basic mode line face for selected window."
+ "Face for the mode lines as well as header lines.
+See `mode-line-active' and `mode-line-inactive' for the faces
+used on mode lines."
:version "21.1"
:group 'mode-line-faces
:group 'basic-faces)
+(defface mode-line-active
+ '((t :inherit mode-line))
+ "Face for the selected mode line.
+This inherits from the `mode-line' face."
+ :version "29.1"
+ :group 'mode-line-faces
+ :group 'basic-faces)
+
(defface mode-line-inactive
'((default
:inherit mode-line)
@@ -2803,11 +2858,9 @@ used to display the prompt text."
:group 'frames
:group 'basic-faces)
-(defface scroll-bar
- '((((background light)) :foreground "black")
- (((background dark)) :foreground "white"))
+(defface scroll-bar '((t nil))
"Basic face for the scroll bar colors under X."
- :version "28.1"
+ :version "21.1"
:group 'frames
:group 'basic-faces)
@@ -2842,7 +2895,10 @@ Note: Other faces cannot inherit from the cursor face."
'((default
:box (:line-width 1 :style released-button)
:foreground "black")
- (((type x w32 ns) (class color))
+ (((type haiku))
+ :foreground "B_MENU_ITEM_TEXT_COLOR"
+ :background "B_MENU_BACKGROUND_COLOR")
+ (((type x w32 ns pgtk) (class color))
:background "grey75")
(((type x) (class mono))
:background "grey"))
@@ -2898,14 +2954,22 @@ Note: Other faces cannot inherit from the cursor face."
:background "grey96" :foreground "DarkBlue"
;; We use negative thickness of the horizontal box border line to
;; avoid enlarging the height of the echo-area display, which
- ;; would then move the mode line a few pixels up.
- :box (:line-width (1 . -1) :color "grey80"))
+ ;; would then move the mode line a few pixels up. We use
+ ;; negative thickness for the vertical border line to avoid
+ ;; making the characters wider, which then would cause unpleasant
+ ;; horizontal shifts of the cursor during C-n/C-p movement
+ ;; through a line with this face.
+ :box (:line-width (-1 . -1) :color "grey80")
+ :inherit fixed-pitch)
(((class color) (min-colors 88) (background dark))
:background "grey19" :foreground "LightBlue"
- :box (:line-width (1 . -1) :color "grey35"))
- (((class color grayscale) (background light)) :background "grey90")
- (((class color grayscale) (background dark)) :background "grey25")
- (t :background "grey90"))
+ :box (:line-width (-1 . -1) :color "grey35")
+ :inherit fixed-pitch)
+ (((class color grayscale) (background light)) :background "grey90"
+ :inherit fixed-pitch)
+ (((class color grayscale) (background dark)) :background "grey25"
+ :inherit fixed-pitch)
+ (t :background "grey90" :inherit fixed-pitch))
"Face for keybindings in *Help* buffers.
This face is added by `substitute-command-keys', which see.
@@ -2957,7 +3021,7 @@ It is used for characters of no fonts too."
:group 'basic-faces)
(defface read-multiple-choice-face
- '((t (:inherit underline
+ '((t (:inherit (help-key-binding underline)
:weight bold)))
"Face for the symbol name in `read-multiple-choice' output."
:group 'basic-faces
diff --git a/lisp/ffap.el b/lisp/ffap.el
index d7544bb5a49..9de0dd40d16 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1,6 +1,6 @@
;;; ffap.el --- find file (or url) at point -*- lexical-binding: t -*-
-;; Copyright (C) 1995-1997, 2000-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2022 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -68,8 +68,8 @@
;; If you do not like these bindings, modify the variable
;; `ffap-bindings', or write your own.
;;
-;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
-;; to load or autoload them before ffap. If you use ff-paths, load it
+;; If you use ange-ftp, browse-url, complete, efs, it is best to load
+;; or autoload them before ffap. If you use ff-paths, load it
;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many
;; option variables. In particular, if ffap is slow, try these:
;;
@@ -79,7 +79,7 @@
;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping
;; (setq ffap-gopher-regexp nil) ; disable gopher bookmark matching
;;
-;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
+;; ffap uses `browse-url' to fetch URLs.
;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
;; the file and URL references within a buffer.
@@ -97,7 +97,6 @@
;; * break long menus into multiple panes (like imenu?)
;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
;; * notice "machine.dom blah blah blah dir/file" (how?)
-;; * as w3 becomes standard, rewrite to rely more on its functions
;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
;; * handle "$(VAR)" in Makefiles
@@ -282,7 +281,7 @@ For a fancy alternative, get `ffap-url.el'."
:risky t)
(defcustom ffap-next-regexp
- ;; If you want ffap-next to find URL's only, try this:
+ ;; If you want ffap-next to find URLs only, try this:
;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
;; (concat "\\<" (substring ffap-url-regexp 2))))
;;
@@ -315,7 +314,7 @@ disable ffap most of the time."
;;; Find Next Thing in buffer (`ffap-next'):
;;
-;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
+;; Original ffap-next-url (URLs only) from RPECK 30 Mar 1995. Since
;; then, broke it up into ffap-next-guess (noninteractive) and
;; ffap-next (a command). It now work on files as well as url's.
@@ -363,7 +362,7 @@ Actual search is done by the function `ffap-next-guess'."
(sit-for 0) ; display point movement
(find-file-at-point (ffap-prompter guess)))
(goto-char pt) ; restore point
- (message "No %sfiles or URL's found"
+ (message "No %sfiles or URLs found"
(if wrap "" "more ")))))
(defun ffap-next-url (&optional back wrap)
@@ -377,6 +376,12 @@ Actual search is done by the function `ffap-next-guess'."
;;; Machines (`ffap-machine-p'):
+(defun ffap-accept-or-reject-p (symbol)
+ "Return non-nil if SYMBOL is `accept' or `reject'.
+Otherwise, return nil. This is intended for use as the
+predicate in the `:safe' property of user options."
+ (memq symbol '(accept reject)))
+
;; I cannot decide a "best" strategy here, so these are variables. In
;; particular, if `Pinging...' is broken or takes too long on your
;; machine, try setting these all to accept or reject.
@@ -385,16 +390,21 @@ Actual search is done by the function `ffap-next-guess'."
Value should be a symbol, one of `ping', `accept', and `reject'."
:type '(choice (const ping)
(const accept)
- (const reject))
+ (const reject))
+ :safe #'ffap-accept-or-reject-p
:group 'ffap)
-(defcustom ffap-machine-p-known 'ping ; `accept' for higher speed
+
+(defcustom ffap-machine-p-known 'accept
"What `ffap-machine-p' does with hostnames that have a known domain.
Value should be a symbol, one of `ping', `accept', and `reject'.
See `mail-extr.el' for the known domains."
:type '(choice (const ping)
(const accept)
- (const reject))
- :group 'ffap)
+ (const reject))
+ :safe #'ffap-accept-or-reject-p
+ :group 'ffap
+ :version "29.1")
+
(defcustom ffap-machine-p-unknown 'reject
"What `ffap-machine-p' does with hostnames that have an unknown domain.
Value should be a symbol, one of `ping', `accept', and `reject'.
@@ -402,6 +412,7 @@ See `mail-extr.el' for the known domains."
:type '(choice (const ping)
(const accept)
(const reject))
+ :safe #'ffap-accept-or-reject-p
:group 'ffap)
(defun ffap-what-domain (domain)
@@ -544,6 +555,7 @@ The optional NOMODIFY argument suppresses the extra search."
(string-match ffap-rfs-regexp filename)
filename)))
+;;;###autoload
(defun ffap-machine-at-point ()
"Return machine name at point if it exists, or nil."
(let ((mach (ffap-string-at-point 'machine)))
@@ -651,7 +663,7 @@ also is substituted for the first empty-string component, if there is one.
Uses `path-separator' to separate the path into substrings."
;; We cannot use parse-colon-path (files.el), since it kills
;; "//" entries using file-name-as-directory.
- ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
+ ;; Similar: TeX-split-string, and RHOGEE's psg-list-env
;; in ff-paths and bib-cite. The EMPTY arg may help mimic kpathsea.
(if (or empty (getenv env)) ; should return something
(let ((start 0) match dir ret)
@@ -1229,13 +1241,13 @@ If the region is active, return a string from the region.
If the point is in a comment, ensure that the returned string does not
contain the comment start characters (especially for major modes that
-have '//' as comment start characters).
+have \"//\" as comment start characters).
Set the variables `ffap-string-at-point' and
`ffap-string-at-point-region'.
When the region is active and larger than `ffap-max-region-length',
-return an empty string, and set `ffap-string-at-point-region' to '(1 1)."
+return an empty string, and set `ffap-string-at-point-region' to `(1 1)'."
(let* (dir-separator
(args
(cdr
@@ -1326,29 +1338,25 @@ Assumes the buffer has not changed."
;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
(message "Copied to kill ring: %s" str))))
-;; External.
-(declare-function w3-view-this-url "ext:w3" (&optional no-show))
-
+;;;###autoload
(defun ffap-url-at-point ()
"Return URL from around point if it exists, or nil.
Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any."
(when ffap-url-regexp
- (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button?
- (w3-view-this-url t))
- (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp)
- (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix)
- val)
- (setq val (thing-at-point-url-at-point ffap-lax-url
- (if (use-region-p)
- (cons (region-beginning)
- (region-end)))))
- (if val
- (let ((bounds (thing-at-point-bounds-of-url-at-point
- ffap-lax-url)))
- (setq ffap-string-at-point-region
- (list (car bounds) (cdr bounds)))))
- val))))
+ (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp)
+ (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix)
+ val)
+ (setq val (thing-at-point-url-at-point ffap-lax-url
+ (if (use-region-p)
+ (cons (region-beginning)
+ (region-end)))))
+ (if val
+ (let ((bounds (thing-at-point-bounds-of-url-at-point
+ ffap-lax-url)))
+ (setq ffap-string-at-point-region
+ (list (car bounds) (cdr bounds)))))
+ val)))
(defvar ffap-gopher-regexp
"\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *"
@@ -1449,10 +1457,13 @@ which may actually result in an URL rather than a filename."
(ffap-file-exists-string (substring name 0 (match-beginning 0)))))
;; If it contains a colon, get rid of it (and return if exists)
((and (string-match path-separator name)
- (setq name (ffap-string-at-point 'nocolon))
- (> (length name) 0)
- (ffap-file-exists-string name)))
- ;; File does not exist, try the alist:
+ (let ((this-name (ffap-string-at-point 'nocolon)))
+ ;; But don't interpret the first part if ":/bin" as
+ ;; the empty string.
+ (when (> (length this-name) 0)
+ (setq name this-name)
+ (ffap-file-exists-string name)))))
+ ;; File does not exist, try the alist:
((let ((alist ffap-alist) tem try case-fold-search)
(while (and alist (not try))
(setq tem (car alist) alist (cdr alist))
@@ -1486,12 +1497,7 @@ which may actually result in an URL rather than a filename."
((and (eq major-mode 'internal-ange-ftp-mode)
(string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$"
(buffer-name)))
- (concat "/" (substring (buffer-name) 5 -1) ":"))
- ;; This is too often a bad idea:
- ;;((and (eq major-mode 'w3-mode)
- ;; (stringp url-current-server))
- ;; (host-to-ange-path url-current-server))
- )))
+ (concat "/" (substring (buffer-name) 5 -1) ":")))))
(and remote-dir
(or
(and (string-match "\\`\\(/?~?ftp\\)/" name)
@@ -1865,7 +1871,7 @@ Return value:
;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands:
;; There could be a real `ffap-noselect' function, but we would need
-;; at least two new user variables, and there is no w3-fetch-noselect.
+;; at least two new user variables.
;; So instead, we just fake it with a slow save-window-excursion.
(defun ffap-other-window (filename)
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index befd2ae437e..94e07289e32 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -480,6 +480,14 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
;; Modify `file-notify-descriptors' and send a `stopped' event.
(file-notify--rm-descriptor descriptor))))
+(defun file-notify-rm-all-watches ()
+ "Remove all existing file notification watches from Emacs."
+ (interactive)
+ (maphash
+ (lambda (key _value)
+ (file-notify-rm-watch key))
+ file-notify-descriptors))
+
(defun file-notify-valid-p (descriptor)
"Check a watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
diff --git a/lisp/files-x.el b/lisp/files-x.el
index e86ba8f8d04..da1e44e2504 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -81,8 +81,7 @@ Intended to be used in the `interactive' spec of
(let ((default (format "%S"
(cond ((eq variable 'unibyte) t)
((boundp variable)
- (symbol-value variable)))))
- (minibuffer-completing-symbol t))
+ (symbol-value variable))))))
(read-from-minibuffer (format "Add %s with value: " variable)
nil read-expression-map t
'set-variable-value-history
@@ -502,24 +501,26 @@ from the MODE alist ignoring the input argument VALUE."
((and (symbolp (car b)) (stringp (car a))) nil)
(t (string< (car a) (car b)))))))
(current-buffer))
+ (when (eobp) (insert "\n"))
(goto-char (point-min))
(indent-sexp))))
(defun dir-locals-to-string (variables)
"Output alists of VARIABLES to string in dotted pair notation syntax."
- (format "(%s)" (mapconcat
- (lambda (mode-variables)
- (format "(%S . %s)"
- (car mode-variables)
- (format "(%s)" (mapconcat
- (lambda (variable-value)
- (format "(%S . %s)"
- (car variable-value)
- (string-trim-right
- (pp-to-string
- (cdr variable-value)))))
- (cdr mode-variables) "\n"))))
- variables "\n")))
+ (format "(%s)"
+ (mapconcat
+ (lambda (mode-variables)
+ (format "(%S . %s)"
+ (car mode-variables)
+ (format "(%s)" (mapconcat
+ (lambda (variable-value)
+ (format "(%S . %s)"
+ (car variable-value)
+ (string-trim-right
+ (pp-to-string
+ (cdr variable-value)))))
+ (cdr mode-variables) "\n"))))
+ variables "\n")))
;;;###autoload
(defun add-dir-local-variable (mode variable value)
@@ -579,15 +580,22 @@ changed by the user.")
(setq ignored-local-variables
(cons 'connection-local-variables-alist ignored-local-variables))
-(defvar connection-local-profile-alist nil
+(defcustom connection-local-profile-alist nil
"Alist mapping connection profiles to variable lists.
Each element in this list has the form (PROFILE VARIABLES).
PROFILE is the name of a connection profile (a symbol).
VARIABLES is a list that declares connection-local variables for
PROFILE. An element in VARIABLES is an alist whose elements are
-of the form (VAR . VALUE).")
-
-(defvar connection-local-criteria-alist nil
+of the form (VAR . VALUE)."
+ :type '(repeat (cons (symbol :tag "Profile")
+ (repeat :tag "Variables"
+ (cons (symbol :tag "Variable")
+ (sexp :tag "Value")))))
+ :group 'files
+ :group 'tramp
+ :version "29.1")
+
+(defcustom connection-local-criteria-alist nil
"Alist mapping connection criteria to connection profiles.
Each element in this list has the form (CRITERIA PROFILES).
CRITERIA is a plist identifying a connection and the application
@@ -596,7 +604,19 @@ using this connection. Property names might be `:application',
`:application' is a symbol, all other property values are
strings. All properties are optional; if CRITERIA is nil, it
always applies.
-PROFILES is a list of connection profiles (symbols).")
+PROFILES is a list of connection profiles (symbols)."
+ :type '(repeat (cons (plist :tag "Criteria"
+ ;; Give the most common options as checkboxes.
+ :options (((const :format "%v " :application)
+ symbol)
+ ((const :format "%v " :protocol) string)
+ ((const :format "%v " :user) string)
+ ((const :format "%v " :machine) string)))
+ (repeat :tag "Profiles"
+ (symbol :tag "Profile"))))
+ :group 'files
+ :group 'tramp
+ :version "29.1")
(defsubst connection-local-normalize-criteria (criteria)
"Normalize plist CRITERIA according to properties.
@@ -649,7 +669,9 @@ variables for a connection profile are defined using
(setcdr slot (delete-dups (append (cdr slot) profiles)))
(setq connection-local-criteria-alist
(cons (cons criteria (delete-dups profiles))
- connection-local-criteria-alist)))))
+ connection-local-criteria-alist))))
+ (customize-set-variable
+ 'connection-local-criteria-alist connection-local-criteria-alist))
(defsubst connection-local-get-profile-variables (profile)
"Return the connection-local variable list for PROFILE."
@@ -668,7 +690,9 @@ connection profile using `connection-local-set-profiles'. Then
variables are set in the server's process buffer according to the
VARIABLES list of the connection profile. The list is processed
in order."
- (setf (alist-get profile connection-local-profile-alist) variables))
+ (setf (alist-get profile connection-local-profile-alist) variables)
+ (customize-set-variable
+ 'connection-local-profile-alist connection-local-profile-alist))
(defun hack-connection-local-variables (criteria)
"Read connection-local variables according to CRITERIA.
@@ -699,36 +723,46 @@ will not be changed."
(copy-tree connection-local-variables-alist)))
(hack-local-variables-apply)))
+(defvar connection-local-default-application 'tramp
+ "Default application in connection-local functions, a symbol.
+This variable must not be changed globally.")
+
(defsubst connection-local-criteria-for-default-directory (&optional application)
"Return a connection-local criteria, which represents `default-directory'.
-If APPLICATION is nil, the symbol `tramp' is used."
+If APPLICATION is nil, `connection-local-default-application' is used."
(when (file-remote-p default-directory)
- `(:application ,(or application 'tramp)
- :protocol ,(file-remote-p default-directory 'method)
- :user ,(file-remote-p default-directory 'user)
- :machine ,(file-remote-p default-directory 'host))))
+ `(:application ,(or application connection-local-default-application)
+ :protocol ,(file-remote-p default-directory 'method)
+ :user ,(file-remote-p default-directory 'user)
+ :machine ,(file-remote-p default-directory 'host))))
;;;###autoload
(defmacro with-connection-local-variables (&rest body)
"Apply connection-local variables according to `default-directory'.
Execute BODY, and unwind connection-local variables."
(declare (debug t))
- `(if (file-remote-p default-directory)
- (let ((enable-connection-local-variables t)
- (old-buffer-local-variables (buffer-local-variables))
- connection-local-variables-alist)
- (hack-connection-local-variables-apply
- (connection-local-criteria-for-default-directory))
- (unwind-protect
- (progn ,@body)
- ;; Cleanup.
- (dolist (variable connection-local-variables-alist)
- (let ((elt (assq (car variable) old-buffer-local-variables)))
- (if elt
- (set (make-local-variable (car elt)) (cdr elt))
- (kill-local-variable (car variable)))))))
- ;; No connection-local variables to apply.
- ,@body))
+ `(with-connection-local-variables-1 (lambda () ,@body)))
+
+;;;###autoload
+(defun with-connection-local-variables-1 (body-fun)
+ "Apply connection-local variables according to `default-directory'.
+Call BODY-FUN with no args, and then unwind connection-local variables."
+ (if (file-remote-p default-directory)
+ (let ((enable-connection-local-variables t)
+ (old-buffer-local-variables (buffer-local-variables))
+ connection-local-variables-alist)
+ (hack-connection-local-variables-apply
+ (connection-local-criteria-for-default-directory))
+ (unwind-protect
+ (funcall body-fun)
+ ;; Cleanup.
+ (dolist (variable connection-local-variables-alist)
+ (let ((elt (assq (car variable) old-buffer-local-variables)))
+ (if elt
+ (set (make-local-variable (car elt)) (cdr elt))
+ (kill-local-variable (car variable)))))))
+ ;; No connection-local variables to apply.
+ (funcall body-fun)))
;;;###autoload
(defun path-separator ()
diff --git a/lisp/files.el b/lisp/files.el
index 12121872748..b99ccf66d8a 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -68,6 +68,31 @@ a regexp matching the name it is linked to."
:group 'abbrev
:group 'find-file)
+(defun directory-abbrev-make-regexp (directory)
+ "Create a regexp to match DIRECTORY for `directory-abbrev-alist'."
+ (let ((regexp
+ ;; We include a slash at the end, to avoid spurious
+ ;; matches such as `/usr/foobar' when the home dir is
+ ;; `/usr/foo'.
+ (concat "\\`" (regexp-quote directory) "\\(/\\|\\'\\)")))
+ ;; The value of regexp could be multibyte or unibyte. In the
+ ;; latter case, we need to decode it.
+ (if (multibyte-string-p regexp)
+ regexp
+ (decode-coding-string regexp
+ (if (eq system-type 'windows-nt)
+ 'utf-8
+ locale-coding-system)))))
+
+(defun directory-abbrev-apply (filename)
+ "Apply the abbreviations in `directory-abbrev-alist' to FILENAME.
+Note that when calling this, you should set `case-fold-search' as
+appropriate for the filesystem used for FILENAME."
+ (dolist (dir-abbrev directory-abbrev-alist filename)
+ (when (string-match (car dir-abbrev) filename)
+ (setq filename (concat (cdr dir-abbrev)
+ (substring filename (match-end 0)))))))
+
(defcustom make-backup-files t
"Non-nil means make a backup of a file the first time it is saved.
This can be done by renaming the file or by copying.
@@ -279,19 +304,17 @@ When nil, make them for files that have some already.
The value `never' means do not make them."
:type '(choice (const :tag "Never" never)
(const :tag "If existing" nil)
- (other :tag "Always" t))
+ (other :tag "Always" t))
+ :safe #'version-control-safe-local-p
:group 'backup)
(defun version-control-safe-local-p (x)
"Return whether X is safe as local value for `version-control'."
(or (booleanp x) (equal x 'never)))
-(put 'version-control 'safe-local-variable
- #'version-control-safe-local-p)
-
(defcustom dired-kept-versions 2
"When cleaning directory, number of versions to keep."
- :type 'integer
+ :type 'natnum
:group 'backup
:group 'dired)
@@ -305,16 +328,16 @@ If nil, ask confirmation. Any other value prevents any trimming."
(defcustom kept-old-versions 2
"Number of oldest versions to keep when a new numbered backup is made."
- :type 'integer
+ :type 'natnum
+ :safe #'natnump
:group 'backup)
-(put 'kept-old-versions 'safe-local-variable 'integerp)
(defcustom kept-new-versions 2
"Number of newest versions to keep when a new numbered backup is made.
Includes the new backup. Must be greater than 0."
- :type 'integer
+ :type 'natnum
+ :safe #'natnump
:group 'backup)
-(put 'kept-new-versions 'safe-local-variable 'integerp)
(defcustom require-final-newline nil
"Whether to add a newline automatically at the end of the file.
@@ -418,6 +441,39 @@ idle for `auto-save-visited-interval' seconds."
(when auto-save--timer
(timer-set-idle-time auto-save--timer value :repeat))))
+(defcustom auto-save-visited-predicate nil
+ "Predicate function for `auto-save-visited-mode'.
+
+If non-nil, the value should be a function of no arguments; it
+will be called once in each file-visiting buffer when the time
+comes to auto-save. A buffer will be saved only if the predicate
+function returns a non-nil value.
+
+For example, you could add this to your Init file to only save
+files that are both in Org mode and in a particular directory:
+
+ (setq auto-save-visited-predicate
+ (lambda () (and (eq major-mode \\='org-mode)
+ (string-match \"^/home/skangas/org/\"
+ buffer-file-name))))
+
+If the value of this variable is not a function, it is ignored.
+This is the same as having a predicate that always returns
+non-nil."
+ :group 'auto-save
+ :type '(choice :tag "Function:"
+ (const :tag "No extra predicate" :value nil)
+ (function :tag "Predicate function" :value always))
+ :risky t
+ :version "29.1")
+
+(defcustom remote-file-name-inhibit-auto-save-visited nil
+ "When nil, `auto-save-visited-mode' will auto-save remote files.
+Any other value means that it will not."
+ :group 'auto-save
+ :type 'boolean
+ :version "29.1")
+
(define-minor-mode auto-save-visited-mode
"Toggle automatic saving of file-visiting buffers to their files.
@@ -429,6 +485,9 @@ file intact. See Info node `Saving' for details of the save process.
The user option `auto-save-visited-interval' controls how often to
auto-save a buffer into its visited file.
+You can use `auto-save-visited-predicate' to control which
+buffers are saved.
+
You can also set the buffer-local value of the variable
`auto-save-visited-mode' to nil. A buffer where the buffer-local
value of this variable is nil is ignored for the purpose of
@@ -448,7 +507,11 @@ For more details, see Info node `(emacs) Auto Save Files'."
(and buffer-file-name
auto-save-visited-mode
(not (and buffer-auto-save-file-name
- auto-save-visited-file-name))))))))
+ auto-save-visited-file-name))
+ (or (not (file-remote-p buffer-file-name))
+ (not remote-file-name-inhibit-auto-save-visited))
+ (or (not (functionp auto-save-visited-predicate))
+ (funcall auto-save-visited-predicate))))))))
;; The 'set' part is so we don't get a warning for using this variable
;; above, while still catching code that _sets_ the variable to get
@@ -968,10 +1031,7 @@ one or more of those symbols."
(logior (if (memq 'executable predicate) 1 0)
(if (memq 'writable predicate) 2 0)
(if (memq 'readable predicate) 4 0))))
- (let ((file (locate-file-internal filename path suffixes predicate)))
- (if (and file (string-match "\\.eln\\'" file))
- (gethash (file-name-nondirectory file) comp-eln-to-el-h)
- file)))
+ (locate-file-internal filename path suffixes predicate))
(defun locate-file-completion-table (dirs suffixes string pred action)
"Do completion for file names passed to `locate-file'."
@@ -1099,10 +1159,17 @@ directory if it does not exist."
(if (file-directory-p user-emacs-directory)
(or (file-accessible-directory-p user-emacs-directory)
(setq errtype "access"))
- (with-file-modes ?\700
- (condition-case nil
- (make-directory user-emacs-directory t)
- (error (setq errtype "create")))))
+ ;; We don't want to create HOME if it doesn't exist.
+ (if (and (not (file-exists-p "~"))
+ (string-prefix-p
+ (expand-file-name "~")
+ (expand-file-name user-emacs-directory)))
+ (setq errtype "create")
+ ;; Create `user-emacs-directory'.
+ (with-file-modes ?\700
+ (condition-case nil
+ (make-directory user-emacs-directory t)
+ (error (setq errtype "create"))))))
(when (and errtype
user-emacs-directory-warning
(not (get 'user-emacs-directory-warning 'this-session)))
@@ -1474,8 +1541,13 @@ in all cases, since that is the standard symbol for byte."
(if (string= prefix "") "" "i")
(or unit "B"))
(concat prefix unit))))
- (format (if (and (>= (mod file-size 1.0) 0.05)
+ ;; Mimic what GNU "ls -lh" does:
+ ;; If the formatted size will have just one digit before the decimal...
+ (format (if (and (< file-size 10)
+ ;; ...and its fractional part is not too small...
+ (>= (mod file-size 1.0) 0.05)
(< (mod file-size 1.0) 0.95))
+ ;; ...then emit one digit after the decimal.
"%.1f%s%s"
"%.0f%s%s")
file-size
@@ -1996,12 +2068,14 @@ otherwise a string <2> or <3> or ... is appended to get an unused name.
Emacs treats buffers whose names begin with a space as internal buffers.
To avoid confusion when visiting a file whose name begins with a space,
this function prepends a \"|\" to the final result if necessary."
- (let ((lastname (file-name-nondirectory filename)))
- (if (string= lastname "")
- (setq lastname filename))
- (generate-new-buffer (if (string-prefix-p " " lastname)
- (concat "|" lastname)
- lastname))))
+ (let* ((lastname (file-name-nondirectory filename))
+ (lastname (if (string= lastname "")
+ filename lastname))
+ (buf (generate-new-buffer (if (string-prefix-p " " lastname)
+ (concat "|" lastname)
+ lastname))))
+ (uniquify--create-file-buffer-advice buf filename)
+ buf))
(defcustom automount-dir-prefix (purecopy "^/tmp_mnt/")
"Regexp to match the automounter prefix in a directory name."
@@ -2026,80 +2100,64 @@ if you want to permanently change your home directory after having
started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)."
;; Get rid of the prefixes added by the automounter.
(save-match-data ;FIXME: Why?
- (if (and automount-dir-prefix
- (string-match automount-dir-prefix filename)
- (file-exists-p (file-name-directory
- (substring filename (1- (match-end 0))))))
- (setq filename (substring filename (1- (match-end 0)))))
- ;; Avoid treating /home/foo as /home/Foo during `~' substitution.
- (let ((case-fold-search (file-name-case-insensitive-p filename)))
- ;; If any elt of directory-abbrev-alist matches this name,
- ;; abbreviate accordingly.
- (dolist (dir-abbrev directory-abbrev-alist)
- (if (string-match (car dir-abbrev) filename)
- (setq filename
- (concat (cdr dir-abbrev)
- (substring filename (match-end 0))))))
- ;; Compute and save the abbreviated homedir name.
- ;; We defer computing this until the first time it's needed, to
- ;; give time for directory-abbrev-alist to be set properly.
- ;; We include a slash at the end, to avoid spurious matches
- ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
- (unless abbreviated-home-dir
- (put 'abbreviated-home-dir 'home (expand-file-name "~"))
- (setq abbreviated-home-dir
- (let* ((abbreviated-home-dir "\\`\\'.") ;Impossible regexp.
- (regexp
- (concat "\\`"
- (regexp-quote
- (abbreviate-file-name
- (get 'abbreviated-home-dir 'home)))
- "\\(/\\|\\'\\)")))
- ;; Depending on whether default-directory does or
- ;; doesn't include non-ASCII characters, the value
- ;; of abbreviated-home-dir could be multibyte or
- ;; unibyte. In the latter case, we need to decode
- ;; it. Note that this function is called for the
- ;; first time (from startup.el) when
- ;; locale-coding-system is already set up.
- (if (multibyte-string-p regexp)
- regexp
- (decode-coding-string regexp
- (if (eq system-type 'windows-nt)
- 'utf-8
- locale-coding-system))))))
-
- ;; If FILENAME starts with the abbreviated homedir,
- ;; and ~ hasn't changed since abbreviated-home-dir was set,
- ;; make it start with `~' instead.
- ;; If ~ has changed, we ignore abbreviated-home-dir rather than
- ;; invalidating it, on the assumption that a change in HOME
- ;; is likely temporary (eg for testing).
- ;; FIXME Is it even worth caching abbreviated-home-dir?
- ;; Ref: https://debbugs.gnu.org/19657#20
- (let (mb1)
- (if (and (string-match abbreviated-home-dir filename)
- (setq mb1 (match-beginning 1))
- ;; If the home dir is just /, don't change it.
- (not (and (= (match-end 0) 1)
- (= (aref filename 0) ?/)))
- ;; MS-DOS root directories can come with a drive letter;
- ;; Novell Netware allows drive letters beyond `Z:'.
- (not (and (memq system-type '(ms-dos windows-nt cygwin))
- (string-match "\\`[a-zA-`]:/\\'" filename)))
- (equal (get 'abbreviated-home-dir 'home)
- (expand-file-name "~")))
- (setq filename
- (concat "~"
- (substring filename mb1))))
- filename))))
+ (if-let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
+ (funcall handler 'abbreviate-file-name filename)
+ (if (and automount-dir-prefix
+ (string-match automount-dir-prefix filename)
+ (file-exists-p (file-name-directory
+ (substring filename (1- (match-end 0))))))
+ (setq filename (substring filename (1- (match-end 0)))))
+ ;; Avoid treating /home/foo as /home/Foo during `~' substitution.
+ (let ((case-fold-search (file-name-case-insensitive-p filename)))
+ ;; If any elt of directory-abbrev-alist matches this name,
+ ;; abbreviate accordingly.
+ (setq filename (directory-abbrev-apply filename))
+
+ ;; Compute and save the abbreviated homedir name.
+ ;; We defer computing this until the first time it's needed, to
+ ;; give time for directory-abbrev-alist to be set properly.
+ (unless abbreviated-home-dir
+ (put 'abbreviated-home-dir 'home (expand-file-name "~"))
+ (setq abbreviated-home-dir
+ (directory-abbrev-make-regexp
+ (let ((abbreviated-home-dir "\\`\\'.")) ;Impossible regexp.
+ (abbreviate-file-name
+ (get 'abbreviated-home-dir 'home))))))
+
+ ;; If FILENAME starts with the abbreviated homedir,
+ ;; and ~ hasn't changed since abbreviated-home-dir was set,
+ ;; make it start with `~' instead.
+ ;; If ~ has changed, we ignore abbreviated-home-dir rather than
+ ;; invalidating it, on the assumption that a change in HOME
+ ;; is likely temporary (eg for testing).
+ ;; FIXME Is it even worth caching abbreviated-home-dir?
+ ;; Ref: https://debbugs.gnu.org/19657#20
+ (let (mb1)
+ (if (and (string-match abbreviated-home-dir filename)
+ (setq mb1 (match-beginning 1))
+ ;; If the home dir is just /, don't change it.
+ (not (and (= (match-end 0) 1)
+ (= (aref filename 0) ?/)))
+ ;; MS-DOS root directories can come with a drive letter;
+ ;; Novell Netware allows drive letters beyond `Z:'.
+ (not (and (memq system-type '(ms-dos windows-nt cygwin))
+ (string-match "\\`[a-zA-`]:/\\'" filename)))
+ (equal (get 'abbreviated-home-dir 'home)
+ (expand-file-name "~")))
+ (setq filename
+ (concat "~"
+ (substring filename mb1))))
+ filename)))))
(defun find-buffer-visiting (filename &optional predicate)
"Return the buffer visiting file FILENAME (a string).
This is like `get-file-buffer', except that it checks for any buffer
visiting the same file, possibly under a different name.
+
If PREDICATE is non-nil, only buffers satisfying it are eligible,
-and others are ignored.
+and others are ignored. PREDICATE is called with the buffer as
+the only argument, but not with the buffer as the current buffer.
+
If there is no such live buffer, return nil."
(let ((predicate (or predicate #'identity))
(truename (abbreviate-file-name (file-truename filename))))
@@ -2320,7 +2378,16 @@ the various files."
(attributes (file-attributes truename))
(number (nthcdr 10 attributes))
;; Find any buffer for a file that has same truename.
- (other (and (not buf) (find-buffer-visiting filename))))
+ (other (and (not buf)
+ (find-buffer-visiting
+ filename
+ ;; We want to filter out buffers that we've
+ ;; visited via symlinks and the like, where
+ ;; the symlink no longer exists.
+ (lambda (buffer)
+ (let ((file (buffer-local-value
+ 'buffer-file-name buffer)))
+ (and file (file-exists-p file))))))))
;; Let user know if there is a buffer with the same truename.
(if other
(progn
@@ -2756,8 +2823,7 @@ since only a single case-insensitive search through the alist is made."
(defvar auto-mode-alist
;; Note: The entries for the modes defined in cc-mode.el (c-mode,
;; c++-mode, java-mode and more) are added through autoload
- ;; directives in that file. That way is discouraged since it
- ;; spreads out the definition of the initial value.
+ ;; directives in that file.
(mapcar
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
@@ -2772,6 +2838,7 @@ since only a single case-insensitive search through the alist is made."
("\\.gif\\'" . image-mode)
("\\.png\\'" . image-mode)
("\\.jpe?g\\'" . image-mode)
+ ("\\.webp\\'" . image-mode)
("\\.te?xt\\'" . text-mode)
("\\.[tT]e[xX]\\'" . tex-mode)
("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
@@ -2781,6 +2848,9 @@ since only a single case-insensitive search through the alist is made."
;; .dir-locals.el is not really Elisp. Could use the
;; `dir-locals-file' constant if it weren't defined below.
("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode)
+ ("\\.eld\\'" . lisp-data-mode)
+ ;; FIXME: The lisp-data-mode files below should use the `.eld' extension
+ ;; (or a -*- mode cookie) so we don't need ad-hoc entries here.
("eww-bookmarks\\'" . lisp-data-mode)
("tramp\\'" . lisp-data-mode)
("/archive-contents\\'" . lisp-data-mode)
@@ -2897,6 +2967,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
("\\.[ds]?va?h?\\'" . verilog-mode)
("\\.by\\'" . bovine-grammar-mode)
("\\.wy\\'" . wisent-grammar-mode)
+ ("\\.erts\\'" . erts-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix or MS-DOS syntax.
("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
@@ -2926,7 +2997,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS
("\\.[eE]?[pP][sS]\\'" . ps-mode)
- ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
+ ("\\.\\(?:PDF\\|EPUB\\|CBZ\\|FB2\\|O?XPS\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|epub\\|cbz\\|fb2\\|o?xps\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode)
("BROWSE\\'" . ebrowse-tree-mode)
@@ -2989,6 +3060,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
("\\.dng\\'" . image-mode)
("\\.dpx\\'" . image-mode)
("\\.fax\\'" . image-mode)
+ ("\\.heic\\'" . image-mode)
("\\.hrz\\'" . image-mode)
("\\.icb\\'" . image-mode)
("\\.icc\\'" . image-mode)
@@ -3052,8 +3124,7 @@ and `magic-mode-alist', which determines modes based on file contents.")
(defvar interpreter-mode-alist
;; Note: The entries for the modes defined in cc-mode.el (awk-mode
;; and pike-mode) are added through autoload directives in that
- ;; file. That way is discouraged since it spreads out the
- ;; definition of the initial value.
+ ;; file.
(mapcar
(lambda (l)
(cons (purecopy (car l)) (cdr l)))
@@ -3091,9 +3162,6 @@ major mode MODE.
See also `auto-mode-alist'.")
-(define-obsolete-variable-alias 'inhibit-first-line-modes-regexps
- 'inhibit-file-local-variables-regexps "24.1")
-
;; TODO really this should be a list of modes (eg tar-mode), not regexps,
;; because we are duplicating info from auto-mode-alist.
;; TODO many elements of this list are also in auto-coding-alist.
@@ -3114,9 +3182,6 @@ member files with their own local variable sections, which are
not appropriate for the containing file.
The function `inhibit-local-variables-p' uses this.")
-(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes
- 'inhibit-local-variables-suffixes "24.1")
-
(defvar inhibit-local-variables-suffixes nil
"List of regexps matching suffixes to remove from file names.
The function `inhibit-local-variables-p' uses this: when checking
@@ -3245,6 +3310,7 @@ extra checks should be done."
(let ((case-fold-search t))
(assoc-default name alist 'string-match))))))
(if (and mode
+ (not (functionp mode))
(consp mode)
(cadr mode))
(setq mode (car mode)
@@ -3637,7 +3703,7 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil."
(cond
(unsafe-vars
(insert "The local variables list in " name
- "\ncontains values that may not be safe (*)"
+ "\nor .dir-locals.el contains values that may not be safe (*)"
(if risky-vars
", and variables that are risky (**)."
".")))
@@ -3736,8 +3802,8 @@ return as the symbol specifying the mode."
(while (not (or (and (eq handle-mode t) result)
(>= (point) end)))
(unless (looking-at hack-local-variable-regexp)
- (message "Malformed mode-line: %S"
- (buffer-substring-no-properties (point) end))
+ (message "Malformed mode-line: %S in buffer %S"
+ (buffer-substring-no-properties (point) end) (buffer-name))
(throw 'malformed-line nil))
(goto-char (match-end 0))
;; There used to be a downcase here,
@@ -3964,22 +4030,21 @@ major-mode."
;; Discard the prefix.
(if (looking-at prefix)
(delete-region (point) (match-end 0))
- (error "Local variables entry is missing the prefix"))
+ (user-error "Local variables entry is missing the prefix"))
(end-of-line)
;; Discard the suffix.
(if (looking-back suffix (line-beginning-position))
(delete-region (match-beginning 0) (point))
- (error "Local variables entry is missing the suffix"))
+ (user-error "Local variables entry is missing the suffix"))
(forward-line 1))
(goto-char (point-min))
- (while (not (or (eobp)
- (and (eq handle-mode t) result)))
+ (while (not (eobp))
;; Find the variable name;
(unless (looking-at hack-local-variable-regexp)
- (error "Malformed local variable line: %S"
- (buffer-substring-no-properties
- (point) (line-end-position))))
+ (user-error "Malformed local variable line: %S"
+ (buffer-substring-no-properties
+ (point) (line-end-position))))
(goto-char (match-end 1))
(let* ((str (match-string 1))
(var (intern str))
@@ -4000,7 +4065,8 @@ major-mode."
(not (string-match
"-minor\\'"
(setq val2 (downcase (symbol-name val)))))
- (setq result (intern (concat val2 "-mode"))))
+ ;; Allow several mode: elements.
+ (push (intern (concat val2 "-mode")) result))
(cond ((eq var 'coding))
((eq var 'lexical-binding)
(unless hack-local-variables--warned-lexical
@@ -4024,7 +4090,10 @@ major-mode."
val)
result))))))
(forward-line 1)))))))
- result))
+ (if (eq handle-mode t)
+ ;; Return the final mode: setting that's defined.
+ (car (seq-filter #'fboundp result))
+ result)))
(defun hack-local-variables-apply ()
"Apply the elements of `file-local-variables-alist'.
@@ -4058,7 +4127,8 @@ It is safe if any of these conditions are met:
(and (functionp safep)
;; If the function signals an error, that means it
;; can't assure us that the value is safe.
- (with-demoted-errors (funcall safep val))))))
+ (with-demoted-errors "Local variable error: %S"
+ (funcall safep val))))))
(defun risky-local-variable-p (sym &optional _ignored)
"Non-nil if SYM could be dangerous as a file-local variable.
@@ -4083,11 +4153,8 @@ It is dangerous if either of these conditions are met:
(defun hack-one-local-variable-quotep (exp)
(and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
-(defun hack-one-local-variable-constantp (exp)
- (or (and (not (symbolp exp)) (not (consp exp)))
- (memq exp '(t nil))
- (keywordp exp)
- (hack-one-local-variable-quotep exp)))
+(define-obsolete-function-alias 'hack-one-local-variable-constantp
+ #'macroexp-const-p "29.1")
(defun hack-one-local-variable-eval-safep (exp)
"Return non-nil if it is safe to eval EXP when it is found in a file."
@@ -4125,7 +4192,7 @@ It is dangerous if either of these conditions are met:
(cond ((eq prop t)
(let ((ok t))
(dolist (arg (cdr exp))
- (unless (hack-one-local-variable-constantp arg)
+ (unless (macroexp-const-p arg)
(setq ok nil)))
ok))
((functionp prop)
@@ -4475,7 +4542,7 @@ Return the new class name, which is a symbol named DIR."
(with-demoted-errors "Error reading dir-locals: %S"
(dolist (file files)
(let ((file-time (file-attribute-modification-time
- (file-attributes file))))
+ (file-attributes (file-chase-links file)))))
(if (time-less-p latest file-time)
(setq latest file-time)))
(with-temp-buffer
@@ -4747,7 +4814,6 @@ using \\<minibuffer-local-map>\\[next-history-element].
If optional second arg CONFIRM is non-nil, this function
asks for confirmation before overwriting an existing file.
Interactively, confirmation is required unless you supply a prefix argument."
-;; (interactive "FWrite file: ")
(interactive
(list (if buffer-file-name
(read-file-name "Write file: "
@@ -4758,33 +4824,64 @@ Interactively, confirmation is required unless you supply a prefix argument."
default-directory)
nil nil))
(not current-prefix-arg)))
- (or (null filename) (string-equal filename "")
- (progn
- ;; If arg is a directory name,
- ;; use the default file name, but in that directory.
- (if (directory-name-p filename)
- (setq filename (concat filename
- (file-name-nondirectory
- (or buffer-file-name (buffer-name))))))
- (and confirm
- (file-exists-p filename)
- ;; NS does its own confirm dialog.
- (not (and (eq (framep-on-display) 'ns)
- (listp last-nonmenu-event)
- use-dialog-box))
- (or (y-or-n-p (format-message
- "File `%s' exists; overwrite? " filename))
- (user-error "Canceled")))
- (set-visited-file-name filename (not confirm))))
- (set-buffer-modified-p t)
- ;; Make buffer writable if file is writable.
- (and buffer-file-name
- (file-writable-p buffer-file-name)
- (setq buffer-read-only nil))
- (save-buffer)
- ;; It's likely that the VC status at the new location is different from
- ;; the one at the old location.
- (vc-refresh-state))
+ (let ((old-modes
+ (and buffer-file-name
+ ;; File may have gone away; ignore errors in that case.
+ (ignore-errors (file-modes buffer-file-name)))))
+ (or (null filename) (string-equal filename "")
+ (progn
+ ;; If arg is a directory name,
+ ;; use the default file name, but in that directory.
+ (if (directory-name-p filename)
+ (setq filename (concat filename
+ (file-name-nondirectory
+ (or buffer-file-name (buffer-name))))))
+ (and confirm
+ (file-exists-p filename)
+ ;; NS does its own confirm dialog.
+ (not (and (eq (framep-on-display) 'ns)
+ (listp last-nonmenu-event)
+ use-dialog-box))
+ (or (y-or-n-p (format-message
+ "File `%s' exists; overwrite? " filename))
+ (user-error "Canceled")))
+ (set-visited-file-name filename (not confirm))))
+ (set-buffer-modified-p t)
+ ;; Make buffer writable if file is writable.
+ (and buffer-file-name
+ (file-writable-p buffer-file-name)
+ (setq buffer-read-only nil))
+ (save-buffer)
+ ;; If the old file was executable, then make the new file
+ ;; executable, too.
+ (when (and old-modes
+ (not (zerop (logand #o111 old-modes))))
+ (set-file-modes buffer-file-name
+ (logior (logand #o111 old-modes)
+ (file-modes buffer-file-name))))
+ ;; It's likely that the VC status at the new location is different from
+ ;; the one at the old location.
+ (vc-refresh-state)))
+
+(defun rename-visited-file (new-location)
+ "Rename the file visited by the current buffer to NEW-LOCATION.
+This command also sets the visited file name. If the buffer
+isn't visiting any file, that's all it does.
+
+Interactively, this prompts for NEW-LOCATION."
+ (interactive
+ (list (if buffer-file-name
+ (read-file-name "Rename visited file to: ")
+ (read-file-name "Set visited file name: "
+ default-directory
+ (expand-file-name
+ (file-name-nondirectory (buffer-name))
+ default-directory)))))
+ (when (and buffer-file-name
+ (file-exists-p buffer-file-name))
+ (rename-file buffer-file-name new-location))
+ (set-visited-file-name new-location nil t))
+
(defun file-extended-attributes (filename)
"Return an alist of extended attributes of file FILENAME.
@@ -4927,7 +5024,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
nil)))
;; If set-file-extended-attributes fails, fall back on set-file-modes.
(unless (and extended-attributes
- (with-demoted-errors
+ (with-demoted-errors "Error setting attributes: %S"
(set-file-extended-attributes to-name extended-attributes)))
(and modes
(set-file-modes to-name (logand modes #o1777) nofollow-flag)))))
@@ -5059,6 +5156,51 @@ See also `file-name-sans-extension'."
(file-name-sans-extension
(file-name-nondirectory (or filename (buffer-file-name)))))
+(defun file-name-split (filename)
+ "Return a list of all the components of FILENAME.
+On most systems, this will be true:
+
+ (equal (string-join (file-name-split filename) \"/\") filename)"
+ (let ((components nil))
+ ;; If this is a directory file name, then we have a null file name
+ ;; at the end.
+ (when (directory-name-p filename)
+ (push "" components)
+ (setq filename (directory-file-name filename)))
+ ;; Loop, chopping off components.
+ (while (length> filename 0)
+ (push (file-name-nondirectory filename) components)
+ (let ((dir (file-name-directory filename)))
+ (setq filename (and dir (directory-file-name dir)))
+ ;; If there's nothing left to peel off, we're at the root and
+ ;; we can stop.
+ (when (and dir (equal dir filename))
+ (push (if (equal dir "") ""
+ ;; On Windows, the first component might be "c:" or
+ ;; the like.
+ (substring dir 0 -1))
+ components)
+ (setq filename nil))))
+ components))
+
+(defun file-parent-directory (filename)
+ "Return the directory name of the parent directory of FILENAME.
+If FILENAME is at the root of the filesystem, return nil.
+If FILENAME is relative, it is interpreted to be relative
+to `default-directory', and the result will also be relative."
+ (let* ((expanded-filename (expand-file-name filename))
+ (parent (file-name-directory (directory-file-name expanded-filename))))
+ (cond
+ ;; filename is at top-level, therefore no parent
+ ((or (null parent)
+ (file-equal-p parent expanded-filename))
+ nil)
+ ;; filename is relative, return relative parent
+ ((not (file-name-absolute-p filename))
+ (file-relative-name parent))
+ (t
+ parent))))
+
(defcustom make-backup-file-name-function
#'make-backup-file-name--default-function
"A function that `make-backup-file-name' uses to create backup file names.
@@ -5310,7 +5452,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
(let ((fremote (file-remote-p filename))
(dremote (file-remote-p directory))
(fold-case (or (file-name-case-insensitive-p filename)
- read-file-name-completion-ignore-case)))
+ ;; During bootstrap, it can happen that
+ ;; `read-file-name-completion-ignore-case' is
+ ;; not defined yet.
+ ;; FIXME: `read-file-name-completion-ignore-case' is
+ ;; a user-config which we shouldn't trust to reflect
+ ;; the actual file system's semantics.
+ (and (boundp 'read-file-name-completion-ignore-case)
+ read-file-name-completion-ignore-case))))
(if ;; Conditions for separate trees
(or
;; Test for different filesystems on DOS/Windows
@@ -5525,7 +5674,8 @@ Before and after saving the buffer, this function runs
(goto-char (point-max))
(insert ?\n))))
;; Don't let errors prevent saving the buffer.
- (with-demoted-errors (run-hooks 'before-save-hook))
+ (with-demoted-errors "Before-save hook error: %S"
+ (run-hooks 'before-save-hook))
;; Give `write-contents-functions' a chance to
;; short-circuit the whole process.
(unless (run-hook-with-args-until-success 'write-contents-functions)
@@ -5573,7 +5723,7 @@ Before and after saving the buffer, this function runs
(condition-case ()
(progn
(unless
- (with-demoted-errors
+ (with-demoted-errors "Error setting file modes: %S"
(set-file-modes buffer-file-name (car setmodes)))
(set-file-extended-attributes buffer-file-name
(nth 1 setmodes))))
@@ -5661,11 +5811,14 @@ Before and after saving the buffer, this function runs
(signal (car err) (cdr err))))
;; Since we have created an entirely new file,
;; make sure it gets the right permission bits set.
- (setq setmodes (or setmodes
- (list (or (file-modes buffer-file-name)
- (logand ?\666 (default-file-modes)))
- (file-extended-attributes buffer-file-name)
- buffer-file-name)))
+ (setq setmodes
+ (or setmodes
+ (list (or (file-modes buffer-file-name)
+ (logand ?\666 (default-file-modes)))
+ (with-demoted-errors
+ "Error getting extended attributes: %s"
+ (file-extended-attributes buffer-file-name))
+ buffer-file-name)))
;; We succeeded in writing the temp file,
;; so rename it.
(rename-file tempname
@@ -5682,13 +5835,16 @@ Before and after saving the buffer, this function runs
;; (setmodes is set) because that says we're superseding.
(cond ((and tempsetmodes (not setmodes))
;; Change the mode back, after writing.
- (setq setmodes (list (file-modes buffer-file-name)
- (file-extended-attributes buffer-file-name)
- buffer-file-name))
+ (setq setmodes
+ (list (file-modes buffer-file-name)
+ (with-demoted-errors
+ "Error getting extended attributes: %s"
+ (file-extended-attributes buffer-file-name))
+ buffer-file-name))
;; If set-file-extended-attributes fails, fall back on
;; set-file-modes.
(unless
- (with-demoted-errors
+ (with-demoted-errors "Error setting attributes: %s"
(set-file-extended-attributes buffer-file-name
(nth 1 setmodes)))
(set-file-modes buffer-file-name
@@ -5783,15 +5939,50 @@ of the directory that was default during command invocation."
(lambda () (file-in-directory-p default-directory root))))
(put 'save-some-buffers-root 'save-some-buffers-function t)
+(defun files--buffers-needing-to-be-saved (pred)
+ "Return a list of buffers to save according to PRED.
+See `save-some-buffers' for PRED values."
+ (let ((buffers
+ (mapcar (lambda (buffer)
+ (if
+ ;; Note that killing some buffers may kill others via
+ ;; hooks (e.g. Rmail and its viewing buffer).
+ (and (buffer-live-p buffer)
+ (buffer-modified-p buffer)
+ (not (buffer-base-buffer buffer))
+ (or
+ (buffer-file-name buffer)
+ (with-current-buffer buffer
+ (or (eq buffer-offer-save 'always)
+ (and pred buffer-offer-save
+ (> (buffer-size) 0)))))
+ (or (not (functionp pred))
+ (with-current-buffer buffer
+ (funcall pred))))
+ buffer))
+ (buffer-list))))
+ (delq nil buffers)))
+
+(defvar save-some-buffers-functions nil
+ "Functions to be run by `save-some-buffers' after saving the buffers.
+The functions can be called in two \"modes\", depending on the
+first argument. If the first argument is `query', then the
+function should return non-nil if there is something to be
+saved (but it should not actually save anything).
+
+If the first argument is something else, then the function should
+save according to the value of the second argument, which is the
+ARG argument from `save-some-buffers'.")
+
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
-You can answer `y' or SPC to save, `n' or DEL not to save, `C-r'
+You can answer \\`y' or \\`SPC' to save, \\`n' or \\`DEL' not to save, \\`C-r'
to look at the buffer in question with `view-buffer' before
-deciding, `d' to view the differences using
-`diff-buffer-with-file', `!' to save the buffer and all remaining
-buffers without any further querying, `.' to save only the
-current buffer and skip the remaining ones and `q' or RET to exit
-the function without saving any more buffers. `C-h' displays a
+deciding, \\`d' to view the differences using
+`diff-buffer-with-file', \\`!' to save the buffer and all remaining
+buffers without any further querying, \\`.' to save only the
+current buffer and skip the remaining ones and \\`q' or \\`RET' to exit
+the function without saving any more buffers. \\`C-h' displays a
help message describing these options.
This command first saves any buffers where `buffer-save-without-query' is
@@ -5807,7 +5998,10 @@ should return non-nil if that buffer should be considered.
PRED defaults to the value of `save-some-buffers-default-predicate'.
See `save-some-buffers-action-alist' if you want to
-change the additional actions you can take on files."
+change the additional actions you can take on files.
+
+The functions in `save-some-buffers-functions' will be called
+after saving the buffers."
(interactive "P")
(unless pred
(setq pred
@@ -5823,7 +6017,7 @@ change the additional actions you can take on files."
(lambda (buffer)
(setq switched-buffer buffer)))
queried autosaved-buffers
- files-done abbrevs-done)
+ files-done inhibit-message)
(unwind-protect
(save-window-excursion
(dolist (buffer (buffer-list))
@@ -5839,64 +6033,42 @@ change the additional actions you can take on files."
(setq files-done
(map-y-or-n-p
(lambda (buffer)
- ;; Note that killing some buffers may kill others via
- ;; hooks (e.g. Rmail and its viewing buffer).
- (and (buffer-live-p buffer)
- (buffer-modified-p buffer)
- (not (buffer-base-buffer buffer))
- (or
- (buffer-file-name buffer)
- (with-current-buffer buffer
- (or (eq buffer-offer-save 'always)
- (and pred buffer-offer-save
- (> (buffer-size) 0)))))
- (or (not (functionp pred))
- (with-current-buffer buffer (funcall pred)))
- (if arg
- t
- (setq queried t)
- (if (buffer-file-name buffer)
- (if (or
- (equal (buffer-name buffer)
- (file-name-nondirectory
- (buffer-file-name buffer)))
- (string-match
- (concat "\\<"
- (regexp-quote
- (file-name-nondirectory
- (buffer-file-name buffer)))
- "<[^>]*>\\'")
- (buffer-name buffer)))
- ;; The buffer name is similar to the
- ;; file name.
- (format "Save file %s? "
- (buffer-file-name buffer))
- ;; The buffer and file names are
- ;; dissimilar; display both.
- (format "Save file %s (buffer %s)? "
- (buffer-file-name buffer)
- (buffer-name buffer)))
- ;; No file name
- (format "Save buffer %s? " (buffer-name buffer))))))
+ (if arg
+ t
+ (setq queried t)
+ (if (buffer-file-name buffer)
+ (if (or
+ (equal (buffer-name buffer)
+ (file-name-nondirectory
+ (buffer-file-name buffer)))
+ (string-match
+ (concat "\\<"
+ (regexp-quote
+ (file-name-nondirectory
+ (buffer-file-name buffer)))
+ "<[^>]*>\\'")
+ (buffer-name buffer)))
+ ;; The buffer name is similar to the file
+ ;; name.
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ ;; The buffer and file names are dissimilar;
+ ;; display both.
+ (format "Save file %s (buffer %s)? "
+ (buffer-file-name buffer)
+ (buffer-name buffer)))
+ ;; No file name.
+ (format "Save buffer %s? " (buffer-name buffer)))))
(lambda (buffer)
(with-current-buffer buffer
(save-buffer)))
- (buffer-list)
+ (files--buffers-needing-to-be-saved pred)
'("buffer" "buffers" "save")
save-some-buffers-action-alist))
- ;; Maybe to save abbrevs, and record whether
- ;; we either saved them or asked to.
- (and save-abbrevs abbrevs-changed
- (progn
- (if (or arg
- (eq save-abbrevs 'silently)
- (y-or-n-p (format "Save abbrevs in %s? "
- abbrev-file-name)))
- (write-abbrev-file nil))
- ;; Don't keep bothering user if he says no.
- (setq abbrevs-changed nil)
- (setq abbrevs-done t)))
- (or queried (> files-done 0) abbrevs-done
+ ;; Allow other things to be saved at this time, like abbrevs.
+ (dolist (func save-some-buffers-functions)
+ (setq inhibit-message (or (funcall func nil arg) inhibit-message)))
+ (or queried (> files-done 0) inhibit-message
(cond
((null autosaved-buffers)
(when (called-interactively-p 'any)
@@ -6192,6 +6364,29 @@ Return nil if DIR is not an existing directory."
(unless mismatch
(file-equal-p root dir)))))))
+(defvar file-has-changed-p--hash-table (make-hash-table :test #'equal)
+ "Internal variable used by `file-has-changed-p'.")
+
+(defun file-has-changed-p (file &optional tag)
+ "Return non-nil if FILE has changed.
+The size and modification time of FILE are compared to the size
+and modification time of the same FILE during a previous
+invocation of `file-has-changed-p'. Thus, the first invocation
+of `file-has-changed-p' always returns non-nil when FILE exists.
+The optional argument TAG, which must be a symbol, can be used to
+limit the comparison to invocations with identical tags; it can be
+the symbol of the calling function, for example."
+ (let* ((file (directory-file-name (expand-file-name file)))
+ (remote-file-name-inhibit-cache t)
+ (fileattr (file-attributes file 'integer))
+ (attr (and fileattr
+ (cons (file-attribute-size fileattr)
+ (file-attribute-modification-time fileattr))))
+ (sym (concat (symbol-name tag) "@" file))
+ (cachedattr (gethash sym file-has-changed-p--hash-table)))
+ (when (not (equal attr cachedattr))
+ (puthash sym attr file-has-changed-p--hash-table))))
+
(defun copy-directory (directory newname &optional keep-time parents copy-contents)
"Copy DIRECTORY to NEWNAME. Both args must be strings.
This function always sets the file modes of the output files to match
@@ -7114,13 +7309,22 @@ by `sh' are supported."
:type 'string
:group 'dired)
-(defun file-expand-wildcards (pattern &optional full)
+(defun file-expand-wildcards (pattern &optional full regexp)
"Expand (a.k.a. \"glob\") file-name wildcard pattern PATTERN.
This returns a list of file names that match PATTERN.
The returned list of file names is sorted in the `string<' order.
-If PATTERN is written as an absolute file name,
-the expansions in the returned list are also absolute.
+PATTERN is, by default, a \"glob\"/wildcard string, e.g.,
+\"/tmp/*.png\" or \"/*/*/foo.png\", but can also be a regular
+expression if the optional REGEXP parameter is non-nil. In any
+case, the matches are applied per sub-directory, so a match can't
+span a parent/sub directory, which means that a regexp bit can't
+contain the \"/\" character.
+
+The returned list of file names is sorted in the `string<' order.
+
+If PATTERN is written as an absolute file name, the expansions in
+the returned list are also absolute.
If PATTERN is written as a relative file name, it is interpreted
relative to the current `default-directory'.
@@ -7135,7 +7339,8 @@ default directory. However, if FULL is non-nil, they are absolute."
(dirs (if (and dirpart
(string-match "[[*?]" (file-local-name dirpart)))
(mapcar 'file-name-as-directory
- (file-expand-wildcards (directory-file-name dirpart)))
+ (file-expand-wildcards
+ (directory-file-name dirpart) nil regexp))
(list dirpart)))
contents)
(dolist (dir dirs)
@@ -7144,21 +7349,116 @@ default directory. However, if FULL is non-nil, they are absolute."
(let ((this-dir-contents
;; Filter out "." and ".."
(delq nil
- (mapcar #'(lambda (name)
- (unless (string-match "\\`\\.\\.?\\'"
- (file-name-nondirectory name))
- name))
- (directory-files (or dir ".") full
- (wildcard-to-regexp nondir))))))
+ (mapcar (lambda (name)
+ (unless (string-match "\\`\\.\\.?\\'"
+ (file-name-nondirectory name))
+ name))
+ (directory-files
+ (or dir ".") full
+ (if regexp
+ ;; We're matching each file name
+ ;; element separately.
+ (concat "\\`" nondir "\\'")
+ (wildcard-to-regexp nondir)))))))
(setq contents
(nconc
(if (and dir (not full))
- (mapcar #'(lambda (name) (concat dir name))
+ (mapcar (lambda (name) (concat dir name))
this-dir-contents)
this-dir-contents)
contents)))))
contents)))
+(defcustom find-sibling-rules nil
+ "Rules for finding \"sibling\" files.
+This is used by the `find-sibling-file' command.
+
+This variable is a list of (MATCH EXPANSION...) elements.
+
+MATCH is a regular expression that should match a file name that
+has a sibling. It can contain sub-expressions that will be used
+in EXPANSIONS.
+
+EXPANSION is a string that matches file names. For instance, to
+define \".h\" files as siblings of any \".c\", you could say:
+
+ (\"\\\\([^/]+\\\\)\\\\.c\\\\\\='\" \"\\\\1.h\")
+
+MATCH and EXPANSION can also be fuller paths. For instance, if
+you want to define other versions of a project as being sibling
+files, you could say something like:
+
+ (\"src/emacs/[^/]+/\\\\(.*\\\\)\\\\\\='\" \"src/emacs/.*/\\\\1\\\\\\='\")
+
+In this example, if you're in src/emacs/emacs-27/lisp/abbrev.el,
+and you an src/emacs/emacs-28/lisp/abbrev.el file exists, it's
+now defined as a sibling."
+ :type 'sexp
+ :version "29.1")
+
+(defun find-sibling-file (file)
+ "Visit a \"sibling\" file of FILE.
+When called interactively, FILE is the currently visited file.
+
+The \"sibling\" file is defined by the `find-sibling-rules' variable."
+ (interactive (progn
+ (unless buffer-file-name
+ (user-error "Not visiting a file"))
+ (list buffer-file-name)))
+ (unless find-sibling-rules
+ (user-error "The `find-sibling-rules' variable has not been configured"))
+ (let ((siblings (find-sibling-file-search (expand-file-name file)
+ find-sibling-rules)))
+ (cond
+ ((null siblings)
+ (user-error "Couldn't find any sibling files"))
+ ((length= siblings 1)
+ (find-file (car siblings)))
+ (t
+ (let ((relatives (mapcar (lambda (sibling)
+ (file-relative-name
+ sibling (file-name-directory file)))
+ siblings)))
+ (find-file
+ (completing-read (format-prompt "Find file" (car relatives))
+ relatives nil t nil nil (car relatives))))))))
+
+(defun find-sibling-file-search (file &optional rules)
+ "Return a list of FILE's \"siblings\"
+RULES should be a list on the form defined by `find-sibling-rules' (which
+see), and if nil, defaults to `find-sibling-rules'."
+ (let ((results nil))
+ (pcase-dolist (`(,match . ,expansions) (or rules find-sibling-rules))
+ ;; Go through the list and find matches.
+ (when (string-match match file)
+ (let ((match-data (match-data)))
+ (dolist (expansion expansions)
+ (let ((start 0))
+ ;; Expand \\1 forms in the expansions.
+ (while (string-match "\\\\\\([&0-9]+\\)" expansion start)
+ (let ((index (string-to-number (match-string 1 expansion))))
+ (setq start (match-end 0)
+ expansion
+ (replace-match
+ (substring file
+ (elt match-data (* index 2))
+ (elt match-data (1+ (* index 2))))
+ t t expansion)))))
+ ;; Then see which files we have that are matching. (And
+ ;; expand from the end of the file's match, since we might
+ ;; be doing a relative match.)
+ (let ((default-directory (substring file 0 (car match-data))))
+ ;; Keep the first matches first.
+ (setq results
+ (nconc
+ results
+ (mapcar #'expand-file-name
+ (file-expand-wildcards expansion nil t)))))))))
+ ;; Delete the file itself (in case it matched), and remove
+ ;; duplicates, in case we have several expansions and some match
+ ;; the same subsets of files.
+ (delete file (delete-dups results))))
+
;; Let Tramp know that `file-expand-wildcards' does not need an advice.
(provide 'files '(remote-wildcards))
@@ -7168,11 +7468,17 @@ DIRNAME is globbed by the shell if necessary.
Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
Actions controlled by variables `list-directory-brief-switches'
and `list-directory-verbose-switches'."
- (interactive (let ((pfx current-prefix-arg))
- (list (read-directory-name (if pfx "List directory (verbose): "
- "List directory (brief): ")
- nil default-directory nil)
- pfx)))
+ (interactive
+ (let ((pfx current-prefix-arg))
+ (list (read-file-name
+ (if pfx "List directory (verbose): "
+ "List directory (brief): ")
+ nil default-directory
+ (lambda (file)
+ (or (file-directory-p file)
+ (insert-directory-wildcard-in-dir-p
+ (file-name-as-directory (expand-file-name file))))))
+ pfx)))
(let ((switches (if verbose list-directory-verbose-switches
list-directory-brief-switches))
buffer)
@@ -7190,9 +7496,9 @@ and `list-directory-verbose-switches'."
;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
(with-current-buffer buffer
(setq default-directory
- (if (file-directory-p dirname)
+ (if (file-accessible-directory-p dirname)
(file-name-as-directory dirname)
- (file-name-directory dirname))))))
+ (file-name-directory (directory-file-name dirname)))))))
(defun shell-quote-wildcard-pattern (pattern)
"Quote characters special to the shell in PATTERN, leave wildcards alone.
@@ -7625,21 +7931,7 @@ normally equivalent short `-D' option is just passed on to
(if val coding-no-eol coding))
(if val
(put-text-property pos (point)
- 'dired-filename t)))))))
-
- (if full-directory-p
- ;; Try to insert the amount of free space.
- (save-excursion
- (goto-char beg)
- ;; First find the line to put it on.
- (when (re-search-forward "^ *\\(total\\)" nil t)
- ;; Replace "total" with "total used in directory" to
- ;; avoid confusion.
- (replace-match "total used in directory" nil nil nil 1)
- (let ((available (get-free-disk-space file)))
- (when available
- (end-of-line)
- (insert " available " available))))))))))
+ 'dired-filename t)))))))))))
(defun insert-directory-adj-pos (pos error-lines)
"Convert `ls --dired' file name position value POS to a buffer position.
@@ -7694,18 +7986,34 @@ prompt the user before killing them."
:group 'convenience
:version "26.1")
-(defun save-buffers-kill-emacs (&optional arg)
+(defun save-buffers-kill-emacs (&optional arg restart)
"Offer to save each buffer, then kill this Emacs process.
With prefix ARG, silently save all file-visiting buffers without asking.
If there are active processes where `process-query-on-exit-flag'
returns non-nil and `confirm-kill-processes' is non-nil,
asks whether processes should be killed.
+
Runs the members of `kill-emacs-query-functions' in turn and stops
-if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
+if any returns nil. If `confirm-kill-emacs' is non-nil, calls it.
+
+If RESTART, restart Emacs after killing the current Emacs process."
(interactive "P")
;; Don't use save-some-buffers-default-predicate, because we want
;; to ask about all the buffers before killing Emacs.
- (save-some-buffers arg t)
+ (when (or (files--buffers-needing-to-be-saved t)
+ (catch 'need-save
+ (dolist (func save-some-buffers-functions)
+ (when (funcall func 'query)
+ (throw 'need-save t)))))
+ (if (use-dialog-box-p)
+ (pcase (x-popup-dialog
+ t `("Unsaved Buffers"
+ ("Close Without Saving" . no-save)
+ ("Save All" . save-all)
+ ("Cancel" . cancel)))
+ ('cancel (user-error "Exit cancelled"))
+ ('save-all (save-some-buffers t)))
+ (save-some-buffers arg t)))
(let ((confirm confirm-kill-emacs))
(and
(or (not (memq t (mapcar (lambda (buf)
@@ -7746,7 +8054,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm)
(funcall confirm "Really exit Emacs? "))
- (kill-emacs))))
+ (kill-emacs nil restart))))
(defun save-buffers-kill-terminal (&optional arg)
"Offer to save each buffer, then kill the current connection.
@@ -7761,6 +8069,16 @@ only these files will be asked to be saved."
(if (frame-parameter nil 'client)
(server-save-buffers-kill-terminal arg)
(save-buffers-kill-emacs arg)))
+
+(defun restart-emacs ()
+ "Kill the current Emacs process and start a new one.
+This goes through the same shutdown procedure as
+`save-buffers-kill-emacs', but instead of killing Emacs and
+exiting, it re-executes Emacs (using the same command line
+arguments as the running Emacs)."
+ (interactive)
+ (save-buffers-kill-emacs nil t))
+
;; We use /: as a prefix to "quote" a file name
;; so that magic file name handlers will not apply to it.
@@ -7800,10 +8118,11 @@ only these files will be asked to be saved."
;; Get a list of the indices of the args that are file names.
(file-arg-indices
(cdr (or (assq operation
- '(;; The first seven are special because they
+ '(;; The first eight are special because they
;; return a file name. We want to include
;; the /: in the return value. So just
;; avoid stripping it in the first place.
+ (abbreviate-file-name)
(directory-file-name)
(expand-file-name)
(file-name-as-directory)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 83a914d58cc..a8d837e7e15 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -208,7 +208,7 @@ COND-FN takes one argument: the current element."
(defun filesets-reset-fileset (&optional fileset no-cache)
"Reset the cached values for one or all filesets."
(setq filesets-submenus (if fileset
- (lax-plist-put filesets-submenus fileset nil)
+ (plist-put filesets-submenus fileset nil #'equal)
nil))
(setq filesets-has-changed-flag t)
(setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
@@ -326,8 +326,8 @@ See `easy-menu-add-item' for documentation."
Set this to \"\", to disable caching of menus.
Don't forget to check out `filesets-menu-ensure-use-cached'."
:set #'filesets-set-default
- :type 'file)
-(put 'filesets-menu-cache-file 'risky-local-variable t)
+ :type 'file
+ :risky t)
(defcustom filesets-menu-cache-contents
'(filesets-be-docile-flag
@@ -414,12 +414,12 @@ time to time or if the fileset cache causes troubles."
Set this value to 0 to turn menu splitting off. BTW, parts of submenus
will not be rewrapped if their length exceeds this value."
:set #'filesets-set-default
- :type 'integer)
+ :type 'natnum)
(defcustom filesets-max-entry-length 50
"Truncate names of split submenus to this length."
:set #'filesets-set-default
- :type 'integer)
+ :type 'natnum)
(defcustom filesets-browse-dir-function #'dired
"A function or command used for browsing directories.
@@ -518,7 +518,7 @@ i.e. how deep the menu should be. Try something like
and it should become clear what this option is about. In any case,
including directory trees to the menu can take a lot of memory."
:set #'filesets-set-default
- :type 'integer)
+ :type 'natnum)
(defcustom filesets-commands
'(("Isearch"
@@ -546,6 +546,7 @@ function that returns one) to be run on a filesets' files.
The argument <file-name> or <<file-name>> (quoted) will be replaced with
the filename."
:set #'filesets-set-default+
+ :risky t
:type '(repeat :tag "Commands"
(list :tag "Definition" :value ("")
(string "Name")
@@ -561,8 +562,7 @@ the filename."
(string :tag "Quoted File Name"
:value "<<file-name>>")
(function :tag "Function"
- :value nil))))))
-(put 'filesets-commands 'risky-local-variable t)
+ :value nil))))))
(defcustom filesets-external-viewers
(let
@@ -651,6 +651,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
(and (filesets-which-command-p \"rtf2htm\")
(filesets-which-command-p \"w3m\"))))))"
:set #'filesets-set-default
+ :risky t
:type '(repeat :tag "Viewer"
(list :tag "Definition"
:value ("^.+\\.suffix$" "")
@@ -707,7 +708,6 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
(const :format ""
:value :capture-output)
(boolean :tag "Boolean")))))))
-(put 'filesets-external-viewers 'risky-local-variable t)
(defcustom filesets-ingroup-patterns
'(("^.+\\.tex$" t
@@ -848,6 +848,7 @@ With duplicates removed, it would be:
M + A - X
B"
:set #'filesets-set-default
+ :risky t
:type '(repeat
:tag "Include"
(list
@@ -894,7 +895,6 @@ With duplicates removed, it would be:
:value (:preprocess)
(const :format "" :value :preprocess)
(function :tag "Function"))))))))
-(put 'filesets-ingroup-patterns 'risky-local-variable t)
(defcustom filesets-data nil
"Fileset definitions.
@@ -965,6 +965,7 @@ is used.
Before using :ingroup, make sure that the file type is already
defined in `filesets-ingroup-patterns'."
:set #'filesets-data-set-default
+ :risky t
:type '(repeat
(cons :tag "Fileset"
(string :tag "Name" :value "")
@@ -1021,13 +1022,12 @@ defined in `filesets-ingroup-patterns'."
:value (:open)
(const :format "" :value :open)
(function :tag "Function")))))))
-(put 'filesets-data 'risky-local-variable t)
(defcustom filesets-query-user-limit 15
"Query the user before opening a fileset with that many files."
:set #'filesets-set-default
- :type 'integer)
+ :type 'natnum)
(defun filesets-filter-dir-names (lst &optional negative)
@@ -1999,7 +1999,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(defun filesets-ingroup-cache-get (master)
"Access to `filesets-ingroup-cache'."
- (lax-plist-get filesets-ingroup-cache master))
+ (plist-get filesets-ingroup-cache master #'equal))
(defun filesets-ingroup-cache-put (master file)
"Access to `filesets-ingroup-cache'."
@@ -2008,7 +2008,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(cons file (filesets-ingroup-cache-get emaster))
nil)))
(setq filesets-ingroup-cache
- (lax-plist-put filesets-ingroup-cache emaster this))))
+ (plist-put filesets-ingroup-cache emaster this #'equal))))
(defun filesets-ingroup-collect-files (fs &optional remdupl-flag master depth)
"Helper function for `filesets-ingroup-collect'. Collect file names."
@@ -2305,12 +2305,12 @@ bottom up, set `filesets-submenus' to nil, first.)"
((null data))
(let* ((this (car data))
(name (filesets-data-get-name this))
- (cached (lax-plist-get filesets-submenus name))
+ (cached (plist-get filesets-submenus name #'equal))
(submenu (or cached
(filesets-build-submenu count name this))))
(unless cached
(setq filesets-submenus
- (lax-plist-put filesets-submenus name submenu)))
+ (plist-put filesets-submenus name submenu #'equal)))
(unless (filesets-entry-get-dormant-flag this)
(setq filesets-menu-cache
(append filesets-menu-cache (list submenu))))))
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index e4cd6078ec4..63f2148e47c 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -154,6 +154,9 @@ output of `find' (one file per line) when this function is called."
;; History of find-args values entered in the minibuffer.
(defvar find-args-history nil)
+(defvar find-command-history nil
+ "History of commands passed interactively to `find-dired-with-command'.")
+
(defvar dired-sort-inhibit)
;;;###autoload
@@ -176,6 +179,38 @@ man page for \"find\"."
(interactive (list (read-directory-name "Run find in directory: " nil "" t)
(read-string "Run find (with args): " find-args
'(find-args-history . 1))))
+ (setq find-args args ; save for next interactive call
+ args (concat find-program " . "
+ (if (string= args "")
+ ""
+ (concat
+ (shell-quote-argument "(")
+ " " args " "
+ (shell-quote-argument ")")
+ " "))
+ (find-dired--escaped-ls-option)))
+ (find-dired-with-command dir args))
+
+;;;###autoload
+(defun find-dired-with-command (dir command)
+ "Run `find' and go into Dired mode on a buffer of the output.
+The user-supplied COMMAND is run after changing into DIR and should look like
+
+ find . GLOBALARGS \\( ARGS \\) -ls
+
+The car of the variable `find-ls-option' specifies what to
+use in place of \"-ls\" as the starting input.
+
+Collect output in the \"*Find*\" buffer. To kill the job before
+it finishes, type \\[kill-find]."
+ (interactive
+ (list (read-directory-name "Run find in directory: " nil "" t)
+ (read-string "Run find command: "
+ (cons (concat find-program
+ " . \\( \\) "
+ (find-dired--escaped-ls-option))
+ (+ 1 (length find-program) (length " . \\( ")))
+ find-command-history)))
(let ((dired-buffers dired-buffers))
;; Expand DIR ("" means default-directory), and make sure it has a
;; trailing slash.
@@ -204,25 +239,9 @@ man page for \"find\"."
(kill-all-local-variables)
(setq buffer-read-only nil)
(erase-buffer)
- (setq default-directory dir
- find-args args ; save for next interactive call
- args (concat find-program " . "
- (if (string= args "")
- ""
- (concat
- (shell-quote-argument "(")
- " " args " "
- (shell-quote-argument ")")
- " "))
- (if (string-match "\\`\\(.*\\) {} \\(\\\\;\\|\\+\\)\\'"
- (car find-ls-option))
- (format "%s %s %s"
- (match-string 1 (car find-ls-option))
- (shell-quote-argument "{}")
- find-exec-terminator)
- (car find-ls-option))))
+ (setq default-directory dir)
;; Start the find process.
- (shell-command (concat args "&") (current-buffer))
+ (shell-command (concat command "&") (current-buffer))
(dired-mode dir (cdr find-ls-option))
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
@@ -231,7 +250,7 @@ man page for \"find\"."
(setq-local dired-sort-inhibit t)
(setq-local revert-buffer-function
(lambda (_ignore-auto _noconfirm)
- (find-dired dir find-args)))
+ (find-dired-with-command dir command)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
;; will work even with nested dired format (dired-nstd.el,v 1.15
@@ -239,17 +258,19 @@ man page for \"find\"."
(dired-simple-subdir-alist)
;; else we have an ancient tree dired (or classic dired, where
;; this does no harm)
- (setq-local dired-subdir-alist
- (list (cons default-directory (point-min-marker)))))
+ (setq dired-subdir-alist
+ (list (cons default-directory (point-min-marker)))))
(setq-local dired-subdir-switches find-ls-subdir-switches)
(setq buffer-read-only nil)
;; Subdir headlerline must come first because the first marker in
;; subdir-alist points there.
(insert " " dir ":\n")
+ (when dired-make-directory-clickable
+ (dired--make-directory-clickable))
;; Make second line a ``find'' line in analogy to the ``total'' or
;; ``wildcard'' line.
(let ((point (point)))
- (insert " " args "\n")
+ (insert " " command "\n")
(dired-insert-set-properties point (point)))
(setq buffer-read-only t)
(let ((proc (get-buffer-process (current-buffer))))
@@ -259,6 +280,16 @@ man page for \"find\"."
(move-marker (process-mark proc) (point) (current-buffer)))
(setq mode-line-process '(":%s"))))
+(defun find-dired--escaped-ls-option ()
+ "Return the car of `find-ls-option' escaped for a shell command."
+ (if (string-match "\\`\\(.*\\) {} \\(\\\\;\\|\\+\\)\\'"
+ (car find-ls-option))
+ (format "%s %s %s"
+ (match-string 1 (car find-ls-option))
+ (shell-quote-argument "{}")
+ find-exec-terminator)
+ (car find-ls-option)))
+
(defun kill-find ()
"Kill the `find' process running in the current buffer."
(interactive)
@@ -328,11 +359,7 @@ specifies what to use in place of \"-ls\" as the final argument."
(save-restriction
(widen)
(let ((buffer-read-only nil)
- (beg (point-max))
- (l-opt (and (consp find-ls-option)
- (string-match "l" (cdr find-ls-option))))
- (ls-regexp (concat "^ +[^ \t\r\n]+\\( +[^ \t\r\n]+\\) +"
- "[^ \t\r\n]+ +[^ \t\r\n]+\\( +[^[:space:]]+\\)")))
+ (beg (point-max)))
(goto-char beg)
(insert string)
(goto-char beg)
@@ -347,18 +374,6 @@ specifies what to use in place of \"-ls\" as the final argument."
(goto-char (- beg 3)) ; no error if < 0
(while (search-forward " ./" nil t)
(delete-region (point) (- (point) 2)))
- ;; Pad the number of links and file size. This is a
- ;; quick and dirty way of getting the columns to line up
- ;; most of the time, but it's not foolproof.
- (when l-opt
- (goto-char beg)
- (goto-char (line-beginning-position))
- (while (re-search-forward ls-regexp nil t)
- (replace-match (format "%4s" (match-string 1))
- nil nil nil 1)
- (replace-match (format "%9s" (match-string 2))
- nil nil nil 2)
- (forward-line 1)))
;; Find all the complete lines in the unprocessed
;; output and process it to add text properties.
(goto-char (point-max))
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index d4d899aced7..0a712c0b811 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -231,8 +231,8 @@ It is a function which takes two arguments, the directory and its parent."
(dired-simple-subdir-alist)
;; else we have an ancient tree dired (or classic dired, where
;; this does no harm)
- (setq-local dired-subdir-alist
- (list (cons default-directory (point-min-marker)))))
+ (setq dired-subdir-alist
+ (list (cons default-directory (point-min-marker)))))
(find-lisp-insert-directory
dir file-predicate directory-predicate 'ignore)
(goto-char (point-min))
diff --git a/lisp/finder.el b/lisp/finder.el
index 382bc2023f5..73072c0cd48 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -1,7 +1,6 @@
;;; finder.el --- topic & keyword-based code finder -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1997-1999, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 16 Jun 1992
@@ -76,20 +75,18 @@
"Association list of the standard \"Keywords:\" headers.
Each element has the form (KEYWORD . DESCRIPTION).")
-(defvar finder-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map " " 'finder-select)
- (define-key map "f" 'finder-select)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'finder-mouse-select)
- (define-key map "\C-m" 'finder-select)
- (define-key map "?" 'finder-summary)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "q" 'finder-exit)
- (define-key map "d" 'finder-list-keywords)
- map)
- "Keymap used in `finder-mode'.")
+(defvar-keymap finder-mode-map
+ :doc "Keymap used in `finder-mode'."
+ "SPC" #'finder-select
+ "f" #'finder-select
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'finder-mouse-select
+ "C-m" #'finder-select
+ "?" #'finder-summary
+ "n" #'next-line
+ "p" #'previous-line
+ "q" #'finder-exit
+ "d" #'finder-list-keywords)
(easy-menu-define finder-mode-menu finder-mode-map
"Menu for `finder-mode'."
@@ -130,8 +127,6 @@ Keywords and package names both should be symbols.")
cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
"Regexp matching file names not to scan for keywords.")
-(autoload 'autoload-rubric "autoload")
-
(defconst finder--builtins-descriptions
;; I have no idea whether these are supposed to be capitalized
;; and/or end in a full-stop. Existing file headers are inconsistent,
@@ -267,9 +262,9 @@ from; the default is `load-path'."
(find-file-noselect generated-finder-keywords-file)
(setq buffer-undo-list t)
(erase-buffer)
- (insert (autoload-rubric generated-finder-keywords-file
- "keyword-to-package mapping" t))
- (search-backward " ")
+ (generate-lisp-file-heading
+ generated-finder-keywords-file 'finder-compile-keywords
+ :title "keyword-to-package mapping")
;; FIXME: Now that we have package--builtin-versions, package--builtins is
;; only needed to get the list of unversioned packages and to get the
;; summary description of each package.
@@ -283,6 +278,7 @@ from; the default is `load-path'."
(insert "(setq finder-keywords-hash\n ")
(prin1 finder-keywords-hash (current-buffer))
(insert ")\n")
+ (generate-lisp-file-trailer generated-finder-keywords-file)
(basic-save-buffer)))
(defun finder-compile-keywords-make-dist ()
@@ -362,19 +358,13 @@ not `finder-known-keywords'."
(let ((package-list-unversioned t))
(package-show-package-list packages))))
-(define-button-type 'finder-xref 'action #'finder-goto-xref)
-
-(defun finder-goto-xref (button)
- "Jump to a Lisp file for the BUTTON at point."
- (let* ((file (button-get button 'xref))
- (lib (locate-library file)))
- (if lib (finder-commentary lib)
- (message "Unable to locate `%s'" file))))
-
;;;###autoload
(defun finder-commentary (file)
"Display FILE's commentary section.
FILE should be in a form suitable for passing to `locate-library'."
+ ;; FIXME: Merge this function into `describe-package', which is
+ ;; strictly better as it has links to URLs and is in a proper help
+ ;; buffer with navigation forward and backward, etc.
(interactive
(list
(completing-read "Library name: "
@@ -391,12 +381,7 @@ FILE should be in a form suitable for passing to `locate-library'."
(erase-buffer)
(insert str)
(goto-char (point-min))
- (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
- (if (locate-library (match-string 1))
- (make-text-button (match-beginning 1) (match-end 1)
- 'xref (match-string-no-properties 1)
- 'help-echo "Read this file's commentary"
- :type 'finder-xref)))
+ (package--describe-add-library-links)
(goto-char (point-min))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
@@ -465,10 +450,14 @@ Quit the window and kill all Finder-related buffers."
(defun finder-unload-function ()
"Unload the Finder library."
- (with-demoted-errors (unload-feature 'finder-inf t))
+ (with-demoted-errors "Error unloading finder: %S"
+ (unload-feature 'finder-inf t))
;; continue standard unloading
nil)
+(define-obsolete-function-alias 'finder-goto-xref
+ #'package--finder-goto-xref "29.1")
+
(provide 'finder)
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 4b192a7b6aa..e00fb40e3ca 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -473,7 +473,7 @@ What happens depends on the number of mouse clicks:-
"Swallow intervening mouse events so we only get the final click-count.
Signal an error if the final event isn't the same type as the first one."
(let ((initial-event-type (event-basic-type event)))
- (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay))
+ (while (null (sit-for (/ (mouse-double-click-time) 1000.0) 'nodisplay))
(setq event (read--potential-mouse-event)))
(or (eq initial-event-type (event-basic-type event))
(error "")))
diff --git a/lisp/follow.el b/lisp/follow.el
index 6c721899d45..adf1c1b762d 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1552,7 +1552,7 @@ non-first windows in Follow mode."
(declare-function scroll-bar-drag "scroll-bar" (event))
(declare-function scroll-bar-scroll-up "scroll-bar" (event))
(declare-function scroll-bar-scroll-down "scroll-bar" (event))
-(declare-function mwheel-scroll "mwheel" (event))
+(declare-function mwheel-scroll "mwheel" (event &optional arg))
(defun follow-scroll-bar-toolkit-scroll (event)
(interactive "e")
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 21d6f514ab6..f92d1e38306 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -66,6 +66,7 @@ Other variables include that for syntactic keyword fontification,
functions, `font-lock-fontify-buffer-function',
`font-lock-unfontify-buffer-function', `font-lock-fontify-region-function',
`font-lock-unfontify-region-function', and `font-lock-inhibit-thing-lock'.")
+;; Autoload if this file no longer dumped.
;;;###autoload
(put 'font-lock-defaults 'risky-local-variable t)
@@ -106,8 +107,7 @@ example, put in your ~/.emacs:
Where major modes support different levels of fontification, you
can use the variable `font-lock-maximum-decoration' to specify
which level you generally prefer. When you turn Font Lock mode
-on/off the buffer is fontified/defontified, though fontification
-occurs only if the buffer is less than `font-lock-maximum-size'.
+on/off the buffer is fontified/defontified.
To add your own highlighting for some major mode, and modify the
highlighting selected automatically via the variable
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index c9c390840ff..181a7dc90ef 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -47,9 +47,9 @@
;;
;; Fontification for a particular mode may be available in a number of levels
;; of decoration. The higher the level, the more decoration, but the more time
-;; it takes to fontify. See the variable `font-lock-maximum-decoration', and
-;; also the variable `font-lock-maximum-size'. Support modes for Font Lock
-;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'.
+;; it takes to fontify. See the variable `font-lock-maximum-decoration'.
+;; Support modes for Font Lock mode can be used to speed up Font Lock
+;; mode. See `font-lock-support-mode'.
;;;; How Font Lock mode fontifies:
@@ -208,6 +208,7 @@
(require 'syntax)
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
;; Define core `font-lock' group.
(defgroup font-lock '((jit-lock custom-group))
@@ -227,32 +228,6 @@
;; User variables.
-(defcustom font-lock-maximum-size 256000
- "Maximum buffer size for unsupported buffer fontification.
-When `font-lock-support-mode' is nil, only buffers smaller than
-this are fontified. This variable has no effect if a Font Lock
-support mode (usually `jit-lock-mode') is enabled.
-
-If nil, means size is irrelevant.
-If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
-where MAJOR-MODE is a symbol or t (meaning the default). For example:
- ((c-mode . 256000) (c++-mode . 256000) (rmail-mode . 1048576))
-means that the maximum size is 250K for buffers in C or C++ modes, one megabyte
-for buffers in Rmail mode, and size is irrelevant otherwise."
- :type '(choice (const :tag "none" nil)
- (integer :tag "size")
- (repeat :menu-tag "mode specific" :tag "mode specific"
- :value ((t . nil))
- (cons :tag "Instance"
- (radio :tag "Mode"
- (const :tag "all" t)
- (symbol :tag "name"))
- (radio :tag "Size"
- (const :tag "none" nil)
- (integer :tag "size")))))
- :group 'font-lock)
-(make-obsolete-variable 'font-lock-maximum-size nil "24.1")
-
(defcustom font-lock-maximum-decoration t
"Maximum decoration level for fontification.
If nil, use the default decoration (typically the minimum available).
@@ -279,6 +254,47 @@ decoration for buffers in C++ mode, and level 1 decoration otherwise."
(integer :tag "level" 1)))))
:group 'font-lock)
+(defcustom font-lock-ignore nil
+ "Rules to selectively disable fontifications due to `font-lock-keywords'.
+If non-nil, the value should be a list of condition sets of the form
+
+ (SYMBOL CONDITION ...)
+
+where:
+
+ - SYMBOL is a symbol, usually a major or minor mode. The subsequent
+ CONDITIONs apply if SYMBOL is bound as variable and its value is non-nil.
+ If SYMBOL is a symbol of a mode, that means the buffer has that mode
+ enabled (for major modes, it means the buffer's major mode is derived
+ from SYMBOL's mode).
+
+ - Each CONDITION can be one of the following:
+ - A symbol, typically a face. It matches any element of
+ `font-lock-keywords' that references the symbol. The symbol is
+ interpreted as a glob pattern; in particular, `*' matches
+ everything, `?' matches any single character, and `[abcd]'
+ matches one character from the set.
+ - A string. It matches any element of `font-lock-keywords' whose
+ MATCHER is a regexp that matches the string. This can be used to
+ disable fontification of a particular programming keyword.
+ - A form (pred FUNCTION). It matches an element of `font-lock-keywords'
+ if FUNCTION, when called with the element as the argument, returns
+ non-nil.
+ - A form (not CONDITION). It matches if CONDITION doesn't.
+ - A form (and CONDITION ...). It matches if all the provided
+ CONDITIONs match.
+ - A form (or CONDITION ...). It matches if at least one of the
+ provided CONDITIONs matches.
+ - A form (except CONDITIONs ...). This can be used only at top level
+ or inside an `or' clause. It undoes the effect of previous
+ matching CONDITIONs on the same level.
+
+In each buffer, fontifications due to the elements of `font-lock-keywords'
+that match at least one applicable CONDITION are disabled."
+ :type '(alist :key-type symbol :value-type sexp)
+ :group 'font-lock
+ :version "29.1")
+
(defcustom font-lock-verbose nil
"If non-nil, means show status messages for buffer fontification.
If a number, only buffers greater than this size have fontification messages."
@@ -653,15 +669,9 @@ be enabled."
;; The first fontification after turning the mode on. This must
;; only be called after the mode hooks have been run.
(when (and font-lock-mode
- (font-lock-specified-p t))
- (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size)))
- (cond (font-lock-fontified
- nil)
- ((or (null max-size) (> max-size (buffer-size)))
- (with-no-warnings (font-lock-fontify-buffer)))
- (font-lock-verbose
- (message "Fontifying %s...buffer size greater than font-lock-maximum-size"
- (buffer-name)))))))
+ (font-lock-specified-p t)
+ (not font-lock-fontified))
+ (with-no-warnings (font-lock-fontify-buffer))))
(defun font-lock-mode-internal (arg)
;; Turn on Font Lock mode.
@@ -1203,28 +1213,26 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(setq font-lock-beg (or (previous-single-property-change
font-lock-beg 'font-lock-multiline)
(point-min))))
- ;;
- (when (get-text-property font-lock-end 'font-lock-multiline)
- (setq changed t)
- (setq font-lock-end (or (text-property-any font-lock-end (point-max)
- 'font-lock-multiline nil)
- (point-max))))
+ ;; If `font-lock-multiline' starts at `font-lock-end', do not
+ ;; extend the region.
+ (let ((before-end (max (point-min) (1- font-lock-end)))
+ (new-end nil))
+ (when (get-text-property before-end 'font-lock-multiline)
+ (setq new-end (or (text-property-any before-end (point-max)
+ 'font-lock-multiline nil)
+ (point-max)))
+ (when (/= new-end font-lock-end)
+ (setq changed t)
+ (setq font-lock-end new-end))))
changed))
(defun font-lock-extend-region-wholelines ()
"Move fontification boundaries to beginning of lines."
- (let ((changed nil))
- (goto-char font-lock-beg)
- (unless (bolp)
- (setq changed t font-lock-beg
- (let ((inhibit-field-text-motion t))
- (line-beginning-position))))
- (goto-char font-lock-end)
- (unless (bolp)
- (unless (eq font-lock-end
- (setq font-lock-end (line-beginning-position 2)))
- (setq changed t)))
- changed))
+ (let ((new (syntax-propertize-wholelines font-lock-beg font-lock-end)))
+ (when new
+ (setq font-lock-beg (car new))
+ (setq font-lock-end (cdr new))
+ t)))
(defun font-lock-default-fontify-region (beg end loudly)
"Fontify the text between BEG and END.
@@ -1518,7 +1526,7 @@ see `font-lock-syntactic-keywords'."
(or (nth 3 highlight)
(error "No match %d in highlight %S" match highlight))
(when (and (consp value) (not (numberp (car value))))
- (setq value (eval value)))
+ (setq value (eval value t)))
(when (stringp value) (setq value (string-to-syntax value)))
;; Flush the syntax-cache. I believe this is not necessary for
;; font-lock's use of syntax-ppss, but I'm not 100% sure and it can
@@ -1542,7 +1550,7 @@ KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords',
LIMIT can be modified by the value of its PRE-MATCH-FORM."
(let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
;; Evaluate PRE-MATCH-FORM.
- (pre-match-value (eval (nth 1 keywords))))
+ (pre-match-value (eval (nth 1 keywords) t)))
;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
(if (and (numberp pre-match-value) (> pre-match-value (point)))
(setq limit pre-match-value)
@@ -1558,7 +1566,7 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(font-lock-apply-syntactic-highlight (car highlights))
(setq highlights (cdr highlights)))))
;; Evaluate POST-MATCH-FORM.
- (eval (nth 2 keywords))))
+ (eval (nth 2 keywords) t)))
(defun font-lock-fontify-syntactic-keywords-region (start end)
"Fontify according to `font-lock-syntactic-keywords' between START and END.
@@ -1671,7 +1679,7 @@ HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'."
;; No match but we might not signal an error.
(or (nth 3 highlight)
(error "No match %d in highlight %S" match highlight))
- (let ((val (eval (nth 1 highlight))))
+ (let ((val (eval (nth 1 highlight) t)))
(when (eq (car-safe val) 'face)
(add-text-properties start end (cddr val))
(setq val (cadr val)))
@@ -1706,7 +1714,7 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
(lead-start (match-beginning 0))
;; Evaluate PRE-MATCH-FORM.
- (pre-match-value (eval (nth 1 keywords))))
+ (pre-match-value (eval (nth 1 keywords) t)))
;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
(if (not (and (numberp pre-match-value) (> pre-match-value (point))))
(setq limit (line-end-position))
@@ -1731,7 +1739,7 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(font-lock-apply-highlight (car highlights))
(setq highlights (cdr highlights)))))
;; Evaluate POST-MATCH-FORM.
- (eval (nth 2 keywords))))
+ (eval (nth 2 keywords) t)))
(defun font-lock-fontify-keywords-region (start end &optional loudly)
"Fontify according to `font-lock-keywords' between START and END.
@@ -1810,9 +1818,8 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
(error "Font-lock trying to use keywords before setting them up"))
(if (eq (car-safe keywords) t)
keywords
- (setq keywords
- (cons t (cons keywords
- (mapcar #'font-lock-compile-keyword keywords))))
+ (let ((compiled (mapcar #'font-lock-compile-keyword keywords)))
+ (setq keywords `(t ,keywords ,@(font-lock--filter-keywords compiled))))
(if (and (not syntactic-keywords)
(let ((beg-function (with-no-warnings syntax-begin-function)))
(or (eq beg-function #'beginning-of-defun)
@@ -1838,7 +1845,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
(cond ((or (functionp keyword) (nlistp keyword)) ; MATCHER
(list keyword '(0 font-lock-keyword-face)))
((eq (car keyword) 'eval) ; (eval . FORM)
- (font-lock-compile-keyword (eval (cdr keyword))))
+ (font-lock-compile-keyword (eval (cdr keyword) t)))
((eq (car-safe (cdr keyword)) 'quote) ; (MATCHER . 'FORM)
;; If FORM is a FACENAME then quote it. Otherwise ignore the quote.
(if (symbolp (nth 2 keyword))
@@ -1859,7 +1866,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
keywords
(font-lock-eval-keywords (if (fboundp keywords)
(funcall keywords)
- (eval keywords)))))
+ (eval keywords t)))))
(defun font-lock-value-in-major-mode (values)
"If VALUES is a list, use `major-mode' as a key and return the `assq' value.
@@ -1883,6 +1890,50 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to
(t
(car keywords))))
+(defun font-lock--match-keyword (rule keyword)
+ "Return non-nil if font-lock KEYWORD matches RULE.
+See `font-lock-ignore' for the possible rules."
+ (pcase-exhaustive rule
+ ('* t)
+ ((pred symbolp)
+ (let ((regexp (when (string-match-p "[*?]" (symbol-name rule))
+ (wildcard-to-regexp (symbol-name rule)))))
+ (named-let search ((obj keyword))
+ (cond
+ ((consp obj) (or (search (car obj)) (search (cdr obj))))
+ ((not regexp) (eq rule obj))
+ ((symbolp obj) (string-match-p regexp (symbol-name obj)))))))
+ ((pred stringp) (when (stringp (car keyword))
+ (string-match-p (concat "\\`\\(?:" (car keyword) "\\)")
+ rule)))
+ (`(or . ,rules) (let ((match nil))
+ (while rules
+ (pcase-exhaustive (pop rules)
+ (`(except ,rule)
+ (when match
+ (setq match (not (font-lock--match-keyword rule keyword)))))
+ (rule
+ (unless match
+ (setq match (font-lock--match-keyword rule keyword))))))
+ match))
+ (`(not ,rule) (not (font-lock--match-keyword rule keyword)))
+ (`(and . ,rules) (seq-every-p (lambda (rule)
+ (font-lock--match-keyword rule keyword))
+ rules))
+ (`(pred ,fun) (funcall fun keyword))))
+
+(defun font-lock--filter-keywords (keywords)
+ "Filter a list of KEYWORDS using `font-lock-ignore'."
+ (if-let ((rules (mapcan (pcase-lambda (`(,mode . ,rules))
+ (when (or (and (boundp mode) mode)
+ (derived-mode-p mode))
+ (copy-sequence rules)))
+ font-lock-ignore)))
+ (seq-filter (lambda (keyword) (not (font-lock--match-keyword
+ `(or ,@rules) keyword)))
+ keywords)
+ keywords))
+
(defun font-lock-refresh-defaults ()
"Restart fontification in current buffer after recomputing from defaults.
Recompute fontification variables using `font-lock-defaults' and
@@ -1906,8 +1957,9 @@ preserve `hi-lock-mode' highlighting patterns."
Sets various variables using `font-lock-defaults' and
`font-lock-maximum-decoration'."
;; Set fontification defaults if not previously set for correct major mode.
- (unless (and font-lock-set-defaults
- (eq font-lock-major-mode major-mode))
+ (when (or (not font-lock-set-defaults)
+ (not font-lock-major-mode)
+ (not (derived-mode-p font-lock-major-mode)))
(setq font-lock-major-mode major-mode)
(setq font-lock-set-defaults t)
(let* ((defaults font-lock-defaults)
@@ -2075,7 +2127,7 @@ as the constructs of Haddock, Javadoc and similar systems."
(((class color) (min-colors 16) (background dark)) :foreground "PaleGreen")
(((class color) (min-colors 8)) :foreground "green")
(t :weight bold :underline t))
- "Font Lock mode face used to highlight type and classes."
+ "Font Lock mode face used to highlight type and class names."
:group 'font-lock-faces)
(defface font-lock-constant-face
@@ -2277,7 +2329,7 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
;; e.g. assembler code and GNU linker script in Linux kernel.
;; `cpp-font-lock-keywords' is handy for modes for the files.
;;
-;; Here we cannot use `regexp-opt' because because regex-opt is not preloaded
+;; Here we cannot use `regexp-opt' because regex-opt is not preloaded
;; while font-lock.el is preloaded to emacs. So values pre-calculated with
;; regexp-opt are used here.
diff --git a/lisp/format.el b/lisp/format.el
index 39aa5c5457d..2c368b8f9c7 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -139,6 +139,7 @@ MODE-FN, if specified, is called when visiting a file with that format.
PRESERVE, if non-nil, means that `format-write-file' should not remove
this format from `buffer-file-format'.")
+;; Autoload if this file no longer dumped.
;;;###autoload
(put 'format-alist 'risky-local-variable t)
@@ -320,7 +321,7 @@ If the format is not specified, attempt a regexp-based guess.
Set `buffer-file-format' to the format used, and call any
format-specific mode functions."
(interactive
- (list (format-read "Translate buffer from format (default guess): ")))
+ (list (format-read (format-prompt "Translate buffer from format" "guess"))))
(save-excursion
(goto-char (point-min))
(format-decode format (buffer-size) t)))
@@ -331,7 +332,7 @@ Arg FORMAT is optional; if omitted the format will be determined by looking
for identifying regular expressions at the beginning of the region."
(interactive
(list (region-beginning) (region-end)
- (format-read "Translate region from format (default guess): ")))
+ (format-read (format-prompt "Translate region from format" "guess"))))
(save-excursion
(goto-char from)
(format-decode format (- to from) nil)))
diff --git a/lisp/forms.el b/lisp/forms.el
index 8bfeaad1c1a..fdc44b5214f 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -2009,7 +2009,7 @@ It returns the highest number.
Usage: (setq forms-number-of-fields
(forms-enumerate
- '(field1 field2 field2 ...)))"
+ \\='(field1 field2 field2 ...)))"
(let ((the-index 0))
(while the-fields
diff --git a/lisp/frame.el b/lisp/frame.el
index 69119b4c24f..9476cb0ec46 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -702,7 +702,9 @@ Return nil if we don't know how to interpret DISPLAY."
The optional argument PARAMETERS specifies additional frame parameters."
(interactive (if (fboundp 'x-display-list)
(list (completing-read "Make frame on display: "
- (x-display-list)))
+ (x-display-list) nil
+ nil (car (x-display-list))
+ nil (car (x-display-list))))
(user-error "This Emacs build does not support X displays")))
(make-frame (cons (cons 'display display) parameters)))
@@ -799,7 +801,7 @@ also select the new frame."
(window-state-get (frame-root-window frame))))
(default-frame-alist
(seq-remove (lambda (elem)
- (memq (car elem) '(name parent-id)))
+ (memq (car elem) frame-internal-parameters))
(frame-parameters frame)))
(new-frame (make-frame)))
(when windows
@@ -809,12 +811,16 @@ also select the new frame."
new-frame))
(defvar before-make-frame-hook nil
- "Functions to run before `make-frame' creates a new frame.")
+ "Functions to run before `make-frame' creates a new frame.
+Note that these functions are usually not run for the initial
+frame, unless you add them to the hook in your early-init file.")
(defvar after-make-frame-functions nil
"Functions to run after `make-frame' created a new frame.
The functions are run with one argument, the newly created
-frame.")
+frame.
+Note that these functions are usually not run for the initial
+frame, unless you add them to the hook in your early-init file.")
(defvar after-setting-font-hook nil
"Functions to run after a frame's font has been changed.")
@@ -879,7 +885,6 @@ the new frame according to its own rules."
(error "Don't know how to interpret display %S"
display)))
(t window-system)))
- (oldframe (selected-frame))
(params parameters)
frame child-frame)
@@ -897,8 +902,12 @@ the new frame according to its own rules."
(dolist (p default-frame-alist)
(unless (assq (car p) params)
(push p params)))
-
-;; (setq frame-size-history '(1000))
+ ;; Add parameters from `frame-inherited-parameters' unless they are
+ ;; overridden by explicit parameters.
+ (dolist (param frame-inherited-parameters)
+ (unless (assq param parameters)
+ (let ((val (frame-parameter nil param)))
+ (when val (push (cons param val) params)))))
(when (eq (cdr (or (assq 'minibuffer params) '(minibuffer . t)))
'child-frame)
@@ -931,12 +940,6 @@ the new frame according to its own rules."
frame 'minibuffer (frame-root-window child-frame))))
(normal-erase-is-backspace-setup-frame frame)
- ;; Inherit original frame's parameters unless they are overridden
- ;; by explicit parameters.
- (dolist (param frame-inherited-parameters)
- (unless (assq param parameters)
- (let ((val (frame-parameter oldframe param)))
- (when val (set-frame-parameter frame param val)))))
;; We can run `window-configuration-change-hook' for this frame now.
(frame-after-make-frame frame t)
@@ -1586,6 +1589,11 @@ acquires focus to be automatically raised.
Note that this minor mode controls Emacs's own auto-raise
feature. Window managers that switch focus on mouse movement
often have their own auto-raise feature."
+ ;; This isn't really a global minor mode; rather, it's local to the
+ ;; selected frame, but declaring it as global prevents a misleading
+ ;; "Auto-Raise mode enabled in current buffer" message from being
+ ;; displayed when it is turned on.
+ :global t
:variable (frame-parameter nil 'auto-raise)
(if (frame-parameter nil 'auto-raise)
(raise-frame)))
@@ -1634,6 +1642,8 @@ live frame and defaults to the selected one."
(declare-function x-frame-geometry "xfns.c" (&optional frame))
(declare-function w32-frame-geometry "w32fns.c" (&optional frame))
(declare-function ns-frame-geometry "nsfns.m" (&optional frame))
+(declare-function pgtk-frame-geometry "pgtkfns.c" (&optional frame))
+(declare-function haiku-frame-geometry "haikufns.c" (&optional frame))
(defun frame-geometry (&optional frame)
"Return geometric attributes of FRAME.
@@ -1683,6 +1693,10 @@ and width values are in pixels.
(w32-frame-geometry frame))
((eq frame-type 'ns)
(ns-frame-geometry frame))
+ ((eq frame-type 'pgtk)
+ (pgtk-frame-geometry frame))
+ ((eq frame-type 'haiku)
+ (haiku-frame-geometry frame))
(t
(list
'(outer-position 0 . 0)
@@ -1713,7 +1727,7 @@ to the selected frame.
Storing information about resize operations is off by default.
If you set the variable `frame-size-history' like this
-(setq frame-size-history '(100))
+(setq frame-size-history \\='(100))
then Emacs will save information about the next 100 significant
operations affecting any frame's size in that variable. This
@@ -1807,6 +1821,8 @@ of frames like calls to map a frame or change its visibility."
(declare-function x-frame-edges "xfns.c" (&optional frame type))
(declare-function w32-frame-edges "w32fns.c" (&optional frame type))
(declare-function ns-frame-edges "nsfns.m" (&optional frame type))
+(declare-function pgtk-frame-edges "pgtkfns.c" (&optional frame type))
+(declare-function haiku-frame-edges "haikufns.c" (&optional frame type))
(defun frame-edges (&optional frame type)
"Return coordinates of FRAME's edges.
@@ -1830,12 +1846,18 @@ FRAME."
(w32-frame-edges frame type))
((eq frame-type 'ns)
(ns-frame-edges frame type))
+ ((eq frame-type 'pgtk)
+ (pgtk-frame-edges frame type))
+ ((eq frame-type 'haiku)
+ (haiku-frame-edges frame type))
(t
(list 0 0 (frame-width frame) (frame-height frame))))))
(declare-function w32-mouse-absolute-pixel-position "w32fns.c")
(declare-function x-mouse-absolute-pixel-position "xfns.c")
(declare-function ns-mouse-absolute-pixel-position "nsfns.m")
+(declare-function pgtk-mouse-absolute-pixel-position "pgtkfns.c")
+(declare-function haiku-mouse-absolute-pixel-position "haikufns.c")
(defun mouse-absolute-pixel-position ()
"Return absolute position of mouse cursor in pixels.
@@ -1850,12 +1872,18 @@ position (0, 0) of the selected frame's terminal."
(w32-mouse-absolute-pixel-position))
((eq frame-type 'ns)
(ns-mouse-absolute-pixel-position))
+ ((eq frame-type 'pgtk)
+ (pgtk-mouse-absolute-pixel-position))
+ ((eq frame-type 'haiku)
+ (haiku-mouse-absolute-pixel-position))
(t
(cons 0 0)))))
+(declare-function pgtk-set-mouse-absolute-pixel-position "pgtkfns.c" (x y))
(declare-function ns-set-mouse-absolute-pixel-position "nsfns.m" (x y))
(declare-function w32-set-mouse-absolute-pixel-position "w32fns.c" (x y))
(declare-function x-set-mouse-absolute-pixel-position "xfns.c" (x y))
+(declare-function haiku-set-mouse-absolute-pixel-position "haikufns.c" (x y))
(defun set-mouse-absolute-pixel-position (x y)
"Move mouse pointer to absolute pixel position (X, Y).
@@ -1863,12 +1891,16 @@ The coordinates X and Y are interpreted in pixels relative to a
position (0, 0) of the selected frame's terminal."
(let ((frame-type (framep-on-display)))
(cond
+ ((eq frame-type 'pgtk)
+ (pgtk-set-mouse-absolute-pixel-position x y))
((eq frame-type 'ns)
(ns-set-mouse-absolute-pixel-position x y))
((eq frame-type 'x)
(x-set-mouse-absolute-pixel-position x y))
((eq frame-type 'w32)
- (w32-set-mouse-absolute-pixel-position x y)))))
+ (w32-set-mouse-absolute-pixel-position x y))
+ ((eq frame-type 'haiku)
+ (haiku-set-mouse-absolute-pixel-position x y)))))
(defun frame-monitor-attributes (&optional frame)
"Return the attributes of the physical monitor dominating FRAME.
@@ -1961,6 +1993,9 @@ workarea attribute."
(declare-function x-frame-list-z-order "xfns.c" (&optional display))
(declare-function w32-frame-list-z-order "w32fns.c" (&optional display))
(declare-function ns-frame-list-z-order "nsfns.m" (&optional display))
+;; TODO: implement this on PGTK.
+;; (declare-function pgtk-frame-list-z-order "pgtkfns.c" (&optional display))
+(declare-function haiku-frame-list-z-order "haikufns.c" (&optional display))
(defun frame-list-z-order (&optional display)
"Return list of Emacs' frames, in Z (stacking) order.
@@ -1980,11 +2015,19 @@ Return nil if DISPLAY contains no Emacs frame."
((eq frame-type 'w32)
(w32-frame-list-z-order display))
((eq frame-type 'ns)
- (ns-frame-list-z-order display)))))
+ (ns-frame-list-z-order display))
+ ((eq frame-type 'pgtk)
+ ;; This is currently not supported on PGTK.
+ ;; (pgtk-frame-list-z-order display)
+ nil)
+ ((eq frame-type 'haiku)
+ (haiku-frame-list-z-order display)))))
(declare-function x-frame-restack "xfns.c" (frame1 frame2 &optional above))
(declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above))
(declare-function ns-frame-restack "nsfns.m" (frame1 frame2 &optional above))
+(declare-function pgtk-frame-restack "pgtkfns.c" (frame1 frame2 &optional above))
+(declare-function haiku-frame-restack "haikufns.c" (frame1 frame2 &optional above))
(defun frame-restack (frame1 frame2 &optional above)
"Restack FRAME1 below FRAME2.
@@ -2014,7 +2057,11 @@ Some window managers may refuse to restack windows."
((eq frame-type 'w32)
(w32-frame-restack frame1 frame2 above))
((eq frame-type 'ns)
- (ns-frame-restack frame1 frame2 above))))
+ (ns-frame-restack frame1 frame2 above))
+ ((eq frame-type 'haiku)
+ (haiku-frame-restack frame1 frame2 above))
+ ((eq frame-type 'pgtk)
+ (pgtk-frame-restack frame1 frame2 above))))
(error "Cannot restack frames")))
(defun frame-size-changed-p (&optional frame)
@@ -2061,8 +2108,8 @@ frame's display)."
((eq frame-type 'w32)
(with-no-warnings
(> w32-num-mouse-buttons 0)))
- ((memq frame-type '(x ns))
- t) ;; We assume X and NeXTstep *always* have a pointing device
+ ((memq frame-type '(x ns haiku pgtk))
+ t) ;; We assume X, NeXTstep, GTK, and Haiku *always* have a pointing device
(t
(or (and (featurep 'xt-mouse)
xterm-mouse-mode)
@@ -2087,7 +2134,7 @@ frames and several different fonts at once. This is true for displays
that use a window system such as X, and false for text-only terminals.
DISPLAY can be a display name, a frame, or nil (meaning the selected
frame's display)."
- (not (null (memq (framep-on-display display) '(x w32 ns)))))
+ (not (null (memq (framep-on-display display) '(x w32 ns pgtk haiku)))))
(defun display-images-p (&optional display)
"Return non-nil if DISPLAY can display images.
@@ -2102,6 +2149,17 @@ frame's display)."
(defalias 'display-multi-frame-p #'display-graphic-p)
(defalias 'display-multi-font-p #'display-graphic-p)
+(defcustom tty-select-active-regions nil
+ "If non-nil, update PRIMARY window-system selection on text-mode frames.
+On a text-mode terminal that supports setSelection command, if
+this variable is non-nil, Emacs will set the PRIMARY selection
+from the active region, according to `select-active-regions'.
+This is currently supported only on xterm."
+ :group 'frames
+ :group 'killing
+ :version "29.1"
+ :type 'boolean)
+
(defun display-selections-p (&optional display)
"Return non-nil if DISPLAY supports selections.
A selection is a way to transfer text or other data between programs
@@ -2115,7 +2173,10 @@ frame's display)."
;; a Windows DOS Box.
(with-no-warnings
(not (null dos-windows-version))))
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns pgtk))
+ t)
+ ((and tty-select-active-regions
+ (terminal-parameter nil 'xterm--set-selection))
t)
(t
nil))))
@@ -2125,7 +2186,7 @@ frame's display)."
This means that, for example, DISPLAY can differentiate between
the keybinding RET and [return]."
(let ((frame-type (framep-on-display display)))
- (or (memq frame-type '(x w32 ns pc))
+ (or (memq frame-type '(x w32 ns pc pgtk))
;; MS-DOS and MS-Windows terminals have built-in support for
;; function (symbol) keys
(memq system-type '(ms-dos windows-nt)))))
@@ -2138,7 +2199,7 @@ DISPLAY should be either a frame or a display name (a string).
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-screens display))
(t
1))))
@@ -2158,7 +2219,7 @@ with DISPLAY. To get information for each physical monitor, use
`display-monitor-attributes-list'."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-pixel-height display))
(t
(frame-height (if (framep display) display (selected-frame)))))))
@@ -2178,7 +2239,7 @@ with DISPLAY. To get information for each physical monitor, use
`display-monitor-attributes-list'."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-pixel-width display))
(t
(frame-width (if (framep display) display (selected-frame)))))))
@@ -2216,7 +2277,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this
refers to the height in millimeters for all physical monitors
associated with DISPLAY. To get information for each physical
monitor, use `display-monitor-attributes-list'."
- (and (memq (framep-on-display display) '(x w32 ns))
+ (and (memq (framep-on-display display) '(x w32 ns haiku pgtk))
(or (cddr (assoc (or display (frame-parameter nil 'display))
display-mm-dimensions-alist))
(cddr (assoc t display-mm-dimensions-alist))
@@ -2237,7 +2298,7 @@ For graphical terminals, note that on \"multi-monitor\" setups this
refers to the width in millimeters for all physical monitors
associated with DISPLAY. To get information for each physical
monitor, use `display-monitor-attributes-list'."
- (and (memq (framep-on-display display) '(x w32 ns))
+ (and (memq (framep-on-display display) '(x w32 ns haiku pgtk))
(or (cadr (assoc (or display (frame-parameter nil 'display))
display-mm-dimensions-alist))
(cadr (assoc t display-mm-dimensions-alist))
@@ -2255,7 +2316,7 @@ DISPLAY can be a display name or a frame.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-backing-store display))
(t
'not-useful))))
@@ -2268,7 +2329,7 @@ DISPLAY can be a display name or a frame.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-save-under display))
(t
'not-useful))))
@@ -2281,7 +2342,7 @@ DISPLAY can be a display name or a frame.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-planes display))
((eq frame-type 'pc)
4)
@@ -2296,7 +2357,7 @@ DISPLAY can be a display name or a frame.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-color-cells display))
((eq frame-type 'pc)
16)
@@ -2313,7 +2374,7 @@ DISPLAY can be a display name or a frame.
If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
- ((memq frame-type '(x w32 ns))
+ ((memq frame-type '(x w32 ns haiku pgtk))
(x-display-visual-class display))
((and (memq frame-type '(pc t))
(tty-display-color-p display))
@@ -2327,6 +2388,10 @@ If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(&optional display))
(declare-function ns-display-monitor-attributes-list "nsfns.m"
(&optional terminal))
+(declare-function pgtk-display-monitor-attributes-list "pgtkfns.c"
+ (&optional terminal))
+(declare-function haiku-display-monitor-attributes-list "haikufns.c"
+ (&optional terminal))
(defun display-monitor-attributes-list (&optional display)
"Return a list of physical monitor attributes on DISPLAY.
@@ -2344,6 +2409,7 @@ of attribute keys and values as follows:
mm-size -- Width and height in millimeters in the form of
(WIDTH HEIGHT)
frames -- List of frames dominated by the physical monitor
+ scale-factor (*) -- Scale factor (float)
name (*) -- Name of the physical monitor as a string
source (*) -- Source of multi-monitor information as a string
@@ -2375,6 +2441,10 @@ monitors."
(w32-display-monitor-attributes-list display))
((eq frame-type 'ns)
(ns-display-monitor-attributes-list display))
+ ((eq frame-type 'pgtk)
+ (pgtk-display-monitor-attributes-list display))
+ ((eq frame-type 'haiku)
+ (haiku-display-monitor-attributes-list display))
(t
(let ((geometry (list 0 0 (display-pixel-width display)
(display-pixel-height display))))
@@ -2384,6 +2454,70 @@ monitors."
,(display-mm-height display)))
(frames . ,(frames-on-display-list display)))))))))
+(declare-function x-device-class "term/x-win.el" (name))
+(declare-function pgtk-device-class "term/pgtk-win.el" (name))
+
+(defun device-class (frame name)
+ "Return the class of the device NAME for an event generated on FRAME.
+NAME is a string that can be the value of `last-event-device', or
+nil. FRAME is a window system frame, typically the value of
+`last-event-frame' when `last-event-device' was set. On some
+window systems, it can also be a display name or a terminal.
+
+The class of a device is one of the following symbols:
+
+ `core-keyboard' means the device is a keyboard-like device, but
+ any other characteristics are unknown.
+
+ `core-pointer' means the device is a pointing device, but any
+ other characteristics are unknown.
+
+ `mouse' means the device is a computer mouse.
+
+ `trackpoint' means the device is a joystick or trackpoint.
+
+ `eraser' means the device is an eraser, which is typically the
+ other end of a stylus on a graphics tablet.
+
+ `pen' means the device is a stylus or some other similar
+ device.
+
+ `puck' means the device is a device similar to a mouse, but
+ reports absolute coordinates.
+
+ `power-button' means the device is a power button, volume
+ button, or some similar control.
+
+ `keyboard' means the device is a keyboard.
+
+ `touchscreen' means the device is a touchscreen.
+
+ `pad' means the device is a collection of buttons and rings and
+ strips commonly found in drawing tablets.
+
+ `touchpad' means the device is an indirect touch device, such
+ as a touchpad.
+
+ `piano' means the device is a piano, or some other kind of
+ musical instrument.
+
+ `test' means the device is used by the XTEST extension to
+ report input.
+
+It can also be nil, which means the class of the device could not
+be determined. Individual window systems may also return other
+symbols."
+ (let ((frame-type (framep-on-display frame)))
+ (cond ((eq frame-type 'x)
+ (x-device-class name))
+ ((eq frame-type 'pgtk)
+ (pgtk-device-class name))
+ (t (cond
+ ((string= name "Virtual core pointer")
+ 'core-pointer)
+ ((string= name "Virtual core keyboard")
+ 'core-keyboard))))))
+
;;;; Frame geometry values
@@ -2485,6 +2619,77 @@ deleting them."
(if iconify (iconify-frame this) (delete-frame this)))
(setq this next))))
+(defvar undelete-frame--deleted-frames nil
+ "Internal variable used by `undelete-frame--save-deleted-frame'.")
+
+(defun undelete-frame--save-deleted-frame (frame)
+ "Save the configuration of frames deleted with `delete-frame'.
+Only the 16 most recently deleted frames are saved."
+ (when (and after-init-time (frame-live-p frame))
+ (setq undelete-frame--deleted-frames
+ (cons
+ (list
+ (display-graphic-p)
+ (seq-remove
+ (lambda (elem)
+ (or (memq (car elem) frame-internal-parameters)
+ ;; When the daemon is started from a graphical
+ ;; environment, TTY frames have a 'display' parameter set
+ ;; to the value of $DISPLAY (see the note in
+ ;; `server--on-display-p'). Do not store that parameter
+ ;; in the frame data, otherwise `undelete-frame' attempts
+ ;; to restore a graphical frame.
+ (and (eq (car elem) 'display) (not (display-graphic-p)))))
+ (frame-parameters frame))
+ (window-state-get (frame-root-window frame)))
+ undelete-frame--deleted-frames))
+ (if (> (length undelete-frame--deleted-frames) 16)
+ (setq undelete-frame--deleted-frames
+ (butlast undelete-frame--deleted-frames)))))
+
+(define-minor-mode undelete-frame-mode
+ "Enable the `undelete-frame' command."
+ :group 'frames
+ :global t
+ (if undelete-frame-mode
+ (add-hook 'delete-frame-functions
+ #'undelete-frame--save-deleted-frame -75)
+ (remove-hook 'delete-frame-functions
+ #'undelete-frame--save-deleted-frame)
+ (setq undelete-frame--deleted-frames nil)))
+
+(defun undelete-frame (&optional arg)
+ "Undelete a frame deleted with `delete-frame'.
+Without a prefix argument, undelete the most recently deleted
+frame.
+With a numerical prefix argument ARG between 1 and 16, where 1 is
+most recently deleted frame, undelete the ARGth deleted frame.
+When called from Lisp, returns the new frame."
+ (interactive "P")
+ (if (not undelete-frame-mode)
+ (user-error "Undelete-Frame mode is disabled")
+ (if (consp arg)
+ (user-error "Missing deleted frame number argument")
+ (let* ((number (pcase arg ('nil 1) ('- -1) (_ arg)))
+ (frame-data (nth (1- number) undelete-frame--deleted-frames))
+ (graphic (display-graphic-p)))
+ (if (not (<= 1 number 16))
+ (user-error "%d is not a valid deleted frame number argument"
+ number)
+ (if (not frame-data)
+ (user-error "No deleted frame with number %d" number)
+ (if (not (eq graphic (nth 0 frame-data)))
+ (user-error
+ "Cannot undelete a %s display frame on a %s display"
+ (if graphic "non-graphic" "graphic")
+ (if graphic "graphic" "non-graphic"))
+ (setq undelete-frame--deleted-frames
+ (delq frame-data undelete-frame--deleted-frames))
+ (let* ((default-frame-alist (nth 1 frame-data))
+ (frame (make-frame)))
+ (window-state-put (nth 2 frame-data) (frame-root-window frame) 'safe)
+ (select-frame-set-input-focus frame)
+ frame))))))))
;;; Window dividers.
(defgroup window-divider nil
@@ -2636,7 +2841,7 @@ Values smaller than 0.2 sec are treated as 0.2 sec."
"How many times to blink before using a solid cursor on NS, X, and MS-Windows.
Use 0 or negative value to blink forever."
:version "24.4"
- :type 'integer
+ :type 'natnum
:group 'cursor)
(defvar blink-cursor-blinks-done 1
@@ -2776,6 +2981,12 @@ If the frame is in fullscreen state, don't change its state, but
set the frame's `fullscreen-restore' parameter to `maximized', so
the frame will be maximized after disabling fullscreen state.
+If you wish to hide the title bar when the frame is maximized, you
+can add something like the following to your init file:
+
+ (add-hook \\='window-size-change-functions
+ #\\='frame-hide-title-bar-when-maximized)
+
Note that with some window managers you may have to set
`frame-resize-pixelwise' to non-nil in order to make a frame
appear truly maximized. In addition, you may have to set
@@ -2829,6 +3040,7 @@ See also `toggle-frame-maximized'."
(define-key ctl-x-5-map "o" #'other-frame)
(define-key ctl-x-5-map "5" #'other-frame-prefix)
(define-key ctl-x-5-map "c" #'clone-frame)
+(define-key ctl-x-5-map "u" #'undelete-frame)
(define-key global-map [f11] #'toggle-frame-fullscreen)
(define-key global-map [(meta f10)] #'toggle-frame-maximized)
(define-key esc-map [f10] #'toggle-frame-maximized)
@@ -2890,6 +3102,13 @@ Offer NUMBER as default value, if it is a natural number."
bidi-display-reordering
bidi-inhibit-bpa))
+(defun frame-hide-title-bar-when-maximized (frame)
+ "Hide the title bar if FRAME is maximized.
+If FRAME isn't maximized, show the title bar."
+ (set-frame-parameter
+ frame 'undecorated
+ (eq (alist-get 'fullscreen (frame-parameters frame)) 'maximized)))
+
(provide 'frame)
;;; frame.el ends here
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 10714af1fa5..a589f7b5d96 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -436,10 +436,11 @@ Properties can be set with
;;;###autoload
(defvar frameset-session-filter-alist
- '((name . :never)
- (left . frameset-filter-iconified)
- (minibuffer . frameset-filter-minibuffer)
- (top . frameset-filter-iconified))
+ (append
+ '((left . frameset-filter-iconified)
+ (minibuffer . frameset-filter-minibuffer)
+ (top . frameset-filter-iconified))
+ (mapcar (lambda (p) (cons p :never)) frame-internal-parameters))
"Minimum set of parameters to filter for live (on-session) framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
@@ -447,6 +448,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
(defvar frameset-persistent-filter-alist
(append
'((background-color . frameset-filter-sanitize-color)
+ (bottom . frameset-filter-shelve-param)
(buffer-list . :never)
(buffer-predicate . :never)
(buried-buffer-list . :never)
@@ -463,19 +465,23 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
(frameset--text-pixel-height . :save)
(frameset--text-pixel-width . :save)
(fullscreen . frameset-filter-shelve-param)
+ (GUI:bottom . frameset-filter-unshelve-param)
(GUI:font . frameset-filter-unshelve-param)
(GUI:fullscreen . frameset-filter-unshelve-param)
(GUI:height . frameset-filter-unshelve-param)
+ (GUI:left . frameset-filter-unshelve-param)
+ (GUI:right . frameset-filter-unshelve-param)
+ (GUI:top . frameset-filter-unshelve-param)
(GUI:width . frameset-filter-unshelve-param)
(height . frameset-filter-shelve-param)
- (outer-window-id . :never)
+ (left . frameset-filter-shelve-param)
(parent-frame . :never)
- (parent-id . :never)
(mouse-wheel-frame . :never)
+ (right . frameset-filter-shelve-param)
+ (top . frameset-filter-shelve-param)
(tty . frameset-filter-tty-to-GUI)
(tty-type . frameset-filter-tty-to-GUI)
(width . frameset-filter-shelve-param)
- (window-id . :never)
(window-system . :never))
frameset-session-filter-alist)
"Parameters to filter for persistent framesets.
@@ -1012,13 +1018,15 @@ not be changed once the frame has been created. Internal use only."
(cl-loop for param in '(left top width height border-width minibuffer)
when (assq param parameters) collect it))
-(defun frameset--restore-frame (parameters window-state filters force-onscreen)
+(defun frameset--restore-frame (parameters window-state filters force-onscreen
+ &optional dx dy)
"Set up and return a frame according to its saved state.
That means either reusing an existing frame or creating one anew.
PARAMETERS is the frame's parameter alist; WINDOW-STATE is its window state.
For the meaning of FILTERS and FORCE-ONSCREEN, see `frameset-restore'.
Internal use only."
(let* ((fullscreen (cdr (assq 'fullscreen parameters)))
+ (tty-to-GUI (frameset-switch-to-gui-p parameters))
(filtered-cfg (frameset-filter-params parameters filters nil))
(display (cdr (assq 'display filtered-cfg))) ;; post-filtering
alt-cfg frame)
@@ -1095,6 +1103,14 @@ Internal use only."
(not (eq (frame-parameter frame 'visibility) 'icon)))
(frameset-move-onscreen frame force-onscreen))
+ ;; Frames saved on TTY shall be all considered visible when
+ ;; restoring on GUI display. Also, offset each new such frame
+ ;; relative to the previous one, to make it more visible.
+ (when tty-to-GUI
+ (push '(visibility . t) alt-cfg)
+ (when (and (numberp dx) (numberp dy))
+ (push (cons 'left (+ (frame-parameter frame 'left) dx)) alt-cfg)
+ (push (cons 'top (+ (frame-parameter frame 'top) dy)) alt-cfg)))
;; Let's give the finishing touches (visibility, maximization).
(when alt-cfg (modify-frame-parameters frame alt-cfg))
;; Now restore window state.
@@ -1218,7 +1234,9 @@ All keyword parameters default to nil."
((pred functionp)
(cl-remove-if-not reuse-frames frames))
(_
- (error "Invalid arg :reuse-frames %s" reuse-frames)))))
+ (error "Invalid arg :reuse-frames %s" reuse-frames))))
+ (dx 0)
+ (dy 0))
;; Mark existing frames in the map; candidates to reuse are marked as :ignored;
;; they will be reassigned later, if chosen.
@@ -1291,11 +1309,21 @@ All keyword parameters default to nil."
(setq mb-window nil)))
(when mb-window
(push (cons 'minibuffer mb-window) frame-cfg))))))
+ ;; Apply small offsets to each frame that came from
+ ;; a TTY-saved desktop, so that they don't obscure
+ ;; each other, but only if we don't have real frame
+ ;; position info from a GUI session in some,
+ ;; possibly distant, past.
+ (when (and (frameset-switch-to-gui-p frame-cfg)
+ (null (cdr (assq 'GUI:top frame-cfg)))
+ (null (cdr (assq 'GUI:left frame-cfg))))
+ (setq dx (+ dx 20)
+ dy (+ dy 10)))
;; OK, we're ready at last to create (or reuse) a frame and
;; restore the window config.
(setq frame (frameset--restore-frame frame-cfg window-cfg
(or filters frameset-filter-alist)
- force-onscreen))
+ force-onscreen dx dy))
;; Now reset any duplicate frameset--id
(when (and duplicate (not (eq frame duplicate)))
(set-frame-parameter duplicate 'frameset--id nil))
diff --git a/lisp/fringe.el b/lisp/fringe.el
index 8c833f02429..657a73772d5 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -244,10 +244,18 @@ When used in a Lisp program, MODE should be one of these:
nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
fringes.
+
This command may round up the left and right width specifications
to ensure that their sum is a multiple of the character width of
a frame. It never rounds up a fringe width of 0.
+Note that removing a right or left fringe (by setting the width
+to zero) makes Emacs reserve one column of the window body to
+display a line continuation marker. (This happens for both the
+left and right fringe, since Emacs can display both left-to-right
+and right-to-left text.) You can use `window-max-chars-per-line'
+to check the effective width.
+
Fringe widths set by `set-window-fringes' override the default
fringe widths set by this command. This command applies to all
frames that exist and frames to be created in the future. If you
@@ -306,7 +314,7 @@ BITMAP is a symbol identifying the new fringe bitmap.
BITS is either a string or a vector of integers.
HEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS.
WIDTH must be an integer between 1 and 16, or nil which defaults to 8.
-Optional fifth arg ALIGN may be one of ‘top’, ‘center’, or ‘bottom’,
+Optional fifth arg ALIGN may be one of `top', `center', or `bottom',
indicating the positioning of the bitmap relative to the rows where it
is used; the default is to center the bitmap. Fifth arg may also be a
list (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index ecfa8aab845..2c9d1b316e1 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1847,4 +1847,8 @@ like an INI file. You can add this hook to `find-file-hook'."
(provide 'generic-x)
+;; Local Variables:
+;; autoload-compute-prefixes: nil
+;; End:
+
;;; generic-x.el ends here
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index d2edfdf09f4..732c6062b8b 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -439,6 +439,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer."
(unless nodisplay (gnus-outlook-display-article-buffer))
attrib-start))
+;;;###autoload
(defun gnus-article-outlook-rearrange-citation (&optional nodisplay)
"Repair broken citations.
If NODISPLAY is non-nil, don't redisplay the article buffer."
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index e93ebb0cd38..fc18d8a1c51 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -134,47 +134,8 @@ ARGS are passed to `message'."
(const :tag "No map")
(plist :inline t :tag "Properties"))))
-(define-widget 'gmm-tool-bar-zap-list 'lazy
- "Tool bar zap list."
- :tag "Tool bar zap list"
- :type '(choice (const :tag "Zap all" t)
- (const :tag "Keep all" nil)
- (list
- ;; :value
- ;; Work around (bug in customize?), see
- ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de>
- ;; (new-file open-file dired kill-buffer write-file
- ;; print-buffer customize help)
- (set :inline t
- (const new-file)
- (const open-file)
- (const dired)
- (const kill-buffer)
- (const save-buffer)
- (const write-file)
- (const undo)
- (const cut)
- (const copy)
- (const paste)
- (const search-forward)
- (const print-buffer)
- (const customize)
- (const help))
- (repeat :inline t
- :tag "Other"
- (symbol :tag "Icon item")))))
-
-(defcustom gmm-tool-bar-style
- (if (and (boundp 'tool-bar-mode)
- tool-bar-mode
- (not (memq (display-visual-class)
- (list 'static-gray 'gray-scale
- 'static-color 'pseudo-color))))
- 'gnome
- 'retro)
- "Preferred tool bar style."
- :type '(choice (const :tag "GNOME style" gnome)
- (const :tag "Retro look" retro)))
+(defvar gmm-tool-bar-style 'gnome)
+(make-obsolete-variable 'gmm-tool-bar-style nil "29.1")
(defvar tool-bar-map)
@@ -239,6 +200,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST."
"Create function NAME.
If FUNCTION exists, then NAME becomes an alias for FUNCTION.
Otherwise, create function NAME with ARG-LIST and BODY."
+ (declare (indent defun))
(let ((defined-p (fboundp function)))
(if defined-p
`(defalias ',name ',function)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 86a4f80483d..e4704b35c8d 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -31,6 +31,7 @@
(require 'gnus-srvr)
(require 'gnus-util)
(require 'timer)
+(require 'range)
(eval-when-compile (require 'cl-lib))
(autoload 'gnus-server-update-server "gnus-srvr")
@@ -475,17 +476,16 @@ manipulated as follows:
(gnus-run-hooks 'gnus-agent-mode-hook
(intern (format "gnus-agent-%s-mode-hook" buffer)))))
-(defvar gnus-agent-group-mode-map (make-sparse-keymap))
-(gnus-define-keys gnus-agent-group-mode-map
- "Ju" gnus-agent-fetch-groups
- "Jc" gnus-enter-category-buffer
- "Jj" gnus-agent-toggle-plugged
- "Js" gnus-agent-fetch-session
- "JY" gnus-agent-synchronize-flags
- "JS" gnus-group-send-queue
- "Ja" gnus-agent-add-group
- "Jr" gnus-agent-remove-group
- "Jo" gnus-agent-toggle-group-plugged)
+(defvar-keymap gnus-agent-group-mode-map
+ "J u" #'gnus-agent-fetch-groups
+ "J c" #'gnus-enter-category-buffer
+ "J j" #'gnus-agent-toggle-plugged
+ "J s" #'gnus-agent-fetch-session
+ "J Y" #'gnus-agent-synchronize-flags
+ "J S" #'gnus-group-send-queue
+ "J a" #'gnus-agent-add-group
+ "J r" #'gnus-agent-remove-group
+ "J o" #'gnus-agent-toggle-group-plugged)
(defun gnus-agent-group-make-menu-bar ()
(unless (boundp 'gnus-agent-group-menu)
@@ -504,16 +504,15 @@ manipulated as follows:
["Synchronize flags" gnus-agent-synchronize-flags t]
))))
-(defvar gnus-agent-summary-mode-map (make-sparse-keymap))
-(gnus-define-keys gnus-agent-summary-mode-map
- "Jj" gnus-agent-toggle-plugged
- "Ju" gnus-agent-summary-fetch-group
- "JS" gnus-agent-fetch-group
- "Js" gnus-agent-summary-fetch-series
- "J#" gnus-agent-mark-article
- "J\M-#" gnus-agent-unmark-article
- "@" gnus-agent-toggle-mark
- "Jc" gnus-agent-catchup)
+(defvar-keymap gnus-agent-summary-mode-map
+ "J j" #'gnus-agent-toggle-plugged
+ "J u" #'gnus-agent-summary-fetch-group
+ "J S" #'gnus-agent-fetch-group
+ "J s" #'gnus-agent-summary-fetch-series
+ "J #" #'gnus-agent-mark-article
+ "J M-#" #'gnus-agent-unmark-article
+ "@" #'gnus-agent-toggle-mark
+ "J c" #'gnus-agent-catchup)
(defun gnus-agent-summary-make-menu-bar ()
(unless (boundp 'gnus-agent-summary-menu)
@@ -527,11 +526,10 @@ manipulated as follows:
["Fetch downloadable" gnus-agent-summary-fetch-group t]
["Catchup undownloaded" gnus-agent-catchup t]))))
-(defvar gnus-agent-server-mode-map (make-sparse-keymap))
-(gnus-define-keys gnus-agent-server-mode-map
- "Jj" gnus-agent-toggle-plugged
- "Ja" gnus-agent-add-server
- "Jr" gnus-agent-remove-server)
+(defvar-keymap gnus-agent-server-mode-map
+ "J j" #'gnus-agent-toggle-plugged
+ "J a" #'gnus-agent-add-server
+ "J r" #'gnus-agent-remove-server)
(defun gnus-agent-server-make-menu-bar ()
(unless (boundp 'gnus-agent-server-menu)
@@ -1222,8 +1220,8 @@ This can be added to `gnus-select-article-hook' or
(cond ((eq mark 'read)
(setf (gnus-info-read info)
(funcall (if (eq what 'add)
- #'gnus-range-add
- #'gnus-remove-from-range)
+ #'range-concat
+ #'range-remove)
(gnus-info-read info)
range))
(gnus-get-unread-articles-in-group
@@ -1236,8 +1234,8 @@ This can be added to `gnus-select-article-hook' or
(gnus-info-marks info)))
(setcdr info-marks
(funcall (if (eq what 'add)
- #'gnus-range-add
- #'gnus-remove-from-range)
+ #'range-concat
+ #'range-remove)
(cdr info-marks)
range))))))))
@@ -1310,7 +1308,7 @@ downloaded into the agent."
(let ((read (gnus-info-read info)))
(setf (gnus-info-read info)
- (gnus-range-add
+ (range-concat
read
(list (cons (1+ agent-max)
(1- active-min))))))
@@ -1799,13 +1797,13 @@ article numbers will be returned."
(articles (if fetch-all
(if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
- (gnus-uncompress-range
+ (range-uncompress
(cons (max (car active)
(- (cdr active)
gnus-newsgroup-maximum-articles
-1))
(cdr active))))
- (gnus-uncompress-range (gnus-active group)))
+ (range-uncompress (gnus-active group)))
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
@@ -1820,7 +1818,7 @@ article numbers will be returned."
;; because otherwise the agent will remove their marks.)
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(unless (memq (car arts) '(seen recent killed cache))
- (setq articles (gnus-range-add articles (cdr arts)))))
+ (setq articles (range-concat articles (cdr arts)))))
(setq articles (sort (gnus-uncompress-sequence articles) #'<)))
;; At this point, I have the list of articles to consider for
@@ -1854,15 +1852,15 @@ article numbers will be returned."
;; gnus-agent-article-alist) equals (cdr (gnus-active
;; group))}. The addition of one(the 1+ above) then
;; forces Low to be greater than High. When this happens,
- ;; gnus-list-range-intersection returns nil which
+ ;; range-list-intersection returns nil which
;; indicates that no headers need to be fetched. -- Kevin
- (setq articles (gnus-list-range-intersection
+ (setq articles (range-list-intersection
articles (list (cons low high)))))))
(when articles
(gnus-message
10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
- (gnus-compress-sequence articles t)))
+ (range-compress-list articles)))
(with-current-buffer nntp-server-buffer
(if articles
@@ -2063,7 +2061,7 @@ doesn't exist, to valid the overview buffer."
(let (state sequence uncomp)
(while alist
(setq state (caar alist)
- sequence (inline (gnus-uncompress-range (cdar alist)))
+ sequence (inline (range-uncompress (cdar alist)))
alist (cdr alist))
(while sequence
(push (cons (pop sequence) state) uncomp)))
@@ -2407,7 +2405,7 @@ contents, they are first saved to their own file."
(let ((arts (cdr (assq mark (gnus-info-marks
(setq info (gnus-get-info group)))))))
(when arts
- (setq marked-articles (nconc (gnus-uncompress-range arts)
+ (setq marked-articles (nconc (range-uncompress arts)
marked-articles))
))))
(setq marked-articles (sort marked-articles #'<))
@@ -2547,7 +2545,7 @@ contents, they are first saved to their own file."
(let ((read (gnus-info-read
(or info (setq info (gnus-get-info group))))))
(setf (gnus-info-read info)
- (gnus-add-to-range read unfetched-articles)))
+ (range-add-list read unfetched-articles)))
(gnus-group-update-group group t)
(sit-for 0)
@@ -2597,25 +2595,20 @@ General format specifiers can also be used. See Info node
(defvar gnus-category-line-format-spec nil)
(defvar gnus-category-mode-line-format-spec nil)
-(defvar gnus-category-mode-map nil)
-
-(unless gnus-category-mode-map
- (setq gnus-category-mode-map (make-sparse-keymap))
- (suppress-keymap gnus-category-mode-map)
-
- (gnus-define-keys gnus-category-mode-map
- "q" gnus-category-exit
- "k" gnus-category-kill
- "c" gnus-category-copy
- "a" gnus-category-add
- "e" gnus-agent-customize-category
- "p" gnus-category-edit-predicate
- "g" gnus-category-edit-groups
- "s" gnus-category-edit-score
- "l" gnus-category-list
-
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug))
+(defvar-keymap gnus-category-mode-map
+ :suppress t
+ "q" #'gnus-category-exit
+ "k" #'gnus-category-kill
+ "c" #'gnus-category-copy
+ "a" #'gnus-category-add
+ "e" #'gnus-agent-customize-category
+ "p" #'gnus-category-edit-predicate
+ "g" #'gnus-category-edit-groups
+ "s" #'gnus-category-edit-score
+ "l" #'gnus-category-list
+
+ "C-c C-i" #'gnus-info-find-node
+ "C-c C-b" #'gnus-bug)
(defcustom gnus-category-menu-hook nil
"Hook run after the creation of the menu."
@@ -2906,8 +2899,8 @@ The following commands are available:
(defun gnus-agent-read-p ()
"Say whether an article is read or not."
- (gnus-member-of-range (mail-header-number gnus-headers)
- (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
+ (range-member-p (mail-header-number gnus-headers)
+ (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
(defun gnus-category-make-function (predicate)
"Make a function from PREDICATE."
@@ -3123,7 +3116,7 @@ FORCE is equivalent to setting the expiration predicates to true."
;; All articles EXCEPT those named by the caller
;; are protected from expiration
(gnus-sorted-difference
- (gnus-uncompress-range
+ (range-uncompress
(cons (caar alist)
(caar (last alist))))
(sort articles #'<)))))
@@ -3145,9 +3138,9 @@ FORCE is equivalent to setting the expiration predicates to true."
;; Ticked and/or dormant articles are excluded
;; from expiration
(nconc
- (gnus-uncompress-range
+ (range-uncompress
(cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
+ (range-uncompress
(cdr (assq 'dormant
(gnus-info-marks info))))))))
(nov-file (concat dir ".overview"))
@@ -3646,7 +3639,7 @@ has been fetched."
(file-name-directory file) t))
(when fetch-old
- (setq articles (gnus-uncompress-range
+ (setq articles (range-uncompress
(cons (if (numberp fetch-old)
(max 1 (- (car articles) fetch-old))
1)
@@ -3702,7 +3695,7 @@ has been fetched."
;; Clip this list to the headers that will
;; actually be returned
- (setq fetched-articles (gnus-list-range-intersection
+ (setq fetched-articles (range-list-intersection
(cdr fetched-articles)
(cons min max)))
@@ -3711,7 +3704,7 @@ has been fetched."
;; excluded IDs may be fetchable using HEAD.
(if (car tail-fetched-articles)
(setq uncached-articles
- (gnus-list-range-intersection
+ (range-list-intersection
uncached-articles
(cons (car uncached-articles)
(car tail-fetched-articles)))))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 5b5343f5bcd..4b68a54ce81 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -42,6 +42,7 @@
(require 'message)
(require 'mouse)
(require 'seq)
+(require 'range)
(autoload 'gnus-msg-mail "gnus-msg" nil t)
(autoload 'gnus-button-mailto "gnus-msg")
@@ -742,7 +743,7 @@ Each element is a regular expression."
"Face used for highlighting buttons in the article buffer.
An article button is a piece of text that you can activate by pressing
-`RET' or `mouse-2' above it."
+\\`RET' or `mouse-2' above it."
:type 'face
:group 'gnus-article-buttons)
@@ -768,28 +769,37 @@ Obsolete; use the face `gnus-signature' for customizations instead."
:group 'gnus-article-highlight
:group 'gnus-article-signature)
+(defface gnus-header
+ '((t :inherit variable-pitch-text))
+ "Base face used for all Gnus header faces.
+All the other `gnus-header-' faces inherit from this face."
+ :version "29.1"
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
+
(defface gnus-header-from
'((((class color)
(background dark))
- (:foreground "PaleGreen1"))
+ (:foreground "PaleGreen1" :inherit gnus-header))
(((class color)
(background light))
- (:foreground "red3"))
+ (:foreground "red3" :inherit gnus-header))
(t
- (:italic t)))
+ (:italic t :inherit gnus-header)))
"Face used for displaying from headers."
+ :version "29.1"
:group 'gnus-article-headers
:group 'gnus-article-highlight)
(defface gnus-header-subject
'((((class color)
(background dark))
- (:foreground "SeaGreen1"))
+ (:foreground "SeaGreen1" :inherit gnus-header))
(((class color)
(background light))
- (:foreground "red4"))
+ (:foreground "red4" :inherit gnus-header))
(t
- (:bold t :italic t)))
+ (:bold t :italic t :inherit gnus-header)))
"Face used for displaying subject headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -797,7 +807,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
(defface gnus-header-newsgroups
'((((class color)
(background dark))
- (:foreground "yellow" :italic t))
+ (:foreground "yellow" :italic t :inherit gnus-header))
(((class color)
(background light))
(:foreground "MidnightBlue" :italic t))
@@ -812,12 +822,12 @@ articles."
(defface gnus-header-name
'((((class color)
(background dark))
- (:foreground "SpringGreen2"))
+ (:foreground "SpringGreen2" :inherit gnus-header))
(((class color)
(background light))
- (:foreground "maroon"))
+ (:foreground "maroon" :inherit gnus-header))
(t
- (:bold t)))
+ (:bold t :inherit gnus-header)))
"Face used for displaying header names."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -825,12 +835,13 @@ articles."
(defface gnus-header-content
'((((class color)
(background dark))
- (:foreground "SpringGreen1" :italic t))
+ (:foreground "SpringGreen1" :italic t :inherit gnus-header))
(((class color)
(background light))
- (:foreground "indianred4" :italic t))
+ (:foreground "indianred4" :italic t :inherit gnus-header))
(t
- (:italic t))) "Face used for displaying header content."
+ (:italic t :inherit gnus-header)))
+ "Face used for displaying header content."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -1080,9 +1091,9 @@ positive (negative), move point forward (backwards) this many
parts. When nil, redisplay article."
:version "23.1" ;; No Gnus
:group 'gnus-article-mime
- :type '(choice (const nil :tag "Redisplay article.")
- (const 1 :tag "Next part.")
- (const 0 :tag "Current part.")
+ :type '(choice (const :value nil :tag "Redisplay article")
+ (const :value 1 :tag "Next part")
+ (const :value 0 :tag "Current part")
integer))
;;;
@@ -1149,13 +1160,15 @@ predicate. See Info node `(gnus)Customizing Articles'."
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
-(defcustom gnus-treat-emphasize 50000
+(defcustom gnus-treat-emphasize '(and 50000
+ (not (typep "text/html")))
"Emphasize text.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
+ :type gnus-article-treat-custom
+ :version "29.1")
(put 'gnus-treat-emphasize 'highlight t)
(defcustom gnus-treat-strip-cr nil
@@ -1167,6 +1180,19 @@ predicate. See Info node `(gnus)Customizing Articles'."
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
+(defcustom gnus-treat-emojize-symbols nil
+ "Display emoji versions of symbol.
+Some symbols have both a non-emoji presentation and an emoji
+presentation. This treatment will make Gnus display the latter
+as emojis even when they weren't sent as such.
+
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate. See Info node `(gnus)Customizing Articles'."
+ :version "29.1"
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
(defcustom gnus-treat-unsplit-urls nil
"Remove newlines from within URLs.
Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1360,11 +1386,20 @@ This variable has no effect if `gnus-treat-unfold-headers' is nil."
(const :tag "all" t)
(regexp)))
-(defcustom gnus-treat-fold-headers nil
+(defcustom gnus-treat-fold-headers 'head
"Fold headers.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
- :version "22.1"
+ :version "29.1"
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-suspicious-headers 'head
+ "Mark headers that are suspicious.
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate. See Info node `(gnus)Customizing Articles'."
+ :version "29.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
@@ -1650,6 +1685,7 @@ regexp."
(defvar gnus-article-mime-handle-alist-1 nil)
(defvar gnus-treatment-function-alist
'((gnus-treat-strip-cr gnus-article-remove-cr)
+ (gnus-treat-emojize-symbols gnus-article-emojize-symbols)
(gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
(gnus-treat-strip-banner gnus-article-strip-banner)
(gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
@@ -1685,6 +1721,7 @@ regexp."
(gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
(gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
(gnus-treat-fold-headers gnus-article-treat-fold-headers)
+ (gnus-treat-suspicious-headers gnus-article-treat-suspicious-headers)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
@@ -2188,6 +2225,14 @@ unfolded."
(replace-match " " t t))))
(goto-char (point-max)))))))
+(defun gnus--variable-pitch-p (face)
+ (when face
+ (or (eq face 'variable-pitch)
+ (let ((parent (face-attribute face :inherit)))
+ (if (eq parent 'unspecified)
+ nil
+ (seq-some #'gnus--variable-pitch-p (ensure-list parent)))))))
+
(defun gnus-article-treat-fold-headers ()
"Fold message headers."
(interactive nil gnus-article-mode gnus-summary-mode)
@@ -2195,9 +2240,26 @@ unfolded."
(while (not (eobp))
(save-restriction
(mail-header-narrow-to-field)
- (mail-header-fold-field)
+ (if (not (gnus--variable-pitch-p (get-text-property (point) 'face)))
+ (mail-header-fold-field)
+ (forward-char 1)
+ (pixel-fill-region (point) (point-max) (pixel-fill-width)))
(goto-char (point-max))))))
+(defun gnus-article-treat-suspicious-headers ()
+ "Mark suspicious headers."
+ (interactive nil gnus-article-mode gnus-summary-mode)
+ (gnus-with-article-headers
+ (let (match)
+ (while (setq match (text-property-search-forward 'textsec-suspicious))
+ (add-text-properties (prop-match-beginning match)
+ (prop-match-end match)
+ (list 'help-echo (prop-match-value match)
+ 'face 'textsec-suspicious))
+ (overlay-put (make-overlay (prop-match-end match)
+ (prop-match-end match))
+ 'after-string "⚠️")))))
+
(defun gnus-treat-smiley ()
"Toggle display of textual emoticons (\"smileys\") as small graphical icons."
(interactive nil gnus-article-mode gnus-summary-mode)
@@ -2264,9 +2326,7 @@ This only works if the article in question is HTML."
(goto-char (point-max))))))
(defcustom gnus-article-truncate-lines (default-value 'truncate-lines)
- "Value of `truncate-lines' in Gnus Article buffer.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate. See Info node `(gnus)Customizing Articles'."
+ "Value of `truncate-lines' in Gnus Article buffer."
:version "23.1" ;; No Gnus
:group 'gnus-article
;; :link '(custom-manual "(gnus)Customizing Articles")
@@ -2360,6 +2420,20 @@ fill width."
(while (search-forward "\r" nil t)
(replace-match "\n" t t)))))
+(defun article-emojize-symbols ()
+ "Display symbols (that have an emoji version) as emojis."
+ (interactive nil gnus-article-mode)
+ (when-let ((font (and (display-multi-font-p)
+ (car (internal-char-font nil ?😀)))))
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (while (re-search-forward "[[:multibyte:]]" nil t)
+ ;; If there's already a grapheme cluster here, skip it.
+ (when (and (not (find-composition (point)))
+ (font-has-char-p font (char-after (match-beginning 0))))
+ (insert "\N{VARIATION SELECTOR-16}")))))))
+
(defun article-remove-trailing-blank-lines ()
"Remove all trailing blank lines from the article."
(interactive nil gnus-article-mode)
@@ -2560,17 +2634,37 @@ If PROMPT (the prefix), prompt for a coding system to use."
(forward-line -1))
(setq end (point))
(while (not (bobp))
- (while (progn
- (forward-line -1)
- (and (not (bobp))
- (memq (char-after) '(?\t ? )))))
- (setq start (point))
- (if (looking-at "\
+ (let (addresses)
+ (while (progn
+ (forward-line -1)
+ (and (not (bobp))
+ (memq (char-after) '(?\t ? )))))
+ (setq start (point))
+ (save-restriction
+ (narrow-to-region start end)
+ (if (looking-at "\
\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\
\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):")
- (funcall gnus-decode-address-function start end)
- (funcall gnus-decode-header-function start end))
- (goto-char (setq end start)))))
+ (progn
+ (setq addresses (buffer-string))
+ (funcall gnus-decode-address-function (point-min) (point-max)))
+ (funcall gnus-decode-header-function (point-min) (point-max))))
+ (when addresses
+ (article--check-suspicious-addresses addresses))
+ (goto-char (point-max))
+ (goto-char (setq end start))))))
+
+(defun article--check-suspicious-addresses (addresses)
+ (setq addresses (replace-regexp-in-string "\\`[^:]+:[ \t\n]*" "" addresses))
+ (dolist (header (mail-header-parse-addresses addresses t))
+ (when-let* ((address (car (ignore-errors
+ (mail-header-parse-address header))))
+ (warning (and (string-match "@" address)
+ (textsec-suspicious-p address 'email-address))))
+ (goto-char (point-min))
+ (while (search-forward address nil t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'textsec-suspicious warning)))))
(defun article-decode-group-name ()
"Decode group names in Newsgroups, Followup-To and Xref headers."
@@ -3933,8 +4027,8 @@ This format is defined by the `gnus-article-time-format' variable."
;; No split name was found.
((null split-name)
(read-file-name
- (concat prompt " (default "
- (file-name-nondirectory default-name) "): ")
+ (format-prompt prompt
+ (file-name-nondirectory default-name))
(file-name-directory default-name)
default-name))
;; A single group name is returned.
@@ -3943,8 +4037,8 @@ This format is defined by the `gnus-article-time-format' variable."
(funcall function split-name headers
(symbol-value variable)))
(read-file-name
- (concat prompt " (default "
- (file-name-nondirectory default-name) "): ")
+ (format-prompt prompt
+ (file-name-nondirectory default-name))
(file-name-directory default-name)
default-name))
;; A single split name was found
@@ -3956,9 +4050,8 @@ This format is defined by the `gnus-article-time-format' variable."
(file-name-as-directory name))
((file-exists-p name) name)
(t gnus-article-save-directory))))
- (read-file-name
- (concat prompt " (default " name "): ")
- dir name)))
+ (read-file-name (format-prompt prompt name)
+ dir name)))
;; A list of splits was found.
(t
(setq split-name (nreverse split-name))
@@ -4342,6 +4435,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
article-fill-long-lines
article-capitalize-sentences
article-remove-cr
+ article-emojize-symbols
article-remove-leading-whitespace
article-display-x-face
article-display-face
@@ -4387,44 +4481,44 @@ If variable `gnus-use-long-file-name' is non-nil, it is
;;; Gnus article mode
;;;
-(set-keymap-parent gnus-article-mode-map button-buffer-map)
-
-(gnus-define-keys gnus-article-mode-map
- " " gnus-article-goto-next-page
- [?\S-\ ] gnus-article-goto-prev-page
- "\177" gnus-article-goto-prev-page
- [delete] gnus-article-goto-prev-page
- "\C-c^" gnus-article-refer-article
- "h" gnus-article-show-summary
- "s" gnus-article-show-summary
- "\C-c\C-m" gnus-article-mail
- "?" gnus-article-describe-briefly
- "<" beginning-of-buffer
- ">" end-of-buffer
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug
- "R" gnus-article-reply-with-original
- "F" gnus-article-followup-with-original
- "\C-hk" gnus-article-describe-key
- "\C-hc" gnus-article-describe-key-briefly
- "\C-hb" gnus-article-describe-bindings
-
- "e" gnus-article-read-summary-keys
- "\C-d" gnus-article-read-summary-keys
- "\C-c\C-f" gnus-summary-mail-forward
- "\M-*" gnus-article-read-summary-keys
- "\M-#" gnus-article-read-summary-keys
- "\M-^" gnus-article-read-summary-keys
- "\M-g" gnus-article-read-summary-keys)
+(defvar gnus-article-send-map nil)
+
+(define-keymap :keymap gnus-article-mode-map :suppress t
+ :parent button-buffer-map
+ "SPC" #'gnus-article-goto-next-page
+ "S-SPC" #'gnus-article-goto-prev-page
+ "DEL" #'gnus-article-goto-prev-page
+ "<delete>" #'gnus-article-goto-prev-page
+ "C-c ^" #'gnus-article-refer-article
+ "h" #'gnus-article-show-summary
+ "s" #'gnus-article-show-summary
+ "C-c C-m" #'gnus-article-mail
+ "?" #'gnus-article-describe-briefly
+ "<" #'beginning-of-buffer
+ ">" #'end-of-buffer
+ "C-c C-i" #'gnus-info-find-node
+ "C-c C-b" #'gnus-bug
+ "R" #'gnus-article-reply-with-original
+ "F" #'gnus-article-followup-with-original
+ "C-h k" #'gnus-article-describe-key
+ "C-h c" #'gnus-article-describe-key-briefly
+ "C-h b" #'gnus-article-describe-bindings
+
+ "e" #'gnus-article-read-summary-keys
+ "C-d" #'gnus-article-read-summary-keys
+ "C-c C-f" #'gnus-summary-mail-forward
+ "M-*" #'gnus-article-read-summary-keys
+ "M-#" #'gnus-article-read-summary-keys
+ "M-^" #'gnus-article-read-summary-keys
+ "M-g" #'gnus-article-read-summary-keys
+
+ "S" (define-keymap :prefix 'gnus-article-send-map
+ "W" #'gnus-article-wide-reply-with-original
+ "<t>" #'gnus-article-read-summary-send-keys))
(substitute-key-definition
#'undefined #'gnus-article-read-summary-keys gnus-article-mode-map)
-(defvar gnus-article-send-map)
-(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
- "W" gnus-article-wide-reply-with-original
- [t] gnus-article-read-summary-send-keys)
-
(defun gnus-article-make-menu-bar ()
(unless (boundp 'gnus-article-commands-menu)
(gnus-summary-make-menu-bar))
@@ -4449,6 +4543,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
["Treat overstrike" gnus-article-treat-overstrike t]
["Treat ANSI sequences" gnus-article-treat-ansi-sequences t]
["Remove carriage return" gnus-article-remove-cr t]
+ ["Emojize Symbols" gnus-article-emojize-symbols t]
["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
["Remove base64" gnus-article-de-base64-unreadable t]
@@ -4509,7 +4604,8 @@ commands:
(setq show-trailing-whitespace nil)
;; Arrange a callback from `mm-inline-message' if we're
;; displaying a message/rfc822 part.
- (setq-local mm-inline-message-prepare-function #'gnus-mime--inline-message)
+ (setq-local mm-inline-message-prepare-function
+ #'gnus-mime--inline-message-function)
(mm-enable-multibyte))
(defun gnus-article-setup-buffer ()
@@ -4549,7 +4645,6 @@ commands:
(let ((summary gnus-summary-buffer))
(with-current-buffer name
(setq-local gnus-article-edit-mode nil)
- (gnus-article-stop-animations)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
(setq gnus-article-mime-handles nil))
@@ -4575,6 +4670,7 @@ commands:
(current-buffer))))))
(defun gnus-article-stop-animations ()
+ (declare (obsolete nil "29.1"))
(cancel-function-timers 'image-animate-timeout))
(defun gnus-stop-downloads ()
@@ -6033,6 +6129,34 @@ If nil, don't show those extra buttons."
((equal (car handle) "multipart/encrypted")
(gnus-add-wash-type 'encrypted)
(gnus-mime-display-security handle))
+ ;; pkcs7-mime handling:
+ ;;
+ ;; although not really multipart these are structured internally by
+ ;; mm-dissect-buffer like multipart to not discard the decryption
+ ;; and verification results
+ ;;
+ ;; application/pkcs7-mime
+ ((and (equal (car handle) "application/pkcs7-mime")
+ (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/pkcs7-mime_signed-data"))
+ (gnus-add-wash-type 'signed)
+ (gnus-mime-display-security handle))
+ ((and (equal (car handle) "application/pkcs7-mime")
+ (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/pkcs7-mime_enveloped-data"))
+ (gnus-add-wash-type 'encrypted)
+ (gnus-mime-display-security handle))
+ ;; application/x-pkcs7-mime
+ ((and (equal (car handle) "application/x-pkcs7-mime")
+ (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/x-pkcs7-mime_signed-data"))
+ (gnus-add-wash-type 'signed)
+ (gnus-mime-display-security handle))
+ ((and (equal (car handle) "application/x-pkcs7-mime")
+ (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/x-pkcs7-mime_enveloped-data"))
+ (gnus-add-wash-type 'encrypted)
+ (gnus-mime-display-security handle))
;; Other multiparts are handled like multipart/mixed.
(t
(gnus-mime-display-mixed (cdr handle)))))
@@ -6045,7 +6169,7 @@ If nil, don't show those extra buttons."
(defun gnus-mime-display-mixed (handles)
(mapcar #'gnus-mime-display-part handles))
-(defun gnus-mime--inline-message (handle charset)
+(defun gnus-mime--inline-message-function (handle charset)
(let ((handles
(let (gnus-article-mime-handles
;; disable prepare hook
@@ -6938,7 +7062,7 @@ then we display only bindings that start with that prefix."
(setq sumkeys
(append (mapcar
#'vector
- (nreverse (gnus-uncompress-range def)))
+ (nreverse (range-uncompress def)))
sumkeys))))
((setq def (key-binding key))
(unless (eq def 'undefined)
@@ -7222,50 +7346,42 @@ other groups."
(defvar gnus-article-edit-done-function nil)
-(defvar gnus-article-edit-mode-map nil)
-
-;; Should we be using derived.el for this?
-(unless gnus-article-edit-mode-map
- (setq gnus-article-edit-mode-map (make-keymap))
- (set-keymap-parent gnus-article-edit-mode-map text-mode-map)
-
- (gnus-define-keys gnus-article-edit-mode-map
- "\C-c?" describe-mode
- "\C-c\C-c" gnus-article-edit-done
- "\C-c\C-k" gnus-article-edit-exit
- "\C-c\C-f\C-t" message-goto-to
- "\C-c\C-f\C-o" message-goto-from
- "\C-c\C-f\C-b" message-goto-bcc
- ;;"\C-c\C-f\C-w" message-goto-fcc
- "\C-c\C-f\C-c" message-goto-cc
- "\C-c\C-f\C-s" message-goto-subject
- "\C-c\C-f\C-r" message-goto-reply-to
- "\C-c\C-f\C-n" message-goto-newsgroups
- "\C-c\C-f\C-d" message-goto-distribution
- "\C-c\C-f\C-f" message-goto-followup-to
- "\C-c\C-f\C-m" message-goto-mail-followup-to
- "\C-c\C-f\C-k" message-goto-keywords
- "\C-c\C-f\C-u" message-goto-summary
- "\C-c\C-f\C-i" message-insert-or-toggle-importance
- "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to
- "\C-c\C-b" message-goto-body
- "\C-c\C-i" message-goto-signature
-
- "\C-c\C-t" message-insert-to
- "\C-c\C-n" message-insert-newsgroups
- "\C-c\C-o" message-sort-headers
- "\C-c\C-e" message-elide-region
- "\C-c\C-v" message-delete-not-region
- "\C-c\C-z" message-kill-to-signature
- "\M-\r" message-newline-and-reformat
- "\C-c\C-a" mml-attach-file
- "\C-a" message-beginning-of-line
- "\t" message-tab
- "\M-;" comment-region)
-
- (gnus-define-keys (gnus-article-edit-wash-map
- "\C-c\C-w" gnus-article-edit-mode-map)
- "f" gnus-article-edit-full-stops))
+(defvar-keymap gnus-article-edit-mode-map
+ :full t :parent text-mode-map
+ "C-c ?" #'describe-mode
+ "C-c C-c" #'gnus-article-edit-done
+ "C-c C-k" #'gnus-article-edit-exit
+ "C-c C-f C-t" #'message-goto-to
+ "C-c C-f C-o" #'message-goto-from
+ "C-c C-f C-b" #'message-goto-bcc
+ "C-c C-f C-c" #'message-goto-cc
+ "C-c C-f C-s" #'message-goto-subject
+ "C-c C-f C-r" #'message-goto-reply-to
+ "C-c C-f C-n" #'message-goto-newsgroups
+ "C-c C-f C-d" #'message-goto-distribution
+ "C-c C-f C-f" #'message-goto-followup-to
+ "C-c C-f RET" #'message-goto-mail-followup-to
+ "C-c C-f C-k" #'message-goto-keywords
+ "C-c C-f C-u" #'message-goto-summary
+ "C-c C-f TAB" #'message-insert-or-toggle-importance
+ "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to
+ "C-c C-b" #'message-goto-body
+ "C-c TAB" #'message-goto-signature
+
+ "C-c C-t" #'message-insert-to
+ "C-c C-n" #'message-insert-newsgroups
+ "C-c C-o" #'message-sort-headers
+ "C-c C-e" #'message-elide-region
+ "C-c C-v" #'message-delete-not-region
+ "C-c C-z" #'message-kill-to-signature
+ "M-RET" #'message-newline-and-reformat
+ "C-c C-a" #'mml-attach-file
+ "C-a" #'message-beginning-of-line
+ "TAB" #'message-tab
+ "M-;" #'comment-region
+
+ "C-c C-w" (define-keymap :prefix 'gnus-article-edit-wash-map
+ "f" #'gnus-article-edit-full-stops))
(easy-menu-define
gnus-article-edit-mode-field-menu gnus-article-edit-mode-map ""
@@ -7864,8 +7980,8 @@ variable is the real callback function."
(function :tag "Callback")
(repeat :tag "Par"
:inline t
- (integer :tag "Regexp group")))))
-(put 'gnus-button-alist 'risky-local-variable t)
+ (integer :tag "Regexp group"))))
+ :risky t)
(defcustom gnus-header-button-alist
'(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>"
@@ -7904,8 +8020,8 @@ HEADER is a regexp to match a header. For a fuller explanation, see
(function :tag "Callback")
(repeat :tag "Par"
:inline t
- (integer :tag "Regexp group")))))
-(put 'gnus-header-button-alist 'risky-local-variable t)
+ (integer :tag "Regexp group"))))
+ :risky t)
;;; Commands:
@@ -8790,11 +8906,19 @@ For example:
(setq point (point))
(with-current-buffer (mm-handle-multipart-original-buffer handle)
(let* ((mm-verify-option 'known)
- (mm-decrypt-option 'known)
- (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
- (unless (eq nparts (cdr handle))
- (mm-destroy-parts (cdr handle))
- (setcdr handle nparts))))
+ (mm-decrypt-option 'known)
+ (pkcs7-mime-p (or (equal (car handle) "application/pkcs7-mime")
+ (equal (car handle) "application/x-pkcs7-mime")))
+ (nparts (if pkcs7-mime-p
+ (list (mm-possibly-verify-or-decrypt
+ (cadr handle) (cadadr handle)))
+ (mm-possibly-verify-or-decrypt (cdr handle) handle))))
+ (unless (eq nparts (cdr handle))
+ ;; if pkcs7-mime don't destroy the parts as the buffer in
+ ;; the cdr still needs to be accessible
+ (when (not pkcs7-mime-p)
+ (mm-destroy-parts (cdr handle)))
+ (setcdr handle nparts))))
(gnus-mime-display-security handle)
(when region
(delete-region (point) (cdr region))
@@ -8848,14 +8972,35 @@ For example:
(let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
(gnus-tmp-type
(concat
- (or (nth 2 (assoc protocol mm-verify-function-alist))
- (nth 2 (assoc protocol mm-decrypt-function-alist))
- "Unknown")
- (if (equal (car handle) "multipart/signed")
- " Signed" " Encrypted")
- " Part"))
- (gnus-tmp-info
- (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ (or (nth 2 (assoc protocol mm-verify-function-alist))
+ (nth 2 (assoc protocol mm-decrypt-function-alist))
+ "Unknown")
+ (cond ((equal (car handle) "multipart/signed") " Signed")
+ ((equal (car handle) "multipart/encrypted") " Encrypted")
+ ((and (equal (car handle) "application/pkcs7-mime")
+ (equal
+ (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/pkcs7-mime_signed-data"))
+ " Signed")
+ ((and (equal (car handle) "application/pkcs7-mime")
+ (equal
+ (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/pkcs7-mime_enveloped-data"))
+ " Encrypted")
+ ;; application/x-pkcs7-mime
+ ((and (equal (car handle) "application/x-pkcs7-mime")
+ (equal
+ (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/x-pkcs7-mime_signed-data"))
+ " Signed")
+ ((and (equal (car handle) "application/x-pkcs7-mime")
+ (equal
+ (mm-handle-multipart-ctl-parameter handle 'protocol)
+ "application/x-pkcs7-mime_enveloped-data"))
+ " Encrypted"))
+ " Part"))
+ (gnus-tmp-info
+ (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
"Undecided"))
(gnus-tmp-details
(mm-handle-multipart-ctl-parameter handle 'gnus-details))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 98e9bb996bc..4f5b9bd3422 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -418,32 +418,29 @@ That is, all information but the name."
(defvar gnus-bookmark-bmenu-bookmark-column nil)
(defvar gnus-bookmark-bmenu-hidden-bookmarks ())
-(defvar gnus-bookmark-bmenu-mode-map nil)
-
-(if gnus-bookmark-bmenu-mode-map
- nil
- (setq gnus-bookmark-bmenu-mode-map (make-keymap))
- (suppress-keymap gnus-bookmark-bmenu-mode-map t)
- (define-key gnus-bookmark-bmenu-mode-map "q" 'quit-window)
- (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select)
- (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select)
- (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete)
- (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete)
- (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards)
- (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions)
- (define-key gnus-bookmark-bmenu-mode-map " " 'next-line)
- (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line)
- (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line)
- (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark)
- (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode)
- (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark)
- (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark)
- (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load)
- (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save)
- (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos)
- (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details)
- (define-key gnus-bookmark-bmenu-mode-map [mouse-2]
- 'gnus-bookmark-bmenu-select-by-mouse))
+
+(defvar-keymap gnus-bookmark-bmenu-mode-map
+ :full t
+ :suppress 'nodigits
+ "q" #'quit-window
+ "RET" #'gnus-bookmark-bmenu-select
+ "v" #'gnus-bookmark-bmenu-select
+ "d" #'gnus-bookmark-bmenu-delete
+ "k" #'gnus-bookmark-bmenu-delete
+ "C-d" #'gnus-bookmark-bmenu-delete-backwards
+ "x" #'gnus-bookmark-bmenu-execute-deletions
+ "SPC" #'next-line
+ "n" #'next-line
+ "p" #'previous-line
+ "DEL" #'gnus-bookmark-bmenu-backup-unmark
+ "?" #'describe-mode
+ "u" #'gnus-bookmark-bmenu-unmark
+ "m" #'gnus-bookmark-bmenu-mark
+ "l" #'gnus-bookmark-bmenu-load
+ "s" #'gnus-bookmark-bmenu-save
+ "t" #'gnus-bookmark-bmenu-toggle-infos
+ "a" #'gnus-bookmark-bmenu-show-details
+ "<mouse-2>" #'gnus-bookmark-bmenu-select-by-mouse)
;; Bookmark Buffer Menu mode is suitable only for specially formatted
;; data.
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 6ed9e32c919..9bd9f2155f7 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -30,6 +30,7 @@
(require 'parse-time)
(require 'nnimap)
+(require 'range)
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
@@ -404,7 +405,7 @@ When FULL is t, upload everything, not just a difference from the last full."
(let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
(active (gnus-active group))
headers head)
- (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
+ (when (gnus-retrieve-headers (range-uncompress active) group)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(while (setq head (nnheader-parse-head))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index f8714a95d40..ddd939794dd 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -273,7 +273,7 @@ DOC is a documentation string for the parameter.")
gnus-agent-cat-predicate)
(agent-score
(choice :tag "Score File" :value nil
- (const file :tag "Use group's score files")
+ (const :value file :tag "Use group's score files")
(repeat (list (string :format "%v" :tag "File name"))))
"Which score files to use when using score to select articles to fetch.
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 2953b61f04e..3d8882b1a55 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -53,12 +53,10 @@
(autoload 'message-buffers "message")
(autoload 'gnus-print-buffer "gnus-sum")
-(defvar gnus-dired-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-m\C-a" 'gnus-dired-attach)
- (define-key map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap)
- (define-key map "\C-c\C-m\C-p" 'gnus-dired-print)
- map))
+(defvar-keymap gnus-dired-mode-map
+ "C-c C-m C-a" #'gnus-dired-attach
+ "C-c C-m C-l" #'gnus-dired-find-file-mailcap
+ "C-c C-m C-p" #'gnus-dired-print)
;; FIXME: Make it customizable, change the default to `mail-user-agent' when
;; this file is renamed (e.g. to `dired-mime.el').
@@ -206,7 +204,8 @@ If ARG is non-nil, open it in a new buffer."
(find-file file-name)))
(if (file-symlink-p file-name)
(error "File is a symlink to a nonexistent target")
- (error "File no longer exists; type `g' to update Dired buffer"))))
+ (error (substitute-command-keys
+ "File no longer exists; type \\`g' to update Dired buffer")))))
(defun gnus-dired-print (&optional file-name print-to)
"In dired, print FILE-NAME according to the mailcap file.
@@ -246,9 +245,10 @@ of the file to save in."
(error "MIME print only implemented via Gnus")))
(ps-despool print-to))))
((file-symlink-p file-name)
- (error "File is a symlink to a nonexistent target"))
- (t
- (error "File no longer exists; type `g' to update Dired buffer"))))
+ (error "File is a symlink to a nonexistent target"))
+ (t
+ (error (substitute-command-keys
+ "File no longer exists; type \\`g' to update Dired buffer")))))
(provide 'gnus-dired)
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 1228d74cb51..56d498cc4d3 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -33,15 +33,12 @@
;;; Draft minor mode
-(defvar gnus-draft-mode-map
- (let ((map (make-sparse-keymap)))
- (gnus-define-keys map
- "Dt" gnus-draft-toggle-sending
- "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article'
- "De" gnus-draft-edit-message
- "Ds" gnus-draft-send-message
- "DS" gnus-draft-send-all-messages)
- map))
+(defvar-keymap gnus-draft-mode-map
+ "D t" #'gnus-draft-toggle-sending
+ "e" #' gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article'
+ "D e" #'gnus-draft-edit-message
+ "D s" #'gnus-draft-send-message
+ "D S" #'gnus-draft-send-all-messages)
(defun gnus-draft-make-menu-bar ()
(unless (boundp 'gnus-draft-menu)
@@ -203,7 +200,7 @@ Obeys the standard process/prefix convention."
(gnus-activate-group "nndraft:queue")
(save-excursion
(let* ((articles (nndraft-articles))
- (unsendable (gnus-uncompress-range
+ (unsendable (range-uncompress
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index dc10e3cbce0..96f515119dc 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -48,13 +48,10 @@
(defvar gnus-edit-form-buffer "*Gnus edit form*")
(defvar gnus-edit-form-done-function nil)
-(defvar gnus-edit-form-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map emacs-lisp-mode-map)
- (gnus-define-keys map
- "\C-c\C-c" gnus-edit-form-done
- "\C-c\C-k" gnus-edit-form-exit)
- map))
+(defvar-keymap gnus-edit-form-mode-map
+ :parent emacs-lisp-mode-map
+ "C-c C-c" #'gnus-edit-form-done
+ "C-c C-k" #'gnus-edit-form-exit)
(defun gnus-edit-form-make-menu-bar ()
(unless (boundp 'gnus-edit-form-menu)
@@ -95,7 +92,7 @@ The optional LAYOUT overrides the `edit-form' window layout."
(insert ";;; ")
(forward-line 1))
(insert (substitute-command-keys
- ";; Type `C-c C-c' after you've finished editing.\n"))
+ ";; Type \\`C-c C-c' after you've finished editing.\n"))
(insert "\n")
(let ((p (point)))
(gnus-pp form)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 8e12b1cb4bd..04d19e29a3a 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -35,6 +35,7 @@
(require 'gnus-undo)
(require 'gmm-utils)
(require 'time-date)
+(require 'range)
(eval-when-compile
(require 'mm-url)
@@ -62,7 +63,7 @@
(defcustom gnus-keep-same-level nil
"Non-nil means that the newsgroup after this one will be on the same level.
-When you type, for instance, `n' after reading the last article in the
+When you type, for instance, \\`n' after reading the last article in the
current newsgroup, you will go to the next newsgroup. If this variable
is nil, the next newsgroup will be the next from the group
buffer.
@@ -380,8 +381,8 @@ variables in the Lisp expression:
`group-age': Time in seconds since the group was last read
(see info node `(gnus)Group Timestamp')."
:group 'gnus-group-visual
- :type '(repeat (cons (sexp :tag "Form") face)))
-(put 'gnus-group-highlight 'risky-local-variable t)
+ :type '(repeat (cons (sexp :tag "Form") face))
+ :risky t)
(defcustom gnus-new-mail-mark ?%
"Mark used for groups with new mail."
@@ -409,8 +410,8 @@ requires an understanding of Lisp expressions. Hopefully this will
change in a future release. For now, you can use the same
variables in the Lisp expression as in `gnus-group-highlight'."
:group 'gnus-group-icons
- :type '(repeat (cons (sexp :tag "Form") file)))
-(put 'gnus-group-icon-list 'risky-local-variable t)
+ :type '(repeat (cons (sexp :tag "Form") file))
+ :risky t)
(defcustom gnus-group-name-charset-method-alist nil
"Alist of method and the charset for group names.
@@ -512,8 +513,8 @@ simple manner."
((numberp number)
(int-to-string
(+ number
- (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
+ (range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number))
?s)
(?R gnus-tmp-number-of-read ?s)
@@ -523,10 +524,10 @@ simple manner."
?s)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
- (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
- (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
- (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))
+ (?I (range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
+ (?T (range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
+ (?i (+ (range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (range-length (cdr (assq 'tick gnus-tmp-marked))))
?d)
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
@@ -573,209 +574,209 @@ simple manner."
;;; Gnus group mode
;;;
-(gnus-define-keys gnus-group-mode-map
- " " gnus-group-read-group
- "=" gnus-group-select-group
- "\r" gnus-group-select-group
- "\M-\r" gnus-group-quick-select-group
- "\M- " gnus-group-visible-select-group
- [(meta control return)] gnus-group-select-group-ephemerally
- "j" gnus-group-jump-to-group
- "n" gnus-group-next-unread-group
- "p" gnus-group-prev-unread-group
- "\177" gnus-group-prev-unread-group
- [delete] gnus-group-prev-unread-group
- "N" gnus-group-next-group
- "P" gnus-group-prev-group
- "\M-n" gnus-group-next-unread-group-same-level
- "\M-p" gnus-group-prev-unread-group-same-level
- "," gnus-group-best-unread-group
- "." gnus-group-first-unread-group
- "u" gnus-group-toggle-subscription-at-point
- "U" gnus-group-toggle-subscription
- "c" gnus-group-catchup-current
- "C" gnus-group-catchup-current-all
- "\M-c" gnus-group-clear-data
- "l" gnus-group-list-groups
- "L" gnus-group-list-all-groups
- "m" gnus-group-mail
- "i" gnus-group-news
- "g" gnus-group-get-new-news
- "\M-g" gnus-group-get-new-news-this-group
- "R" gnus-group-restart
- "r" gnus-group-read-init-file
- "B" gnus-group-browse-foreign-server
- "b" gnus-group-check-bogus-groups
- "F" gnus-group-find-new-groups
- "\C-c\C-d" gnus-group-describe-group
- "\M-d" gnus-group-describe-all-groups
- "\C-c\C-a" gnus-group-apropos
- "\C-c\M-\C-a" gnus-group-description-apropos
- "a" gnus-group-post-news
- "\ek" gnus-group-edit-local-kill
- "\eK" gnus-group-edit-global-kill
- "\C-k" gnus-group-kill-group
- "\C-y" gnus-group-yank-group
- "\C-w" gnus-group-kill-region
- "\C-x\C-t" gnus-group-transpose-groups
- "\C-c\C-l" gnus-group-list-killed
- "\C-c\C-x" gnus-group-expire-articles
- "\C-c\M-\C-x" gnus-group-expire-all-groups
- "V" gnus-version
- "s" gnus-group-save-newsrc
- "z" gnus-group-suspend
- "q" gnus-group-exit
- "Q" gnus-group-quit
- "?" gnus-group-describe-briefly
- "\C-c\C-i" gnus-info-find-node
- "\M-e" gnus-group-edit-group-method
- "^" gnus-group-enter-server-mode
- [mouse-2] gnus-mouse-pick-group
- [follow-link] mouse-face
- "<" beginning-of-buffer
- ">" end-of-buffer
- "\C-c\C-b" gnus-bug
- "\C-c\C-s" gnus-group-sort-groups
- "t" gnus-topic-mode
- "\C-c\M-g" gnus-activate-all-groups
- "\M-&" gnus-group-universal-argument
- "#" gnus-group-mark-group
- "\M-#" gnus-group-unmark-group)
-
-(gnus-define-keys (gnus-group-cloud-map "~" gnus-group-mode-map)
- "u" gnus-cloud-upload-all-data
- "~" gnus-cloud-upload-all-data
- "d" gnus-cloud-download-all-data
- "\r" gnus-cloud-download-all-data)
-
-(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
- "m" gnus-group-mark-group
- "u" gnus-group-unmark-group
- "w" gnus-group-mark-region
- "b" gnus-group-mark-buffer
- "r" gnus-group-mark-regexp
- "U" gnus-group-unmark-all-groups)
-
-(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
- "u" gnus-sieve-update
- "g" gnus-sieve-generate)
-
-(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
- "d" gnus-group-make-directory-group
- "h" gnus-group-make-help-group
- "u" gnus-group-make-useful-group
- "l" gnus-group-nnimap-edit-acl
- "m" gnus-group-make-group
- "E" gnus-group-edit-group
- "e" gnus-group-edit-group-method
- "p" gnus-group-edit-group-parameters
- "v" gnus-group-add-to-virtual
- "V" gnus-group-make-empty-virtual
- "D" gnus-group-enter-directory
- "f" gnus-group-make-doc-group
- "w" gnus-group-make-web-group
- "G" gnus-group-read-ephemeral-search-group
- "g" gnus-group-make-search-group
- "M" gnus-group-read-ephemeral-group
- "r" gnus-group-rename-group
- "R" gnus-group-make-rss-group
- "c" gnus-group-customize
- "z" gnus-group-compact-group
- "x" gnus-group-expunge-group
- "\177" gnus-group-delete-group
- [delete] gnus-group-delete-group)
-
-(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
- "s" gnus-group-sort-groups
- "a" gnus-group-sort-groups-by-alphabet
- "u" gnus-group-sort-groups-by-unread
- "l" gnus-group-sort-groups-by-level
- "v" gnus-group-sort-groups-by-score
- "r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method
- "n" gnus-group-sort-groups-by-real-name)
-
-(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
- "s" gnus-group-sort-selected-groups
- "a" gnus-group-sort-selected-groups-by-alphabet
- "u" gnus-group-sort-selected-groups-by-unread
- "l" gnus-group-sort-selected-groups-by-level
- "v" gnus-group-sort-selected-groups-by-score
- "r" gnus-group-sort-selected-groups-by-rank
- "m" gnus-group-sort-selected-groups-by-method
- "n" gnus-group-sort-selected-groups-by-real-name)
-
-(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
- "k" gnus-group-list-killed
- "z" gnus-group-list-zombies
- "s" gnus-group-list-groups
- "u" gnus-group-list-all-groups
- "A" gnus-group-list-active
- "a" gnus-group-apropos
- "d" gnus-group-description-apropos
- "m" gnus-group-list-matching
- "M" gnus-group-list-all-matching
- "l" gnus-group-list-level
- "c" gnus-group-list-cached
- "?" gnus-group-list-dormant
- "!" gnus-group-list-ticked)
-
-(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
- "k" gnus-group-list-limit
- "z" gnus-group-list-limit
- "s" gnus-group-list-limit
- "u" gnus-group-list-limit
- "A" gnus-group-list-limit
- "m" gnus-group-list-limit
- "M" gnus-group-list-limit
- "l" gnus-group-list-limit
- "c" gnus-group-list-limit
- "?" gnus-group-list-limit
- "!" gnus-group-list-limit)
-
-(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
- "k" gnus-group-list-flush
- "z" gnus-group-list-flush
- "s" gnus-group-list-flush
- "u" gnus-group-list-flush
- "A" gnus-group-list-flush
- "m" gnus-group-list-flush
- "M" gnus-group-list-flush
- "l" gnus-group-list-flush
- "c" gnus-group-list-flush
- "?" gnus-group-list-flush
- "!" gnus-group-list-flush)
-
-(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
- "k" gnus-group-list-plus
- "z" gnus-group-list-plus
- "s" gnus-group-list-plus
- "u" gnus-group-list-plus
- "A" gnus-group-list-plus
- "m" gnus-group-list-plus
- "M" gnus-group-list-plus
- "l" gnus-group-list-plus
- "c" gnus-group-list-plus
- "?" gnus-group-list-plus
- "!" gnus-group-list-plus)
-
-(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
- "f" gnus-score-flush-cache
- "e" gnus-score-edit-all-score)
-
-(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
- "d" gnus-group-describe-group
- "v" gnus-version)
-
-(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
- "l" gnus-group-set-current-level
- "t" gnus-group-toggle-subscription-at-point
- "s" gnus-group-toggle-subscription
- "k" gnus-group-kill-group
- "y" gnus-group-yank-group
- "w" gnus-group-kill-region
- "\C-k" gnus-group-kill-level
- "z" gnus-group-kill-all-zombies)
+(define-keymap :keymap gnus-group-mode-map
+ "SPC" #'gnus-group-read-group
+ "=" #'gnus-group-select-group
+ "RET" #'gnus-group-select-group
+ "M-RET" #'gnus-group-quick-select-group
+ "M-SPC" #'gnus-group-visible-select-group
+ "C-M-<return>" #'gnus-group-select-group-ephemerally
+ "j" #'gnus-group-jump-to-group
+ "n" #'gnus-group-next-unread-group
+ "p" #'gnus-group-prev-unread-group
+ "DEL" #'gnus-group-prev-unread-group
+ "<delete>" #'gnus-group-prev-unread-group
+ "N" #'gnus-group-next-group
+ "P" #'gnus-group-prev-group
+ "M-n" #'gnus-group-next-unread-group-same-level
+ "M-p" #'gnus-group-prev-unread-group-same-level
+ "," #'gnus-group-best-unread-group
+ "." #'gnus-group-first-unread-group
+ "u" #'gnus-group-toggle-subscription-at-point
+ "U" #'gnus-group-toggle-subscription
+ "c" #'gnus-group-catchup-current
+ "C" #'gnus-group-catchup-current-all
+ "M-c" #'gnus-group-clear-data
+ "l" #'gnus-group-list-groups
+ "L" #'gnus-group-list-all-groups
+ "m" #'gnus-group-mail
+ "i" #'gnus-group-news
+ "g" #'gnus-group-get-new-news
+ "M-g" #'gnus-group-get-new-news-this-group
+ "R" #'gnus-group-restart
+ "r" #'gnus-group-read-init-file
+ "B" #'gnus-group-browse-foreign-server
+ "b" #'gnus-group-check-bogus-groups
+ "F" #'gnus-group-find-new-groups
+ "C-c C-d" #'gnus-group-describe-group
+ "M-d" #'gnus-group-describe-all-groups
+ "C-c C-a" #'gnus-group-apropos
+ "C-c C-M-a" #'gnus-group-description-apropos
+ "a" #'gnus-group-post-news
+ "ESC k" #'gnus-group-edit-local-kill
+ "ESC K" #'gnus-group-edit-global-kill
+ "C-k" #'gnus-group-kill-group
+ "C-y" #'gnus-group-yank-group
+ "C-w" #'gnus-group-kill-region
+ "C-x C-t" #'gnus-group-transpose-groups
+ "C-c C-l" #'gnus-group-list-killed
+ "C-c C-x" #'gnus-group-expire-articles
+ "C-c C-M-x" #'gnus-group-expire-all-groups
+ "V" #'gnus-version
+ "s" #'gnus-group-save-newsrc
+ "z" #'gnus-group-suspend
+ "q" #'gnus-group-exit
+ "Q" #'gnus-group-quit
+ "?" #'gnus-group-describe-briefly
+ "C-c C-i" #'gnus-info-find-node
+ "M-e" #'gnus-group-edit-group-method
+ "^" #'gnus-group-enter-server-mode
+ "<mouse-2>" #'gnus-mouse-pick-group
+ "<follow-link>" 'mouse-face
+ "<" #'beginning-of-buffer
+ ">" #'end-of-buffer
+ "C-c C-b" #'gnus-bug
+ "C-c C-s" #'gnus-group-sort-groups
+ "t" #'gnus-topic-mode
+ "C-c M-g" #'gnus-activate-all-groups
+ "M-&" #'gnus-group-universal-argument
+ "#" #'gnus-group-mark-group
+ "M-#" #'gnus-group-unmark-group
+
+ "~" (define-keymap :prefix 'gnus-group-cloud-map
+ "u" #'gnus-cloud-upload-all-data
+ "~" #'gnus-cloud-upload-all-data
+ "d" #'gnus-cloud-download-all-data
+ "RET" #'gnus-cloud-download-all-data)
+
+ "M" (define-keymap :prefix 'gnus-group-mark-map
+ "m" #'gnus-group-mark-group
+ "u" #'gnus-group-unmark-group
+ "w" #'gnus-group-mark-region
+ "b" #'gnus-group-mark-buffer
+ "r" #'gnus-group-mark-regexp
+ "U" #'gnus-group-unmark-all-groups)
+
+ "D" (define-keymap :prefix 'gnus-group-sieve-map
+ "u" #'gnus-sieve-update
+ "g" #'gnus-sieve-generate)
+
+ "G" (define-keymap :prefix 'gnus-group-group-map
+ "d" #'gnus-group-make-directory-group
+ "h" #'gnus-group-make-help-group
+ "u" #'gnus-group-make-useful-group
+ "l" #'gnus-group-nnimap-edit-acl
+ "m" #'gnus-group-make-group
+ "E" #'gnus-group-edit-group
+ "e" #'gnus-group-edit-group-method
+ "p" #'gnus-group-edit-group-parameters
+ "v" #'gnus-group-add-to-virtual
+ "V" #'gnus-group-make-empty-virtual
+ "D" #'gnus-group-enter-directory
+ "f" #'gnus-group-make-doc-group
+ "w" #'gnus-group-make-web-group
+ "G" #'gnus-group-read-ephemeral-search-group
+ "g" #'gnus-group-make-search-group
+ "M" #'gnus-group-read-ephemeral-group
+ "r" #'gnus-group-rename-group
+ "R" #'gnus-group-make-rss-group
+ "c" #'gnus-group-customize
+ "z" #'gnus-group-compact-group
+ "x" #'gnus-group-expunge-group
+ "DEL" #'gnus-group-delete-group
+ "<delete>" #'gnus-group-delete-group
+
+ "S" (define-keymap :prefix 'gnus-group-sort-map
+ "s" #'gnus-group-sort-groups
+ "a" #'gnus-group-sort-groups-by-alphabet
+ "u" #'gnus-group-sort-groups-by-unread
+ "l" #'gnus-group-sort-groups-by-level
+ "v" #'gnus-group-sort-groups-by-score
+ "r" #'gnus-group-sort-groups-by-rank
+ "m" #'gnus-group-sort-groups-by-method
+ "n" #'gnus-group-sort-groups-by-real-name)
+
+ "P" (define-keymap :prefix 'gnus-group-sort-selected-map
+ "s" #'gnus-group-sort-selected-groups
+ "a" #'gnus-group-sort-selected-groups-by-alphabet
+ "u" #'gnus-group-sort-selected-groups-by-unread
+ "l" #'gnus-group-sort-selected-groups-by-level
+ "v" #'gnus-group-sort-selected-groups-by-score
+ "r" #'gnus-group-sort-selected-groups-by-rank
+ "m" #'gnus-group-sort-selected-groups-by-method
+ "n" #'gnus-group-sort-selected-groups-by-real-name))
+
+ "A" (define-keymap :prefix 'gnus-group-list-map
+ "k" #'gnus-group-list-killed
+ "z" #'gnus-group-list-zombies
+ "s" #'gnus-group-list-groups
+ "u" #'gnus-group-list-all-groups
+ "A" #'gnus-group-list-active
+ "a" #'gnus-group-apropos
+ "d" #'gnus-group-description-apropos
+ "m" #'gnus-group-list-matching
+ "M" #'gnus-group-list-all-matching
+ "l" #'gnus-group-list-level
+ "c" #'gnus-group-list-cached
+ "?" #'gnus-group-list-dormant
+ "!" #'gnus-group-list-ticked
+
+ "/" (define-keymap :prefix 'gnus-group-list-limit-map
+ "k" #'gnus-group-list-limit
+ "z" #'gnus-group-list-limit
+ "s" #'gnus-group-list-limit
+ "u" #'gnus-group-list-limit
+ "A" #'gnus-group-list-limit
+ "m" #'gnus-group-list-limit
+ "M" #'gnus-group-list-limit
+ "l" #'gnus-group-list-limit
+ "c" #'gnus-group-list-limit
+ "?" #'gnus-group-list-limit
+ "!" #'gnus-group-list-limit)
+
+ "f" (define-keymap :prefix 'gnus-group-list-flush-map
+ "k" #'gnus-group-list-flush
+ "z" #'gnus-group-list-flush
+ "s" #'gnus-group-list-flush
+ "u" #'gnus-group-list-flush
+ "A" #'gnus-group-list-flush
+ "m" #'gnus-group-list-flush
+ "M" #'gnus-group-list-flush
+ "l" #'gnus-group-list-flush
+ "c" #'gnus-group-list-flush
+ "?" #'gnus-group-list-flush
+ "!" #'gnus-group-list-flush)
+
+ "p" (define-keymap :prefix 'gnus-group-list-plus-map
+ "k" #'gnus-group-list-plus
+ "z" #'gnus-group-list-plus
+ "s" #'gnus-group-list-plus
+ "u" #'gnus-group-list-plus
+ "A" #'gnus-group-list-plus
+ "m" #'gnus-group-list-plus
+ "M" #'gnus-group-list-plus
+ "l" #'gnus-group-list-plus
+ "c" #'gnus-group-list-plus
+ "?" #'gnus-group-list-plus
+ "!" #'gnus-group-list-plus))
+
+ "W" (define-keymap :prefix 'gnus-group-score-map
+ "f" #'gnus-score-flush-cache
+ "e" #'gnus-score-edit-all-score)
+
+ "H" (define-keymap :prefix 'gnus-group-help-map
+ "d" #'gnus-group-describe-group
+ "v" #'gnus-version)
+
+ "S" (define-keymap :prefix 'gnus-group-sub-map
+ "l" #'gnus-group-set-current-level
+ "t" #'gnus-group-toggle-subscription-at-point
+ "s" #'gnus-group-toggle-subscription
+ "k" #'gnus-group-kill-group
+ "y" #'gnus-group-yank-group
+ "w" #'gnus-group-kill-region
+ "C-k" #'gnus-group-kill-level
+ "z" #'gnus-group-kill-all-zombies))
(defun gnus-topic-mode-p ()
"Return non-nil in `gnus-topic-mode'."
@@ -982,66 +983,36 @@ simple manner."
(gnus-run-hooks 'gnus-group-menu-hook)))
-
(defvar gnus-group-tool-bar-map nil)
-(defun gnus-group-tool-bar-update (&optional symbol value)
- "Update group buffer toolbar.
-Setter function for custom variables."
- (when symbol
- (set-default symbol value))
- ;; (setq-default gnus-group-tool-bar-map nil)
- ;; (use-local-map gnus-group-mode-map)
- (when (gnus-alive-p)
- (with-current-buffer gnus-group-buffer
- (gnus-group-make-tool-bar t))))
-
-(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
- 'gnus-group-tool-bar-gnome
- 'gnus-group-tool-bar-retro)
- "Specifies the Gnus group tool bar.
-
-It can be either a list or a symbol referring to a list. See
-`gmm-tool-bar-from-list' for the format of the list. The
-default key map is `gnus-group-mode-map'.
-
-Pre-defined symbols include `gnus-group-tool-bar-gnome' and
-`gnus-group-tool-bar-retro'."
- :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
- (const :tag "Retro look" gnus-group-tool-bar-retro)
- (repeat :tag "User defined list" gmm-tool-bar-item)
- (symbol))
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
- :group 'gnus-group)
-
-(defcustom gnus-group-tool-bar-gnome
+(defcustom gnus-group-tool-bar
'((gnus-group-post-news "mail/compose")
;; Some useful agent icons? I don't use the agent so agent users should
;; suggest useful commands:
- (gnus-agent-toggle-plugged "unplugged" t
- :help "Gnus is currently unplugged. Click to work online."
- :visible (and gnus-agent (not gnus-plugged)))
- (gnus-agent-toggle-plugged "plugged" t
- :help "Gnus is currently plugged. Click to work offline."
- :visible (and gnus-agent gnus-plugged))
- ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
- ;; should have a better help text.
- (gnus-group-send-queue "mail/outbox" t
- :visible (and gnus-agent gnus-plugged)
- :help "Send articles from the queue group")
- (gnus-group-get-new-news "mail/inbox" nil
- :visible (or (not gnus-agent)
- gnus-plugged))
- ;; FIXME: gnus-*-read-group should have a better help text.
- (gnus-topic-read-group "open" nil
- :visible (and (boundp 'gnus-topic-mode)
- gnus-topic-mode))
- (gnus-group-read-group "open" nil
- :visible (not (and (boundp 'gnus-topic-mode)
- gnus-topic-mode)))
- ;; (gnus-group-find-new-groups "???" nil)
+ (gnus-agent-toggle-plugged
+ "unplugged" t
+ :help "Gnus is currently unplugged. Click to work online."
+ :visible (and gnus-agent (not gnus-plugged)))
+ (gnus-agent-toggle-plugged
+ "plugged" t
+ :help "Gnus is currently plugged. Click to work offline."
+ :visible (and gnus-agent gnus-plugged))
+ (gnus-group-send-queue
+ "mail/outbox" t
+ :visible (and gnus-agent gnus-plugged)
+ :help "Send articles from the queue group")
+ (gnus-group-get-new-news
+ "mail/inbox" nil
+ :visible (or (not gnus-agent)
+ gnus-plugged))
+ (gnus-topic-read-group
+ "open" nil
+ :visible (and (boundp 'gnus-topic-mode)
+ gnus-topic-mode))
+ (gnus-group-read-group
+ "open" nil
+ :visible (not (and (boundp 'gnus-topic-mode)
+ gnus-topic-mode)))
(gnus-group-save-newsrc "save")
(gnus-group-describe-group "describe")
(gnus-group-toggle-subscription-at-point "gnus/toggle-subscription")
@@ -1050,44 +1021,22 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
(gnus-group-exit "exit")
(gmm-customize-mode "preferences" t :help "Edit mode preferences")
(gnus-info-find-node "help"))
- "List of functions for the group tool bar (GNOME style).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
- :group 'gnus-group)
+ "Specifies the Gnus group tool bar.
-(defcustom gnus-group-tool-bar-retro
- '((gnus-group-get-new-news "gnus/get-news")
- (gnus-group-get-new-news-this-group "gnus/gnntg")
- (gnus-group-catchup-current "gnus/catchup")
- (gnus-group-describe-group "gnus/describe-group")
- (gnus-group-subscribe "gnus/subscribe" t
- :help "Subscribe to the current group")
- (gnus-group-unsubscribe "gnus/unsubscribe" t
- :help "Unsubscribe from the current group")
- (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
- "List of functions for the group tool bar (retro look).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
+It can be either a list or a symbol referring to a list. See
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `gnus-group-mode-map'."
+ :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "29.1"
:group 'gnus-group)
-(defcustom gnus-group-tool-bar-zap-list t
- "List of icon items from the global tool bar.
-These items are not displayed in the Gnus group mode tool bar.
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type 'gmm-tool-bar-zap-list
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
- :group 'gnus-group)
+(defvar gnus-group-tool-bar-gnome nil)
+(make-obsolete-variable 'gnus-group-tool-bar-gnome nil "29.1")
+(defvar gnus-group-tool-bar-retro nil)
+(make-obsolete-variable 'gnus-group-tool-bar-retro nil "29.1")
+(defvar gnus-group-tool-bar-zap-list t)
+(make-obsolete-variable 'gnus-group-tool-bar-zap-list nil "29.1")
(defvar image-load-path)
(defvar tool-bar-map)
@@ -1482,9 +1431,9 @@ if it is a string, only list groups matching REGEXP."
(active (gnus-active group)))
(if (not active)
0
- (length (gnus-uncompress-range
- (gnus-range-difference
- (gnus-range-difference (list active) (gnus-info-read info))
+ (length (range-uncompress
+ (range-difference
+ (range-difference (list active) (gnus-info-read info))
seen))))))
;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
@@ -1642,7 +1591,7 @@ Some value are bound so the form can use them."
'(mail post-mail))))
(cons 'level (or (gnus-info-level info) gnus-level-killed))
(cons 'score (or (gnus-info-score info) 0))
- (cons 'ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (cons 'ticked (range-length (cdr (assq 'tick marked))))
(cons 'group-age (gnus-group-timestamp-delta group)))))
(while (and list
(not (eval (caar list) env)))
@@ -2065,9 +2014,9 @@ that group."
(- (1+ (cdr active)) (car active)))))
(gnus-summary-read-group
group (or all (and (numberp number)
- (zerop (+ number (gnus-range-length
+ (zerop (+ number (range-length
(cdr (assq 'tick marked)))
- (gnus-range-length
+ (range-length
(cdr (assq 'dormant marked)))))))
no-article nil no-display nil select-articles)))
@@ -2832,7 +2781,7 @@ according to the expiry settings. Note that this will delete old
not-expirable articles, too."
(interactive (list (gnus-group-group-name) current-prefix-arg)
gnus-group-mode)
- (let ((articles (gnus-uncompress-range (gnus-active group))))
+ (let ((articles (range-uncompress (gnus-active group))))
(when (gnus-yes-or-no-p
(format "Do you really want to delete these %d articles forever? "
(length articles)))
@@ -3134,9 +3083,9 @@ If SOLID (the prefix), create a solid group."
(if (derived-mode-p 'gnus-summary-mode) 'summary 'group))))))
(defvar nnrss-group-alist)
-(eval-when-compile
- (defun nnrss-discover-feed (_arg))
- (defun nnrss-save-server-data (_arg)))
+(declare-function nnrss-discover-feed "nnrss" (url))
+(declare-function nnrss-save-server-data "nnrss" (server))
+
(defun gnus-group-make-rss-group (&optional url)
"Given a URL, discover if there is an RSS feed.
If there is, use Gnus to create an nnrss group"
@@ -3225,7 +3174,11 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
- (lambda (elt) (gnus-group-server elt))
+ (lambda (elt)
+ (if (gnus-group-native-p elt)
+ (gnus-group-server elt)
+ (gnus-method-to-server
+ (gnus-find-method-for-group elt))))
(or gnus-group-marked
(if (gnus-group-group-name)
(list (gnus-group-group-name))
@@ -3276,7 +3229,11 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
- (lambda (elt) (gnus-group-server elt))
+ (lambda (elt)
+ (if (gnus-group-native-p elt)
+ (gnus-group-server elt)
+ (gnus-method-to-server
+ (gnus-find-method-for-group elt))))
(or gnus-group-marked
(if (gnus-group-group-name)
(list (gnus-group-group-name))
@@ -3755,15 +3712,15 @@ or nil if no action could be taken."
'del '(tick))
(list (cdr (assq 'dormant marks))
'del '(dormant))))
- (setq unread (gnus-range-add (gnus-range-add
- unread (cdr (assq 'dormant marks)))
- (cdr (assq 'tick marks))))
+ (setq unread (range-concat (range-concat
+ unread (cdr (assq 'dormant marks)))
+ (cdr (assq 'tick marks))))
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
(when (and (gnus-group-auto-expirable-p group)
(not (gnus-group-read-only-p group)))
- (gnus-range-map
+ (range-map
(lambda (article)
(gnus-add-marked-articles group 'expire (list article))
(gnus-request-set-mark group (list (list (list article)
@@ -3795,7 +3752,7 @@ Uses the process/prefix convention."
(cons nil (gnus-list-of-read-articles group))
(assq 'expire (gnus-info-marks info))))
(articles-to-expire
- (gnus-list-range-difference
+ (range-list-difference
(gnus-uncompress-sequence (cdr expirable))
(cdr (assq 'unexist (gnus-info-marks info)))))
(expiry-wait (gnus-group-find-parameter group 'expiry-wait))
@@ -4671,23 +4628,22 @@ and the second element is the address."
(and (not (setq marked (nthcdr 3 info)))
(or (null articles)
(setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t)))))))
+ (list (list (cons type (range-compress-list
+ articles)))))))
(and (not (setq m (assq type (car marked))))
(or (null articles)
(setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
+ (cons (cons type (range-compress-list articles))
(car marked)))))
(if force
(if (null articles)
(setcar (nthcdr 3 info)
(assq-delete-all type (car marked)))
- (setcdr m (gnus-compress-sequence articles t)))
- (setcdr m (gnus-compress-sequence
- (sort (nconc (gnus-uncompress-range (cdr m))
+ (setcdr m (range-compress-list articles)))
+ (setcdr m (range-compress-list
+ (sort (nconc (range-uncompress (cdr m))
(copy-sequence articles))
- #'<)
- t))))))
+ #'<)))))))
(declare-function gnus-summary-add-mark "gnus-sum" (article type))
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index e259d9ae18b..87f3ee63623 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -40,14 +40,11 @@
(require 'help-fns)
(require 'url-queue)
-(defcustom gnus-html-image-cache-ttl (days-to-time 7)
- "Time used to determine if we should use images from the cache."
- :version "24.1"
+(defcustom gnus-html-image-cache-ttl (time-convert (days-to-time 7) 'integer)
+ "Number of seconds used to determine if we should use images from the cache."
+ :version "29.1"
:group 'gnus-art
- ;; FIXME hardly the friendliest type. The allowed value is actually
- ;; any time value, but we are assuming no-one cares about USEC and
- ;; PSEC here. It would be better to eg make it a number of minutes.
- :type '(list integer integer))
+ :type 'number)
(defcustom gnus-html-image-automatic-caching t
"Whether automatically cache retrieve images."
@@ -71,21 +68,17 @@ fit these criteria."
:group 'gnus-art
:type 'float)
-(defvar gnus-html-image-map
- (let ((map (make-sparse-keymap)))
- (define-key map "u" 'gnus-article-copy-string)
- (define-key map "i" 'gnus-html-insert-image)
- (define-key map "v" 'gnus-html-browse-url)
- map))
-
-(defvar gnus-html-displayed-image-map
- (let ((map (make-sparse-keymap)))
- (define-key map "a" 'gnus-html-show-alt-text)
- (define-key map "i" 'gnus-html-browse-image)
- (define-key map "\r" 'gnus-html-browse-url)
- (define-key map "u" 'gnus-article-copy-string)
- (define-key map [tab] 'button-forward)
- map))
+(defvar-keymap gnus-html-image-map
+ "u" #'gnus-article-copy-string
+ "i" #'gnus-html-insert-image
+ "v" #'gnus-html-browse-url)
+
+(defvar-keymap gnus-html-displayed-image-map
+ "a" #'gnus-html-show-alt-text
+ "i" #'gnus-html-browse-image
+ "RET" #'gnus-html-browse-url
+ "u" #'gnus-article-copy-string
+ "<tab>" #'forward-button)
(defun gnus-html-encode-url (url)
"Encode URL."
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index d35b0ebb1d9..1bffdf3513a 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -194,7 +194,11 @@
(caddr event))))
(cl-labels
- ((attendee-role (prop) (plist-get (cadr prop) 'ROLE))
+ ((attendee-role (prop)
+ ;; RFC5546: default ROLE is REQ-PARTICIPANT
+ (and prop
+ (or (plist-get (cadr prop) 'ROLE)
+ "REQ-PARTICIPANT")))
(attendee-name
(prop)
(or (plist-get (cadr prop) 'CN)
@@ -225,7 +229,10 @@
(gnus-icalendar-event--find-attendee
ical attendee-name-or-email)))
(attendee-names (gnus-icalendar-event--get-attendee-names ical))
- (role (plist-get (cadr attendee) 'ROLE))
+ ;; RFC5546: default ROLE is REQ-PARTICIPANT
+ (role (and attendee
+ (or (plist-get (cadr attendee) 'ROLE)
+ "REQ-PARTICIPANT")))
(participation-type (pcase role
("REQ-PARTICIPANT" 'required)
("OPT-PARTICIPANT" 'optional)
@@ -345,10 +352,16 @@ status will be retrieved from the first matching attendee record."
(mapc #'process-event-line (split-string ical-request "\n"))
+ ;; RFC5546 refers to uninvited attendees as "party crashers".
+ ;; This situation is common if the invitation is sent to a group
+ ;; of people via a mailing list.
(unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x))
reply-event-lines)
(lwarn 'gnus-icalendar :warning
- "Could not find an event attendee matching given identity"))
+ "Could not find an event attendee matching given identity")
+ (push (format "ATTENDEE;RSVP=TRUE;PARTSTAT=%s;CN=%s:MAILTO:%s"
+ attendee-status user-full-name user-mail-address)
+ reply-event-lines))
(mapconcat #'identity `("BEGIN:VEVENT"
,@(nreverse reply-event-lines)
@@ -817,11 +830,12 @@ These will be used to retrieve the RSVP information from ical events."
(defmacro gnus-icalendar-with-decoded-handle (handle &rest body)
"Execute BODY in buffer containing the decoded contents of HANDLE."
(let ((charset (make-symbol "charset")))
- `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle)))))
+ `(let ((,charset (downcase
+ (or (cdr (assoc 'charset (mm-handle-type ,handle)))
+ "utf-8"))))
(with-temp-buffer
(mm-insert-part ,handle)
- (when (and ,charset (string= (downcase ,charset) "utf-8"))
- (decode-coding-region (point-min) (point-max) 'utf-8))
+ (decode-coding-region (point-min) (point-max) (intern ,charset))
,@body))))
@@ -847,10 +861,14 @@ These will be used to retrieve the RSVP information from ical events."
button t
gnus-data ,data))))
-(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject)
+(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject organizer)
(let ((message-signature nil))
(with-current-buffer gnus-summary-buffer
(gnus-summary-reply)
+ ;; Reply to the organizer, not to whoever sent the invitation. person
+ ;; Some calendar systems use specific email address as organizer to
+ ;; receive these responses.
+ (message-replace-header "To" organizer)
(message-goto-body)
(mml-insert-multipart "alternative")
(mml-insert-empty-tag 'part 'type "text/plain")
@@ -866,7 +884,8 @@ These will be used to retrieve the RSVP information from ical events."
(event (caddr data))
(reply (gnus-icalendar-with-decoded-handle handle
(gnus-icalendar-event-reply-from-buffer
- (current-buffer) status (gnus-icalendar-identities)))))
+ (current-buffer) status (gnus-icalendar-identities))))
+ (organizer (gnus-icalendar-event:organizer event)))
(when reply
(cl-labels
@@ -883,7 +902,7 @@ These will be used to retrieve the RSVP information from ical events."
(delete-region (point-min) (point-max))
(insert reply)
(fold-icalendar-buffer)
- (gnus-icalendar-send-buffer-by-mail (buffer-name) subject))
+ (gnus-icalendar-send-buffer-by-mail (buffer-name) subject organizer))
;; Back in article buffer
(setq-local gnus-icalendar-reply-status status)
@@ -897,10 +916,16 @@ These will be used to retrieve the RSVP information from ical events."
(gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status))
(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle)
- (when (gnus-icalendar-event:rsvp event)
- `(("Accept" gnus-icalendar-reply (,handle accepted ,event))
- ("Tentative" gnus-icalendar-reply (,handle tentative ,event))
- ("Decline" gnus-icalendar-reply (,handle declined ,event)))))
+ (let ((accept-btn "Accept")
+ (tentative-btn "Tentative")
+ (decline-btn "Decline"))
+ (unless (gnus-icalendar-event:rsvp event)
+ (setq accept-btn "Uninvited Accept"
+ tentative-btn "Uninvited Tentative"
+ decline-btn "Uninvited Decline"))
+ `((,accept-btn gnus-icalendar-reply (,handle accepted ,event))
+ (,tentative-btn gnus-icalendar-reply (,handle tentative ,event))
+ (,decline-btn gnus-icalendar-reply (,handle declined ,event)))))
(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((_event gnus-icalendar-event-reply) _handle)
"No buttons for REPLY events."
@@ -1038,13 +1063,14 @@ These will be used to retrieve the RSVP information from ical events."
(add-to-list 'mm-automatic-display "text/calendar")
(add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity))
- (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map)
- "a" gnus-icalendar-reply-accept
- "t" gnus-icalendar-reply-tentative
- "d" gnus-icalendar-reply-decline
- "c" gnus-icalendar-event-check-agenda
- "e" gnus-icalendar-event-export
- "s" gnus-icalendar-event-show)
+ (define-key gnus-summary-mode-map "i"
+ (define-keymap :prefix 'gnus-summary-calendar-map
+ "a" #'gnus-icalendar-reply-accept
+ "t" #'gnus-icalendar-reply-tentative
+ "d" #'gnus-icalendar-reply-decline
+ "c" #'gnus-icalendar-event-check-agenda
+ "e" #'gnus-icalendar-event-export
+ "s" #'gnus-icalendar-event-show))
(require 'gnus-art)
(add-to-list 'gnus-mime-action-alist
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 5a619e8f07b..f00f2a0d04e 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -802,7 +802,7 @@ If GROUP is nil, all groups on COMMAND-METHOD are scanned."
(when (> min 1)
(let* ((range (if (= min 2) 1 (cons 1 (1- min))))
(read (gnus-info-read info))
- (new-read (gnus-range-add read (list range))))
+ (new-read (range-concat read (list range))))
(setf (gnus-info-read info) new-read)))
info))))))
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 57b4444d577..bc49f8385ea 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -66,18 +66,15 @@ of time."
;;; Gnus Kill File Mode
;;;
-(defvar gnus-kill-file-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map emacs-lisp-mode-map)
- (gnus-define-keymap map
- "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
- "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
- "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
- "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
- "\C-c\C-a" gnus-kill-file-apply-buffer
- "\C-c\C-e" gnus-kill-file-apply-last-sexp
- "\C-c\C-c" gnus-kill-file-exit)
- map))
+(defvar-keymap gnus-kill-file-mode-map
+ :parent emacs-lisp-mode-map
+ "C-c C-k C-s" #'gnus-kill-file-kill-by-subject
+ "C-c C-k C-a" #'gnus-kill-file-kill-by-author
+ "C-c C-k C-t" #'gnus-kill-file-kill-by-thread
+ "C-c C-k C-x" #'gnus-kill-file-kill-by-xref
+ "C-c C-a" #'gnus-kill-file-apply-buffer
+ "C-c C-e" #'gnus-kill-file-apply-last-sexp
+ "C-c C-c" #'gnus-kill-file-exit)
(define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill"
"Major mode for editing kill files.
@@ -352,7 +349,7 @@ Returns the number of articles marked as read."
(setq gnus-newsgroup-kill-headers
(mapcar #'mail-header-number headers))
(while headers
- (unless (gnus-member-of-range
+ (unless (range-member-p
(mail-header-number (car headers))
gnus-newsgroup-killed)
(push (mail-header-number (car headers))
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index 3fb2ed3c626..c1b559ba6f4 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -224,8 +224,8 @@
(goto-char (point-min))
(prog1
(funcall search-func match nil t)
- (widen)))
- (when handles (mm-destroy-parts handles))))))
+ (widen)
+ (when handles (mm-destroy-parts handles))))))))
(provide 'gnus-logic)
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index 077ea3b6b8c..211980aa9e3 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -31,16 +31,13 @@
;;; Mailing list minor mode
-(defvar gnus-mailing-list-mode-map
- (let ((map (make-sparse-keymap)))
- (gnus-define-keys map
- "\C-c\C-nh" gnus-mailing-list-help
- "\C-c\C-ns" gnus-mailing-list-subscribe
- "\C-c\C-nu" gnus-mailing-list-unsubscribe
- "\C-c\C-np" gnus-mailing-list-post
- "\C-c\C-no" gnus-mailing-list-owner
- "\C-c\C-na" gnus-mailing-list-archive)
- map))
+(defvar-keymap gnus-mailing-list-mode-map
+ "C-c C-n h" #'gnus-mailing-list-help
+ "C-c C-n s" #'gnus-mailing-list-subscribe
+ "C-c C-n u" #'gnus-mailing-list-unsubscribe
+ "C-c C-n p" #'gnus-mailing-list-post
+ "C-c C-n o" #'gnus-mailing-list-owner
+ "C-c C-n a" #'gnus-mailing-list-archive)
(defvar gnus-mailing-list-menu)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index f7eecece26b..3fc5ce2408a 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -52,24 +52,6 @@ method to use when posting."
(const current)
(sexp :tag "Methods" ,gnus-select-method)))
-(defcustom gnus-outgoing-message-group nil
- "All outgoing messages will be put in this group.
-If you want to store all your outgoing mail and articles in the group
-\"nnml:archive\", you set this variable to that value. This variable
-can also be a list of group names.
-
-If you want to have greater control over what group to put each
-message in, you can set this variable to a function that checks the
-current newsgroup name and then returns a suitable group name (or list
-of names)."
- :group 'gnus-message
- :type '(choice (const nil)
- (function)
- (string :tag "Group")
- (repeat :tag "List of groups" (string :tag "Group"))))
-
-(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1")
-
(defcustom gnus-mailing-list-groups nil
"If non-nil a regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
@@ -215,30 +197,6 @@ use this option with care."
:parameter-document "\
List of charsets that are permitted to be unencoded.")
-(defcustom gnus-debug-files
- '("gnus.el" "gnus-sum.el" "gnus-group.el"
- "gnus-art.el" "gnus-start.el" "gnus-async.el"
- "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
- "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
- "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
- "Files whose variables will be reported in `gnus-bug'."
- :version "22.1"
- :group 'gnus-message
- :type '(repeat file))
-
-(make-obsolete-variable 'gnus-debug-files "it is no longer used." "24.1")
-
-(defcustom gnus-debug-exclude-variables
- '(mm-mime-mule-charset-alist
- nnmail-split-fancy message-minibuffer-local-map)
- "Variables that should not be reported in `gnus-bug'."
- :version "22.1"
- :group 'gnus-message
- :type '(repeat variable))
-
-(make-obsolete-variable
- 'gnus-debug-exclude-variables "it is no longer used." "24.1")
-
(defcustom gnus-discouraged-post-methods
'(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
"A list of back ends that are not used in \"real\" newsgroups.
@@ -349,39 +307,39 @@ only affect the Gcc copy, but not the original message."
;;; Gnus Posting Functions
;;;
-(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
- "p" gnus-summary-post-news
- "i" gnus-summary-news-other-window
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "c" gnus-summary-cancel-article
- "s" gnus-summary-supersede-article
- "r" gnus-summary-reply
- "y" gnus-summary-yank-message
- "R" gnus-summary-reply-with-original
- "L" gnus-summary-reply-to-list-with-original
- "w" gnus-summary-wide-reply
- "W" gnus-summary-wide-reply-with-original
- "v" gnus-summary-very-wide-reply
- "V" gnus-summary-very-wide-reply-with-original
- "n" gnus-summary-followup-to-mail
- "N" gnus-summary-followup-to-mail-with-original
- "m" gnus-summary-mail-other-window
- "u" gnus-uu-post-news
- "A" gnus-summary-attach-article
- "\M-c" gnus-summary-mail-crosspost-complaint
- "Br" gnus-summary-reply-broken-reply-to
- "BR" gnus-summary-reply-broken-reply-to-with-original
- "om" gnus-summary-mail-forward
- "op" gnus-summary-post-forward
- "Om" gnus-uu-digest-mail-forward
- "Op" gnus-uu-digest-post-forward)
-
-(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
- "b" gnus-summary-resend-bounced-mail
- ;; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message
- "e" gnus-summary-resend-message-edit)
+(define-keymap :prefix 'gnus-summary-send-map
+ "p" #'gnus-summary-post-news
+ "i" #'gnus-summary-news-other-window
+ "f" #'gnus-summary-followup
+ "F" #'gnus-summary-followup-with-original
+ "c" #'gnus-summary-cancel-article
+ "s" #'gnus-summary-supersede-article
+ "r" #'gnus-summary-reply
+ "y" #'gnus-summary-yank-message
+ "R" #'gnus-summary-reply-with-original
+ "L" #'gnus-summary-reply-to-list-with-original
+ "w" #'gnus-summary-wide-reply
+ "W" #'gnus-summary-wide-reply-with-original
+ "v" #'gnus-summary-very-wide-reply
+ "V" #'gnus-summary-very-wide-reply-with-original
+ "n" #'gnus-summary-followup-to-mail
+ "N" #'gnus-summary-followup-to-mail-with-original
+ "m" #'gnus-summary-mail-other-window
+ "u" #'gnus-uu-post-news
+ "A" #'gnus-summary-attach-article
+ "M-c" #'gnus-summary-mail-crosspost-complaint
+ "B r" #'gnus-summary-reply-broken-reply-to
+ "B R" #'gnus-summary-reply-broken-reply-to-with-original
+ "o m" #'gnus-summary-mail-forward
+ "o p" #'gnus-summary-post-forward
+ "O m" #'gnus-uu-digest-mail-forward
+ "O p" #'gnus-uu-digest-post-forward
+
+ "D" (define-keymap :prefix 'gnus-send-bounce-map
+ "b" #'gnus-summary-resend-bounced-mail
+ ;; "c" gnus-summary-send-draft
+ "r" #'gnus-summary-resend-message
+ "e" #'gnus-summary-resend-message-edit))
;;; Internal functions.
@@ -1305,7 +1263,7 @@ For the \"inline\" alternatives, also see the variable
(gnus-inews-insert-gcc)
(let ((gcc (message-unquote-tokens
(message-tokenize-header (mail-fetch-field "gcc" nil t)
- " ,")))
+ ",")))
(self (with-current-buffer gnus-summary-buffer
gnus-gcc-self-resent-messages)))
(message-remove-header "gcc")
@@ -1571,8 +1529,9 @@ this is a reply."
(when gcc
(message-remove-header "gcc")
(widen)
- (setq groups (message-unquote-tokens
- (message-tokenize-header gcc " ,\n\t")))
+ (setq groups (mapcar #'string-trim
+ (message-unquote-tokens
+ (message-tokenize-header gcc))))
;; Copy the article over to some group(s).
(while (setq group (pop groups))
(setq method (gnus-inews-group-method group))
@@ -1593,9 +1552,10 @@ this is a reply."
(nnheader-set-temp-buffer " *acc*")
(setq message-options (with-current-buffer cur message-options))
(insert-buffer-substring cur)
+ (restore-buffer-modified-p nil)
(run-hooks 'gnus-gcc-pre-body-encode-hook)
;; Avoid re-doing things like GPG-encoding secret parts.
- (if (not encoded-cache)
+ (if (or (buffer-modified-p) (not encoded-cache))
(message-encode-message-body)
(erase-buffer)
(insert encoded-cache))
@@ -1663,7 +1623,7 @@ this is a reply."
(defun gnus-inews-insert-gcc (&optional group)
"Insert the Gcc to say where the article is to be archived."
(let* ((group (or group gnus-newsgroup-name))
- (var (or gnus-outgoing-message-group gnus-message-archive-group))
+ (var gnus-message-archive-group)
(gcc-self-val
(and group (not (gnus-virtual-group-p group))
(gnus-group-find-parameter group 'gcc-self t)))
@@ -1748,7 +1708,7 @@ this is a reply."
(concat "\"" str "\"")
str)))
(when groups
- (insert " ")))
+ (insert ",")))
(insert "\n")))))))
(defun gnus-mailing-list-followup-to ()
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index da3ff473725..2b9d7fac1db 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -26,10 +26,8 @@
;;; List and range functions
-(defsubst gnus-range-normalize (range)
- "Normalize RANGE.
-If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
- (if (listp (cdr-safe range)) range (list range)))
+(require 'range)
+(define-obsolete-function-alias 'gnus-range-normalize #'range-normalize "29.1")
(defun gnus-last-element (list)
"Return last element of LIST."
@@ -38,10 +36,10 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
(car list))
(make-obsolete 'gnus-last-element "use `car' of `last' instead." "27.1")
-(define-obsolete-function-alias 'gnus-copy-sequence 'copy-tree "27.1")
+(define-obsolete-function-alias 'gnus-copy-sequence #'copy-tree "27.1")
-;;; We could be using `seq-difference' here, but it's much slower
-;;; on these data sets. See bug#50877.
+;; We could be using `seq-difference' here, but it's much slower
+;; on these data sets. See bug#50877.
(defun gnus-set-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2."
(let ((hash2 (make-hash-table :test 'eq))
@@ -56,10 +54,10 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
"Return a range comprising all the RANGES, which are pre-sorted.
RANGES will be destructively altered."
(setq ranges (delete nil ranges))
- (let* ((result (gnus-range-normalize (pop ranges)))
+ (let* ((result (range-normalize (pop ranges)))
(last (last result)))
(dolist (range ranges)
- (setq range (gnus-range-normalize range))
+ (setq range (range-normalize range))
;; Normalize the single-number case, so that we don't need to
;; special-case that so much.
(when (numberp (car last))
@@ -82,47 +80,8 @@ RANGES will be destructively altered."
(car result)
result)))
-(defun gnus-range-difference (range1 range2)
- "Return the range of elements in RANGE1 that do not appear in RANGE2.
-Both ranges must be in ascending order."
- (setq range1 (gnus-range-normalize range1))
- (setq range2 (gnus-range-normalize range2))
- (let* ((new-range (cons nil (copy-sequence range1)))
- (r new-range)
- ) ;; (safe t)
- (while (cdr r)
- (let* ((r1 (cadr r))
- (r2 (car range2))
- (min1 (if (numberp r1) r1 (car r1)))
- (max1 (if (numberp r1) r1 (cdr r1)))
- (min2 (if (numberp r2) r2 (car r2)))
- (max2 (if (numberp r2) r2 (cdr r2))))
-
- (cond ((> min1 max1)
- ;; Invalid range: may result from overlap condition (below)
- ;; remove Invalid range
- (setcdr r (cddr r)))
- ((and (= min1 max1)
- (listp r1))
- ;; Inefficient representation: may result from overlap condition (below)
- (setcar (cdr r) min1))
- ((not min2)
- ;; All done with range2
- (setq r nil))
- ((< max1 min2)
- ;; No overlap: range1 precedes range2
- (pop r))
- ((< max2 min1)
- ;; No overlap: range2 precedes range1
- (pop range2))
- ((and (<= min2 min1) (<= max1 max2))
- ;; Complete overlap: range1 removed
- (setcdr r (cddr r)))
- (t
- (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r)))))))
- (cdr new-range)))
-
-
+(define-obsolete-function-alias 'gnus-range-difference
+ #'range-difference "29.1")
;;;###autoload
(defun gnus-sorted-difference (list1 list2)
@@ -200,60 +159,11 @@ LIST1 and LIST2 have to be sorted over <."
(setq list2 (cdr list2)))))
(nreverse out)))
-;;;###autoload
-(defun gnus-sorted-range-intersection (range1 range2)
- "Return intersection of RANGE1 and RANGE2.
-RANGE1 and RANGE2 have to be sorted over <."
- (let* (out
- (min1 (car range1))
- (max1 (if (numberp min1)
- (if (numberp (cdr range1))
- (prog1 (cdr range1)
- (setq range1 nil)) min1)
- (prog1 (cdr min1)
- (setq min1 (car min1)))))
- (min2 (car range2))
- (max2 (if (numberp min2)
- (if (numberp (cdr range2))
- (prog1 (cdr range2)
- (setq range2 nil)) min2)
- (prog1 (cdr min2)
- (setq min2 (car min2))))))
- (setq range1 (cdr range1)
- range2 (cdr range2))
- (while (and min1 min2)
- (cond ((< max1 min2) ; range1 precedes range2
- (setq range1 (cdr range1)
- min1 nil))
- ((< max2 min1) ; range2 precedes range1
- (setq range2 (cdr range2)
- min2 nil))
- (t ; some sort of overlap is occurring
- (let ((min (max min1 min2))
- (max (min max1 max2)))
- (setq out (if (= min max)
- (cons min out)
- (cons (cons min max) out))))
- (if (< max1 max2) ; range1 ends before range2
- (setq min1 nil) ; incr range1
- (setq min2 nil)))) ; incr range2
- (unless min1
- (setq min1 (car range1)
- max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1))))
- range1 (cdr range1)))
- (unless min2
- (setq min2 (car range2)
- max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
- range2 (cdr range2))))
- (cond ((cdr out)
- (nreverse out))
- ((numberp (car out))
- out)
- (t
- (car out)))))
+(define-obsolete-function-alias 'gnus-sorted-range-intersection
+ #'range-intersection "29.1")
;;;###autoload
-(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
+(defalias 'gnus-set-sorted-intersection #'gnus-sorted-nintersection)
;;;###autoload
(defun gnus-sorted-nintersection (list1 list2)
@@ -327,315 +237,33 @@ LIST1 and LIST2 have to be sorted over <."
"Convert sorted list of numbers to a list of ranges or a single range.
If ALWAYS-LIST is non-nil, this function will always release a list of
ranges."
- (let* ((first (car numbers))
- (last (car numbers))
- result)
- (if (null numbers)
- nil
- (if (not (listp (cdr numbers)))
- numbers
- (while numbers
- (cond ((= last (car numbers)) nil) ;Omit duplicated number
- ((= (1+ last) (car numbers)) ;Still in sequence
- (setq last (car numbers)))
- (t ;End of one sequence
- (setq result
- (cons (if (= first last) first
- (cons first last))
- result))
- (setq first (car numbers))
- (setq last (car numbers))))
- (setq numbers (cdr numbers)))
- (if (and (not always-list) (null result))
- (if (= first last) (list first) (cons first last))
- (nreverse (cons (if (= first last) first (cons first last))
- result)))))))
-
-(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
-(defun gnus-uncompress-range (ranges)
- "Expand a list of ranges into a list of numbers.
-RANGES is either a single range on the form `(num . num)' or a list of
-these ranges."
- (let (first last result)
- (cond
- ((null ranges)
- nil)
- ((not (listp (cdr ranges)))
- (setq first (car ranges))
- (setq last (cdr ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first)))
- (nreverse result))
- (t
- (while ranges
- (if (atom (car ranges))
- (when (numberp (car ranges))
- (setq result (cons (car ranges) result)))
- (setq first (caar ranges))
- (setq last (cdar ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first))))
- (setq ranges (cdr ranges)))
- (nreverse result)))))
-
-(defun gnus-add-to-range (ranges list)
- "Return a list of ranges that has all articles from both RANGES and LIST.
-Note: LIST has to be sorted over `<'."
- (if (not ranges)
- (gnus-compress-sequence list t)
- (setq list (copy-sequence list))
- (unless (listp (cdr ranges))
- (setq ranges (list ranges)))
- (let ((out ranges)
- ilist lowest highest temp)
- (while (and ranges list)
- (setq ilist list)
- (setq lowest (or (and (atom (car ranges)) (car ranges))
- (caar ranges)))
- (while (and list (cdr list) (< (cadr list) lowest))
- (setq list (cdr list)))
- (when (< (car ilist) lowest)
- (setq temp list)
- (setq list (cdr list))
- (setcdr temp nil)
- (setq out (nconc (gnus-compress-sequence ilist t) out)))
- (setq highest (or (and (atom (car ranges)) (car ranges))
- (cdar ranges)))
- (while (and list (<= (car list) highest))
- (setq list (cdr list)))
- (setq ranges (cdr ranges)))
- (when list
- (setq out (nconc (gnus-compress-sequence list t) out)))
- (setq out (sort out (lambda (r1 r2)
- (< (or (and (atom r1) r1) (car r1))
- (or (and (atom r2) r2) (car r2))))))
- (setq ranges out)
- (while ranges
- (if (atom (car ranges))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (car ranges)) (cadr ranges))
- (setcar ranges (cons (car ranges)
- (cadr ranges)))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (car ranges)) (caadr ranges))
- (setcar (cadr ranges) (car ranges))
- (setcar ranges (cadr ranges))
- (setcdr ranges (cddr ranges)))))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (cdar ranges)) (cadr ranges))
- (setcdr (car ranges) (cadr ranges))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (cdar ranges)) (caadr ranges))
- (setcdr (car ranges) (cdadr ranges))
- (setcdr ranges (cddr ranges))))))
- (setq ranges (cdr ranges)))
- out)))
-
-(defun gnus-remove-from-range (range1 range2)
- "Return a range that has all articles from RANGE2 removed from RANGE1.
-The returned range is always a list. RANGE2 can also be a unsorted
-list of articles. RANGE1 is modified by side effects, RANGE2 is not
-modified."
- (if (or (null range1) (null range2))
- range1
- (let (out r1 r2 r1_min r1_max r2_min r2_max
- (range2 (copy-tree range2)))
- (setq range1 (if (listp (cdr range1)) range1 (list range1))
- range2 (sort (if (listp (cdr range2)) range2 (list range2))
- (lambda (e1 e2)
- (< (if (consp e1) (car e1) e1)
- (if (consp e2) (car e2) e2))))
- r1 (car range1)
- r2 (car range2)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2))
- (while (and range1 range2)
- (cond ((< r2_max r1_min) ; r2 < r1
- (pop range2)
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1
- (pop range2)
- (setq r1_min (1+ r2_max)
- r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop range2)
- (if (< r2_max r1_max) ; finished with r1?
- (setq r1_min (1+ r2_max))
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((< r1_max r2_min) ; r2 > r1
- (pop range1)
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))))
- (when r1
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
- (pop range1))
- (while range1
- (push (pop range1) out))
- (nreverse out))))
-
-(defun gnus-member-of-range (number ranges)
- (if (not (listp (cdr ranges)))
- (and (>= number (car ranges))
- (<= number (cdr ranges)))
- (let ((not-stop t))
- (while (and ranges
- (if (numberp (car ranges))
- (>= number (car ranges))
- (>= number (caar ranges)))
- not-stop)
- (when (if (numberp (car ranges))
- (= number (car ranges))
- (and (>= number (caar ranges))
- (<= number (cdar ranges))))
- (setq not-stop nil))
- (setq ranges (cdr ranges)))
- (not not-stop))))
-
-(defun gnus-list-range-intersection (list ranges)
- "Return a list of numbers in LIST that are members of RANGES.
-LIST is a sorted list."
- (setq ranges (gnus-range-normalize ranges))
- (let (number result)
- (while (setq number (pop list))
- (while (and ranges
- (if (numberp (car ranges))
- (< (car ranges) number)
- (< (cdar ranges) number)))
- (setq ranges (cdr ranges)))
- (when (and ranges
- (if (numberp (car ranges))
- (= (car ranges) number)
- ;; (caar ranges) <= number <= (cdar ranges)
- (>= number (caar ranges))))
- (push number result)))
- (nreverse result)))
+ (if always-list
+ (range-compress-list numbers)
+ (range-denormalize (range-compress-list numbers))))
-(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference)
-
-(defun gnus-list-range-difference (list ranges)
- "Return a list of numbers in LIST that are not members of RANGES.
-LIST is a sorted list."
- (setq ranges (gnus-range-normalize ranges))
- (let (number result)
- (while (setq number (pop list))
- (while (and ranges
- (if (numberp (car ranges))
- (< (car ranges) number)
- (< (cdar ranges) number)))
- (setq ranges (cdr ranges)))
- (when (or (not ranges)
- (if (numberp (car ranges))
- (not (= (car ranges) number))
- ;; not ((caar ranges) <= number <= (cdar ranges))
- (< number (caar ranges))))
- (push number result)))
- (nreverse result)))
+(defalias 'gnus-uncompress-sequence #'gnus-uncompress-range)
+(define-obsolete-function-alias 'gnus-uncompress-range
+ #'range-uncompress "29.1")
+
+(define-obsolete-function-alias 'gnus-add-to-range
+ #'range-add-list "29.1")
+
+(define-obsolete-function-alias 'gnus-remove-from-range
+ #'range-remove "29.1")
+
+(define-obsolete-function-alias 'gnus-member-of-range #'range-member-p "29.1")
+
+(define-obsolete-function-alias 'gnus-list-range-intersection
+ #'range-list-intersection "29.1")
+
+(defalias 'gnus-inverse-list-range-intersection #'range-list-difference)
+
+(define-obsolete-function-alias 'gnus-list-range-difference
+ #'range-list-difference "29.1")
+
+(define-obsolete-function-alias 'gnus-range-length #'range-length "29.1")
-(defun gnus-range-length (range)
- "Return the length RANGE would have if uncompressed."
- (cond
- ((null range)
- 0)
- ((not (listp (cdr range)))
- (- (cdr range) (car range) -1))
- (t
- (let ((sum 0))
- (dolist (x range sum)
- (setq sum
- (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
-
-(defun gnus-range-add (range1 range2)
- "Add RANGE2 to RANGE1 (nondestructively)."
- (unless (listp (cdr range1))
- (setq range1 (list range1)))
- (unless (listp (cdr range2))
- (setq range2 (list range2)))
- (let ((item1 (pop range1))
- (item2 (pop range2))
- range item selector)
- (while (or item1 item2)
- (setq selector
- (cond
- ((null item1) nil)
- ((null item2) t)
- ((and (numberp item1) (numberp item2)) (< item1 item2))
- ((numberp item1) (< item1 (car item2)))
- ((numberp item2) (< (car item1) item2))
- (t (< (car item1) (car item2)))))
- (setq item
- (or
- (let ((tmp1 item) (tmp2 (if selector item1 item2)))
- (cond
- ((null tmp1) tmp2)
- ((null tmp2) tmp1)
- ((and (numberp tmp1) (numberp tmp2))
- (cond
- ((eq tmp1 tmp2) tmp1)
- ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
- ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
- (t nil)))
- ((numberp tmp1)
- (cond
- ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2)
- ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2)))
- ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1))
- (t nil)))
- ((numberp tmp2)
- (cond
- ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1)
- ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1)))
- ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2))
- (t nil)))
- ((< (1+ (cdr tmp1)) (car tmp2)) nil)
- ((< (1+ (cdr tmp2)) (car tmp1)) nil)
- (t (cons (min (car tmp1) (car tmp2))
- (max (cdr tmp1) (cdr tmp2))))))
- (progn
- (if item (push item range))
- (if selector item1 item2))))
- (if selector
- (setq item1 (pop range1))
- (setq item2 (pop range2))))
- (if item (push item range))
- (reverse range)))
+(define-obsolete-function-alias 'gnus-range-add #'range-concat "29.1")
;;;###autoload
(defun gnus-add-to-sorted-list (list num)
@@ -649,18 +277,7 @@ LIST is a sorted list."
(setcdr prev (cons num list)))
(cdr top)))
-(defun gnus-range-map (func range)
- "Apply FUNC to each value contained by RANGE."
- (setq range (gnus-range-normalize range))
- (while range
- (let ((span (pop range)))
- (if (numberp span)
- (funcall func span)
- (let ((first (car span))
- (last (cdr span)))
- (while (<= first last)
- (funcall func first)
- (setq first (1+ first))))))))
+(define-obsolete-function-alias 'gnus-range-map #'range-map "29.1")
(provide 'gnus-range)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index e41b74fbd92..ceeb1848542 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -163,7 +163,9 @@ nnmairix groups are specifically excluded because they are ephemeral."
:type 'boolean
:version "28.1")
-(defvar gnus-registry-enabled nil)
+(make-obsolete-variable
+ 'gnus-registry-enabled
+ "Check for non-nil value of `gnus-registry-db'" "29.1")
(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
@@ -355,8 +357,12 @@ This is not required after changing `gnus-registry-cache-file'."
"Load the registry from the cache file."
(interactive)
(let ((file gnus-registry-cache-file))
+ (gnus-message 5 "Initializing the registry")
(condition-case nil
- (gnus-registry-read file)
+ (progn
+ (gnus-registry-read file)
+ (gnus-registry-install-hooks)
+ (gnus-registry-install-shortcuts))
(file-error
;; Fix previous mis-naming of the registry file.
(let ((old-file-name
@@ -846,8 +852,9 @@ Overrides existing keywords with FORCE set non-nil."
(defun gnus-registry-register-message-ids ()
"Register the Message-ID of every article in the group."
- (unless (or (gnus-parameter-registry-ignore gnus-newsgroup-name)
- (null gnus-registry-register-all))
+ (unless (or (null gnus-registry-db)
+ (null gnus-registry-register-all)
+ (gnus-parameter-registry-ignore gnus-newsgroup-name))
(dolist (article gnus-newsgroup-articles)
(let* ((id (gnus-registry-fetch-message-id-fast article))
(groups (gnus-registry-get-id-key id 'group)))
@@ -948,13 +955,12 @@ FUNCTION should take two parameters, a mark symbol and the cell value."
(defun gnus-registry-install-shortcuts ()
"Install the keyboard shortcuts and menus for the registry.
Uses `gnus-registry-marks' to find what shortcuts to install."
- (let (keys-plist)
- (setq gnus-registry-misc-menus nil)
- (gnus-registry-do-marks
- :char
- (lambda (mark data)
- (let ((function-format
- (format "gnus-registry-%%s-article-%s-mark" mark)))
+ (setq gnus-registry-misc-menus nil)
+ (gnus-registry-do-marks
+ :char
+ (lambda (mark data)
+ (let ((function-format
+ (format "gnus-registry-%%s-article-%s-mark" mark)))
;;; The following generates these functions:
;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
@@ -966,48 +972,43 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
;;; (interactive (gnus-summary-work-articles current-prefix-arg))
;;; (gnus-registry-set-article-mark-internal 'Important articles t t))
- (dolist (remove '(t nil))
- (let* ((variant-name (if remove "remove" "set"))
- (function-name
- (intern (format function-format variant-name)))
- (shortcut (format "%c" (if remove (upcase data) data))))
- (defalias function-name
- (lambda (&rest articles)
- (:documentation
- (format
- "%s the %s mark over process-marked ARTICLES."
- (upcase-initials variant-name)
- mark))
- (interactive
- (gnus-summary-work-articles current-prefix-arg))
- (gnus-registry--set/remove-mark mark remove articles)))
- (push function-name keys-plist)
- (push shortcut keys-plist)
- (push (vector (format "%s %s"
- (upcase-initials variant-name)
- (symbol-name mark))
- function-name t)
- gnus-registry-misc-menus)
- (gnus-message 9 "Defined mark handling function %s"
- function-name))))))
- (gnus-define-keys-1
- '(gnus-registry-mark-map "M" gnus-summary-mark-map)
- keys-plist)
- (add-hook 'gnus-summary-menu-hook
- (lambda ()
- (easy-menu-add-item
- gnus-summary-misc-menu
- nil
- (cons "Registry Marks" gnus-registry-misc-menus))))))
-
-(define-obsolete-function-alias 'gnus-registry-user-format-function-M
- #'gnus-registry-article-marks-to-chars "24.1")
+ (dolist (remove '(t nil))
+ (let* ((variant-name (if remove "remove" "set"))
+ (function-name
+ (intern (format function-format variant-name)))
+ (shortcut (format "%c" (if remove (upcase data) data))))
+ (defalias function-name
+ (lambda (&rest articles)
+ (:documentation
+ (format
+ "%s the %s mark over process-marked ARTICLES."
+ (upcase-initials variant-name)
+ mark))
+ (interactive
+ (gnus-summary-work-articles current-prefix-arg))
+ (gnus-registry--set/remove-mark mark remove articles)))
+ (keymap-set gnus-summary-mark-map
+ (concat "M " shortcut)
+ function-name)
+ (push (vector (format "%s %s"
+ (upcase-initials variant-name)
+ (symbol-name mark))
+ function-name t)
+ gnus-registry-misc-menus)
+ (gnus-message 9 "Defined mark handling function %s"
+ function-name))))))
+ (add-hook 'gnus-summary-menu-hook
+ (lambda ()
+ (easy-menu-add-item
+ gnus-summary-misc-menu
+ nil
+ (cons "Registry Marks" gnus-registry-misc-menus)))))
;; use like this:
;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
(defun gnus-registry-article-marks-to-chars (headers)
"Show the marks for an article by the :char property."
- (if gnus-registry-enabled
+ (if gnus-registry-db
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(concat (delq nil
@@ -1023,7 +1024,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
(defun gnus-registry-article-marks-to-names (headers)
"Show the marks for an article by name."
- (if gnus-registry-enabled
+ (if gnus-registry-db
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(mapconcat #'symbol-name marks ","))
@@ -1142,7 +1143,7 @@ non-nil."
entry)
(while (car-safe old)
(cl-incf count)
- ;; don't use progress reporters for backwards compatibility
+ ;; todo: use progress reporters.
(when (and (< 0 expected)
(= 0 (mod count 100)))
(message "importing: %d of %d (%.2f%%)"
@@ -1182,16 +1183,12 @@ non-nil."
(defun gnus-registry-initialize ()
"Initialize the Gnus registry."
(interactive)
- (gnus-message 5 "Initializing the registry")
- (gnus-registry-install-hooks)
- (gnus-registry-install-shortcuts)
(if (gnus-alive-p)
(gnus-registry-load)
(add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)))
(defun gnus-registry-install-hooks ()
"Install the registry hooks."
- (setq gnus-registry-enabled t)
(add-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
(add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
(add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
@@ -1211,17 +1208,16 @@ non-nil."
(remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
(remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)
- (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)
- (setq gnus-registry-enabled nil))
+ (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids))
-(add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook)
+(add-hook 'gnus-registry-unload-hook #'gnus-registry-clear)
(defun gnus-registry-install-p ()
"Return non-nil if the registry is enabled (and maybe enable it first).
If the registry is not already enabled, then if `gnus-registry-install'
is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it."
(interactive)
- (unless gnus-registry-enabled
+ (unless gnus-registry-db
(when (if (eq gnus-registry-install 'ask)
(gnus-y-or-n-p
(concat "Enable the Gnus registry? "
@@ -1229,7 +1225,7 @@ is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it."
"to get rid of this query permanently. "))
gnus-registry-install)
(gnus-registry-initialize)))
- gnus-registry-enabled)
+ (null (null gnus-registry-db)))
;; largely based on nnselect-warp-to-article
(defun gnus-try-warping-via-registry ()
diff --git a/lisp/gnus/gnus-rmail.el b/lisp/gnus/gnus-rmail.el
new file mode 100644
index 00000000000..15ead1add41
--- /dev/null
+++ b/lisp/gnus/gnus-rmail.el
@@ -0,0 +1,142 @@
+;;; gnus-rmail.el --- Saving to rmail/babyl files -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+;;; Functions for saving to babyl/mail files.
+
+(require 'rmail)
+(require 'rmailsum)
+(require 'nnmail)
+
+(defun gnus-output-to-rmail (filename &optional ask)
+ "Append the current article to an Rmail file named FILENAME.
+In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless
+FILENAME exists and is Babyl format."
+ ;; Some of this codes is borrowed from rmailout.el.
+ (setq filename (expand-file-name filename))
+ ;; FIXME should we really be messing with this defcustom?
+ ;; It is not needed for the operation of this function.
+ (if (boundp 'rmail-default-rmail-file)
+ (setq rmail-default-rmail-file filename) ; 22
+ (setq rmail-default-file filename)) ; 23
+ (let ((artbuf (current-buffer))
+ (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))
+ ;; Babyl rmail.el defines this, mbox does not.
+ (babyl (fboundp 'rmail-insert-rmail-file-header)))
+ (save-excursion
+ ;; Note that we ignore the possibility of visiting a Babyl
+ ;; format buffer in Emacs 23, since Rmail no longer supports that.
+ (or (get-file-buffer filename)
+ (progn
+ ;; In case someone wants to write to a Babyl file from Emacs 23.
+ (when (file-exists-p filename)
+ (setq babyl (mail-file-babyl-p filename))
+ t))
+ (if (or (not ask)
+ (gnus-yes-or-no-p
+ (concat "\"" filename "\" does not exist, create it? ")))
+ (let ((file-buffer (create-file-buffer filename)))
+ (with-current-buffer file-buffer
+ (if (fboundp 'rmail-insert-rmail-file-header)
+ (rmail-insert-rmail-file-header))
+ (let ((require-final-newline nil)
+ (coding-system-for-write mm-text-coding-system))
+ (gnus-write-buffer filename)))
+ (kill-buffer file-buffer))
+ (error "Output file does not exist")))
+ (set-buffer tmpbuf)
+ (erase-buffer)
+ (insert-buffer-substring artbuf)
+ (if babyl
+ (gnus-convert-article-to-rmail)
+ ;; Non-Babyl case copied from gnus-output-to-mail.
+ (goto-char (point-min))
+ (if (looking-at "From ")
+ (forward-line 1)
+ (insert "From nobody " (current-time-string) "\n"))
+ (let (case-fold-search)
+ (while (re-search-forward "^From " nil t)
+ (beginning-of-line)
+ (insert ">"))))
+ ;; Decide whether to append to a file or to an Emacs buffer.
+ (let ((outbuf (get-file-buffer filename)))
+ (if (not outbuf)
+ (progn
+ (unless babyl ; from gnus-output-to-mail
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (forward-char -2)
+ (unless (looking-at "\n\n")
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n"))))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (mm-append-to-file (point-min) (point-max) filename)))
+ ;; File has been visited, in buffer OUTBUF.
+ (set-buffer outbuf)
+ (let ((buffer-read-only nil)
+ (msg (and (boundp 'rmail-current-message)
+ (symbol-value 'rmail-current-message))))
+ ;; If MSG is non-nil, buffer is in RMAIL mode.
+ ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23.
+ (when msg
+ (unless babyl
+ (rmail-swap-buffers-maybe)
+ (rmail-maybe-set-message-counters))
+ (widen)
+ (unless babyl
+ (goto-char (point-max))
+ ;; Ensure we have a blank line before the next message.
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n"))
+ (narrow-to-region (point-max) (point-max)))
+ (insert-buffer-substring tmpbuf)
+ (when msg
+ (when babyl
+ (goto-char (point-min))
+ (widen)
+ (search-backward "\n\^_")
+ (narrow-to-region (point) (point-max)))
+ (rmail-count-new-messages t)
+ (when (rmail-summary-exists)
+ (rmail-select-summary
+ (rmail-update-summary)))
+ (rmail-show-message msg))
+ (save-buffer)))))
+ (kill-buffer tmpbuf)))
+
+(defun gnus-convert-article-to-rmail ()
+ "Convert article in current buffer to Rmail message format."
+ (let ((buffer-read-only nil))
+ ;; Convert article directly into Babyl format.
+ (goto-char (point-min))
+ (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
+ (while (search-forward "\n\^_" nil t) ;single char
+ (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
+ (goto-char (point-max))
+ (insert "\^_")))
+
+;;; gnus-rmail.el ends here
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index b39ee32f118..4ef2ebf1dd7 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -64,15 +64,12 @@ It accepts the same format specs that `gnus-summary-line-format' does."
;;; Internal variables.
-(defvar gnus-pick-mode-map
- (let ((map (make-sparse-keymap)))
- (gnus-define-keys map
- " " gnus-pick-next-page
- "u" gnus-pick-unmark-article-or-thread
- "." gnus-pick-article-or-thread
- [down-mouse-2] gnus-pick-mouse-pick-region
- "\r" gnus-pick-start-reading)
- map))
+(defvar-keymap gnus-pick-mode-map
+ "SPC" #'gnus-pick-next-page
+ "u" #'gnus-pick-unmark-article-or-thread
+ "." #'gnus-pick-article-or-thread
+ "<down-mouse-2>" #'gnus-pick-mouse-pick-region
+ "RET" #'gnus-pick-start-reading)
(defun gnus-pick-make-menu-bar ()
(unless (boundp 'gnus-pick-menu)
@@ -136,9 +133,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(defun gnus-pick-start-reading (&optional catch-up)
"Start reading the picked articles.
If given a prefix, mark all unpicked articles as read."
- (interactive "P")
- (declare (completion (lambda (s b)
- (completion-minor-mode-active-p s b 'gnus-pick-mode))))
+ (interactive "P" gnus-pick-mode)
(if gnus-newsgroup-processable
(progn
(gnus-summary-limit-to-articles nil)
@@ -315,11 +310,8 @@ This must be bound to a button-down mouse event."
(defvar gnus-binary-mode-hook nil
"Hook run in summary binary mode buffers.")
-(defvar gnus-binary-mode-map
- (let ((map (make-sparse-keymap)))
- (gnus-define-keys map
- "g" gnus-binary-show-article)
- map))
+(defvar-keymap gnus-binary-mode-map
+ "g" #'gnus-binary-show-article)
(defun gnus-binary-make-menu-bar ()
(unless (boundp 'gnus-binary-menu)
@@ -424,21 +416,17 @@ Two predefined functions are available:
(defvar gnus-tree-displayed-thread nil)
(defvar gnus-tree-inhibit nil)
-(defvar gnus-tree-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
- (gnus-define-keys
- map
- "\r" gnus-tree-select-article
- [mouse-2] gnus-tree-pick-article
- "\C-?" gnus-tree-read-summary-keys
- "h" gnus-tree-show-summary
-
- "\C-c\C-i" gnus-info-find-node)
-
- (substitute-key-definition
- 'undefined 'gnus-tree-read-summary-keys map)
- map))
+(defvar-keymap gnus-tree-mode-map
+ :full t :suppress t
+ "RET" #'gnus-tree-select-article
+ "<mouse-2>" #'gnus-tree-pick-article
+ "DEL" #'gnus-tree-read-summary-keys
+ "h" #'gnus-tree-show-summary
+
+ "C-c C-i" #'gnus-info-find-node)
+
+(substitute-key-definition 'undefined #'gnus-tree-read-summary-keys
+ gnus-tree-mode-map)
(defun gnus-tree-make-menu-bar ()
(unless (boundp 'gnus-tree-menu)
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 3b78a405fdb..c852986ae61 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -502,19 +502,20 @@ of the last successful match.")
;;; Summary mode score maps.
-(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
- "s" gnus-summary-set-score
- "S" gnus-summary-current-score
- "c" gnus-score-change-score-file
- "C" gnus-score-customize
- "m" gnus-score-set-mark-below
- "x" gnus-score-set-expunge-below
- "R" gnus-summary-rescore
- "e" gnus-score-edit-current-scores
- "f" gnus-score-edit-file
- "F" gnus-score-flush-cache
- "t" gnus-score-find-trace
- "w" gnus-score-find-favorite-words)
+(define-key gnus-summary-mode-map "V"
+ (define-keymap :prefix 'gnus-summary-score-map
+ "s" #'gnus-summary-set-score
+ "S" #'gnus-summary-current-score
+ "c" #'gnus-score-change-score-file
+ "C" #'gnus-score-customize
+ "m" #'gnus-score-set-mark-below
+ "x" #'gnus-score-set-expunge-below
+ "R" #'gnus-summary-rescore
+ "e" #'gnus-score-edit-current-scores
+ "f" #'gnus-score-edit-file
+ "F" #'gnus-score-flush-cache
+ "t" #'gnus-score-find-trace
+ "w" #'gnus-score-find-favorite-words))
;; Summary score file commands
@@ -1748,7 +1749,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq type 'after
match-func 'string<
match (gnus-time-iso8601
- (time-subtract (current-time)
+ (time-subtract nil
(* 86400 (nth 0 kill))))))
((eq type 'before)
(setq match-func 'gnus-string>
@@ -1757,7 +1758,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq type 'before
match-func 'gnus-string>
match (gnus-time-iso8601
- (time-subtract (current-time)
+ (time-subtract nil
(* 86400 (nth 0 kill))))))
((eq type 'at)
(setq match-func 'string=
@@ -2561,16 +2562,17 @@ score in `gnus-newsgroup-scored' by SCORE."
(or (caddr s)
gnus-score-interactive-default-score))
trace))))
- (insert
- "\n\nQuick help:
+ (insert
+ (substitute-command-keys
+ "\n\nQuick help:
-Type `e' to edit score file corresponding to the score rule on current line,
-`f' to format (pretty print) the score file and edit it,
-`t' toggle to truncate long lines in this buffer,
-`q' to quit, `k' to kill score trace buffer.
+Type \\`e' to edit score file corresponding to the score rule on current line,
+\\`f' to format (pretty print) the score file and edit it,
+\\`t' toggle to truncate long lines in this buffer,
+\\`q' to quit, \\`k' to kill score trace buffer.
The first sexp on each line is the score rule, followed by the file name of
-the score file and its full name, including the directory.")
+the score file and its full name, including the directory."))
(goto-char (point-min))
(gnus-configure-windows 'score-trace)))
(set-buffer gnus-summary-buffer)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 424f11a6b96..369df81d9bd 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -105,9 +105,13 @@
(gnus-add-shutdown #'gnus-search-shutdown 'gnus)
-(define-error 'gnus-search-parse-error "Gnus search parsing error")
+(define-error 'gnus-search-error "Gnus search error")
-(define-error 'gnus-search-config-error "Gnus search configuration error")
+(define-error 'gnus-search-parse-error "Gnus search parsing error"
+ 'gnus-search-error)
+
+(define-error 'gnus-search-config-error "Gnus search configuration error"
+ 'gnus-search-error)
;;; User Customizable Variables:
@@ -163,10 +167,9 @@ Instead, use this:
This variable can also be set per-server."
:type '(repeat string))
-(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
+(defcustom gnus-search-swish++-remove-prefix (expand-file-name "Mail/" "~")
"The prefix to remove from each file name returned by swish++
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+in order to get a group name (albeit with / instead of .).
This variable can also be set per-server."
:type 'regexp)
@@ -200,10 +203,9 @@ This variable can also be set per-server."
:type '(repeat string)
:version "28.1")
-(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
+(defcustom gnus-search-swish-e-remove-prefix (expand-file-name "Mail/" "~")
"The prefix to remove from each file name returned by swish-e
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+in order to get a group name (albeit with / instead of .).
This variable can also be set per-server."
:type 'regexp
@@ -248,7 +250,7 @@ This variable can also be set per-server."
:type '(repeat string)
:version "28.1")
-(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
+(defcustom gnus-search-namazu-remove-prefix (expand-file-name "Mail/" "~")
"The prefix to remove from each file name returned by Namazu
in order to get a group name (albeit with / instead of .).
@@ -292,10 +294,9 @@ This variable can also be set per-server."
:type '(repeat string)
:version "28.1")
-(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
+(defcustom gnus-search-notmuch-remove-prefix (expand-file-name "Mail/" "~")
"The prefix to remove from each file name returned by notmuch
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+in order to get a group name (albeit with / instead of .).
This variable can also be set per-server."
:type 'regexp
@@ -335,10 +336,9 @@ This variable can also be set per-server."
:version "28.1"
:type '(repeat string))
-(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
+(defcustom gnus-search-mairix-remove-prefix (expand-file-name "Mail/" "~")
"The prefix to remove from each file name returned by mairix
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+in order to get a group name (albeit with / instead of .).
This variable can also be set per-server."
:version "28.1"
@@ -349,6 +349,41 @@ This variable can also be set per-server."
:version "28.1"
:type 'boolean)
+(defcustom gnus-search-mu-program "mu"
+ "Name of the mu search executable.
+This can also be set per-server."
+ :version "29.1"
+ :type 'string)
+
+(defcustom gnus-search-mu-switches nil
+ "A list of strings, to be given as additional arguments to mu.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-mu-switches \"-u -r\")
+Instead, use this:
+ (setq gnus-search-mu-switches \\='(\"-u\" \"-r\"))
+This can also be set per-server."
+ :version "29.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-mu-remove-prefix (expand-file-name "~/Mail/")
+ "A prefix to remove from the mu results to get a group name.
+Usually this will be set to the path to your mail directory. This
+can also be set per-server."
+ :version "29.1"
+ :type 'directory)
+
+(defcustom gnus-search-mu-config-directory (expand-file-name "~/.cache/mu")
+ "Configuration directory for mu.
+This can also be set per-server."
+ :version "29.1"
+ :type 'file)
+
+(defcustom gnus-search-mu-raw-queries-p nil
+ "If t, all mu engines will only accept raw search query strings.
+This can also be set per-server."
+ :version "29.1"
+ :type 'boolean)
+
;; Options for search language parsing.
(defcustom gnus-search-expandable-keys
@@ -568,15 +603,13 @@ REL-DATE, or (current-time) if REL-DATE is nil."
;; Time parsing doesn't seem to work with slashes.
(let ((value (string-replace "/" "-" value))
(now (append '(0 0 0)
- (seq-subseq (decode-time (or rel-date
- (current-time)))
- 3))))
+ (seq-subseq (decode-time rel-date) 3))))
;; Check for relative time parsing.
(if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value)
(seq-subseq
(decode-time
(time-subtract
- (apply #'encode-time now)
+ (encode-time now)
(days-to-time
(* (string-to-number (match-string 1 value))
(cdr (assoc (match-string 2 value)
@@ -595,7 +628,7 @@ REL-DATE, or (current-time) if REL-DATE is nil."
;; If DOW is given, handle that specially.
(if (and (seq-elt d-time 6) (null (seq-elt d-time 3)))
(decode-time
- (time-subtract (apply #'encode-time now)
+ (time-subtract (encode-time now)
(days-to-time
(+ (if (> (seq-elt d-time 6)
(seq-elt now 6))
@@ -760,6 +793,9 @@ the files in ARTLIST by that search key.")
(generate-new-buffer " *gnus-search-")))
(cl-call-next-method engine slots))
+(defclass gnus-search-nnselect (gnus-search-engine)
+ nil)
+
(defclass gnus-search-imap (gnus-search-engine)
((literal-plus
:initarg :literal-plus
@@ -821,7 +857,7 @@ quirks.")
:documentation "Location of the config file, if any.")
(remove-prefix
:initarg :remove-prefix
- :initform (concat (getenv "HOME") "/Mail/")
+ :initform (expand-file-name "Mail/" "~")
:type string
:documentation
"The path to the directory where the indexed mails are
@@ -902,16 +938,30 @@ quirks.")
(raw-queries-p
:initform (symbol-value 'gnus-search-notmuch-raw-queries-p))))
+(defclass gnus-search-mu (gnus-search-indexed)
+ ((program
+ :initform (symbol-value 'gnus-search-mu-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-mu-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-mu-switches))
+ (config-directory
+ :initform (symbol-value 'gnus-search-mu-config-directory))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-mu-raw-queries-p))))
+
(define-obsolete-variable-alias 'nnir-method-default-engines
'gnus-search-default-engines "28.1")
-(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap))
+(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap)
+ (nnselect . gnus-search-nnselect))
"Alist of default search engines keyed by server method."
:version "26.1"
:type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool)
(const nneething) (const nndir) (const nnmbox)
(const nnml) (const nnmh) (const nndraft)
- (const nnfolder) (const nnmaildir))
+ (const nnfolder) (const nnmaildir)
+ (const nnselect))
(choice
,@(mapcar
(lambda (el) (list 'const (intern (car el))))
@@ -1008,6 +1058,33 @@ Responsible for handling and, or, and parenthetical expressions.")
unseen all old new or not)
"Known IMAP search keys.")
+(autoload 'nnselect-categorize "nnselect")
+(autoload 'nnselect-get-artlist "nnselect" nil nil 'macro)
+(autoload 'ids-by-group "nnselect")
+;; nnselect interface
+(cl-defmethod gnus-search-run-search ((_engine gnus-search-nnselect)
+ _srv query-spec groups)
+ (let ((artlist []))
+ (dolist (group groups)
+ (let* ((gnus-newsgroup-selection (nnselect-get-artlist group))
+ (group-spec
+ (nnselect-categorize
+ (mapcar 'car
+ (ids-by-group
+ (number-sequence 1
+ (length gnus-newsgroup-selection))))
+ (lambda (x)
+ (gnus-group-server x)))))
+ (setq artlist
+ (vconcat artlist
+ (seq-intersection
+ gnus-newsgroup-selection
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))))))
+ artlist))
+
+
;; imap interface
(cl-defmethod gnus-search-run-search ((engine gnus-search-imap)
srv query groups)
@@ -1018,7 +1095,7 @@ Responsible for handling and, or, and parenthetical expressions.")
(single-search (gnus-search-single-p query))
(grouplist (or groups (gnus-search-get-active srv)))
q-string artlist group)
- (message "Opening server %s" server)
+ (gnus-message 7 "Opening server %s" server)
(gnus-open-server srv)
;; We should only be doing this once, in
;; `nnimap-open-connection', but it's too frustrating to try to
@@ -1058,11 +1135,11 @@ Responsible for handling and, or, and parenthetical expressions.")
q-string)))
(while (and (setq group (pop grouplist))
- (or (null single-search) (null artlist)))
+ (or (null single-search) (= 0 (length artlist))))
(when (nnimap-change-group
(gnus-group-short-name group) server)
(with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
+ (gnus-message 7 "Searching %s..." group)
(let ((result
(gnus-search-imap-search-command engine q-string)))
(when (car result)
@@ -1075,7 +1152,7 @@ Responsible for handling and, or, and parenthetical expressions.")
(vector group artn 100))))
(cdr (assoc "SEARCH" (cdr result))))
artlist))))
- (message "Searching %s...done" group))))
+ (gnus-message 7 "Searching %s...done" group))))
(nreverse artlist))))
(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
@@ -1084,7 +1161,8 @@ Responsible for handling and, or, and parenthetical expressions.")
Currently takes into account support for the LITERAL+ capability.
Other capabilities could be tested here."
(with-slots (literal-plus) engine
- (when literal-plus
+ (when (and literal-plus
+ (string-match-p "\n" query))
(setq query (split-string query "\n")))
(cond
((consp query)
@@ -1234,8 +1312,7 @@ nil (except that (dd nil yyyy) is not allowed). Massage those
numbers into the most recent past occurrence of whichever date
elements are present."
(pcase-let ((`(,nday ,nmonth ,nyear)
- (seq-subseq (decode-time (current-time))
- 3 6))
+ (seq-subseq (decode-time) 3 6))
(`(,dday ,dmonth ,dyear) date))
(unless (and dday dmonth dyear)
(unless dday (setq dday 1))
@@ -1255,14 +1332,16 @@ elements are present."
(setq dmonth 1))))
(format-time-string
"%e-%b-%Y"
- (apply #'encode-time
- (append '(0 0 0)
- (list dday dmonth dyear))))))
+ (encode-time 0 0 0 dday dmonth dyear))))
(cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap)
(str string))
(with-slots (literal-plus) engine
- (if (multibyte-string-p str)
+ ;; TODO: Figure out how Exchange IMAP servers actually work. They
+ ;; do not accept any CHARSET but US-ASCII, but they do report
+ ;; Literal+ capability. So what do we do? Will quoted strings
+ ;; always work?
+ (if (string-match-p "[^[:ascii:]]" str)
;; If LITERAL+ is available, use it and encode string as
;; UTF-8.
(if literal-plus
@@ -1318,19 +1397,17 @@ This method is common to all indexed search engines.
Returns a list of [group article score] vectors."
- (save-excursion
- (let* ((qstring (gnus-search-make-query-string engine query))
- (program (slot-value engine 'program))
- (buffer (slot-value engine 'proc-buffer))
- (cp-list (gnus-search-indexed-search-command
- engine qstring query groups))
- proc exitstatus)
- (set-buffer buffer)
+ (let* ((qstring (gnus-search-make-query-string engine query))
+ (program (slot-value engine 'program))
+ (buffer (slot-value engine 'proc-buffer))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ proc exitstatus)
+ (with-current-buffer buffer
(erase-buffer)
-
(if groups
- (message "Doing %s query on %s..." program groups)
- (message "Doing %s query..." program))
+ (gnus-message 7 "Doing %s query on %s..." program groups)
+ (gnus-message 7 "Doing %s query..." program))
(setq proc (apply #'start-process (format "search-%s" server)
buffer program cp-list))
(while (process-live-p proc)
@@ -1346,7 +1423,7 @@ Returns a list of [group article score] vectors."
;; wants it.
(when (> gnus-verbose 6)
(display-buffer buffer))
- nil))))
+ nil))))
(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
server query &optional groups)
@@ -1367,18 +1444,27 @@ Returns a list of [group article score] vectors."
(when (and f-name
(file-readable-p f-name)
(null (file-directory-p f-name)))
- (setq group
- (replace-regexp-in-string
- "[/\\]" "."
- (replace-regexp-in-string
- "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ ;; `expand-file-name' canoncalizes the file name,
+ ;; specifically collapsing multiple consecutive directory
+ ;; separators.
+ (setq f-name (expand-file-name f-name)
+ group
+ (delete
+ "" ; forward slash at root leaves an empty string
+ (file-name-split
(replace-regexp-in-string
- "\\`\\." ""
- (string-remove-prefix
+ "\\`\\." "" ; why do we do this?
+ (string-remove-prefix
prefix (file-name-directory f-name))
- nil t)
- nil t)
- nil t))
+ nil t)))
+ ;; Turn file name segments into a Gnus group name.
+ group (mapconcat
+ #'identity
+ (if (member (car (last group))
+ '("new" "tmp" "cur"))
+ (nbutlast group)
+ group)
+ "."))
(setq article (file-name-nondirectory f-name)
article
;; TODO: Provide a cleaner way of producing final
@@ -1600,19 +1686,26 @@ Namazu provides a little more information, for instance a score."
(cp-list (gnus-search-indexed-search-command
engine qstring query groups))
thread-ids proc)
- (set-buffer proc-buffer)
- (erase-buffer)
- (setq proc (apply #'start-process (format "search-%s" server)
- proc-buffer program cp-list))
- (while (process-live-p proc)
- (accept-process-output proc))
- (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t)
- (push (match-string 1) thread-ids))
+ (with-current-buffer proc-buffer
+ (erase-buffer)
+ (setq proc (apply #'start-process (format "search-%s" server)
+ proc-buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^thread:\\([^[:space:]\n]+\\)"
+ (point-max) t)
+ (cl-pushnew (match-string 1) thread-ids :test #'equal)))
(cl-call-next-method
engine server
- ;; Completely replace the query with our new thread-based one.
- (mapconcat (lambda (thrd) (concat "thread:" thrd))
- thread-ids " or ")
+ ;; If we found threads, completely replace the query with
+ ;; our new thread-based one.
+ (if thread-ids
+ `((query . ,(mapconcat (lambda (thrd)
+ (concat "thread:" thrd))
+ thread-ids " or ")))
+ query)
nil)))
(cl-call-next-method engine server query groups)))
@@ -1625,16 +1718,16 @@ Namazu provides a little more information, for instance a score."
(let ((limit (alist-get 'limit query))
(thread (alist-get 'thread query)))
(with-slots (switches config-file) engine
- `(,(format "--config=%s" config-file)
- "search"
- ,(if thread
- "--output=threads"
- "--output=files")
- "--duplicate=1" ; I have found this necessary, I don't know why.
- ,@switches
- ,(if limit (format "--limit=%d" limit) "")
- ,qstring
- ))))
+ (append
+ (list (format "--config=%s" config-file)
+ "search"
+ (if thread
+ "--output=threads"
+ "--output=files"))
+ (unless thread '("--duplicate=1"))
+ (when limit (list (format "--limit=%d" limit)))
+ switches
+ (list qstring)))))
;;; Mairix interface
@@ -1807,6 +1900,101 @@ Assume \"size\" key is equal to \"larger\"."
(when (alist-get 'thread query) (list "-t"))
(list qstring))))
+;;; Mu interface
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mu)
+ (expr list))
+ (cl-case (car expr)
+ (recipient (setf (car expr) 'recip))
+ (address (setf (car expr) 'contact))
+ (id (setf (car expr) 'msgid))
+ (attachment (setf (car expr) 'file)))
+ (cl-flet ()
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ;; Explicitly leave out 'date as gnus-search will encode it
+ ;; first; it is handled later
+ ((memq (car expr) '(cc c bcc h from f to t subject s body b
+ maildir m msgid i prio p flag g d
+ size z embed e file j mime y tag x
+ list v))
+ (format "%s:%s" (car expr)
+ (if (string-match "\\`\\*" (cdr expr))
+ (replace-match "" nil nil (cdr expr))
+ (cdr expr))))
+ ((eq (car expr) 'mark)
+ (format "flag:%s" (gnus-search-mu-handle-flag (cdr expr))))
+ ((eq (car expr) 'date)
+ (format "date:%s" (gnus-search-mu-handle-date (cdr expr))))
+ ((eq (car expr) 'before)
+ (format "date:..%s" (gnus-search-mu-handle-date (cdr expr))))
+ ((eq (car expr) 'since)
+ (format "date:%s.." (gnus-search-mu-handle-date (cdr expr))))
+ (t (ignore-errors (cl-call-next-method))))))
+
+(defun gnus-search-mu-handle-date (date)
+ (if (stringp date)
+ date
+ (pcase date
+ (`(nil ,m nil)
+ (nth (1- m) gnus-english-month-names))
+ (`(nil nil ,y)
+ (number-to-string y))
+ ;; mu prefers ISO date YYYY-MM-DD HH:MM:SS
+ (`(,d ,m nil)
+ (let* ((ct (decode-time))
+ (cm (decoded-time-month ct))
+ (cy (decoded-time-year ct))
+ (y (if (> cm m)
+ cy
+ (1- cy))))
+ (format "%d-%02d-%02d" y m d)))
+ (`(nil ,m ,y)
+ (format "%d-%02d" y m))
+ (`(,d ,m ,y)
+ (format "%d-%02d-%02d" y m d)))))
+
+(defun gnus-search-mu-handle-flag (flag)
+ ;; Only change what doesn't match
+ (cond ((string= flag "flag")
+ "flagged")
+ ((string= flag "read")
+ "seen")
+ (t
+ flag)))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-mu))
+ (prog1
+ (let ((bol (line-beginning-position))
+ (eol (line-end-position)))
+ (list (buffer-substring-no-properties bol eol)
+ 100))
+ (move-beginning-of-line 2)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mu)
+ (qstring string)
+ query &optional groups)
+ (let ((limit (alist-get 'limit query))
+ (thread (alist-get 'thread query)))
+ (with-slots (switches config-directory) engine
+ `("find" ; command must come first
+ "--nocolor" ; mu will always give coloured output otherwise
+ ,(format "--muhome=%s" config-directory)
+ ,@switches
+ ,(if thread "-r" "")
+ ,(if limit (format "--maxnum=%d" limit) "")
+ ,qstring
+ ,@(if groups
+ `("and" "("
+ ,@(nbutlast (mapcan (lambda (x)
+ (list (concat "maildir:/" x) "or"))
+ groups))
+ ")")
+ "")
+ "--format=plain"
+ "--fields=l"))))
+
;;; Find-grep interface
(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep)
@@ -1836,8 +2024,8 @@ Assume \"size\" key is equal to \"larger\"."
(mapcar (lambda (x)
(let ((group x)
artlist)
- (message "Searching %s using find-grep..."
- (or group server))
+ (gnus-message 7 "Searching %s using find-grep..."
+ (or group server))
(save-window-excursion
(set-buffer buffer)
(if (> gnus-verbose 6)
@@ -1892,8 +2080,8 @@ Assume \"size\" key is equal to \"larger\"."
(vector (gnus-group-full-name group server) art 0)
artlist))
(forward-line 1)))
- (message "Searching %s using find-grep...done"
- (or group server))
+ (gnus-message 7 "Searching %s using find-grep...done"
+ (or group server))
artlist)))
grouplist))))
@@ -1926,7 +2114,7 @@ Assume \"size\" key is equal to \"larger\"."
(apply #'nnheader-message 4
"Search engine for %s improperly configured: %s"
server (cdr err))
- (signal 'gnus-search-config-error err)))))
+ (signal (car err) (cdr err))))))
(alist-get 'search-group-spec specs))
;; Some search engines do their own limiting, but some don't, so
;; do it again here. This is bad because, if the user is
@@ -1941,9 +2129,9 @@ Assume \"size\" key is equal to \"larger\"."
(defun gnus-search-prepare-query (query-spec)
"Accept a search query in raw format, and prepare it.
QUERY-SPEC is an alist produced by functions such as
-`gnus-group-make-search-group', and contains at least a 'query
+`gnus-group-make-search-group', and contains at least a `query'
key, and possibly some meta keys. This function extracts any
-additional meta keys from the 'query string, and parses the
+additional meta keys from the `query' string, and parses the
remaining string, then adds all that to the top-level spec."
(let ((query (alist-get 'query query-spec))
val)
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 9c17b7e8133..a520bfcd8b1 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -103,7 +103,43 @@ If nil, a faster, but more primitive, buffer is used instead."
(defvar gnus-server-mode-line-format-spec nil)
(defvar gnus-server-killed-servers nil)
-(defvar gnus-server-mode-map nil)
+(defvar-keymap gnus-server-mode-map
+ :full t :suppress t
+ "SPC" #'gnus-server-read-server-in-server-buffer
+ "RET" #'gnus-server-read-server
+ "<mouse-2>" #'gnus-server-pick-server
+ "q" #'gnus-server-exit
+ "l" #'gnus-server-list-servers
+ "k" #'gnus-server-kill-server
+ "y" #'gnus-server-yank-server
+ "c" #'gnus-server-copy-server
+ "a" #'gnus-server-add-server
+ "e" #'gnus-server-edit-server
+ "S" #'gnus-server-show-server
+ "s" #'gnus-server-scan-server
+
+ "O" #'gnus-server-open-server
+ "M-o" #'gnus-server-open-all-servers
+ "C" #'gnus-server-close-server
+ "M-c" #'gnus-server-close-all-servers
+ "D" #'gnus-server-deny-server
+ "L" #'gnus-server-offline-server
+ "R" #'gnus-server-remove-denials
+
+ "n" #'next-line
+ "p" #'previous-line
+
+ "g" #'gnus-server-regenerate-server
+
+ "G" #'gnus-group-read-ephemeral-search-group
+
+ "z" #'gnus-server-compact-server
+
+ "i" #'gnus-server-toggle-cloud-server
+ "I" #'gnus-server-set-cloud-method-server
+
+ "C-c C-i" #'gnus-info-find-node
+ "C-c C-b" #'gnus-bug)
(defcustom gnus-server-menu-hook nil
"Hook run after the creation of the server mode menu."
@@ -145,47 +181,6 @@ If nil, a faster, but more primitive, buffer is used instead."
(gnus-run-hooks 'gnus-server-menu-hook)))
-(unless gnus-server-mode-map
- (setq gnus-server-mode-map (make-keymap))
- (suppress-keymap gnus-server-mode-map)
-
- (gnus-define-keys gnus-server-mode-map
- " " gnus-server-read-server-in-server-buffer
- "\r" gnus-server-read-server
- [mouse-2] gnus-server-pick-server
- "q" gnus-server-exit
- "l" gnus-server-list-servers
- "k" gnus-server-kill-server
- "y" gnus-server-yank-server
- "c" gnus-server-copy-server
- "a" gnus-server-add-server
- "e" gnus-server-edit-server
- "S" gnus-server-show-server
- "s" gnus-server-scan-server
-
- "O" gnus-server-open-server
- "\M-o" gnus-server-open-all-servers
- "C" gnus-server-close-server
- "\M-c" gnus-server-close-all-servers
- "D" gnus-server-deny-server
- "L" gnus-server-offline-server
- "R" gnus-server-remove-denials
-
- "n" next-line
- "p" previous-line
-
- "g" gnus-server-regenerate-server
-
- "G" gnus-group-read-ephemeral-search-group
-
- "z" gnus-server-compact-server
-
- "i" gnus-server-toggle-cloud-server
- "I" gnus-server-set-cloud-method-server
-
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug))
-
(defface gnus-server-agent
'((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
(((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
@@ -697,37 +692,31 @@ claim them."
function
(repeat function)))
-(defvar gnus-browse-mode-map nil)
-
-(unless gnus-browse-mode-map
- (setq gnus-browse-mode-map (make-keymap))
- (suppress-keymap gnus-browse-mode-map)
-
- (gnus-define-keys
- gnus-browse-mode-map
- " " gnus-browse-read-group
- "=" gnus-browse-select-group
- "n" gnus-browse-next-group
- "p" gnus-browse-prev-group
- "\177" gnus-browse-prev-group
- [delete] gnus-browse-prev-group
- "N" gnus-browse-next-group
- "P" gnus-browse-prev-group
- "\M-n" gnus-browse-next-group
- "\M-p" gnus-browse-prev-group
- "\r" gnus-browse-select-group
- "u" gnus-browse-toggle-subscription-at-point
- "l" gnus-browse-exit
- "L" gnus-browse-exit
- "q" gnus-browse-exit
- "Q" gnus-browse-exit
- "d" gnus-browse-describe-group
- [delete] gnus-browse-delete-group
- "\C-c\C-c" gnus-browse-exit
- "?" gnus-browse-describe-briefly
-
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug))
+(defvar-keymap gnus-browse-mode-map
+ :full t :suppress t
+ "SPC" #'gnus-browse-read-group
+ "=" #'gnus-browse-select-group
+ "n" #'gnus-browse-next-group
+ "p" #'gnus-browse-prev-group
+ "DEL" #'gnus-browse-prev-group
+ "<delete>" #'gnus-browse-prev-group
+ "N" #'gnus-browse-next-group
+ "P" #'gnus-browse-prev-group
+ "M-n" #'gnus-browse-next-group
+ "M-p" #'gnus-browse-prev-group
+ "RET" #'gnus-browse-select-group
+ "u" #'gnus-browse-toggle-subscription-at-point
+ "l" #'gnus-browse-exit
+ "L" #'gnus-browse-exit
+ "q" #'gnus-browse-exit
+ "Q" #'gnus-browse-exit
+ "d" #'gnus-browse-describe-group
+ "<delete>" #'gnus-browse-delete-group
+ "C-c C-c" #'gnus-browse-exit
+ "?" #'gnus-browse-describe-briefly
+
+ "C-c C-i" #'gnus-info-find-node
+ "C-c C-b" #'gnus-bug)
(defun gnus-browse-make-menu-bar ()
(gnus-turn-off-edit-menu 'browse)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 301120e4ee5..7b5721fafbb 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -329,10 +329,10 @@ with the subscription method in this variable."
"If non-nil, Gnus will offer to subscribe hierarchically.
When a new hierarchy appears, Gnus will ask the user:
-'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
+Descend hierarchy alt.binaries? ([y]nsq):
-If the user pressed `d', Gnus will descend the hierarchy, `y' will
-subscribe to all newsgroups in the hierarchy and `s' will skip this
+If the user pressed `y', Gnus will descend the hierarchy, `s' will
+subscribe to all newsgroups in the hierarchy and `n' will skip this
hierarchy in its entirety."
:group 'gnus-group-new
:type 'boolean)
@@ -663,6 +663,7 @@ the first newsgroup."
(defvar mail-sources)
(defvar nnmail-scan-directory-mail-source-once)
(defvar nnmail-split-history)
+(defvar gnus-save-newsrc-file-last-timestamp nil)
(defun gnus-close-all-servers ()
"Close all servers."
@@ -707,6 +708,7 @@ the first newsgroup."
gnus-current-select-method nil
nnmail-split-history nil
gnus-extended-servers nil
+ gnus-save-newsrc-file-last-timestamp nil
gnus-ephemeral-servers nil)
(gnus-shutdown 'gnus)
;; Kill the startup file.
@@ -1882,13 +1884,12 @@ The info element is shared with the same element of
(ranges (gnus-info-read info))
news article)
(while articles
- (when (gnus-member-of-range
- (setq article (pop articles)) ranges)
+ (when (range-member-p (setq article (pop articles)) ranges)
(push article news)))
(when news
;; Enter this list into the group info.
(setf (gnus-info-read info)
- (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+ (range-remove (gnus-info-read info) (nreverse news)))
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
@@ -2360,10 +2361,10 @@ The form should return either t or nil."
ticked (cdr (assq 'tick marks)))
(when (or dormant ticked)
(setf (gnus-info-read info)
- (gnus-add-to-range
+ (range-add-list
(gnus-info-read info)
- (nconc (gnus-uncompress-range dormant)
- (gnus-uncompress-range ticked)))))))))
+ (nconc (range-uncompress dormant)
+ (range-uncompress ticked)))))))))
(defun gnus-load (file)
"Load FILE, but in such a way that read errors can be reported."
@@ -2455,8 +2456,7 @@ The form should return either t or nil."
(unless (nthcdr 3 info)
(nconc info (list nil)))
(setf (gnus-info-marks info)
- (list (cons 'tick (gnus-compress-sequence
- (sort (cdr m) #'<) t))))))
+ (list (cons 'tick (range-compress-list (sort (cdr m) #'<)))))))
(setq newsrc killed)
(while newsrc
(setcar newsrc (caar newsrc))
@@ -2731,7 +2731,6 @@ The form should return either t or nil."
'msdos-long-file-names
(lambda () t))))
-(defvar gnus-save-newsrc-file-last-timestamp nil)
(defun gnus-save-newsrc-file (&optional force)
"Save .newsrc file.
Use the group string names in `gnus-group-list' to pull info
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 3f350bffb31..7f96e16c8ae 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -97,7 +97,7 @@ See `gnus-group-goto-unread'."
:type 'boolean)
(defcustom gnus-summary-stop-at-end-of-message nil
- "If non-nil, don't select the next message when using `SPC'."
+ "If non-nil, don't select the next message when using \\`SPC'."
:link '(custom-manual "(gnus)Group Maneuvering")
:group 'gnus-summary-maneuvering
:version "24.1"
@@ -264,8 +264,8 @@ This variable will only be used if the value of
(defcustom gnus-summary-goto-unread nil
"If t, many commands will go to the next unread article.
This applies to marking commands as well as other commands that
-\"naturally\" select the next article, like, for instance, `SPC' at
-the end of an article.
+\"naturally\" select the next article, like, for instance, \\`SPC'
+at the end of an article.
If nil, the marking commands do NOT go to the next unread article
\(they go to the next article instead). If `never', commands that
@@ -1182,8 +1182,8 @@ mark: The article's mark.
uncached: Non-nil if the article is uncached."
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
- face)))
-(put 'gnus-summary-highlight 'risky-local-variable t)
+ face))
+ :risky t)
(defcustom gnus-alter-header-function nil
"Function called to allow alteration of article header structures.
@@ -1907,485 +1907,483 @@ increase the score of each group you read."
;; Non-orthogonal keys
-(gnus-define-keys gnus-summary-mode-map
- " " gnus-summary-next-page
- [?\S-\ ] gnus-summary-prev-page
- "\177" gnus-summary-prev-page
- [delete] gnus-summary-prev-page
- "\r" gnus-summary-scroll-up
- "\M-\r" gnus-summary-scroll-down
- "n" gnus-summary-next-unread-article
- "p" gnus-summary-prev-unread-article
- "N" gnus-summary-next-article
- "P" gnus-summary-prev-article
- "\M-\C-n" gnus-summary-next-same-subject
- "\M-\C-p" gnus-summary-prev-same-subject
- "\M-n" gnus-summary-next-unread-subject
- "\M-p" gnus-summary-prev-unread-subject
- "." gnus-summary-first-unread-article
- "," gnus-summary-best-unread-article
- "[" gnus-summary-prev-unseen-article
- "]" gnus-summary-next-unseen-article
- "\M-s\M-s" gnus-summary-search-article-forward
- "\M-s\M-r" gnus-summary-search-article-backward
- "\M-r" gnus-summary-search-article-backward
- "\M-S" gnus-summary-repeat-search-article-forward
- "\M-R" gnus-summary-repeat-search-article-backward
- "<" gnus-summary-beginning-of-article
- ">" gnus-summary-end-of-article
- "j" gnus-summary-goto-article
- "^" gnus-summary-refer-parent-article
- "\M-^" gnus-summary-refer-article
- "u" gnus-summary-tick-article-forward
- "!" gnus-summary-tick-article-forward
- "U" gnus-summary-tick-article-backward
- "d" gnus-summary-mark-as-read-forward
- "D" gnus-summary-mark-as-read-backward
- "E" gnus-summary-mark-as-expirable
- "\M-u" gnus-summary-clear-mark-forward
- "\M-U" gnus-summary-clear-mark-backward
- "k" gnus-summary-kill-same-subject-and-select
- "\C-k" gnus-summary-kill-same-subject
- "\M-\C-k" gnus-summary-kill-thread
- "\M-\C-l" gnus-summary-lower-thread
- "e" gnus-summary-edit-article
- "#" gnus-summary-mark-as-processable
- "\M-#" gnus-summary-unmark-as-processable
- "\M-\C-t" gnus-summary-toggle-threads
- "\M-\C-s" gnus-summary-show-thread
- "\M-\C-h" gnus-summary-hide-thread
- "\M-\C-f" gnus-summary-next-thread
- "\M-\C-b" gnus-summary-prev-thread
- [(meta down)] gnus-summary-next-thread
- [(meta up)] gnus-summary-prev-thread
- "\M-\C-u" gnus-summary-up-thread
- "\M-\C-d" gnus-summary-down-thread
- "&" gnus-summary-execute-command
- "c" gnus-summary-catchup-and-exit
- "\C-w" gnus-summary-mark-region-as-read
- "\C-t" toggle-truncate-lines
- "?" gnus-summary-mark-as-dormant
- "\C-c\M-\C-s" gnus-summary-limit-include-expunged
- "\C-c\C-s\C-n" gnus-summary-sort-by-number
- "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number
- "\C-c\C-s\C-l" gnus-summary-sort-by-lines
- "\C-c\C-s\C-c" gnus-summary-sort-by-chars
- "\C-c\C-s\C-m\C-m" gnus-summary-sort-by-marks
- "\C-c\C-s\C-a" gnus-summary-sort-by-author
- "\C-c\C-s\C-t" gnus-summary-sort-by-recipient
- "\C-c\C-s\C-s" gnus-summary-sort-by-subject
- "\C-c\C-s\C-d" gnus-summary-sort-by-date
- "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date
- "\C-c\C-s\C-i" gnus-summary-sort-by-score
- "\C-c\C-s\C-o" gnus-summary-sort-by-original
- "\C-c\C-s\C-r" gnus-summary-sort-by-random
- "\C-c\C-s\C-u" gnus-summary-sort-by-newsgroups
- "\C-c\C-s\C-x" gnus-summary-sort-by-extra
- "=" gnus-summary-expand-window
- "\C-x\C-s" gnus-summary-reselect-current-group
- "\M-g" gnus-summary-rescan-group
- "\C-c\C-r" gnus-summary-caesar-message
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "C" gnus-summary-cancel-article
- "r" gnus-summary-reply
- "R" gnus-summary-reply-with-original
- "\C-c\C-f" gnus-summary-mail-forward
- "o" gnus-summary-save-article
- "\C-o" gnus-summary-save-article-mail
- "|" gnus-summary-pipe-output
- "\M-k" gnus-summary-edit-local-kill
- "\M-K" gnus-summary-edit-global-kill
+(define-keymap :keymap gnus-summary-mode-map
+ "SPC" #'gnus-summary-next-page
+ "S-SPC" #'gnus-summary-prev-page
+ "DEL" #'gnus-summary-prev-page
+ "<delete>" #'gnus-summary-prev-page
+ "RET" #'gnus-summary-scroll-up
+ "M-RET" #'gnus-summary-scroll-down
+ "n" #'gnus-summary-next-unread-article
+ "p" #'gnus-summary-prev-unread-article
+ "N" #'gnus-summary-next-article
+ "P" #'gnus-summary-prev-article
+ "C-M-n" #'gnus-summary-next-same-subject
+ "C-M-p" #'gnus-summary-prev-same-subject
+ "M-n" #'gnus-summary-next-unread-subject
+ "M-p" #'gnus-summary-prev-unread-subject
+ "." #'gnus-summary-first-unread-article
+ "," #'gnus-summary-best-unread-article
+ "[" #'gnus-summary-prev-unseen-article
+ "]" #'gnus-summary-next-unseen-article
+ "M-s M-s" #'gnus-summary-search-article-forward
+ "M-s M-r" #'gnus-summary-search-article-backward
+ "M-r" #'gnus-summary-search-article-backward
+ "M-S" #'gnus-summary-repeat-search-article-forward
+ "M-R" #'gnus-summary-repeat-search-article-backward
+ "<" #'gnus-summary-beginning-of-article
+ ">" #'gnus-summary-end-of-article
+ "j" #'gnus-summary-goto-article
+ "^" #'gnus-summary-refer-parent-article
+ "M-^" #'gnus-summary-refer-article
+ "u" #'gnus-summary-tick-article-forward
+ "!" #'gnus-summary-tick-article-forward
+ "U" #'gnus-summary-tick-article-backward
+ "d" #'gnus-summary-mark-as-read-forward
+ "D" #'gnus-summary-mark-as-read-backward
+ "E" #'gnus-summary-mark-as-expirable
+ "M-u" #'gnus-summary-clear-mark-forward
+ "M-U" #'gnus-summary-clear-mark-backward
+ "k" #'gnus-summary-kill-same-subject-and-select
+ "C-k" #'gnus-summary-kill-same-subject
+ "C-M-k" #'gnus-summary-kill-thread
+ "C-M-l" #'gnus-summary-lower-thread
+ "e" #'gnus-summary-edit-article
+ "#" #'gnus-summary-mark-as-processable
+ "M-#" #'gnus-summary-unmark-as-processable
+ "C-M-t" #'gnus-summary-toggle-threads
+ "C-M-s" #'gnus-summary-show-thread
+ "C-M-h" #'gnus-summary-hide-thread
+ "C-M-f" #'gnus-summary-next-thread
+ "C-M-b" #'gnus-summary-prev-thread
+ "M-<down>" #'gnus-summary-next-thread
+ "M-<up>" #'gnus-summary-prev-thread
+ "C-M-u" #'gnus-summary-up-thread
+ "C-M-d" #'gnus-summary-down-thread
+ "&" #'gnus-summary-execute-command
+ "c" #'gnus-summary-catchup-and-exit
+ "C-w" #'gnus-summary-mark-region-as-read
+ "C-t" #'toggle-truncate-lines
+ "?" #'gnus-summary-mark-as-dormant
+ "C-c C-M-s" #'gnus-summary-limit-include-expunged
+ "C-c C-s C-n" #'gnus-summary-sort-by-number
+ "C-c C-s C-m C-n" #'gnus-summary-sort-by-most-recent-number
+ "C-c C-s C-l" #'gnus-summary-sort-by-lines
+ "C-c C-s C-c" #'gnus-summary-sort-by-chars
+ "C-c C-s C-m C-m" #'gnus-summary-sort-by-marks
+ "C-c C-s C-a" #'gnus-summary-sort-by-author
+ "C-c C-s C-t" #'gnus-summary-sort-by-recipient
+ "C-c C-s C-s" #'gnus-summary-sort-by-subject
+ "C-c C-s C-d" #'gnus-summary-sort-by-date
+ "C-c C-s C-m C-d" #'gnus-summary-sort-by-most-recent-date
+ "C-c C-s C-i" #'gnus-summary-sort-by-score
+ "C-c C-s C-o" #'gnus-summary-sort-by-original
+ "C-c C-s C-r" #'gnus-summary-sort-by-random
+ "C-c C-s C-u" #'gnus-summary-sort-by-newsgroups
+ "C-c C-s C-x" #'gnus-summary-sort-by-extra
+ "=" #'gnus-summary-expand-window
+ "C-x C-s" #'gnus-summary-reselect-current-group
+ "M-g" #'gnus-summary-rescan-group
+ "C-c C-r" #'gnus-summary-caesar-message
+ "f" #'gnus-summary-followup
+ "F" #'gnus-summary-followup-with-original
+ "C" #'gnus-summary-cancel-article
+ "r" #'gnus-summary-reply
+ "R" #'gnus-summary-reply-with-original
+ "C-c C-f" #'gnus-summary-mail-forward
+ "o" #'gnus-summary-save-article
+ "C-o" #'gnus-summary-save-article-mail
+ "|" #'gnus-summary-pipe-output
+ "M-k" #'gnus-summary-edit-local-kill
+ "M-K" #'gnus-summary-edit-global-kill
;; "V" gnus-version
- "\C-c\C-d" gnus-summary-describe-group
- "\C-c\C-p" gnus-summary-make-group-from-search
- "q" gnus-summary-exit
- "Q" gnus-summary-exit-no-update
- "\C-c\C-i" gnus-info-find-node
- [mouse-2] gnus-mouse-pick-article
- [follow-link] mouse-face
- "m" gnus-summary-mail-other-window
- "a" gnus-summary-post-news
- "x" gnus-summary-limit-to-unread
- "s" gnus-summary-isearch-article
- "\t" gnus-summary-button-forward
- [backtab] gnus-summary-button-backward
- "w" gnus-summary-browse-url
- "t" gnus-summary-toggle-header
- "g" gnus-summary-show-article
- "l" gnus-summary-goto-last-article
- "\C-c\C-v\C-v" gnus-uu-decode-uu-view
- "\C-d" gnus-summary-enter-digest-group
- "\M-\C-d" gnus-summary-read-document
- "\M-\C-e" gnus-summary-edit-parameters
- "\M-\C-a" gnus-summary-customize-parameters
- "\C-c\C-b" gnus-bug
- "*" gnus-cache-enter-article
- "\M-*" gnus-cache-remove-article
- "\M-&" gnus-summary-universal-argument
- "\C-l" gnus-recenter
- "I" gnus-summary-increase-score
- "L" gnus-summary-lower-score
- "\M-i" gnus-symbolic-argument
- "h" gnus-summary-select-article-buffer
-
- "b" gnus-article-view-part
- "\M-t" gnus-summary-toggle-display-buttonized
-
- "V" gnus-summary-score-map
- "X" gnus-uu-extract-map
- "S" gnus-summary-send-map)
-
-;; Sort of orthogonal keymap
-(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
- "t" gnus-summary-tick-article-forward
- "!" gnus-summary-tick-article-forward
- "d" gnus-summary-mark-as-read-forward
- "r" gnus-summary-mark-as-read-forward
- "c" gnus-summary-clear-mark-forward
- " " gnus-summary-clear-mark-forward
- "e" gnus-summary-mark-as-expirable
- "x" gnus-summary-mark-as-expirable
- "?" gnus-summary-mark-as-dormant
- "b" gnus-summary-set-bookmark
- "B" gnus-summary-remove-bookmark
- "#" gnus-summary-mark-as-processable
- "\M-#" gnus-summary-unmark-as-processable
- "S" gnus-summary-limit-include-expunged
- "C" gnus-summary-catchup
- "H" gnus-summary-catchup-to-here
- "h" gnus-summary-catchup-from-here
- "\C-c" gnus-summary-catchup-all
- "k" gnus-summary-kill-same-subject-and-select
- "K" gnus-summary-kill-same-subject
- "P" gnus-uu-mark-map)
-
-(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
- "c" gnus-summary-clear-above
- "u" gnus-summary-tick-above
- "m" gnus-summary-mark-above
- "k" gnus-summary-kill-below)
-
-(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
- "/" gnus-summary-limit-to-subject
- "n" gnus-summary-limit-to-articles
- "b" gnus-summary-limit-to-bodies
- "h" gnus-summary-limit-to-headers
- "w" gnus-summary-pop-limit
- "s" gnus-summary-limit-to-subject
- "a" gnus-summary-limit-to-author
- "u" gnus-summary-limit-to-unread
- "m" gnus-summary-limit-to-marks
- "M" gnus-summary-limit-exclude-marks
- "v" gnus-summary-limit-to-score
- "*" gnus-summary-limit-include-cached
- "D" gnus-summary-limit-include-dormant
- "T" gnus-summary-limit-include-thread
- "d" gnus-summary-limit-exclude-dormant
- "t" gnus-summary-limit-to-age
- "." gnus-summary-limit-to-unseen
- "x" gnus-summary-limit-to-extra
- "p" gnus-summary-limit-to-display-predicate
- "E" gnus-summary-limit-include-expunged
- "c" gnus-summary-limit-exclude-childless-dormant
- "C" gnus-summary-limit-mark-excluded-as-read
- "o" gnus-summary-insert-old-articles
- "N" gnus-summary-insert-new-articles
- "S" gnus-summary-limit-to-singletons
- "r" gnus-summary-limit-to-replied
- "R" gnus-summary-limit-to-recipient
- "A" gnus-summary-limit-to-address)
-
-(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
- "n" gnus-summary-next-unread-article
- "p" gnus-summary-prev-unread-article
- "N" gnus-summary-next-article
- "P" gnus-summary-prev-article
- "\C-n" gnus-summary-next-same-subject
- "\C-p" gnus-summary-prev-same-subject
- "\M-n" gnus-summary-next-unread-subject
- "\M-p" gnus-summary-prev-unread-subject
- "f" gnus-summary-first-unread-article
- "b" gnus-summary-best-unread-article
- "u" gnus-summary-next-unseen-article
- "U" gnus-summary-prev-unseen-article
- "j" gnus-summary-goto-article
- "g" gnus-summary-goto-subject
- "l" gnus-summary-goto-last-article
- "o" gnus-summary-pop-article)
-
-(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
- "k" gnus-summary-kill-thread
- "E" gnus-summary-expire-thread
- "l" gnus-summary-lower-thread
- "i" gnus-summary-raise-thread
- "T" gnus-summary-toggle-threads
- "t" gnus-summary-rethread-current
- "^" gnus-summary-reparent-thread
- "\M-^" gnus-summary-reparent-children
- "s" gnus-summary-show-thread
- "S" gnus-summary-show-all-threads
- "h" gnus-summary-hide-thread
- "H" gnus-summary-hide-all-threads
- "n" gnus-summary-next-thread
- "p" gnus-summary-prev-thread
- "u" gnus-summary-up-thread
- "o" gnus-summary-top-thread
- "d" gnus-summary-down-thread
- "#" gnus-uu-mark-thread
- "\M-#" gnus-uu-unmark-thread)
-
-(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
- "g" gnus-summary-prepare
- "c" gnus-summary-insert-cached-articles
- "d" gnus-summary-insert-dormant-articles
- "t" gnus-summary-insert-ticked-articles)
-
-(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
- "c" gnus-summary-catchup-and-exit
- "C" gnus-summary-catchup-all-and-exit
- "E" gnus-summary-exit-no-update
- "Q" gnus-summary-exit
- "Z" gnus-summary-exit
- "n" gnus-summary-catchup-and-goto-next-group
- "p" gnus-summary-catchup-and-goto-prev-group
- "R" gnus-summary-reselect-current-group
- "G" gnus-summary-rescan-group
- "N" gnus-summary-next-group
- "s" gnus-summary-save-newsrc
- "P" gnus-summary-prev-group)
-
-(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
- " " gnus-summary-next-page
- "n" gnus-summary-next-page
- [?\S-\ ] gnus-summary-prev-page
- "\177" gnus-summary-prev-page
- [delete] gnus-summary-prev-page
- "p" gnus-summary-prev-page
- "\r" gnus-summary-scroll-up
- "\M-\r" gnus-summary-scroll-down
- "<" gnus-summary-beginning-of-article
- ">" gnus-summary-end-of-article
- "b" gnus-summary-beginning-of-article
- "e" gnus-summary-end-of-article
- "^" gnus-summary-refer-parent-article
- "r" gnus-summary-refer-parent-article
- "C" gnus-summary-show-complete-article
- "D" gnus-summary-enter-digest-group
- "R" gnus-summary-refer-references
- "T" gnus-summary-refer-thread
- "W" gnus-warp-to-article
- "g" gnus-summary-show-article
- "s" gnus-summary-isearch-article
- "\t" gnus-summary-button-forward
- [backtab] gnus-summary-button-backward
- "w" gnus-summary-browse-url
- "P" gnus-summary-print-article
- "S" gnus-sticky-article
- "M" gnus-mailing-list-insinuate
- "t" gnus-article-babel)
-
-(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
- "b" gnus-article-add-buttons
- "B" gnus-article-add-buttons-to-head
- "o" gnus-article-treat-overstrike
- "e" gnus-article-emphasize
- "w" gnus-article-fill-cited-article
- "Q" gnus-article-fill-long-lines
- "L" gnus-article-toggle-truncate-lines
- "C" gnus-article-capitalize-sentences
- "c" gnus-article-remove-cr
- "q" gnus-article-de-quoted-unreadable
- "6" gnus-article-de-base64-unreadable
- "Z" gnus-article-decode-HZ
- "A" gnus-article-treat-ansi-sequences
- "h" gnus-article-wash-html
- "u" gnus-article-unsplit-urls
- "s" gnus-summary-force-verify-and-decrypt
- "f" gnus-article-display-x-face
- "l" gnus-summary-stop-page-breaking
- "r" gnus-summary-caesar-message
- "m" gnus-summary-morse-message
- "t" gnus-summary-toggle-header
- "g" gnus-treat-smiley
- "v" gnus-summary-verbose-headers
- "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
- "p" gnus-article-verify-x-pgp-sig
- "d" gnus-article-treat-smartquotes
- "U" gnus-article-treat-non-ascii
- "i" gnus-summary-idna-message)
-
-(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
- ;; mnemonic: deuglif*Y*
- "u" gnus-article-outlook-unwrap-lines
- "a" gnus-article-outlook-repair-attribution
- "c" gnus-article-outlook-rearrange-citation
- "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify
-
-(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
- "a" gnus-article-hide
- "h" gnus-article-hide-headers
- "b" gnus-article-hide-boring-headers
- "s" gnus-article-hide-signature
- "c" gnus-article-hide-citation
- "C" gnus-article-hide-citation-in-followups
- "l" gnus-article-hide-list-identifiers
- "B" gnus-article-strip-banner
- "P" gnus-article-hide-pem
- "\C-c" gnus-article-hide-citation-maybe)
-
-(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
- "a" gnus-article-highlight
- "h" gnus-article-highlight-headers
- "c" gnus-article-highlight-citation
- "s" gnus-article-highlight-signature)
-
-(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
- "f" gnus-article-treat-fold-headers
- "u" gnus-article-treat-unfold-headers
- "n" gnus-article-treat-fold-newsgroups)
-
-(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
- "x" gnus-article-display-x-face
- "d" gnus-article-display-face
- "s" gnus-treat-smiley
- "D" gnus-article-remove-images
- "W" gnus-article-show-images
- "F" gnus-article-toggle-fonts
- "f" gnus-treat-from-picon
- "m" gnus-treat-mail-picon
- "n" gnus-treat-newsgroups-picon
- "g" gnus-treat-from-gravatar
- "h" gnus-treat-mail-gravatar)
-
-(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
- "w" gnus-article-decode-mime-words
- "c" gnus-article-decode-charset
- "h" gnus-mime-buttonize-attachments-in-header
- "v" gnus-mime-view-all-parts
- "b" gnus-article-view-part)
-
-(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
- "z" gnus-article-date-ut
- "u" gnus-article-date-ut
- "l" gnus-article-date-local
- "p" gnus-article-date-english
- "e" gnus-article-date-lapsed
- "o" gnus-article-date-original
- "i" gnus-article-date-iso8601
- "s" gnus-article-date-user)
-
-(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
- "t" gnus-article-remove-trailing-blank-lines
- "l" gnus-article-strip-leading-blank-lines
- "m" gnus-article-strip-multiple-blank-lines
- "a" gnus-article-strip-blank-lines
- "A" gnus-article-strip-all-blank-lines
- "s" gnus-article-strip-leading-space
- "e" gnus-article-strip-trailing-space
- "w" gnus-article-remove-leading-whitespace)
-
-(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
- "v" gnus-version
- "d" gnus-summary-describe-group
- "h" gnus-summary-describe-briefly
- "i" gnus-info-find-node)
-
-(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
- "e" gnus-summary-expire-articles
- "\M-\C-e" gnus-summary-expire-articles-now
- "\177" gnus-summary-delete-article
- [delete] gnus-summary-delete-article
- [backspace] gnus-summary-delete-article
- "m" gnus-summary-move-article
- "r" gnus-summary-respool-article
- "w" gnus-summary-edit-article
- "c" gnus-summary-copy-article
- "B" gnus-summary-crosspost-article
- "q" gnus-summary-respool-query
- "t" gnus-summary-respool-trace
- "i" gnus-summary-import-article
- "I" gnus-summary-create-article
- "p" gnus-summary-article-posted-p)
-
-(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
- "o" gnus-summary-save-article
- "m" gnus-summary-save-article-mail
- "F" gnus-summary-write-article-file
- "r" gnus-summary-save-article-rmail
- "f" gnus-summary-save-article-file
- "b" gnus-summary-save-article-body-file
- "B" gnus-summary-write-article-body-file
- "h" gnus-summary-save-article-folder
- "v" gnus-summary-save-article-vm
- "p" gnus-summary-pipe-output
- "P" gnus-summary-muttprint)
-
-(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
- "b" gnus-summary-display-buttonized
- "m" gnus-summary-repair-multipart
- "v" gnus-article-view-part
- "o" gnus-article-save-part
- "O" gnus-article-save-part-and-strip
- "r" gnus-article-replace-part
- "d" gnus-article-delete-part
- "t" gnus-article-view-part-as-type
- "j" gnus-article-jump-to-part
- "c" gnus-article-copy-part
- "C" gnus-article-view-part-as-charset
- "e" gnus-article-view-part-externally
- "H" gnus-article-browse-html-article
- "E" gnus-article-encrypt-body
- "i" gnus-article-inline-part
- "|" gnus-article-pipe-part)
-
-(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
- "p" gnus-summary-mark-as-processable
- "u" gnus-summary-unmark-as-processable
- "U" gnus-summary-unmark-all-processable
- "v" gnus-uu-mark-over
- "s" gnus-uu-mark-series
- "r" gnus-uu-mark-region
- "g" gnus-uu-unmark-region
- "R" gnus-uu-mark-by-regexp
- "G" gnus-uu-unmark-by-regexp
- "t" gnus-uu-mark-thread
- "T" gnus-uu-unmark-thread
- "a" gnus-uu-mark-all
- "b" gnus-uu-mark-buffer
- "S" gnus-uu-mark-sparse
- "k" gnus-summary-kill-process-mark
- "y" gnus-summary-yank-process-mark
- "w" gnus-summary-save-process-mark
- "i" gnus-uu-invert-processable)
-
-(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- "m" gnus-summary-save-parts
- "u" gnus-uu-decode-uu
- "U" gnus-uu-decode-uu-and-save
- "s" gnus-uu-decode-unshar
- "S" gnus-uu-decode-unshar-and-save
- "o" gnus-uu-decode-save
- "O" gnus-uu-decode-save
- "b" gnus-uu-decode-binhex
- "B" gnus-uu-decode-binhex
- "Y" gnus-uu-decode-yenc
- "p" gnus-uu-decode-postscript
- "P" gnus-uu-decode-postscript-and-save)
-
-(gnus-define-keys
- (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
- "u" gnus-uu-decode-uu-view
- "U" gnus-uu-decode-uu-and-save-view
- "s" gnus-uu-decode-unshar-view
- "S" gnus-uu-decode-unshar-and-save-view
- "o" gnus-uu-decode-save-view
- "O" gnus-uu-decode-save-view
- "b" gnus-uu-decode-binhex-view
- "B" gnus-uu-decode-binhex-view
- "p" gnus-uu-decode-postscript-view
- "P" gnus-uu-decode-postscript-and-save-view)
+ "C-c C-d" #'gnus-summary-describe-group
+ "C-c C-p" #'gnus-summary-make-group-from-search
+ "q" #'gnus-summary-exit
+ "Q" #'gnus-summary-exit-no-update
+ "C-c C-i" #'gnus-info-find-node
+ "<mouse-2>" #'gnus-mouse-pick-article
+ "<follow-link>" 'mouse-face
+ "m" #'gnus-summary-mail-other-window
+ "a" #'gnus-summary-post-news
+ "x" #'gnus-summary-limit-to-unread
+ "s" #'gnus-summary-isearch-article
+ "TAB" #'gnus-summary-button-forward
+ "<backtab>" #'gnus-summary-button-backward
+ "w" #'gnus-summary-browse-url
+ "t" #'gnus-summary-toggle-header
+ "g" #'gnus-summary-show-article
+ "l" #'gnus-summary-goto-last-article
+ "C-c C-v C-v" #'gnus-uu-decode-uu-view
+ "C-d" #'gnus-summary-enter-digest-group
+ "C-M-d" #'gnus-summary-read-document
+ "C-M-e" #'gnus-summary-edit-parameters
+ "C-M-a" #'gnus-summary-customize-parameters
+ "C-c C-b" #'gnus-bug
+ "*" #'gnus-cache-enter-article
+ "M-*" #'gnus-cache-remove-article
+ "M-&" #'gnus-summary-universal-argument
+ "C-l" #'gnus-recenter
+ "I" #'gnus-summary-increase-score
+ "L" #'gnus-summary-lower-score
+ "M-i" #'gnus-symbolic-argument
+ "h" #'gnus-summary-select-article-buffer
+
+ "b" #'gnus-article-view-part
+ "M-t" #'gnus-summary-toggle-display-buttonized
+
+ "S" #'gnus-summary-send-map
+
+ ;; Sort of orthogonal keymaps.
+ "M" (define-keymap :prefix 'gnus-summary-mark-map
+ "t" #'gnus-summary-tick-article-forward
+ "!" #'gnus-summary-tick-article-forward
+ "d" #'gnus-summary-mark-as-read-forward
+ "r" #'gnus-summary-mark-as-read-forward
+ "c" #'gnus-summary-clear-mark-forward
+ "SPC" #'gnus-summary-clear-mark-forward
+ "e" #'gnus-summary-mark-as-expirable
+ "x" #'gnus-summary-mark-as-expirable
+ "?" #'gnus-summary-mark-as-dormant
+ "b" #'gnus-summary-set-bookmark
+ "B" #'gnus-summary-remove-bookmark
+ "#" #'gnus-summary-mark-as-processable
+ "M-#" #'gnus-summary-unmark-as-processable
+ "S" #'gnus-summary-limit-include-expunged
+ "C" #'gnus-summary-catchup
+ "H" #'gnus-summary-catchup-to-here
+ "h" #'gnus-summary-catchup-from-here
+ "C-c" #'gnus-summary-catchup-all
+ "k" #'gnus-summary-kill-same-subject-and-select
+ "K" #'gnus-summary-kill-same-subject
+
+ "P" (define-keymap :prefix 'gnus-uu-mark-map
+ "p" #'gnus-summary-mark-as-processable
+ "u" #'gnus-summary-unmark-as-processable
+ "U" #'gnus-summary-unmark-all-processable
+ "v" #'gnus-uu-mark-over
+ "s" #'gnus-uu-mark-series
+ "r" #'gnus-uu-mark-region
+ "g" #'gnus-uu-unmark-region
+ "R" #'gnus-uu-mark-by-regexp
+ "G" #'gnus-uu-unmark-by-regexp
+ "t" #'gnus-uu-mark-thread
+ "T" #'gnus-uu-unmark-thread
+ "a" #'gnus-uu-mark-all
+ "b" #'gnus-uu-mark-buffer
+ "S" #'gnus-uu-mark-sparse
+ "k" #'gnus-summary-kill-process-mark
+ "y" #'gnus-summary-yank-process-mark
+ "w" #'gnus-summary-save-process-mark
+ "i" #'gnus-uu-invert-processable)
+
+ "V" (define-keymap :prefix 'gnus-summary-mscore-map
+ "c" #'gnus-summary-clear-above
+ "u" #'gnus-summary-tick-above
+ "m" #'gnus-summary-mark-above
+ "k" #'gnus-summary-kill-below))
+
+ "/" (define-keymap :prefix 'gnus-summary-limit-map
+ "/" #'gnus-summary-limit-to-subject
+ "n" #'gnus-summary-limit-to-articles
+ "b" #'gnus-summary-limit-to-bodies
+ "h" #'gnus-summary-limit-to-headers
+ "w" #'gnus-summary-pop-limit
+ "s" #'gnus-summary-limit-to-subject
+ "a" #'gnus-summary-limit-to-author
+ "u" #'gnus-summary-limit-to-unread
+ "m" #'gnus-summary-limit-to-marks
+ "M" #'gnus-summary-limit-exclude-marks
+ "v" #'gnus-summary-limit-to-score
+ "*" #'gnus-summary-limit-include-cached
+ "D" #'gnus-summary-limit-include-dormant
+ "T" #'gnus-summary-limit-include-thread
+ "d" #'gnus-summary-limit-exclude-dormant
+ "t" #'gnus-summary-limit-to-age
+ "." #'gnus-summary-limit-to-unseen
+ "x" #'gnus-summary-limit-to-extra
+ "p" #'gnus-summary-limit-to-display-predicate
+ "E" #'gnus-summary-limit-include-expunged
+ "c" #'gnus-summary-limit-exclude-childless-dormant
+ "C" #'gnus-summary-limit-mark-excluded-as-read
+ "o" #'gnus-summary-insert-old-articles
+ "N" #'gnus-summary-insert-new-articles
+ "S" #'gnus-summary-limit-to-singletons
+ "r" #'gnus-summary-limit-to-replied
+ "R" #'gnus-summary-limit-to-recipient
+ "A" #'gnus-summary-limit-to-address)
+
+ "G" (define-keymap :prefix 'gnus-summary-goto-map
+ "n" #'gnus-summary-next-unread-article
+ "p" #'gnus-summary-prev-unread-article
+ "N" #'gnus-summary-next-article
+ "P" #'gnus-summary-prev-article
+ "C-n" #'gnus-summary-next-same-subject
+ "C-p" #'gnus-summary-prev-same-subject
+ "M-n" #'gnus-summary-next-unread-subject
+ "M-p" #'gnus-summary-prev-unread-subject
+ "f" #'gnus-summary-first-unread-article
+ "b" #'gnus-summary-best-unread-article
+ "u" #'gnus-summary-next-unseen-article
+ "U" #'gnus-summary-prev-unseen-article
+ "j" #'gnus-summary-goto-article
+ "g" #'gnus-summary-goto-subject
+ "l" #'gnus-summary-goto-last-article
+ "o" #'gnus-summary-pop-article)
+
+ "T" (define-keymap :prefix 'gnus-summary-thread-map
+ "k" #'gnus-summary-kill-thread
+ "E" #'gnus-summary-expire-thread
+ "l" #'gnus-summary-lower-thread
+ "i" #'gnus-summary-raise-thread
+ "T" #'gnus-summary-toggle-threads
+ "t" #'gnus-summary-rethread-current
+ "^" #'gnus-summary-reparent-thread
+ "M-^" #'gnus-summary-reparent-children
+ "s" #'gnus-summary-show-thread
+ "S" #'gnus-summary-show-all-threads
+ "h" #'gnus-summary-hide-thread
+ "H" #'gnus-summary-hide-all-threads
+ "n" #'gnus-summary-next-thread
+ "p" #'gnus-summary-prev-thread
+ "u" #'gnus-summary-up-thread
+ "o" #'gnus-summary-top-thread
+ "d" #'gnus-summary-down-thread
+ "#" #'gnus-uu-mark-thread
+ "M-#" #'gnus-uu-unmark-thread)
+
+ "Y" (define-keymap :prefix 'gnus-summary-buffer-map
+ "g" #'gnus-summary-prepare
+ "c" #'gnus-summary-insert-cached-articles
+ "d" #'gnus-summary-insert-dormant-articles
+ "t" #'gnus-summary-insert-ticked-articles)
+
+ "Z" (define-keymap :prefix 'gnus-summary-exit-map
+ "c" #'gnus-summary-catchup-and-exit
+ "C" #'gnus-summary-catchup-all-and-exit
+ "E" #'gnus-summary-exit-no-update
+ "Q" #'gnus-summary-exit
+ "Z" #'gnus-summary-exit
+ "n" #'gnus-summary-catchup-and-goto-next-group
+ "p" #'gnus-summary-catchup-and-goto-prev-group
+ "R" #'gnus-summary-reselect-current-group
+ "G" #'gnus-summary-rescan-group
+ "N" #'gnus-summary-next-group
+ "s" #'gnus-summary-save-newsrc
+ "P" #'gnus-summary-prev-group)
+
+ "A" (define-keymap :prefix 'gnus-summary-article-map
+ "SPC" #'gnus-summary-next-page
+ "n" #'gnus-summary-next-page
+ "S-SPC" #'gnus-summary-prev-page
+ "DEL" #'gnus-summary-prev-page
+ "<delete>" #'gnus-summary-prev-page
+ "p" #'gnus-summary-prev-page
+ "RET" #'gnus-summary-scroll-up
+ "M-RET" #'gnus-summary-scroll-down
+ "<" #'gnus-summary-beginning-of-article
+ ">" #'gnus-summary-end-of-article
+ "b" #'gnus-summary-beginning-of-article
+ "e" #'gnus-summary-end-of-article
+ "^" #'gnus-summary-refer-parent-article
+ "r" #'gnus-summary-refer-parent-article
+ "C" #'gnus-summary-show-complete-article
+ "D" #'gnus-summary-enter-digest-group
+ "R" #'gnus-summary-refer-references
+ "T" #'gnus-summary-refer-thread
+ "W" #'gnus-warp-to-article
+ "g" #'gnus-summary-show-article
+ "s" #'gnus-summary-isearch-article
+ "TAB" #'gnus-summary-button-forward
+ "<backtab>" #'gnus-summary-button-backward
+ "w" #'gnus-summary-browse-url
+ "P" #'gnus-summary-print-article
+ "S" #'gnus-sticky-article
+ "M" #'gnus-mailing-list-insinuate
+ "t" #'gnus-article-babel)
+
+ "W" (define-keymap :prefix 'gnus-summary-wash-map
+ "b" #'gnus-article-add-buttons
+ "B" #'gnus-article-add-buttons-to-head
+ "o" #'gnus-article-treat-overstrike
+ "e" #'gnus-article-emphasize
+ "w" #'gnus-article-fill-cited-article
+ "Q" #'gnus-article-fill-long-lines
+ "L" #'gnus-article-toggle-truncate-lines
+ "C" #'gnus-article-capitalize-sentences
+ "c" #'gnus-article-remove-cr
+ "q" #'gnus-article-de-quoted-unreadable
+ "6" #'gnus-article-de-base64-unreadable
+ "Z" #'gnus-article-decode-HZ
+ "A" #'gnus-article-treat-ansi-sequences
+ "h" #'gnus-article-wash-html
+ "u" #'gnus-article-unsplit-urls
+ "s" #'gnus-summary-force-verify-and-decrypt
+ "f" #'gnus-article-display-x-face
+ "l" #'gnus-summary-stop-page-breaking
+ "r" #'gnus-summary-caesar-message
+ "m" #'gnus-summary-morse-message
+ "t" #'gnus-summary-toggle-header
+ "g" #'gnus-treat-smiley
+ "v" #'gnus-summary-verbose-headers
+ "a" #'gnus-article-strip-headers-in-body ;; mnemonic: wash archive
+ "p" #'gnus-article-verify-x-pgp-sig
+ "d" #'gnus-article-treat-smartquotes
+ "U" #'gnus-article-treat-non-ascii
+ "i" #'gnus-summary-idna-message
+
+ "Y" (define-keymap :prefix 'gnus-summary-wash-deuglify-map
+ ;; mnemonic: deuglif*Y*
+ "u" #'gnus-article-outlook-unwrap-lines
+ "a" #'gnus-article-outlook-repair-attribution
+ "c" #'gnus-article-outlook-rearrange-citation
+ ;; mnemonic: full deuglify
+ "f" #'gnus-article-outlook-deuglify-article)
+
+ "W" (define-keymap :prefix 'gnus-summary-wash-hide-map
+ "a" #'gnus-article-hide
+ "h" #'gnus-article-hide-headers
+ "b" #'gnus-article-hide-boring-headers
+ "s" #'gnus-article-hide-signature
+ "c" #'gnus-article-hide-citation
+ "C" #'gnus-article-hide-citation-in-followups
+ "l" #'gnus-article-hide-list-identifiers
+ "B" #'gnus-article-strip-banner
+ "P" #'gnus-article-hide-pem
+ "C-c" #'gnus-article-hide-citation-maybe)
+
+ "H" (define-keymap :prefix 'gnus-summary-wash-highlight-map
+ "a" #'gnus-article-highlight
+ "h" #'gnus-article-highlight-headers
+ "c" #'gnus-article-highlight-citation
+ "s" #'gnus-article-highlight-signature)
+
+ "G" (define-keymap :prefix 'gnus-summary-wash-header-map
+ "f" #'gnus-article-treat-fold-headers
+ "u" #'gnus-article-treat-unfold-headers
+ "n" #'gnus-article-treat-fold-newsgroups)
+
+ "D" (define-keymap :prefix 'gnus-summary-wash-display-map
+ "x" #'gnus-article-display-x-face
+ "d" #'gnus-article-display-face
+ "s" #'gnus-treat-smiley
+ "e" #'gnus-article-emojize-symbols
+ "D" #'gnus-article-remove-images
+ "W" #'gnus-article-show-images
+ "F" #'gnus-article-toggle-fonts
+ "f" #'gnus-treat-from-picon
+ "m" #'gnus-treat-mail-picon
+ "n" #'gnus-treat-newsgroups-picon
+ "g" #'gnus-treat-from-gravatar
+ "h" #'gnus-treat-mail-gravatar)
+
+ "M" (define-keymap :prefix 'gnus-summary-wash-mime-map
+ "w" #'gnus-article-decode-mime-words
+ "c" #'gnus-article-decode-charset
+ "h" #'gnus-mime-buttonize-attachments-in-header
+ "v" #'gnus-mime-view-all-parts
+ "b" #'gnus-article-view-part)
+
+ "T" (define-keymap :prefix 'gnus-summary-wash-time-map
+ "z" #'gnus-article-date-ut
+ "u" #'gnus-article-date-ut
+ "l" #'gnus-article-date-local
+ "p" #'gnus-article-date-english
+ "e" #'gnus-article-date-lapsed
+ "o" #'gnus-article-date-original
+ "i" #'gnus-article-date-iso8601
+ "s" #'gnus-article-date-user)
+
+ "E" (define-keymap :prefix 'gnus-summary-wash-empty-map
+ "t" #'gnus-article-remove-trailing-blank-lines
+ "l" #'gnus-article-strip-leading-blank-lines
+ "m" #'gnus-article-strip-multiple-blank-lines
+ "a" #'gnus-article-strip-blank-lines
+ "A" #'gnus-article-strip-all-blank-lines
+ "s" #'gnus-article-strip-leading-space
+ "e" #'gnus-article-strip-trailing-space
+ "w" #'gnus-article-remove-leading-whitespace))
+
+ "H" (define-keymap :prefix 'gnus-summary-help-map
+ "v" #'gnus-version
+ "d" #'gnus-summary-describe-group
+ "h" #'gnus-summary-describe-briefly
+ "i" #'gnus-info-find-node)
+
+ "B" (define-keymap :prefix 'gnus-summary-backend-map
+ "e" #'gnus-summary-expire-articles
+ "C-M-e" #'gnus-summary-expire-articles-now
+ "DEL" #'gnus-summary-delete-article
+ "<delete>" #'gnus-summary-delete-article
+ "<backspace>" #'gnus-summary-delete-article
+ "m" #'gnus-summary-move-article
+ "r" #'gnus-summary-respool-article
+ "w" #'gnus-summary-edit-article
+ "c" #'gnus-summary-copy-article
+ "B" #'gnus-summary-crosspost-article
+ "q" #'gnus-summary-respool-query
+ "t" #'gnus-summary-respool-trace
+ "i" #'gnus-summary-import-article
+ "I" #'gnus-summary-create-article
+ "p" #'gnus-summary-article-posted-p)
+
+ "O" (define-keymap :prefix 'gnus-summary-save-map
+ "o" #'gnus-summary-save-article
+ "m" #'gnus-summary-save-article-mail
+ "F" #'gnus-summary-write-article-file
+ "r" #'gnus-summary-save-article-rmail
+ "f" #'gnus-summary-save-article-file
+ "b" #'gnus-summary-save-article-body-file
+ "B" #'gnus-summary-write-article-body-file
+ "h" #'gnus-summary-save-article-folder
+ "v" #'gnus-summary-save-article-vm
+ "p" #'gnus-summary-pipe-output
+ "P" #'gnus-summary-muttprint)
+
+ "K" (define-keymap :prefix 'gnus-summary-mime-map
+ "b" #'gnus-summary-display-buttonized
+ "m" #'gnus-summary-repair-multipart
+ "v" #'gnus-article-view-part
+ "o" #'gnus-article-save-part
+ "O" #'gnus-article-save-part-and-strip
+ "r" #'gnus-article-replace-part
+ "d" #'gnus-article-delete-part
+ "t" #'gnus-article-view-part-as-type
+ "j" #'gnus-article-jump-to-part
+ "c" #'gnus-article-copy-part
+ "C" #'gnus-article-view-part-as-charset
+ "e" #'gnus-article-view-part-externally
+ "H" #'gnus-article-browse-html-article
+ "E" #'gnus-article-encrypt-body
+ "i" #'gnus-article-inline-part
+ "|" #'gnus-article-pipe-part)
+
+ "X" (define-keymap :prefix 'gnus-uu-extract-map
+ ;;"x" gnus-uu-extract-any
+ "m" #'gnus-summary-save-parts
+ "u" #'gnus-uu-decode-uu
+ "U" #'gnus-uu-decode-uu-and-save
+ "s" #'gnus-uu-decode-unshar
+ "S" #'gnus-uu-decode-unshar-and-save
+ "o" #'gnus-uu-decode-save
+ "O" #'gnus-uu-decode-save
+ "b" #'gnus-uu-decode-binhex
+ "B" #'gnus-uu-decode-binhex
+ "Y" #'gnus-uu-decode-yenc
+ "p" #'gnus-uu-decode-postscript
+ "P" #'gnus-uu-decode-postscript-and-save
+
+ "v" (define-keymap :prefix 'gnus-uu-extract-view-map
+ "u" #'gnus-uu-decode-uu-view
+ "U" #'gnus-uu-decode-uu-and-save-view
+ "s" #'gnus-uu-decode-unshar-view
+ "S" #'gnus-uu-decode-unshar-and-save-view
+ "o" #'gnus-uu-decode-save-view
+ "O" #'gnus-uu-decode-save-view
+ "b" #'gnus-uu-decode-binhex-view
+ "B" #'gnus-uu-decode-binhex-view
+ "p" #'gnus-uu-decode-postscript-view
+ "P" #'gnus-uu-decode-postscript-and-save-view)))
(defvar gnus-article-post-menu nil)
@@ -2889,45 +2887,11 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
(defvar gnus-summary-tool-bar-map nil)
-;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
-;; affect _new_ message buffers. We might add a function that walks thru all
-;; summary-mode buffers and force the update.
-(defun gnus-summary-tool-bar-update (&optional symbol value)
- "Update summary mode toolbar.
-Setter function for custom variables."
- (setq-default gnus-summary-tool-bar-map nil)
- (when symbol
- ;; When used as ":set" function:
- (set-default symbol value))
- (when (gnus-buffer-live-p gnus-summary-buffer)
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-make-tool-bar))))
-
-(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
- 'gnus-summary-tool-bar-gnome
- 'gnus-summary-tool-bar-retro)
- "Specifies the Gnus summary tool bar.
-
-It can be either a list or a symbol referring to a list. See
-`gmm-tool-bar-from-list' for the format of the list. The
-default key map is `gnus-summary-mode-map'.
-
-Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
-`gnus-summary-tool-bar-retro'."
- :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
- (const :tag "Retro look" gnus-summary-tool-bar-retro)
- (repeat :tag "User defined list" gmm-tool-bar-item)
- (symbol))
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
- :group 'gnus-summary)
-
-(defcustom gnus-summary-tool-bar-gnome
+(defcustom gnus-summary-tool-bar
'((gnus-summary-post-news "mail/compose" nil)
- (gnus-summary-insert-new-articles "mail/inbox" nil
- :visible (or (not gnus-agent)
- gnus-plugged))
+ (gnus-summary-insert-new-articles
+ "mail/inbox" nil
+ :visible (or (not gnus-agent) gnus-plugged))
(gnus-summary-reply-with-original "mail/reply")
(gnus-summary-reply "mail/reply" nil :visible nil)
(gnus-summary-followup-with-original "mail/reply-all")
@@ -2937,17 +2901,10 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
(gnus-summary-search-article-forward "search" nil :visible nil)
(gnus-summary-print-article "print")
(gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
- ;; Some new commands that may need more suitable icons:
(gnus-summary-save-newsrc "save" nil :visible nil)
- ;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
(gnus-summary-prev-article "left-arrow")
(gnus-summary-next-article "right-arrow")
(gnus-summary-next-page "next-page")
- ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
- ;;
- ;; Maybe some sort-by-... could be added:
- ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
- ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
(gnus-summary-mark-as-expirable
"delete" nil
:visible (gnus-check-backend-function 'request-expire-articles
@@ -2961,64 +2918,25 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
"mail/not-spam" nil
:visible (and (fboundp 'spam-group-spam-contents-p)
(spam-group-spam-contents-p gnus-newsgroup-name)))
- ;;
(gnus-summary-exit "exit")
(gmm-customize-mode "preferences" t :help "Edit mode preferences")
(gnus-info-find-node "help"))
- "List of functions for the summary tool bar (GNOME style).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
- :group 'gnus-summary)
+ "Specifies the Gnus summary tool bar.
-(defcustom gnus-summary-tool-bar-retro
- '((gnus-summary-prev-unread-article "gnus/prev-ur")
- (gnus-summary-next-unread-article "gnus/next-ur")
- (gnus-summary-post-news "gnus/post")
- (gnus-summary-followup-with-original "gnus/fuwo")
- (gnus-summary-followup "gnus/followup")
- (gnus-summary-reply-with-original "gnus/reply-wo")
- (gnus-summary-reply "gnus/reply")
- (gnus-summary-caesar-message "gnus/rot13")
- (gnus-uu-decode-uu "gnus/uu-decode")
- (gnus-summary-save-article-file "gnus/save-aif")
- (gnus-summary-save-article "gnus/save-art")
- (gnus-uu-post-news "gnus/uu-post")
- (gnus-summary-catchup "gnus/catchup")
- (gnus-summary-catchup-and-exit "gnus/cu-exit")
- (gnus-summary-exit "gnus/exit-summ")
- ;; Some new command that may need more suitable icons:
- (gnus-summary-print-article "gnus/print" nil :visible nil)
- (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
- (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
- ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
- (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
- ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
- ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
- ;;
- (gnus-info-find-node "gnus/help" nil :visible nil))
- "List of functions for the summary tool bar (retro look).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
+It can be either a list or a symbol referring to a list. See
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `gnus-summary-mode-map'."
+ :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "29.1"
:group 'gnus-summary)
-(defcustom gnus-summary-tool-bar-zap-list t
- "List of icon items from the global tool bar.
-These items are not displayed in the Gnus summary mode tool bar.
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type 'gmm-tool-bar-zap-list
- :version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
- :group 'gnus-summary)
+(defvar gnus-summary-tool-bar-gnome nil)
+(make-obsolete-variable 'gnus-summary-tool-bar-gnome nil "29.1")
+(defvar gnus-summary-tool-bar-retro nil)
+(make-obsolete-variable 'gnus-summary-tool-bar-retro nil "29.1")
+(defvar gnus-summary-tool-bar-zap-list t)
+(make-obsolete-variable 'gnus-summary-tool-bar-zap-list nil "29.1")
(defvar image-load-path)
(defvar tool-bar-map)
@@ -3970,10 +3888,9 @@ Returns \" ? \" if there's bad input or if another error occurs.
Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(condition-case ()
(let* ((messy-date (gnus-date-get-time messy-date))
- (now (current-time))
;;If we don't find something suitable we'll use this one
(my-format "%b %d '%y"))
- (let* ((difference (time-subtract now messy-date))
+ (let* ((difference (time-subtract nil messy-date))
(templist gnus-user-date-format-alist)
(top (eval (caar templist) t)))
(while (if (numberp top) (time-less-p top difference) (not top))
@@ -5004,23 +4921,13 @@ If LINE, insert the rebuilt thread starting on line LINE."
gnus-article-sort-functions)))
(gnus-message 7 "Sorting articles...done"))))
-;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-(defmacro gnus-thread-header (thread)
- "Return header of first article in THREAD.
-Note that THREAD must never, ever be anything else than a variable -
-using some other form will lead to serious barfage."
- (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
- ;; (8% speedup to gnus-summary-prepare, just for fun :-)
- (cond
- ((and (boundp 'lexical-binding) lexical-binding)
- ;; FIXME: This version could be a "defsubst" rather than a macro.
- `(#[257 "\211:\203\16\0\211@;\203\15\0A@@\207"
- [] 2]
- ,thread))
- (t
- ;; Not sure how XEmacs handles these things, so let's keep the old code.
- (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
- (vector thread) 2))))
+(defsubst gnus-thread-header (thread)
+ "Return header of first article in THREAD."
+ (if (consp thread)
+ (car (if (stringp (car thread))
+ (cadr thread)
+ thread))
+ thread))
(defsubst gnus-article-sort-by-number (h1 h2)
"Sort articles by article number."
@@ -5768,7 +5675,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; (let ((n (cdr (gnus-active group))))
;; (lambda () (> number (- n display))))
(setq select-articles
- (gnus-uncompress-range
+ (range-uncompress
(cons (let ((tmp (- (cdr (gnus-active group)) display)))
(if (> tmp 0)
tmp
@@ -5941,7 +5848,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
"Find out what articles the user wants to read."
(let* ((only-read-p t)
(articles
- (gnus-list-range-difference
+ (range-list-difference
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
@@ -5956,13 +5863,13 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(or
(if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
- (gnus-uncompress-range
+ (range-uncompress
(cons (max (car active)
(- (cdr active)
gnus-newsgroup-maximum-articles
-1))
(cdr active))))
- (gnus-uncompress-range (gnus-active group)))
+ (range-uncompress (gnus-active group)))
(gnus-cache-articles-in-group group))
;; Select only the "normal" subset of articles.
(setq only-read-p nil)
@@ -6053,7 +5960,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(defun gnus-killed-articles (killed articles)
(let (out)
(while articles
- (when (inline (gnus-member-of-range (car articles) killed))
+ (when (inline (range-member-p (car articles) killed))
(push (car articles) out))
(setq articles (cdr articles)))
out))
@@ -6091,7 +5998,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; Adjust "simple" lists - compressed yet unsorted
((eq mark-type 'list)
;; Simultaneously uncompress and clip to active range
- ;; See gnus-uncompress-range for a description of possible marks
+ ;; See range-uncompress for a description of possible marks
(let (l lh)
(if (not (cadr marks))
(set var nil)
@@ -6190,10 +6097,10 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq (cdr type) 'seen)
- (setq list (gnus-range-add list gnus-newsgroup-unseen)))
+ (setq list (range-concat list gnus-newsgroup-unseen)))
(when (eq (gnus-article-mark-to-type (cdr type)) 'list)
- (setq list (gnus-compress-sequence (set symbol (sort list #'<)) t)))
+ (setq list (range-compress-list (set symbol (sort list #'<)))))
(when (and (gnus-check-backend-function
'request-set-mark gnus-newsgroup-name)
@@ -6202,20 +6109,19 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; Don't do anything about marks for articles we
;; didn't actually get any headers for.
(del
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-articles
- (gnus-remove-from-range (copy-tree old) list)))
+ (range-remove (copy-tree old) list)))
(add
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-articles
- (gnus-remove-from-range
- (copy-tree list) old))))
+ (range-remove (copy-tree list) old))))
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
- (setq del (gnus-sorted-range-intersection
+ (setq del (range-intersection
(gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
@@ -6399,7 +6305,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(setq ninfo (cons 1 (1- (car active))))
(setq ninfo (gnus-info-read info)))
;; Then we add the read articles to the range.
- (gnus-add-to-range
+ (range-add-list
ninfo (setq articles (sort articles #'<))))))
(defun gnus-group-make-articles-read (group articles)
@@ -6980,10 +6886,10 @@ displayed, no centering will be performed."
(marked (gnus-info-marks info))
(active (gnus-active group)))
(and info active
- (gnus-list-range-difference
- (gnus-list-range-difference
+ (range-list-difference
+ (range-list-difference
(gnus-sorted-complement
- (gnus-uncompress-range
+ (range-uncompress
(if gnus-newsgroup-maximum-articles
(cons (max (car active)
(- (cdr active)
@@ -7142,12 +7048,11 @@ The prefix argument ALL means to select all articles."
(when group
(when gnus-newsgroup-kill-headers
(setq gnus-newsgroup-killed
- (gnus-compress-sequence
+ (range-compress-list
(gnus-sorted-union
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-unselected gnus-newsgroup-killed)
- gnus-newsgroup-unreads)
- t)))
+ gnus-newsgroup-unreads))))
(unless (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
(let ((headers gnus-newsgroup-headers)
@@ -7208,7 +7113,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-dribble-save)))
(declare-function gnus-cache-write-active "gnus-cache" (&optional force))
-(declare-function gnus-article-stop-animations "gnus-art" ())
(defun gnus-summary-exit (&optional temporary leave-hidden)
"Exit reading current newsgroup, and then return to group selection mode.
@@ -7272,7 +7176,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(not (string= group (gnus-group-group-name))))
(gnus-group-next-unread-group 1))
(setq group-point (point))
- (gnus-article-stop-animations)
(unless leave-hidden
(gnus-configure-windows 'group 'force))
(if temporary
@@ -7332,7 +7235,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
- (gnus-article-stop-animations)
(gnus-stop-downloads)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
@@ -7364,7 +7266,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-group-update-group group nil t))
(when (gnus-group-goto-group group)
(gnus-group-next-unread-group 1))
- (gnus-article-stop-animations)
(when quit-config
(gnus-handle-ephemeral-exit quit-config)))))
@@ -8067,9 +7968,7 @@ Return nil if there are no unread articles."
Return nil if there are no unread articles."
(interactive nil gnus-summary-mode)
(prog1
- (when (gnus-summary-first-subject t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject t))
+ (gnus-summary--goto-and-possibly-unhide t)
(gnus-summary-position-point)))
(defun gnus-summary-next-unseen-article (&optional backward)
@@ -8103,23 +8002,27 @@ Return nil if there are no unread articles."
Return nil if there are no unseen articles."
(interactive nil gnus-summary-mode)
(prog1
- (when (gnus-summary-first-subject nil nil t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject nil nil t))
+ (gnus-summary--goto-and-possibly-unhide)
(gnus-summary-position-point)))
+(defun gnus-summary--goto-and-possibly-unhide (&optional unread undownloaded
+ unseen)
+ (let ((first (gnus-summary-first-subject unread undownloaded unseen)))
+ (if (and first
+ (not (= first (gnus-summary-article-number))))
+ (progn
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject unread undownloaded unseen))
+ first)))
+
(defun gnus-summary-first-unseen-or-unread-subject ()
"Place the point on the subject line of the first unseen and unread article.
If all articles have been seen, on the subject line of the first unread
article."
(interactive nil gnus-summary-mode)
(prog1
- (unless (when (gnus-summary-first-subject nil nil t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject nil nil t))
- (when (gnus-summary-first-subject t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject t)))
+ (unless (gnus-summary--goto-and-possibly-unhide nil nil t)
+ (gnus-summary-first-subject t))
(gnus-summary-position-point)))
(defun gnus-summary-first-article ()
@@ -8673,20 +8576,20 @@ these articles."
(gnus-fetch-old-headers nil)
(gnus-build-sparse-threads nil))
(prog1
- (gnus-summary-limit (if thread-only articles
- (nconc articles gnus-newsgroup-limit)))
- (gnus-summary-limit-include-matching-articles
- "subject"
- (regexp-quote (gnus-general-simplify-subject
- (mail-header-subject (gnus-id-to-header id)))))
- ;; the previous two calls each push a limit onto the limit
- ;; stack. the first pop remove the articles that match the
- ;; subject, while the second pop gets us back to the state
- ;; before we started to deal with the thread. presumably we want
- ;; to think of the thread and its associated subject matches as
- ;; a single thing so that we need to pop only once to get back
- ;; to the original view.
- (pop gnus-newsgroup-limits)
+ (gnus-summary-limit (if thread-only articles
+ (nconc articles gnus-newsgroup-limit)))
+ (let ((matching-subject (gnus-general-simplify-subject
+ (mail-header-subject (gnus-id-to-header id)))))
+ (when matching-subject
+ (gnus-summary-limit-include-matching-articles
+ "subject"
+ (regexp-quote matching-subject))
+ ;; Each of the previous two limit calls push a limit onto
+ ;; the limit stack. Presumably we want to think of the
+ ;; thread and its associated subject matches as a single
+ ;; thing so we probably want a single pop to restore the
+ ;; original view. Hence we pop this last limit off.
+ (pop gnus-newsgroup-limits)))
(gnus-summary-position-point))))
(defun gnus-summary-limit-include-matching-articles (header regexp)
@@ -9462,6 +9365,16 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
(push primary urls))
(delete-dups urls)))
+(defun gnus-collect-urls-from-article ()
+ "Select the article and return the list of URLs in it.
+See `gnus-collect-urls'."
+ (gnus-summary-select-article)
+ (gnus-with-article-buffer
+ (article-goto-body)
+ ;; Back up a char, in case body starts with a button.
+ (backward-char)
+ (gnus-collect-urls)))
+
(defun gnus-shorten-url (url max)
"Return an excerpt from URL not exceeding MAX characters."
(if (<= (length url) max)
@@ -9477,33 +9390,27 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
"Scan the current article body for links, and offer to browse them.
Links are opened using `browse-url' unless a prefix argument is
-given: Then `browse-url-secondary-browser-function' is used instead.
+given: then `browse-url-secondary-browser-function' is used instead.
If only one link is found, browse that directly, otherwise use
completion to select a link. The first link marked in the
article text with `gnus-collect-urls-primary-text' is the
default."
(interactive "P" gnus-summary-mode)
- (let (urls target)
- (gnus-summary-select-article)
- (gnus-with-article-buffer
- (article-goto-body)
- ;; Back up a char, in case body starts with a button.
- (backward-char)
- (setq urls (gnus-collect-urls))
- (setq target
- (cond ((= (length urls) 1)
- (car urls))
- ((> (length urls) 1)
- (completing-read
- (format-prompt "URL to browse"
- (gnus-shorten-url (car urls) 40))
- urls nil t nil nil (car urls)))))
- (if target
- (if external
- (funcall browse-url-secondary-browser-function target)
- (browse-url target))
- (message "No URLs found.")))))
+ (let* ((urls (gnus-collect-urls-from-article))
+ (target
+ (cond ((= (length urls) 1)
+ (car urls))
+ ((> (length urls) 1)
+ (completing-read
+ (format-prompt "URL to browse"
+ (gnus-shorten-url (car urls) 40))
+ urls nil t nil nil (car urls))))))
+ (if target
+ (if external
+ (funcall browse-url-secondary-browser-function target)
+ (browse-url target))
+ (message "No URLs found."))))
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
@@ -9908,7 +9815,6 @@ article. Normally, the keystroke is `\\[universal-argument] \\[gnus-summary-sho
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
- (gnus-article-stop-animations)
(gnus-stop-downloads)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
@@ -10257,8 +10163,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(cdr art-group))
(push 'read to-marks)
(setf (gnus-info-read info)
- (gnus-add-to-range (gnus-info-read info)
- (list (cdr art-group)))))
+ (range-add-list (gnus-info-read info)
+ (list (cdr art-group)))))
;; See whether the article is to be put in the cache.
(let* ((expirable (gnus-group-auto-expirable-p to-group))
@@ -10501,7 +10407,6 @@ latter case, they will be copied into the relevant groups."
"Create an article in a mail newsgroup."
(interactive nil gnus-summary-mode)
(let ((group gnus-newsgroup-name)
- (now (current-time))
group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
(error "%s does not support article importing" group))
@@ -10511,7 +10416,7 @@ latter case, they will be copied into the relevant groups."
;; This doesn't look like an article, so we fudge some headers.
(insert "From: " (read-string "From: ") "\n"
"Subject: " (read-string "Subject: ") "\n"
- "Date: " (message-make-date now) "\n"
+ "Date: " (message-make-date) "\n"
"Message-ID: " (message-make-message-id) "\n")
(setq group-art (gnus-request-accept-article group nil t))
(kill-buffer (current-buffer)))
@@ -10542,7 +10447,7 @@ This will be the case if the article has both been mailed and posted."
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable
- (gnus-list-range-difference
+ (range-list-difference
(if total
(progn
;; We need to update the info for
@@ -11915,7 +11820,8 @@ Returns nil if no threads were there to be hidden."
(beginning-of-line)
(let ((start (point))
(starteol (line-end-position))
- (article (gnus-summary-article-number)))
+ (article (unless (gnus-summary-article-intangible-p)
+ (gnus-summary-article-number))))
;; Go forward until either the buffer ends or the subthread ends.
(when (and (not (eobp))
(or (zerop (gnus-summary-next-thread 1 t))
@@ -11929,7 +11835,9 @@ Returns nil if no threads were there to be hidden."
(let ((ol (make-overlay starteol (point) nil t nil)))
(overlay-put ol 'invisible 'gnus-sum)
(overlay-put ol 'evaporate t)))
- (gnus-summary-goto-subject article)
+ (if article
+ (gnus-summary-goto-subject article)
+ (gnus-summary-position-point))
;; We moved backward past the start point (invisible thread?)
(when (> start (point))
(goto-char starteol)))
@@ -12888,8 +12796,8 @@ UNREAD is a sorted list."
(gnus-find-method-for-group group)
'server-marks)
(gnus-check-backend-function 'request-set-mark group))
- (let ((del (gnus-remove-from-range (gnus-info-read info) read))
- (add (gnus-remove-from-range read (gnus-info-read info))))
+ (let ((del (range-remove (gnus-info-read info) read))
+ (add (range-remove read (gnus-info-read info))))
(when (or add del)
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
@@ -13147,10 +13055,10 @@ If ALL is a number, fetch this number of articles."
;; Some nntp servers lie about their active range. When
;; this happens, the active range can be in the millions.
;; Use a compressed range to avoid creating a huge list.
- (gnus-range-difference
- (gnus-range-difference (list gnus-newsgroup-active) old)
+ (range-difference
+ (range-difference (list gnus-newsgroup-active) old)
gnus-newsgroup-unexist))
- (setq len (gnus-range-length older))
+ (setq len (range-length older))
(cond
((null older) nil)
((numberp all)
@@ -13167,9 +13075,9 @@ If ALL is a number, fetch this number of articles."
(push max older)
(setq all (1- all)
max (1- max))))))
- (setq older (gnus-uncompress-range older))))
+ (setq older (range-uncompress older))))
(all
- (setq older (gnus-uncompress-range older)))
+ (setq older (range-uncompress older)))
(t
(when (and (numberp gnus-large-newsgroup)
(> len gnus-large-newsgroup))
@@ -13204,7 +13112,7 @@ If ALL is a number, fetch this number of articles."
(push max older)
(setq all (1- all)
max (1- max))))))))))
- (setq older (gnus-uncompress-range older))))
+ (setq older (range-uncompress older))))
(if (not older)
(message "No old news.")
(gnus-summary-insert-articles older)
@@ -13294,6 +13202,8 @@ BOOKMARK is a bookmark name or a bookmark record."
(buffer . ,(current-buffer))
. ,(bookmark-get-bookmark-record bookmark)))))
+(put 'gnus-summary-bookmark-jump 'bookmark-handler-type "Gnus")
+
(gnus-summary-make-all-marking-commands)
(provide 'gnus-sum)
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 9493b02d062..fa942bee8e8 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -650,6 +650,7 @@ articles in the topic and its subtopics."
(let* ((visible (if visiblep "" "..."))
(level level)
(name name)
+ (entries entries)
(indentation (make-string (* gnus-topic-indent-level level) ? ))
(total-number-of-articles unread)
(number-of-groups (length entries))
@@ -677,7 +678,7 @@ articles in the topic and its subtopics."
(defun gnus-topic-update-topics-containing-group (group)
"Update all topics that have GROUP as a member."
- (when (and (eq major-mode 'gnus-topic-mode)
+ (when (and (derived-mode-p 'gnus-group-mode)
gnus-topic-mode)
(save-excursion
(let ((alist gnus-topic-alist))
@@ -693,7 +694,7 @@ articles in the topic and its subtopics."
(defun gnus-topic-update-topic ()
"Update all parent topics to the current group."
- (when (and (eq major-mode 'gnus-topic-mode)
+ (when (and (derived-mode-p 'gnus-group-mode)
gnus-topic-mode)
(let ((group (gnus-group-group-name))
(m (point-marker))
@@ -747,8 +748,8 @@ articles in the topic and its subtopics."
(car type) (car gnus-group-list-mode)
(cdr gnus-group-list-mode)))
(all-groups (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode) nil t))
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode) nil t))
entry)
(while children
(cl-incf unread (gnus-topic-unread (caar (pop children)))))
@@ -787,8 +788,8 @@ articles in the topic and its subtopics."
(car type) (car gnus-group-list-mode)
(cdr gnus-group-list-mode)))
(all-groups (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode) t))
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode) nil t))
(parent (gnus-topic-parent-topic topic-name))
(all-entries entries)
(unread 0)
@@ -1056,63 +1057,56 @@ articles in the topic and its subtopics."
;;; Topic mode, commands and keymap.
-(defvar gnus-topic-mode-map nil)
-(defvar gnus-group-topic-map nil)
-
-(unless gnus-topic-mode-map
- (setq gnus-topic-mode-map (make-sparse-keymap))
-
+(defvar-keymap gnus-topic-mode-map
;; Override certain group mode keys.
- (gnus-define-keys gnus-topic-mode-map
- "=" gnus-topic-select-group
- "\r" gnus-topic-select-group
- " " gnus-topic-read-group
- "\C-c\C-x" gnus-topic-expire-articles
- "c" gnus-topic-catchup-articles
- "\C-k" gnus-topic-kill-group
- "\C-y" gnus-topic-yank-group
- "\M-g" gnus-topic-get-new-news-this-topic
- "AT" gnus-topic-list-active
- "Gp" gnus-topic-edit-parameters
- "#" gnus-topic-mark-topic
- "\M-#" gnus-topic-unmark-topic
- [tab] gnus-topic-indent
- [(meta tab)] gnus-topic-unindent
- "\C-i" gnus-topic-indent
- "\M-\C-i" gnus-topic-unindent
- [mouse-2] gnus-mouse-pick-topic)
-
- ;; Define a new submap.
- (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map)
- "#" gnus-topic-mark-topic
- "\M-#" gnus-topic-unmark-topic
- "n" gnus-topic-create-topic
- "m" gnus-topic-move-group
- "D" gnus-topic-remove-group
- "c" gnus-topic-copy-group
- "h" gnus-topic-hide-topic
- "s" gnus-topic-show-topic
- "j" gnus-topic-jump-to-topic
- "M" gnus-topic-move-matching
- "C" gnus-topic-copy-matching
- "\M-p" gnus-topic-goto-previous-topic
- "\M-n" gnus-topic-goto-next-topic
- "\C-i" gnus-topic-indent
- [tab] gnus-topic-indent
- "r" gnus-topic-rename
- "\177" gnus-topic-delete
- [delete] gnus-topic-delete
- "H" gnus-topic-toggle-display-empty-topics)
-
- (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map)
- "s" gnus-topic-sort-groups
- "a" gnus-topic-sort-groups-by-alphabet
- "u" gnus-topic-sort-groups-by-unread
- "l" gnus-topic-sort-groups-by-level
- "e" gnus-topic-sort-groups-by-server
- "v" gnus-topic-sort-groups-by-score
- "r" gnus-topic-sort-groups-by-rank
- "m" gnus-topic-sort-groups-by-method))
+ "=" #'gnus-topic-select-group
+ "RET" #'gnus-topic-select-group
+ "SPC" #'gnus-topic-read-group
+ "C-c C-x" #'gnus-topic-expire-articles
+ "c" #'gnus-topic-catchup-articles
+ "C-k" #'gnus-topic-kill-group
+ "C-y" #'gnus-topic-yank-group
+ "M-g" #'gnus-topic-get-new-news-this-topic
+ "A T" #'gnus-topic-list-active
+ "G p" #'gnus-topic-edit-parameters
+ "#" #'gnus-topic-mark-topic
+ "M-#" #'gnus-topic-unmark-topic
+ "<tab>" #'gnus-topic-indent
+ "M-<tab>" #'gnus-topic-unindent
+ "TAB" #'gnus-topic-indent
+ "C-M-i" #'gnus-topic-unindent
+ "<mouse-2>" #'gnus-mouse-pick-topic
+
+ "T" (define-keymap :prefix 'gnus-group-topic-map
+ "#" #'gnus-topic-mark-topic
+ "M-#" #'gnus-topic-unmark-topic
+ "n" #'gnus-topic-create-topic
+ "m" #'gnus-topic-move-group
+ "D" #'gnus-topic-remove-group
+ "c" #'gnus-topic-copy-group
+ "h" #'gnus-topic-hide-topic
+ "s" #'gnus-topic-show-topic
+ "j" #'gnus-topic-jump-to-topic
+ "M" #'gnus-topic-move-matching
+ "C" #'gnus-topic-copy-matching
+ "M-p" #'gnus-topic-goto-previous-topic
+ "M-n" #'gnus-topic-goto-next-topic
+ "TAB" #'gnus-topic-indent
+ "<tab>" #'gnus-topic-indent
+ "r" #'gnus-topic-rename
+ "DEL" #'gnus-topic-delete
+ "<delete>" #'gnus-topic-delete
+ "H" #'gnus-topic-toggle-display-empty-topics
+
+ "S" (define-keymap :prefix 'gnus-topic-sort-map
+ "s" #'gnus-topic-sort-groups
+ "a" #'gnus-topic-sort-groups-by-alphabet
+ "u" #'gnus-topic-sort-groups-by-unread
+ "l" #'gnus-topic-sort-groups-by-level
+ "e" #'gnus-topic-sort-groups-by-server
+ "v" #'gnus-topic-sort-groups-by-score
+ "r" #'gnus-topic-sort-groups-by-rank
+ "m" #'gnus-topic-sort-groups-by-method)))
(defun gnus-topic-make-menu-bar ()
(unless (boundp 'gnus-topic-menu)
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index 406d0a51d52..8c2be7b07e4 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -75,15 +75,12 @@
;;; Minor mode definition.
-(defvar gnus-undo-mode-map
- (let ((map (make-sparse-keymap)))
- (gnus-define-keys map
- "\M-\C-_" gnus-undo
- "\C-_" gnus-undo
- "\C-xu" gnus-undo
- ;; Many people are used to type `C-/' on GUI frames and get `C-_'.
- [(control /)] gnus-undo)
- map))
+(defvar-keymap gnus-undo-mode-map
+ "C-M-_" #'gnus-undo
+ "C-_" #'gnus-undo
+ "C-x u" #'gnus-undo
+ ;; many people are used to type `C-/' on GUI frames and get `C-_'.
+ "C-/" #'gnus-undo)
(defun gnus-undo-make-menu-bar ()
;; This is disabled for the time being.
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 662817255bb..218a4d242b2 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -300,25 +300,26 @@ Symbols are also allowed; their print names are used instead."
(defmacro gnus-local-set-keys (&rest plist)
"Set the keys in PLIST in the current keymap."
- (declare (indent 1))
+ (declare (obsolete define-keymap "29.1") (indent 1))
`(gnus-define-keys-1 (current-local-map) ',plist))
(defmacro gnus-define-keys (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
- (declare (indent 1))
+ (declare (obsolete define-keymap "29.1") (indent 1))
`(gnus-define-keys-1 ,(if (symbolp keymap) keymap `',keymap) (quote ,plist)))
(defmacro gnus-define-keys-safe (keymap &rest plist)
"Define all keys in PLIST in KEYMAP without overwriting previous definitions."
- (declare (indent 1))
+ (declare (obsolete define-keymap "29.1") (indent 1))
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
(defmacro gnus-define-keymap (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
- (declare (indent 1))
+ (declare (obsolete define-keymap "29.1") (indent 1))
`(gnus-define-keys-1 ,keymap (quote ,plist)))
(defun gnus-define-keys-1 (keymap plist &optional safe)
+ (declare (obsolete define-keymap "29.1"))
(when (null keymap)
(error "Can't set keys in a null keymap"))
(cond ((symbolp keymap) (error "First arg should be a keymap object"))
@@ -561,7 +562,7 @@ If N, return the Nth ancestor instead."
buffer))
(define-obsolete-function-alias 'gnus-buffer-exists-p
- 'gnus-buffer-live-p "27.1")
+ #'gnus-buffer-live-p "27.1")
(defun gnus-horizontal-recenter ()
"Recenter the current buffer horizontally."
@@ -679,7 +680,7 @@ yield \"nnimap:yxa\"."
(defun gnus-turn-off-edit-menu (type)
"Turn off edit menu in `gnus-TYPE-mode-map'."
(define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
- [menu-bar edit] 'undefined))
+ [menu-bar edit] #'undefined))
(defvar print-string-length)
@@ -857,126 +858,9 @@ variables and then do only the assignment atomically."
`(let ((inhibit-quit gnus-atomic-be-safe))
,@forms))
-;;; Functions for saving to babyl/mail files.
-
-(require 'rmail)
-(autoload 'rmail-update-summary "rmailsum")
-
(defvar mm-text-coding-system)
-
(declare-function mm-append-to-file "mm-util"
(start end filename &optional codesys inhibit))
-(declare-function rmail-swap-buffers-maybe "rmail" ())
-(declare-function rmail-maybe-set-message-counters "rmail" ())
-(declare-function rmail-count-new-messages "rmail" (&optional nomsg))
-(declare-function rmail-summary-exists "rmail" ())
-(declare-function rmail-show-message "rmail" (&optional n no-summary))
-;; Macroexpansion of rmail-select-summary:
-(declare-function rmail-summary-displayed "rmail" ())
-(declare-function rmail-pop-to-buffer "rmail" (&rest args))
-(declare-function rmail-maybe-display-summary "rmail" ())
-
-(defun gnus-output-to-rmail (filename &optional ask)
- "Append the current article to an Rmail file named FILENAME.
-In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless
-FILENAME exists and is Babyl format."
- (require 'rmail)
- (require 'mm-util)
- (require 'nnmail)
- ;; Some of this codes is borrowed from rmailout.el.
- (setq filename (expand-file-name filename))
- ;; FIXME should we really be messing with this defcustom?
- ;; It is not needed for the operation of this function.
- (if (boundp 'rmail-default-rmail-file)
- (setq rmail-default-rmail-file filename) ; 22
- (setq rmail-default-file filename)) ; 23
- (let ((artbuf (current-buffer))
- (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))
- ;; Babyl rmail.el defines this, mbox does not.
- (babyl (fboundp 'rmail-insert-rmail-file-header)))
- (save-excursion
- ;; Note that we ignore the possibility of visiting a Babyl
- ;; format buffer in Emacs 23, since Rmail no longer supports that.
- (or (get-file-buffer filename)
- (progn
- ;; In case someone wants to write to a Babyl file from Emacs 23.
- (when (file-exists-p filename)
- (setq babyl (mail-file-babyl-p filename))
- t))
- (if (or (not ask)
- (gnus-yes-or-no-p
- (concat "\"" filename "\" does not exist, create it? ")))
- (let ((file-buffer (create-file-buffer filename)))
- (with-current-buffer file-buffer
- (if (fboundp 'rmail-insert-rmail-file-header)
- (rmail-insert-rmail-file-header))
- (let ((require-final-newline nil)
- (coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer filename)))
- (kill-buffer file-buffer))
- (error "Output file does not exist")))
- (set-buffer tmpbuf)
- (erase-buffer)
- (insert-buffer-substring artbuf)
- (if babyl
- (gnus-convert-article-to-rmail)
- ;; Non-Babyl case copied from gnus-output-to-mail.
- (goto-char (point-min))
- (if (looking-at "From ")
- (forward-line 1)
- (insert "From nobody " (current-time-string) "\n"))
- (let (case-fold-search)
- (while (re-search-forward "^From " nil t)
- (beginning-of-line)
- (insert ">"))))
- ;; Decide whether to append to a file or to an Emacs buffer.
- (let ((outbuf (get-file-buffer filename)))
- (if (not outbuf)
- (progn
- (unless babyl ; from gnus-output-to-mail
- (let ((buffer-read-only nil))
- (goto-char (point-max))
- (forward-char -2)
- (unless (looking-at "\n\n")
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert "\n"))))
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (mm-append-to-file (point-min) (point-max) filename)))
- ;; File has been visited, in buffer OUTBUF.
- (set-buffer outbuf)
- (let ((buffer-read-only nil)
- (msg (and (boundp 'rmail-current-message)
- (symbol-value 'rmail-current-message))))
- ;; If MSG is non-nil, buffer is in RMAIL mode.
- ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23.
- (when msg
- (unless babyl
- (rmail-swap-buffers-maybe)
- (rmail-maybe-set-message-counters))
- (widen)
- (unless babyl
- (goto-char (point-max))
- ;; Ensure we have a blank line before the next message.
- (unless (bolp)
- (insert "\n"))
- (insert "\n"))
- (narrow-to-region (point-max) (point-max)))
- (insert-buffer-substring tmpbuf)
- (when msg
- (when babyl
- (goto-char (point-min))
- (widen)
- (search-backward "\n\^_")
- (narrow-to-region (point) (point-max)))
- (rmail-count-new-messages t)
- (when (rmail-summary-exists)
- (rmail-select-summary
- (rmail-update-summary)))
- (rmail-show-message msg))
- (save-buffer)))))
- (kill-buffer tmpbuf)))
(defun gnus-output-to-mail (filename &optional ask)
"Append the current article to a mail file named FILENAME."
@@ -1034,17 +918,6 @@ FILENAME exists and is Babyl format."
(insert-buffer-substring tmpbuf)))))
(kill-buffer tmpbuf)))
-(defun gnus-convert-article-to-rmail ()
- "Convert article in current buffer to Rmail message format."
- (let ((buffer-read-only nil))
- ;; Convert article directly into Babyl format.
- (goto-char (point-min))
- (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
- (while (search-forward "\n\^_" nil t) ;single char
- (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
- (goto-char (point-max))
- (insert "\^_")))
-
(defun gnus-map-function (funs arg)
"Apply the result of the first function in FUNS to the second, and so on.
ARG is passed to the first function."
@@ -1081,9 +954,9 @@ ARG is passed to the first function."
(with-current-buffer gnus-group-buffer
(eq major-mode 'gnus-group-mode))))
-(define-obsolete-function-alias 'gnus-remove-if 'seq-remove "27.1")
+(define-obsolete-function-alias 'gnus-remove-if #'seq-remove "27.1")
-(define-obsolete-function-alias 'gnus-remove-if-not 'seq-filter "27.1")
+(define-obsolete-function-alias 'gnus-remove-if-not #'seq-filter "27.1")
(defun gnus-grep-in-list (word list)
"Find if a WORD matches any regular expression in the given LIST."
@@ -1218,9 +1091,10 @@ ARG is passed to the first function."
(defun gnus-byte-compile (form)
"Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
(if gnus-use-byte-compile
- (let ((byte-compile-warnings '(unresolved callargs redefine)))
+ (let ((byte-compile-warnings '(unresolved callargs redefine))
+ (lexical-binding t))
(byte-compile form))
- form))
+ (eval form t)))
(defun gnus-remassoc (key alist)
"Delete by side effect any elements of LIST whose car is `equal' to KEY.
@@ -1310,9 +1184,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
initial-input history def)
"Call `gnus-completing-read-function'."
(funcall gnus-completing-read-function
- (concat prompt (when def
- (concat " (default " def ")"))
- ": ")
+ (format-prompt prompt def)
collection require-match initial-input history def))
(defun gnus-emacs-completing-read (prompt collection &optional require-match
@@ -1676,6 +1548,11 @@ lists of strings."
(while overlays
(delete-overlay (pop overlays)))))
+;; This function used to live in this file, but was moved to a
+;; separate file to avoid pulling in rmail.el when requiring
+;; gnus-util.
+(autoload 'gnus-output-to-rmail "gnus-rmail")
+
(provide 'gnus-util)
;;; gnus-util.el ends here
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index ad7062d84bd..7eea08f1744 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -662,12 +662,11 @@ be used directly.")
(gnus-prune-buffers)
(cl-pushnew (current-buffer) gnus-buffers))
-(defmacro gnus-kill-buffer (buffer)
+(defun gnus-kill-buffer (buffer)
"Kill BUFFER and remove from the list of Gnus buffers."
- `(let ((buf ,buffer))
- (when (gnus-buffer-live-p buf)
- (kill-buffer buf)
- (gnus-prune-buffers))))
+ (when (gnus-buffer-live-p buffer)
+ (kill-buffer buffer)
+ (gnus-prune-buffers)))
(defun gnus-buffers ()
"Return a list of live Gnus buffers."
@@ -1131,16 +1130,6 @@ you could set this variable:
:group 'gnus-server
:type '(repeat gnus-select-method))
-(defcustom gnus-local-domain nil
- "Local domain name without a host name.
-The DOMAINNAME environment variable is used instead if it is defined.
-If the function `system-name' returns the full Internet name, there is
-no need to set this variable."
- :group 'gnus-message
- :type '(choice (const :tag "default" nil)
- string))
-(make-obsolete-variable 'gnus-local-domain nil "24.1")
-
;; Customization variables
(defcustom gnus-refer-article-method 'current
@@ -1467,11 +1456,11 @@ address was listed in gnus-group-split Addresses (see below).")
:variable-group gnus-group-parameter
:parameter-type '(gnus-email-address :tag "To List")
:parameter-document "\
-This address will be used when doing a `a' in the group.
+This address will be used when doing a \\`a' in the group.
It is totally ignored when doing a followup--except that if it is
present in a news group, you'll get mail group semantics when doing
-`f'.
+\\`f'.
The gnus-group-split mail splitting mechanism will behave as if this
address was listed in gnus-group-split Addresses (see below).")
@@ -1592,7 +1581,7 @@ posting an article."
"Alist of group regexps and its initial input of the number of articles."
:variable-group gnus-group-parameter
:parameter-type '(choice :tag "Initial Input for Large Newsgroup"
- (const :tag "All" 'all)
+ (const :tag "All" all)
(integer))
:parameter-document "\
@@ -2264,12 +2253,12 @@ a string, be sure to use a valid format, see RFC 2616."
:version "22.1"
:group 'gnus-message
:type '(choice (list (set :inline t
- (const gnus :tag "Gnus version")
- (const emacs :tag "Emacs version")
+ (const :value gnus :tag "Gnus version")
+ (const :value emacs :tag "Emacs version")
(choice :tag "system"
- (const type :tag "system type")
- (const config :tag "system configuration"))
- (const codename :tag "Emacs codename")))
+ (const :value type :tag "system type")
+ (const :value config :tag "system configuration"))
+ (const :value codename :tag "Emacs codename")))
(string)))
;; Convert old (< 2005-01-10) symbol type values:
@@ -2317,11 +2306,6 @@ automatically cache the article in the agent cache."
(defvar gnus-server-method-cache nil)
(defvar gnus-extended-servers nil)
-;; The carpal mode has been removed, but define the variable for
-;; backwards compatibility.
-(defvar gnus-carpal nil)
-(make-obsolete-variable 'gnus-carpal nil "24.1")
-
(defvar gnus-agent-fetching nil
"Whether Gnus agent is in fetching mode.")
@@ -2528,16 +2512,9 @@ are always t.")
("babel" babel-as-string)
("nnmail" nnmail-split-fancy nnmail-article-group)
("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
- ;; This is only used in message.el, which has an autoload.
- ("rmailout" rmail-output)
- ;; Next two used in gnus-util, which has autoloads, and contrib/sendmail.
- ("rmail" rmail-count-new-messages rmail-show-message
- ;; Next two only used in gnus-util.
- rmail-summary-exists rmail-select-summary)
- ;; Only used in gnus-util, which has an autoload.
- ("rmailsum" rmail-update-summary)
("gnus-xmas" gnus-xmas-splash)
("score-mode" :interactive t gnus-score-mode)
+ ("gnus-score" :interactive t gnus-score-edit-all-score)
("gnus-mh" gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder)
@@ -2609,7 +2586,11 @@ are always t.")
gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
gnus-uu-decode-binhex-view gnus-uu-unmark-thread
- gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable)
+ gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable
+ gnus-uu-decode-postscript-and-save-view
+ gnus-uu-decode-postscript-view gnus-uu-decode-postscript-and-save
+ gnus-uu-decode-yenc gnus-uu-unmark-by-regexp gnus-uu-unmark-region
+ gnus-uu-decode-postscript)
("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
("gnus-msg" (gnus-summary-send-map keymap)
gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
@@ -2656,6 +2637,7 @@ are always t.")
gnus-article-hide-headers gnus-article-hide-boring-headers
gnus-article-treat-overstrike
gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
+ gnus-article-emojize-symbols
gnus-article-display-x-face gnus-article-de-quoted-unreadable
gnus-article-de-base64-unreadable
gnus-article-decode-HZ
@@ -2667,7 +2649,34 @@ are always t.")
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done gnus-article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer
- gnus-mime-view-all-parts)
+ gnus-mime-view-all-parts gnus-article-pipe-part
+ gnus-article-inline-part gnus-article-encrypt-body
+ gnus-article-browse-html-article gnus-article-view-part-externally
+ gnus-article-view-part-as-charset gnus-article-copy-part
+ gnus-article-jump-to-part gnus-article-view-part-as-type
+ gnus-article-delete-part gnus-article-replace-part
+ gnus-article-save-part-and-strip gnus-article-save-part
+ gnus-article-remove-leading-whitespace gnus-article-strip-trailing-space
+ gnus-article-strip-leading-space gnus-article-strip-all-blank-lines
+ gnus-article-strip-blank-lines gnus-article-strip-multiple-blank-lines
+ gnus-article-date-user gnus-article-date-iso8601
+ gnus-article-date-english gnus-article-date-ut
+ gnus-article-decode-charset gnus-article-decode-mime-words
+ gnus-article-toggle-fonts gnus-article-show-images
+ gnus-article-remove-images gnus-article-display-face
+ gnus-article-treat-fold-newsgroups gnus-article-treat-unfold-headers
+ gnus-article-treat-fold-headers gnus-article-highlight-signature
+ gnus-article-highlight-headers gnus-article-highlight
+ gnus-article-strip-banner gnus-article-hide-list-identifiers
+ gnus-article-hide gnus-article-outlook-rearrange-citation
+ gnus-article-treat-non-ascii gnus-article-treat-smartquotes
+ gnus-article-verify-x-pgp-sig gnus-article-strip-headers-in-body
+ gnus-treat-smiley gnus-article-treat-ansi-sequences
+ gnus-article-capitalize-sentences gnus-article-toggle-truncate-lines
+ gnus-article-fill-long-lines gnus-article-emphasize
+ gnus-article-add-buttons-to-head gnus-article-add-button
+ gnus-article-babel gnus-sticky-article gnus-article-view-part
+ gnus-article-add-buttons)
("gnus-int" gnus-request-type)
("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
gnus-dribble-enter gnus-read-init-file gnus-dribble-touch
@@ -3118,9 +3127,9 @@ g -- Group name."
"Check whether GROUP supports function FUNC.
GROUP can either be a string (a group name) or a select method."
(ignore-errors
- (let ((method (if (stringp group)
- (car (gnus-find-method-for-group group))
- group)))
+ (when-let ((method (if (stringp group)
+ (car (gnus-find-method-for-group group))
+ group)))
(unless (featurep method)
(require method))
(fboundp (intern (format "%s-%s" method func))))))
@@ -3754,6 +3763,8 @@ just the host name."
(setq foreign server
group (substring group (+ 1 colon))))
(setq foreign (concat foreign ":")))
+ ;; Remove braces from name (common in IMAP groups).
+ (setq group (replace-regexp-in-string "[][]+" "" group))
;; Collapse group name leaving LEVELS uncollapsed elements
(let* ((slist (split-string group "/"))
(slen (length slist))
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index a0edbf6a2ad..320bc9c3b0e 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -31,6 +31,7 @@
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
(require 'mm-util)
+(require 'gnus-range)
(require 'message) ;; for `message-directory'
(defvar display-time-mail-function)
@@ -224,12 +225,9 @@ Leave mails for this many days" :value 14)))))
(const :format "" :value :plugged)
(boolean :tag "Plugged"))))))))
-(defcustom mail-source-ignore-errors nil
- "Ignore errors when querying mail sources.
-If nil, the user will be prompted when an error occurs. If non-nil,
-the error will be ignored."
- :version "22.1"
- :type 'boolean)
+(make-obsolete-variable 'mail-source-ignore-errors
+ "configure `gnus-verbose' instead"
+ "29.1")
(defcustom mail-source-primary-source nil
"Primary source for incoming mail.
@@ -415,7 +413,7 @@ the `mail-source-keyword-map' variable."
(let* ((type (pop source))
(defaults (cdr (assq type mail-source-keyword-map)))
(search '(:max 1))
- found default value keyword user-auth pass-auth) ;; auth-info
+ found default keyword user-auth pass-auth) ;; auth-info
;; append to the search the useful info from the source and the defaults:
;; user, host, and port
@@ -442,22 +440,22 @@ the `mail-source-keyword-map' variable."
;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL
;; using `mail-source-value' to evaluate the plist value
(set (mail-source-strip-keyword (setq keyword (car default)))
- ;; note the following reasons for this structure:
+ ;; Note the following reasons for this structure:
;; 1) the auth-sources user and password override everything
;; 2) it avoids macros, so it's cleaner
;; 3) it falls through to the mail-sources and then default values
(cond
((and
- (eq keyword :user)
- (setq user-auth
- (plist-get
- ;; cache the search result in `found'
- (or found
- (setq found (nth 0 (apply #'auth-source-search
- search))))
- :user)))
+ (eq keyword :user)
+ (setq user-auth
+ (plist-get
+ ;; cache the search result in `found'
+ (or found
+ (setq found (nth 0 (apply #'auth-source-search
+ search))))
+ :user)))
user-auth)
- ((and
+ ((and ; cf. 'auth-source-pick-first-password'
(eq keyword :password)
(setq pass-auth
(plist-get
@@ -470,9 +468,8 @@ the `mail-source-keyword-map' variable."
(if (functionp pass-auth)
(setq pass-auth (funcall pass-auth))
pass-auth))
- (t (if (setq value (plist-get source keyword))
- (mail-source-value value)
- (mail-source-value (cadr default)))))))))
+ (t (mail-source-value (or (plist-get source keyword)
+ (cadr default)))))))))
(eval-and-compile
(defun mail-source-bind-common-1 ()
@@ -554,18 +551,16 @@ Return the number of files that were found."
(condition-case err
(funcall function source callback)
(error
- (if (and (not mail-source-ignore-errors)
- (not
- (yes-or-no-p
- (format "Mail source %s error (%s). Continue? "
+ (gnus-error
+ 5
+ (format "Mail source %s error (%s)"
(if (memq ':password source)
(let ((s (copy-sequence source)))
(setcar (cdr (memq ':password s))
"********")
s)
source)
- (cadr err)))))
- (error "Cannot get new mail"))
+ (cadr err)))
0)))))))))
(declare-function gnus-message "gnus-util" (level &rest args))
@@ -1053,8 +1048,6 @@ This only works when `display-time' is enabled."
(autoload 'imap-range-to-message-set "imap")
(autoload 'nnheader-ms-strip-cr "nnheader")
-(autoload 'gnus-compress-sequence "gnus-range")
-
(defvar mail-source-imap-file-coding-system 'binary
"Coding system for the crashbox made by `mail-source-fetch-imap'.")
@@ -1072,9 +1065,7 @@ This only works when `display-time' is enabled."
(let ((from (format "%s:%s:%s" server user port))
(found 0)
(buf (generate-new-buffer " *imap source*"))
- (mail-source-string (format "imap:%s:%s" server mailbox))
- (imap-shell-program (or (list program) imap-shell-program))
- remove)
+ (imap-shell-program (or (list program) imap-shell-program)))
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
user (or (cdr (assoc from mail-source-password-cache))
@@ -1083,8 +1074,10 @@ This only works when `display-time' is enabled."
(let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
(dolist (mailbox mailbox-list)
(when (imap-mailbox-select mailbox nil buf)
- (let ((coding-system-for-write mail-source-imap-file-coding-system)
- str)
+ (let ((coding-system-for-write
+ mail-source-imap-file-coding-system)
+ (mail-source-string (format "imap:%s:%s" server mailbox))
+ str remove)
(message "Fetching from %s..." mailbox)
(with-temp-file mail-source-crash-box
;; Avoid converting 8-bit chars from inserted strings to
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index cbaa74d61cf..7c2b24c6eee 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -48,6 +48,9 @@
(require 'puny)
(require 'rmc) ; read-multiple-choice
(require 'subr-x)
+(require 'yank-media)
+(require 'mailcap)
+(require 'sendmail)
(autoload 'mailclient-send-it "mailclient")
@@ -714,7 +717,7 @@ The function accepts 1 parameter which is the matched prefix."
(defvar sendmail-program)
(cond ((executable-find sendmail-program)
#'message-send-mail-with-sendmail)
- ((bound-and-true-p 'smtpmail-default-smtp-server)
+ ((bound-and-true-p smtpmail-default-smtp-server)
#'message-smtpmail-send-it)
(t
#'message-send-mail-with-mailclient)))
@@ -1408,7 +1411,7 @@ text and it replaces `self-insert-command' with the other command, e.g.
(file-name-as-directory (expand-file-name "drafts" message-directory))
"~/")
"Directory where Message auto-saves buffers if Gnus isn't running.
-If nil, Message won't auto-save."
+If nil, Message won't auto-save, whether or not Gnus is running."
:group 'message-buffers
:link '(custom-manual "(message)Various Message Variables")
:type '(choice directory (const :tag "Don't auto-save" nil)))
@@ -1465,11 +1468,11 @@ candidates:
(memq feature message-shoot-gnksa-feet)))
(defcustom message-hidden-headers '("^References:" "^Face:" "^X-Face:"
- "^X-Draft-From:")
+ "^X-Draft-From:" "^In-Reply-To:")
"Regexp of headers to be hidden when composing new messages.
This can also be a list of regexps to match headers. Or a list
starting with `not' and followed by regexps."
- :version "22.1"
+ :version "29.1"
:group 'message
:link '(custom-manual "(message)Message Headers")
:type '(choice
@@ -2051,7 +2054,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
(autoload 'gnus-groups-from-server "gnus")
(autoload 'gnus-open-server "gnus-int")
(autoload 'gnus-output-to-mail "gnus-util")
-(autoload 'gnus-output-to-rmail "gnus-util")
+(autoload 'gnus-output-to-rmail "gnus-rmail")
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-server-string "gnus")
(autoload 'message-setup-toolbar "messagexmas")
@@ -2870,84 +2873,78 @@ Consider adding this function to `message-header-setup-hook'"
;;; Set up keymap.
-(defvar message-mode-map nil)
-
-(unless message-mode-map
- (setq message-mode-map (make-keymap))
- (set-keymap-parent message-mode-map text-mode-map)
- (define-key message-mode-map "\C-c?" #'describe-mode)
-
- (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to)
- (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from)
- (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc)
- (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc)
- (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc)
- (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject)
- (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to)
- (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups)
- (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution)
- (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords)
- (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary)
- (define-key message-mode-map "\C-c\C-f\C-i"
- #'message-insert-or-toggle-importance)
- (define-key message-mode-map "\C-c\C-f\C-a"
- #'message-generate-unsubscribed-mail-followup-to)
+(defvar-keymap message-mode-map
+ :full t :parent text-mode-map
+ :doc "Message Mode keymap."
+ "C-c ?" #'describe-mode
+
+ "C-c C-f C-t" #'message-goto-to
+ "C-c C-f C-o" #'message-goto-from
+ "C-c C-f C-b" #'message-goto-bcc
+ "C-c C-f C-w" #'message-goto-fcc
+ "C-c C-f C-c" #'message-goto-cc
+ "C-c C-f C-s" #'message-goto-subject
+ "C-c C-f C-r" #'message-goto-reply-to
+ "C-c C-f C-n" #'message-goto-newsgroups
+ "C-c C-f C-d" #'message-goto-distribution
+ "C-c C-f C-f" #'message-goto-followup-to
+ "C-c C-f C-m" #'message-goto-mail-followup-to
+ "C-c C-f C-k" #'message-goto-keywords
+ "C-c C-f C-u" #'message-goto-summary
+ "C-c C-f C-i" #'message-insert-or-toggle-importance
+ "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to
;; modify headers (and insert notes in body)
- (define-key message-mode-map "\C-c\C-fs" #'message-change-subject)
+ "C-c C-f s" #'message-change-subject
;;
- (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to)
+ "C-c C-f x" #'message-cross-post-followup-to
;; prefix+message-cross-post-followup-to = same w/o cross-post
- (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc)
- (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header)
+ "C-c C-f t" #'message-reduce-to-to-cc
+ "C-c C-f a" #'message-add-archive-header
;; mark inserted text
- (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region)
- (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file)
-
- (define-key message-mode-map "\C-c\C-b" #'message-goto-body)
- (define-key message-mode-map "\C-c\C-i" #'message-goto-signature)
-
- (define-key message-mode-map "\C-c\C-t" #'message-insert-to)
- (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply)
- (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups)
- (define-key message-mode-map "\C-c\C-l" #'message-to-list-only)
- (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires)
-
- (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance)
- (define-key message-mode-map "\C-c\M-n"
- #'message-insert-disposition-notification-to)
-
- (define-key message-mode-map "\C-c\C-y" #'message-yank-original)
- (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer)
- (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message)
- (define-key message-mode-map "\C-c\C-w" #'message-insert-signature)
- (define-key message-mode-map "\C-c\M-h" #'message-insert-headers)
- (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body)
- (define-key message-mode-map "\C-c\C-o" #'message-sort-headers)
- (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer)
-
- (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit)
- (define-key message-mode-map "\C-c\C-s" #'message-send)
- (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer)
- (define-key message-mode-map "\C-c\C-d" #'message-dont-send)
- (define-key message-mode-map "\C-c\n" #'gnus-delay-article)
-
- (define-key message-mode-map "\C-c\M-k" #'message-kill-address)
- (define-key message-mode-map "\C-c\C-e" #'message-elide-region)
- (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region)
- (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature)
- (define-key message-mode-map "\M-\r" #'message-newline-and-reformat)
- (define-key message-mode-map [remap split-line] #'message-split-line)
-
- (define-key message-mode-map "\C-c\C-a" #'mml-attach-file)
- (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot)
-
- (define-key message-mode-map "\C-a" #'message-beginning-of-line)
- (define-key message-mode-map "\t" #'message-tab)
-
- (define-key message-mode-map "\M-n" #'message-display-abbrev))
+ "C-c M-m" #'message-mark-inserted-region
+ "C-c M-f" #'message-mark-insert-file
+
+ "C-c C-b" #'message-goto-body
+ "C-c C-i" #'message-goto-signature
+
+ "C-c C-t" #'message-insert-to
+ "C-c C-f w" #'message-insert-wide-reply
+ "C-c C-n" #'message-insert-newsgroups
+ "C-c C-l" #'message-to-list-only
+ "C-c C-f C-e" #'message-insert-expires
+ "C-c C-u" #'message-insert-or-toggle-importance
+ "C-c M-n" #'message-insert-disposition-notification-to
+
+ "C-c C-y" #'message-yank-original
+ "C-c C-M-y" #'message-yank-buffer
+ "C-c C-q" #'message-fill-yanked-message
+ "C-c C-w" #'message-insert-signature
+ "C-c M-h" #'message-insert-headers
+ "C-c C-r" #'message-caesar-buffer-body
+ "C-c C-o" #'message-sort-headers
+ "C-c M-r" #'message-rename-buffer
+
+ "C-c C-c" #'message-send-and-exit
+ "C-c C-s" #'message-send
+ "C-c C-k" #'message-kill-buffer
+ "C-c C-d" #'message-dont-send
+ "C-c C-j" #'gnus-delay-article
+
+ "C-c M-k" #'message-kill-address
+ "C-c C-e" #'message-elide-region
+ "C-c C-v" #'message-delete-not-region
+ "C-c C-z" #'message-kill-to-signature
+ "M-RET" #'message-newline-and-reformat
+ "<remap> <split-line>" #'message-split-line
+
+ "C-c C-a" #'mml-attach-file
+ "C-c C-p" #'message-insert-screenshot
+
+ "C-a" #'message-beginning-of-line
+ "TAB" #'message-tab
+
+ "M-n" #'message-display-abbrev)
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
@@ -3161,6 +3158,7 @@ Like `text-mode', but with these additional commands:
(setq-local message-checksum nil)
(setq-local message-mime-part 0)
(message-setup-fill-variables)
+ (yank-media-handler "image/.*" #'message--yank-media-image-handler)
(when message-fill-column
(setq fill-column message-fill-column)
(turn-on-auto-fill))
@@ -3182,8 +3180,7 @@ Like `text-mode', but with these additional commands:
(mail-abbrevs-setup))
((message-mail-alias-type-p 'ecomplete)
(ecomplete-setup)))
- ;; FIXME: merge the completion tables from ecomplete/bbdb/...?
- ;;(add-hook 'completion-at-point-functions #'message-ecomplete-capf nil t)
+ (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t)
(add-hook 'completion-at-point-functions #'message-completion-function nil t)
(unless buffer-file-name
(message-set-auto-save-file-name))
@@ -4338,6 +4335,48 @@ Instead, just auto-save the buffer and then bury it."
(autoload 'mml-secure-bcc-is-safe "mml-sec")
+(defcustom message-server-alist nil
+ "Alist of rules to generate \"X-Message-SMTP-Method\" header.
+The header will be inserted just before the message is sent.
+Elements should be of the form (COND . METHOD).
+If COND is a string, METHOD will be inserted if the \"From\"
+address compares equal with COND.
+If COND is a function, METHOD will be inserted if COND returns
+a non-nil value when called in the message buffer without any
+arguments. If METHOD is nil in this case, the return value of
+the function will be inserted instead.
+If the buffer already has a\"X-Message-SMTP-Method\" header,
+it is left unchanged."
+ :type '(alist :key-type '(choice
+ (string :tag "From Address")
+ (function :tag "Predicate"))
+ :value-type 'string)
+ :version "29.1"
+ :group 'message-sending)
+
+(defun message-update-smtp-method-header ()
+ "Insert an X-Message-SMTP-Method header according to `message-server-alist'."
+ (unless (message-fetch-field "X-Message-SMTP-Method")
+ (let ((from (cadr (mail-extract-address-components
+ (save-restriction
+ (widen)
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "From")))))
+ method)
+ (catch 'exit
+ (dolist (server message-server-alist)
+ (cond ((functionp (car server))
+ (let ((res (funcall (car server))))
+ (when res
+ (setq method (or (cdr server) res))
+ (throw 'exit nil))))
+ ((and (stringp (car server))
+ (string= (car server) from))
+ (setq method (cdr server))
+ (throw 'exit nil)))))
+ (when method
+ (message-add-header (concat "X-Message-SMTP-Method: " method))))))
+
(defun message-send (&optional arg)
"Send the message in the current buffer.
If `message-interactive' is non-nil, wait for success indication or
@@ -4351,6 +4390,7 @@ It should typically alter the sending method in some way or other."
(undo-boundary)
(let ((inhibit-read-only t))
(put-text-property (point-min) (point-max) 'read-only nil))
+ (message-update-smtp-method-header)
(message-fix-before-sending)
(run-hooks 'message-send-hook)
(mml-secure-bcc-is-safe)
@@ -4766,23 +4806,25 @@ Valid types are `send', `return', `exit', `kill' and `postpone'."
t
"\
The message size, "
- (/ (buffer-size) 1000) "KB, is too large.
+ (/ (buffer-size) 1000)
+ (substitute-command-keys "KB, is too large.
Some mail gateways (MTA's) bounce large messages. To avoid the
-problem, answer `y', and the message will be split into several
-smaller pieces, the size of each is about "
+problem, answer \\`y', and the message will be split into several
+smaller pieces, the size of each is about ")
(/ message-send-mail-partially-limit 1000)
- "KB except the last
+ (substitute-command-keys
+ "KB except the last
one.
However, some mail readers (MUA's) can't read split messages, i.e.,
-mails in message/partially format. Answer `n', and the message
+mails in message/partially format. Answer \\`n', and the message
will be sent in one piece.
The size limit is controlled by `message-send-mail-partially-limit'.
If you always want Gnus to send messages in one piece, set
`message-send-mail-partially-limit' to nil.
-")))
+"))))
(progn
(message "Sending via mail...")
(if message-send-mail-real-function
@@ -4863,7 +4905,18 @@ If you always want Gnus to send messages in one piece, set
(message-generate-headers '(Lines)))
;; Remove some headers.
(message-remove-header message-ignored-mail-headers t)
- (mail-encode-encoded-word-buffer))
+ (mail-encode-encoded-word-buffer)
+ ;; Then check for suspicious addresses.
+ (dolist (hdr '("To" "Cc" "Bcc"))
+ (let ((addr (message-fetch-field hdr)))
+ (when (stringp addr)
+ (dolist (address (mail-header-parse-addresses addr t))
+ (when-let ((warning (textsec-suspicious-p
+ address 'email-address-header)))
+ (unless (y-or-n-p
+ (format "Suspicious address: %s; send anyway?"
+ warning))
+ (user-error "Suspicious address %s" address))))))))
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
@@ -5358,7 +5411,7 @@ Otherwise, generate and save a value for `canlock-password' first."
(zerop
(length
(setq to (completing-read
- "Followups to (default no Followup-To header): "
+ (format-prompt "Followups to" "no Followup-To header")
(mapcar #'list
(cons "poster"
(message-tokenize-header
@@ -5829,15 +5882,15 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
;; You might for example insert a "." somewhere (not next to another dot
;; or string boundary), or modify the "fsf" string.
(defun message-unique-id ()
- ;; Don't use microseconds from (current-time), they may be unsupported.
+ ;; Don't use fractional seconds from timestamp; they may be unsupported.
;; Instead we use this randomly inited counter.
(setq message-unique-id-char
- (% (1+ (or message-unique-id-char
- (random (ash 1 20))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (current-time)))
+ ;; 2^16 * 25 just fits into 4 digits i base 36.
+ (let ((base (* 25 25)))
+ (if message-unique-id-char
+ (% (1+ message-unique-id-char) base)
+ (random base))))
+ (let ((tm (time-convert nil 'integer)))
(concat
(if (or (eq system-type 'ms-dos)
;; message-number-base36 doesn't handle bigints.
@@ -5847,10 +5900,12 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
(aset user (match-beginning 0) ?_))
user)
(message-number-base36 (user-uid) -1))
- (message-number-base36 (+ (car tm)
- (ash (% message-unique-id-char 25) 16)) 4)
- (message-number-base36 (+ (nth 1 tm)
- (ash (/ message-unique-id-char 25) 16)) 4)
+ (message-number-base36 (+ (ash tm -16)
+ (ash (% message-unique-id-char 25) 16))
+ 4)
+ (message-number-base36 (+ (logand tm #xffff)
+ (ash (/ message-unique-id-char 25) 16))
+ 4)
;; Append a given name, because while the generated ID is unique
;; to this newsreader, other newsreaders might otherwise generate
;; the same ID via another algorithm.
@@ -5947,12 +6002,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
(defun message-make-expires ()
"Return an Expires header based on `message-expires'."
- (let ((current (current-time))
- (future (* 1.0 message-expires 60 60 24)))
+ (let ((future (* 60 60 24 message-expires)))
;; Add the future to current.
- (setcar current (+ (car current) (round (/ future (expt 2 16)))))
- (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
- (message-make-date current)))
+ (message-make-date (time-add nil future))))
(defun message-make-path ()
"Return uucp path."
@@ -6829,13 +6881,14 @@ are not included."
(or (bolp) (insert ?\n)))
(insert (concat mail-header-separator "\n"))
(forward-line -1)
- ;; If a crash happens while replying, the auto-save file would *not* have a
- ;; `References:' header if `message-generate-headers-first' was nil.
- ;; Therefore, always generate it first.
+ ;; If a crash happens while replying, the auto-save file would *not*
+ ;; have a `References:' header if `message-generate-headers-first'
+ ;; was nil. Therefore, always generate it first. (And why not
+ ;; include the `In-Reply-To' header as well.)
(let ((message-generate-headers-first
(if (eq message-generate-headers-first t)
t
- (append message-generate-headers-first '(References)))))
+ (append message-generate-headers-first '(References In-Reply-To)))))
(when (message-news-p)
(when message-default-news-headers
(insert message-default-news-headers)
@@ -6965,7 +7018,15 @@ is a function used to switch to and display the mail buffer."
;; https://lists.gnu.org/r/emacs-devel/2011-01/msg00337.html
;; We need to convert any string input, eg from rmail-start-mail.
(dolist (h other-headers other-headers)
- (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
+ (when (stringp (car h))
+ (setcar h (intern (capitalize (car h)))))
+ ;; Firefox sends us In-Reply-To headers that are Message-IDs
+ ;; without <> around them. Fix that.
+ (when (and (eq (car h) 'In-Reply-To)
+ ;; Looks like a Message-ID.
+ (string-match-p "\\`[^ @]+@[^ @]+\\'" (cdr h))
+ (not (string-match-p "\\`<.*>\\'" (cdr h))))
+ (setcdr h (concat "<" (cdr h) ">")))))
yank-action send-actions continue switch-function
return-action))))
@@ -7964,7 +8025,18 @@ is for the internal use."
(select-safe-coding-system-function nil)
message-required-mail-headers
message-generate-hashcash
- rfc2047-encode-encoded-words)
+ rfc2047-encode-encoded-words
+ ;; If `message-sendmail-envelope-from' is `header' then
+ ;; the envelope-from will be the original sender's
+ ;; address, not the resender's. But when resending, the
+ ;; envelope-from should be the resender's address. Defuse
+ ;; that particular case.
+ (message-sendmail-envelope-from
+ (and (not (and (eq message-sendmail-envelope-from
+ 'obey-mail-envelope-from)
+ (eq mail-envelope-from 'header)))
+ (not (eq message-sendmail-envelope-from 'header))
+ message-sendmail-envelope-from)))
(message-send-mail))
(when gcc
(message-goto-eoh)
@@ -8103,39 +8175,7 @@ which specify the range to operate on."
;; Support for toolbar
(defvar tool-bar-mode)
-;; Note: The :set function in the `message-tool-bar*' variables will only
-;; affect _new_ message buffers. We might add a function that walks thru all
-;; message-mode buffers and force the update.
-(defun message-tool-bar-update (&optional symbol value)
- "Update message mode toolbar.
-Setter function for custom variables."
- (setq-default message-tool-bar-map nil)
- (when symbol
- ;; When used as ":set" function:
- (set-default symbol value)))
-
-(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome)
- 'message-tool-bar-gnome
- 'message-tool-bar-retro)
- "Specifies the message mode tool bar.
-
-It can be either a list or a symbol referring to a list. See
-`gmm-tool-bar-from-list' for the format of the list. The
-default key map is `message-mode-map'.
-
-Pre-defined symbols include `message-tool-bar-gnome' and
-`message-tool-bar-retro'."
- :type '(repeat gmm-tool-bar-list-item)
- :type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
- (const :tag "Retro look" message-tool-bar-retro)
- (repeat :tag "User defined list" gmm-tool-bar-item)
- (symbol))
- :version "23.1" ;; No Gnus
- :initialize #'custom-initialize-default
- :set #'message-tool-bar-update
- :group 'message)
-
-(defcustom message-tool-bar-gnome
+(defcustom message-tool-bar
'((ispell-message "spell" nil
:vert-only t
:visible (not flyspell-mode))
@@ -8151,47 +8191,23 @@ Pre-defined symbols include `message-tool-bar-gnome' and
(message-insert-importance-high "important" nil :visible nil)
(message-insert-importance-low "unimportant" nil :visible nil)
(message-insert-disposition-notification-to "receipt" nil :visible nil))
- "List of items for the message tool bar (GNOME style).
-
-See `gmm-tool-bar-from-list' for details on the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "23.1" ;; No Gnus
- :initialize #'custom-initialize-default
- :set #'message-tool-bar-update
- :group 'message)
+ "Specifies the message mode tool bar.
-(defcustom message-tool-bar-retro
- '(;; Old Emacs 21 icon for consistency.
- (message-send-and-exit "mail/send")
- (message-kill-buffer "close")
- (message-dont-send "cancel")
- (mml-attach-file "attach" mml-mode-map)
- (ispell-message "spell")
- (mml-preview "preview" mml-mode-map)
- (message-insert-importance-high "gnus/important")
- (message-insert-importance-low "gnus/unimportant")
- (message-insert-disposition-notification-to "gnus/receipt"))
- "List of items for the message tool bar (retro style).
-
-See `gmm-tool-bar-from-list' for details on the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "23.1" ;; No Gnus
- :initialize #'custom-initialize-default
- :set #'message-tool-bar-update
+It can be either a list or a symbol referring to a list. See
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `message-mode-map'."
+ :type '(repeat gmm-tool-bar-list-item)
+ :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "29.1"
:group 'message)
-(defcustom message-tool-bar-zap-list
- '(new-file open-file dired kill-buffer write-file
- print-buffer customize help)
- "List of icon items from the global tool bar.
-These items are not displayed on the message mode tool bar.
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type 'gmm-tool-bar-zap-list
- :version "23.1" ;; No Gnus
- :initialize #'custom-initialize-default
- :set #'message-tool-bar-update
- :group 'message)
+(defvar message-tool-bar-gnome nil)
+(make-obsolete-variable 'message-tool-bar-gnome nil "29.1")
+(defvar message-tool-bar-retro nil)
+(make-obsolete-variable 'message-tool-bar-gnome nil "29.1")
+(defvar message-tool-bar-zap-list t)
+(make-obsolete-variable 'message-tool-bar-zap-list nil "29.1")
(defvar image-load-path)
(declare-function image-load-path-for-library "image"
@@ -8213,17 +8229,23 @@ When FORCE, rebuild the tool bar."
'message-mode-map))))
message-tool-bar-map)
-;;; Group name completion.
+;;; Group name and email address completion.
(defcustom message-newgroups-header-regexp
"^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
- "Regexp that match headers that lists groups."
+ "Regexp matching headers that list groups."
:group 'message
:type 'regexp)
+(defcustom message-email-recipient-header-regexp
+ "^\\([^ :]*-\\)?\\(To\\|B?Cc\\|From\\|Reply-to\\|Mail-Followup-To\\|Mail-Copies-To\\):"
+ "Regexp matching headers that list email addresses."
+ :version "29.1"
+ :type 'regexp)
+
(defcustom message-completion-alist
`((,message-newgroups-header-regexp . ,#'message-expand-group)
- ("^\\([^ :]*-\\)?\\(To\\|B?Cc\\|From\\):" . ,#'message-expand-name))
+ (,message-email-recipient-header-regexp . ,#'message-expand-name))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE.
FUN should be a function that obeys the same rules as those
of `completion-at-point-functions'."
@@ -8317,7 +8339,11 @@ regular text mode tabbing command."
(defcustom message-expand-name-standard-ui nil
"If non-nil, use the standard completion UI in `message-expand-name'.
-E.g. this means it will obey `completion-styles' and other such settings."
+E.g. this means it will obey `completion-styles' and other such settings.
+
+If this variable is non-nil and `message-mail-alias-type' is
+`ecomplete', `message-self-insert-commands' should probably be
+set to nil."
:version "27.1"
:type 'boolean)
@@ -8346,7 +8372,8 @@ E.g. this means it will obey `completion-styles' and other such settings."
(t
(expand-abbrev))))
-(add-to-list 'completion-category-defaults '(email (styles substring)))
+(add-to-list 'completion-category-defaults '(email (styles substring
+ partial-completion)))
(defun message--bbdb-query-with-words (words)
;; FIXME: This (or something like this) should live on the BBDB side.
@@ -8569,26 +8596,23 @@ From headers in the original article."
message-hidden-headers))
(inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
- (end-of-headers (point-min)))
+ end-of-headers)
(when regexps
(save-excursion
(save-restriction
(message-narrow-to-headers)
+ (setq end-of-headers (point-min-marker))
(goto-char (point-min))
(while (not (eobp))
(if (not (message-hide-header-p regexps))
(message-next-header)
- (let ((begin (point))
- header header-len)
+ (let ((begin (point)))
(message-next-header)
- (setq header (buffer-substring begin (point))
- header-len (- (point) begin))
- (delete-region begin (point))
- (goto-char end-of-headers)
- (insert header)
- (setq end-of-headers
- (+ end-of-headers header-len))))))))
- (narrow-to-region end-of-headers (point-max))))
+ (let ((header (delete-and-extract-region begin (point))))
+ (save-excursion
+ (goto-char end-of-headers)
+ (insert-before-markers header))))))))
+ (narrow-to-region end-of-headers (point-max)))))
(defun message-hide-header-p (regexps)
(let ((result nil)
@@ -8879,24 +8903,29 @@ used to take the screenshot."
(car message-screenshot-command) nil (current-buffer) nil
(cdr message-screenshot-command))
(buffer-string))))
- (set-mark (point))
- (insert-image
- (create-image image 'png t
- :max-width (truncate (* (frame-pixel-width) 0.8))
- :max-height (truncate (* (frame-pixel-height) 0.8))
- :scale 1)
- (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>"
- ;; Get a base64 version of the image -- this avoids later
- ;; complications if we're auto-saving the buffer and
- ;; restoring from a file.
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert image)
- (base64-encode-region (point-min) (point-max) t)
- (buffer-string))))
- (insert "\n\n")
+ (message--yank-media-image-handler 'image/png image)
(message "")))
+(defun message--yank-media-image-handler (type image)
+ (set-mark (point))
+ (insert-image
+ (create-image image (mailcap-mime-type-to-extension type) t
+ :max-width (truncate (* (frame-pixel-width) 0.8))
+ :max-height (truncate (* (frame-pixel-height) 0.8))
+ :scale 1)
+ (format "<#part type=\"%s\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>"
+ type
+ ;; Get a base64 version of the image -- this avoids later
+ ;; complications if we're auto-saving the buffer and
+ ;; restoring from a file.
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert image)
+ (base64-encode-region (point-min) (point-max) t)
+ (buffer-string)))
+ nil nil t)
+ (insert "\n\n"))
+
(declare-function gnus-url-unhex-string "gnus-util")
(defun message-parse-mailto-url (url)
@@ -8932,7 +8961,7 @@ used to take the screenshot."
This is meant to be used for MIME handlers: Setting the handler
for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
will then start up Emacs ready to compose mail. For emacsclient use
- emacsclient -e '(message-mailto \"%u\")'"
+ emacsclient -e \\='(message-mailto \"%u\")'"
(interactive)
;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a>
(message-mail)
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 956449dac14..9045966df5a 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -191,19 +191,21 @@ If TYPE is `text/plain' CRLF->LF translation may occur."
((eq encoding 'base64)
(base64-decode-region
(point-min)
- ;; Some mailers insert whitespace
- ;; junk at the end which
- ;; base64-decode-region dislikes.
- ;; Also remove possible junk which could
- ;; have been added by mailing list software.
(save-excursion
+ ;; Some mailers insert whitespace junk at the end which
+ ;; base64-decode-region dislikes.
(goto-char (point-min))
(while (re-search-forward "^[\t ]*\r?\n" nil t)
(delete-region (match-beginning 0) (match-end 0)))
+ ;; Also ignore junk which could have been added by
+ ;; mailing list software by finding the final line with
+ ;; base64 text.
(goto-char (point-max))
- (when (re-search-backward "^[\t ]*[A-Za-z0-9+/]+=*[\t ]*$"
- nil t)
- (forward-line))
+ (beginning-of-line)
+ (while (and (not (mm-base64-line-p))
+ (not (bobp)))
+ (forward-line -1))
+ (forward-line 1)
(point))))
((memq encoding '(nil 7bit 8bit binary))
;; Do nothing.
@@ -236,6 +238,20 @@ If TYPE is `text/plain' CRLF->LF translation may occur."
(while (search-forward "\r\n" nil t)
(replace-match "\n" t t)))))
+(defun mm-base64-line-p ()
+ "Say whether the current line is base64."
+ ;; This is coded in this way to avoid using regexps that may
+ ;; overflow -- a base64 line may be megabytes long.
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (and (looking-at "[A-Za-z0-9+/]\\{3\\}")
+ (progn
+ (skip-chars-forward "A-Za-z0-9+/")
+ (skip-chars-forward "=")
+ (skip-chars-forward " \t")
+ (eolp)))))
+
(defun mm-decode-body (charset &optional encoding type)
"Decode the current article that has been encoded with ENCODING to CHARSET.
ENCODING is a MIME content transfer encoding.
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index e04423ce377..7256e5a2f7c 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -446,10 +446,11 @@ If not set, `default-directory' will be used."
:type 'integer
:group 'mime-display)
-(defcustom mm-external-terminal-program "xterm"
- "The program to start an external terminal."
- :version "22.1"
- :type 'string
+(defcustom mm-external-terminal-program '("xterm" "-e")
+ "The program to start an external terminal.
+This should be a list of strings."
+ :version "29.1"
+ :type '(choice string (repeat string))
:group 'mime-display)
;;; Internal variables.
@@ -473,6 +474,7 @@ The file will be saved in the directory `mm-tmp-directory'.")
(autoload 'mml2015-verify-test "mml2015")
(autoload 'mml-smime-verify "mml-smime")
(autoload 'mml-smime-verify-test "mml-smime")
+(autoload 'mm-view-pkcs7-verify "mm-view")
(defvar mm-verify-function-alist
'(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
@@ -481,7 +483,15 @@ The file will be saved in the directory `mm-tmp-directory'.")
("application/pkcs7-signature" mml-smime-verify "S/MIME"
mml-smime-verify-test)
("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
- mml-smime-verify-test)))
+ mml-smime-verify-test)
+ ("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
+ mml-smime-verify-test)
+ ;; these are only used for security-buttons and contain the
+ ;; smime-type after the underscore
+ ("application/pkcs7-mime_signed-data" mm-view-pkcs7-verify "S/MIME"
+ nil)
+ ("application/x-pkcs7-mime_signed-data" mml-view-pkcs7-verify "S/MIME"
+ nil)))
(defcustom mm-verify-option 'never
"Option of verifying signed parts.
@@ -500,11 +510,17 @@ result of the verification."
(autoload 'mml2015-decrypt "mml2015")
(autoload 'mml2015-decrypt-test "mml2015")
+(autoload 'mm-view-pkcs7-decrypt "mm-view")
(defvar mm-decrypt-function-alist
'(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)
("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP"
- mm-uu-pgp-encrypted-test)))
+ mm-uu-pgp-encrypted-test)
+ ;; these are only used for security-buttons and contain the
+ ;; smime-type after the underscore
+ ("application/pkcs7-mime_enveloped-data" mm-view-pkcs7-decrypt "S/MIME" nil)
+ ("application/x-pkcs7-mime_enveloped-data"
+ mm-view-pkcs7-decrypt "S/MIME" nil)))
(defcustom mm-decrypt-option nil
"Option of decrypting encrypted parts.
@@ -681,18 +697,35 @@ MIME-Version header before proceeding."
'start start)
(car ctl))
(cons (car ctl) (mm-dissect-multipart ctl from))))
- (t
- (mm-possibly-verify-or-decrypt
- (mm-dissect-singlepart
- ctl
- (and cte (intern (downcase (mail-header-strip-cte cte))))
- no-strict-mime
- (and cd (mail-header-parse-content-disposition cd))
- description id)
- ctl from))))
- (when id
- (when (string-match " *<\\(.*\\)> *" id)
- (setq id (match-string 1 id)))
+ (t
+ (let* ((handle
+ (mm-dissect-singlepart
+ ctl
+ (and cte (intern (downcase (mail-header-strip-cte cte))))
+ no-strict-mime
+ (and cd (mail-header-parse-content-disposition cd))
+ description id))
+ (intermediate-result
+ (mm-possibly-verify-or-decrypt handle ctl from)))
+ (when (and (equal type "application")
+ (or (equal subtype "pkcs7-mime")
+ (equal subtype "x-pkcs7-mime")))
+ (add-text-properties
+ 0 (length (car ctl))
+ (list 'protocol
+ (concat (substring-no-properties (car ctl))
+ "_"
+ (cdr (assoc 'smime-type ctl))))
+ (car ctl))
+ ;; If this is a pkcs7-mime lets treat this special and
+ ;; more like multipart so the pkcs7-mime part does not
+ ;; get ignored.
+ (setq intermediate-result
+ (cons (car ctl) (list intermediate-result))))
+ intermediate-result))))
+ (when id
+ (when (string-match " *<\\(.*\\)> *" id)
+ (setq id (match-string 1 id)))
(push (cons id result) mm-content-id-alist))
result))))
@@ -957,10 +990,16 @@ external if displayed external."
(unwind-protect
(if window-system
(set-process-sentinel
- (start-process "*display*" nil
- mm-external-terminal-program
- "-e" shell-file-name
- shell-command-switch command)
+ (apply #'start-process "*display*" nil
+ (append
+ (if (listp mm-external-terminal-program)
+ mm-external-terminal-program
+ ;; Be backwards-compatible.
+ (list mm-external-terminal-program
+ "-e"))
+ (list shell-file-name
+ shell-command-switch
+ command)))
(lambda (process _state)
(if (eq 'exit (process-status process))
(run-at-time
@@ -1670,43 +1709,40 @@ If RECURSIVE, search recursively."
(cond
((or (equal type "application/x-pkcs7-mime")
(equal type "application/pkcs7-mime"))
- (with-temp-buffer
- (when (and (cond
- ((equal smime-type "signed-data") t)
- ((eq mm-decrypt-option 'never) nil)
- ((eq mm-decrypt-option 'always) t)
- ((eq mm-decrypt-option 'known) t)
- (t (y-or-n-p "Decrypt (S/MIME) part? ")))
- (mm-view-pkcs7 parts from))
- (goto-char (point-min))
- ;; The encrypted document is a MIME part, and may use either
- ;; CRLF (Outlook and the like) or newlines for end-of-line
- ;; markers. Translate from CRLF.
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
- ;; Normally there will be a Content-type header here, but
- ;; some mailers don't add that to the encrypted part, which
- ;; makes the subsequent re-dissection fail here.
- (save-restriction
- (mail-narrow-to-head)
- (unless (mail-fetch-field "content-type")
- (goto-char (point-max))
- (insert "Content-type: text/plain\n\n")))
- (setq parts
- (if (equal smime-type "signed-data")
- (list (propertize
- "multipart/signed"
- 'protocol "application/pkcs7-signature"
- 'gnus-info
- (format
- "%s:%s"
- (get-text-property 0 'gnus-info
- (car mm-security-handle))
- (get-text-property 0 'gnus-details
- (car mm-security-handle))))
- (mm-dissect-buffer t)
- parts)
- (mm-dissect-buffer t))))))
+ (add-text-properties 0 (length (car ctl))
+ (list 'buffer (car parts))
+ (car ctl))
+ (let* ((envelope-p (string= smime-type "enveloped-data"))
+ (decrypt-or-verify-option (if envelope-p
+ mm-decrypt-option
+ mm-verify-option))
+ (question (if envelope-p
+ "Decrypt (S/MIME) part? "
+ "Verify signed (S/MIME) part? ")))
+ (with-temp-buffer
+ (when (and (cond
+ ((equal smime-type "signed-data") t)
+ ((eq decrypt-or-verify-option 'never) nil)
+ ((eq decrypt-or-verify-option 'always) t)
+ ((eq decrypt-or-verify-option 'known) t)
+ (t (y-or-n-p (format question))))
+ (mm-view-pkcs7 parts from))
+
+ (goto-char (point-min))
+ ;; The encrypted document is a MIME part, and may use either
+ ;; CRLF (Outlook and the like) or newlines for end-of-line
+ ;; markers. Translate from CRLF.
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ ;; Normally there will be a Content-type header here, but
+ ;; some mailers don't add that to the encrypted part, which
+ ;; makes the subsequent re-dissection fail here.
+ (save-restriction
+ (mail-narrow-to-head)
+ (unless (mail-fetch-field "content-type")
+ (goto-char (point-max))
+ (insert "Content-type: text/plain\n\n")))
+ (setq parts (mm-dissect-buffer t))))))
((equal subtype "signed")
(unless (and (setq protocol
(mm-handle-multipart-ctl-parameter ctl 'protocol))
@@ -1833,7 +1869,7 @@ If RECURSIVE, search recursively."
;; Require since we bind its variables.
(require 'shr)
(let ((shr-width (if shr-use-fonts
- nil
+ shr-width
fill-column))
(shr-content-function (lambda (id)
(let ((handle (mm-get-content-id id)))
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index 0910748ab50..e4d686ac837 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -34,8 +34,6 @@
(require 'gnus)
(defvar url-current-object)
-(defvar url-package-name)
-(defvar url-package-version)
(defgroup mm-url nil
"A wrapper of url package and external url command for Gnus."
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 3c529dbea0f..727e3abfffc 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -31,7 +31,7 @@
(defun mm-ucs-to-char (codepoint)
"Convert Unicode codepoint to character."
- (or (decode-char 'ucs codepoint) ?#))
+ (or codepoint ?#))
(defvar mm-coding-system-list nil)
(defun mm-get-coding-system-list ()
@@ -101,9 +101,9 @@ version, you could use `autoload-coding-system' here."
:type '(list (repeat :inline t
:tag "Other options"
(cons (symbol :tag "charset")
- (symbol :tag "form"))))
+ (symbol :tag "form"))))
+ :risky t
:group 'mime)
-(put 'mm-charset-eval-alist 'risky-local-variable t)
(defvar mm-charset-override-alist)
@@ -315,8 +315,7 @@ Valid elements include:
"ISO-8859-15 exchangeable coding systems and inconvertible characters.")
(defvar mm-iso-8859-x-to-15-table
- (and (fboundp 'coding-system-p)
- (mm-coding-system-p 'iso-8859-15)
+ (and (mm-coding-system-p 'iso-8859-15)
(mapcar
(lambda (cs)
(if (mm-coding-system-p (car cs))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 44c744b068b..57ce36a9442 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -504,8 +504,6 @@ If MODE is not set, try to find mode automatically."
(setq coding-system (mm-find-buffer-file-coding-system)))
(setq text (buffer-string))))
(with-temp-buffer
- (buffer-disable-undo)
- (mm-enable-multibyte)
(insert (cond ((eq charset 'gnus-decoded)
(with-current-buffer (mm-handle-buffer handle)
(buffer-string)))
@@ -521,17 +519,17 @@ If MODE is not set, try to find mode automatically."
;; setting now, but it seems harmless and potentially still useful.
(setq-local font-lock-mode-hook nil)
(setq buffer-file-name (mm-handle-filename handle))
- (with-demoted-errors
- (if mode
- (save-window-excursion
- ;; According to Katsumi Yamaoka <yamaoka@jpl.org>, org-mode
- ;; requires the buffer to be temporarily displayed here, but
- ;; I could not reproduce this problem. Furthermore, if
- ;; there's such a problem, we should fix org-mode rather than
- ;; use switch-to-buffer which can have undesirable
- ;; side-effects!
- ;;(switch-to-buffer (current-buffer))
- (funcall mode))
+ (with-demoted-errors "Error setting mode: %S"
+ (if mode
+ (save-window-excursion
+ ;; According to Katsumi Yamaoka <yamaoka@jpl.org>, org-mode
+ ;; requires the buffer to be temporarily displayed here, but
+ ;; I could not reproduce this problem. Furthermore, if
+ ;; there's such a problem, we should fix org-mode rather than
+ ;; use switch-to-buffer which can have undesirable
+ ;; side-effects!
+ ;;(switch-to-buffer (current-buffer))
+ (funcall mode))
(let ((auto-mode-alist
(delq (rassq 'doc-view-mode-maybe auto-mode-alist)
(copy-sequence auto-mode-alist))))
@@ -634,12 +632,9 @@ If MODE is not set, try to find mode automatically."
(context (epg-make-context 'CMS)))
(prog1
(epg-verify-string context part)
- (let ((result (car (epg-context-result-for context 'verify))))
+ (let ((result (epg-context-result-for context 'verify)))
(mm-sec-status
- 'gnus-info (epg-signature-status result)
- 'gnus-details
- (format "%s:%s" (epg-signature-validity result)
- (epg-signature-key-id result))))))))
+ 'gnus-info (epg-verify-result-to-string result)))))))
(with-temp-buffer
(insert "MIME-Version: 1.0\n")
(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
@@ -659,7 +654,11 @@ If MODE is not set, try to find mode automatically."
;; Use EPG/gpgsm
(let ((part (base64-decode-string (buffer-string))))
(erase-buffer)
- (insert (epg-decrypt-string (epg-make-context 'CMS) part)))
+ (insert
+ (let ((context (epg-make-context 'CMS)))
+ (prog1
+ (epg-decrypt-string context part)
+ (mm-sec-status 'gnus-info "OK")))))
;; Use openssl
(insert "MIME-Version: 1.0\n")
(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index acf9ef0ebd1..093e582ea7a 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -500,7 +500,8 @@ type detected."
(when (and (consp (car cont))
(= (length cont) 1)
content-type)
- (setcdr (assq 'type (cdr (car cont))) content-type))
+ (when-let ((spec (assq 'type (cdr (car cont)))))
+ (setcdr spec content-type)))
(when (fboundp 'libxml-parse-html-region)
(setq cont (mapcar #'mml-expand-all-html-into-multipart-related cont)))
(prog1
@@ -1143,48 +1144,40 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
;;; Mode for inserting and editing MML forms
;;;
-(defvar mml-mode-map
- (let ((sign (make-sparse-keymap))
- (encrypt (make-sparse-keymap))
- (signpart (make-sparse-keymap))
- (encryptpart (make-sparse-keymap))
- (map (make-sparse-keymap))
- (main (make-sparse-keymap)))
- (define-key map "\C-s" 'mml-secure-message-sign)
- (define-key map "\C-c" 'mml-secure-message-encrypt)
- (define-key map "\C-e" 'mml-secure-message-sign-encrypt)
- (define-key map "\C-p\C-s" 'mml-secure-sign)
- (define-key map "\C-p\C-c" 'mml-secure-encrypt)
- (define-key sign "p" 'mml-secure-message-sign-pgpmime)
- (define-key sign "o" 'mml-secure-message-sign-pgp)
- (define-key sign "s" 'mml-secure-message-sign-smime)
- (define-key signpart "p" 'mml-secure-sign-pgpmime)
- (define-key signpart "o" 'mml-secure-sign-pgp)
- (define-key signpart "s" 'mml-secure-sign-smime)
- (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
- (define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
- (define-key encrypt "s" 'mml-secure-message-encrypt-smime)
- (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime)
- (define-key encryptpart "o" 'mml-secure-encrypt-pgp)
- (define-key encryptpart "s" 'mml-secure-encrypt-smime)
- (define-key map "\C-n" 'mml-unsecure-message)
- (define-key map "f" 'mml-attach-file)
- (define-key map "b" 'mml-attach-buffer)
- (define-key map "e" 'mml-attach-external)
- (define-key map "q" 'mml-quote-region)
- (define-key map "m" 'mml-insert-multipart)
- (define-key map "p" 'mml-insert-part)
- (define-key map "v" 'mml-validate)
- (define-key map "P" 'mml-preview)
- (define-key map "s" sign)
- (define-key map "S" signpart)
- (define-key map "c" encrypt)
- (define-key map "C" encryptpart)
- ;;(define-key map "n" 'mml-narrow-to-part)
- ;; `M-m' conflicts with `back-to-indentation'.
- ;; (define-key main "\M-m" map)
- (define-key main "\C-c\C-m" map)
- main))
+(defvar-keymap mml-mode-map
+ "C-c C-m"
+ (define-keymap
+ "C-s" #'mml-secure-message-sign
+ "C-c" #'mml-secure-message-encrypt
+ "C-e" #'mml-secure-message-sign-encrypt
+ "C-p C-s" #'mml-secure-sign
+ "C-p C-c" #'mml-secure-encrypt
+
+ "s" (define-keymap
+ "p" #'mml-secure-message-sign-pgpmime
+ "o" #'mml-secure-message-sign-pgp
+ "s" #'mml-secure-message-sign-smime)
+ "S" (define-keymap
+ "p" #'mml-secure-sign-pgpmime
+ "o" #'mml-secure-sign-pgp
+ "s" #'mml-secure-sign-smime)
+ "c" (define-keymap
+ "p" #'mml-secure-message-encrypt-pgpmime
+ "o" #'mml-secure-message-encrypt-pgp
+ "s" #'mml-secure-message-encrypt-smime)
+ "C" (define-keymap
+ "p" #'mml-secure-encrypt-pgpmime
+ "o" #'mml-secure-encrypt-pgp
+ "s" #'mml-secure-encrypt-smime)
+ "C-n" #'mml-unsecure-message
+ "f" #'mml-attach-file
+ "b" #'mml-attach-buffer
+ "e" #'mml-attach-external
+ "q" #'mml-quote-region
+ "m" #'mml-insert-multipart
+ "p" #'mml-insert-part
+ "v" #'mml-validate
+ "P" #'mml-preview))
(easy-menu-define
mml-menu mml-mode-map ""
@@ -1409,6 +1402,13 @@ to specify options."
:version "22.1" ;; Gnus 5.10.9
:group 'message)
+(defcustom mml-attach-file-at-the-end nil
+ "If non-nil, \\[mml-attach-file] attaches files at the end of the message.
+If nil, files are attached at point."
+ :type 'boolean
+ :version "29.1"
+ :group 'message)
+
;;;###autoload
(defun mml-attach-file (file &optional type description disposition)
"Attach a file to the outgoing MIME message.
@@ -1423,6 +1423,8 @@ specifies how the attachment is intended to be displayed. It can
be either \"inline\" (displayed automatically within the message
body) or \"attachment\" (separate from the body).
+Also see the `mml-attach-file-at-the-end' variable.
+
If given a prefix interactively, no prompting will be done for
the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults
will be computed and used."
@@ -1440,8 +1442,11 @@ will be computed and used."
(mml-minibuffer-read-disposition type nil file))))
(list file type description disposition)))
;; If in the message header, attach at the end and leave point unchanged.
- (let ((head (unless (message-in-body-p) (point))))
- (if head (goto-char (point-max)))
+ (let ((at-end (and (or (not (message-in-body-p))
+ mml-attach-file-at-the-end)
+ (point))))
+ (when at-end
+ (goto-char (point-max)))
(mml-insert-empty-tag 'part
'type type
;; icicles redefines read-file-name and returns a
@@ -1451,13 +1456,13 @@ will be computed and used."
'description description)
;; When using Mail mode, make sure it does the mime encoding
;; when you send the message.
- (or (eq mail-user-agent 'message-user-agent)
- (setq mail-encode-mml t))
- (when head
+ (unless (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
+ (when at-end
(unless (pos-visible-in-window-p)
(message "The file \"%s\" has been attached at the end of the message"
(file-name-nondirectory file)))
- (goto-char head))))
+ (goto-char at-end))))
(defun mml-dnd-attach-file (uri _action)
"Attach a drag and drop file.
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 0ab92488f83..bd60c43f59d 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1308,7 +1308,7 @@ all. This may very well take some time.")
(let ((minute (nndiary-max (nth 0 sched)))
(hour (nndiary-max (nth 1 sched)))
(year (nndiary-max (nth 4 sched)))
- (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
+ (time-zone (or (car (nth 6 sched))
(current-time-zone))))
(when year
(or minute (setq minute 59))
@@ -1405,7 +1405,7 @@ all. This may very well take some time.")
t))
(dow-list (nth 5 sched))
(year (1- this-year))
- (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
+ (time-zone (or (car (nth 6 sched))
(current-time-zone))))
;; Special case: an asterisk in one of the days specifications means that
;; only the other should be taken into account. If both are unspecified,
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 8b3718ed7e8..c1c5f00ff7f 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -27,6 +27,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'range)
(defvar gnus-decode-encoded-word-function)
(defvar gnus-decode-encoded-address-function)
@@ -44,8 +45,6 @@
(require 'mm-util)
(require 'gnus-util)
(autoload 'gnus-remove-odd-characters "gnus-sum")
-(autoload 'gnus-range-add "gnus-range")
-(autoload 'gnus-remove-from-range "gnus-range")
;; FIXME none of these are used explicitly in this file.
(autoload 'gnus-sorted-intersection "gnus-range")
(autoload 'gnus-intersection "gnus-range")
@@ -1044,10 +1043,9 @@ See `find-file-noselect' for the arguments."
mark
(cond
((eq what 'add)
- (gnus-range-add (cdr (assoc mark backend-marks)) range))
+ (range-concat (cdr (assoc mark backend-marks)) range))
((eq what 'del)
- (gnus-remove-from-range
- (cdr (assoc mark backend-marks)) range))
+ (range-remove (cdr (assoc mark backend-marks)) range))
((eq what 'set)
range))
backend-marks)))))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index fd6e3c0ccf7..746109f26fa 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -40,6 +40,7 @@
(autoload 'auth-source-forget+ "auth-source")
(autoload 'auth-source-search "auth-source")
+(autoload 'auth-info-password "auth-source")
(nnoo-declare nnimap)
@@ -94,9 +95,6 @@ Uses the same syntax as `nnmail-split-methods'.")
(defvoo nnimap-unsplittable-articles '(%Deleted %Seen)
"Articles with the flags in the list will not be considered when splitting.")
-(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'."
- "24.1")
-
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
Possible choices are nil (use default methods), `anonymous',
@@ -232,20 +230,30 @@ during splitting, which may be slow."
params)
(format "%s" (nreverse params))))
+(defvar nnimap--max-retrieve-headers 200)
+
(deffoo nnimap-retrieve-headers (articles &optional group server _fetch-old)
(with-current-buffer nntp-server-buffer
(erase-buffer)
(when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
- (nnimap-wait-for-response
- (nnimap-send-command
- "UID FETCH %s %s"
- (nnimap-article-ranges (gnus-compress-sequence articles))
- (nnimap-header-parameters))
- t)
+ ;; If we have a lot of ranges, split them up to avoid
+ ;; generating too-long lines. (The limit is 8192 octects,
+ ;; and this should guarantee that it's (much) shorter than
+ ;; that.) We don't stream the requests, since the server
+ ;; may respond to the requests out-of-order:
+ ;; https://datatracker.ietf.org/doc/html/rfc3501#section-5.5
+ (dolist (ranges (seq-split (gnus-compress-sequence articles t)
+ nnimap--max-retrieve-headers))
+ (nnimap-wait-for-response
+ (nnimap-send-command
+ "UID FETCH %s %s"
+ (nnimap-article-ranges ranges)
+ (nnimap-header-parameters))
+ t))
(unless (process-live-p (get-buffer-process (current-buffer)))
- (error "Server closed connection"))
+ (error "IMAP server %S closed connection" nnimap-address))
(nnimap-transform-headers)
(nnheader-remove-cr-followed-by-lf))
(insert-buffer-substring
@@ -407,10 +415,7 @@ during splitting, which may be slow."
:create t))))
(if found
(list (plist-get found :user)
- (let ((secret (plist-get found :secret)))
- (if (functionp secret)
- (funcall secret)
- secret))
+ (auth-info-password found)
(plist-get found :save-function))
nil)))
@@ -429,8 +434,18 @@ during splitting, which may be slow."
now
(nnimap-last-command-time nnimap-object))))
(with-local-quit
- (ignore-errors ;E.g. "buffer foo has no process".
- (nnimap-send-command "NOOP")))))))))
+ (ignore-errors ;E.g. "buffer foo has no process".
+ (nnimap-send-command "NOOP"))
+ ;; If our connection has died in the meantime, clean it
+ ;; and its buffer up.
+ (unless (process-live-p (get-buffer-process buffer))
+ (setq nnimap-process-buffers
+ (delq buffer nnimap-process-buffers))
+ (setq nnimap-connection-alist
+ (seq-filter (lambda (elt)
+ (null (eq buffer (cdr elt))))
+ nnimap-connection-alist))
+ (kill-buffer buffer)))))))))
(defun nnimap-open-connection (buffer)
;; Be backwards-compatible -- the earlier value of nnimap-stream was
@@ -662,10 +677,17 @@ during splitting, which may be slow."
(deffoo nnimap-close-server (&optional server defs)
(when (nnoo-change-server 'nnimap server defs)
- (ignore-errors
- (delete-process (get-buffer-process (nnimap-buffer))))
- (nnoo-close-server 'nnimap server)
- t))
+ (let ((buf (nnimap-buffer)))
+ (ignore-errors
+ (delete-process (get-buffer-process buf)))
+ (setq nnimap-process-buffers
+ (delq buf nnimap-process-buffers)
+ nnimap-connection-alist
+ (seq-filter (lambda (elt)
+ (null (eq buf (cdr elt))))
+ nnimap-connection-alist))
+ (nnoo-close-server 'nnimap server)
+ t)))
(deffoo nnimap-request-close ()
t)
@@ -1645,13 +1667,13 @@ If LIMIT, first try to limit the search to the N last articles."
(cdr (assoc '%Seen flags))
(cdr (assoc '%Deleted flags))))
(cdr (assoc '%Flagged flags)))))
- (read (gnus-range-difference
+ (read (range-difference
(cons start-article high) unread)))
(when (> start-article 1)
(setq read
(gnus-range-nconcat
(if (> start-article 1)
- (gnus-sorted-range-intersection
+ (range-intersection
(cons 1 (1- start-article))
(gnus-info-read info))
(gnus-info-read info))
@@ -1676,7 +1698,7 @@ If LIMIT, first try to limit the search to the N last articles."
(pop old-marks)
(when (and old-marks
(> start-article 1))
- (setq old-marks (gnus-range-difference
+ (setq old-marks (range-difference
old-marks
(cons start-article high)))
(setq new-marks (gnus-range-nconcat old-marks new-marks)))
@@ -1687,15 +1709,15 @@ If LIMIT, first try to limit the search to the N last articles."
(active (gnus-active group))
(unexists
(if completep
- (gnus-range-difference
+ (range-difference
active
(gnus-compress-sequence existing))
- (gnus-add-to-range
+ (range-add-list
(cdr old-unexists)
- (gnus-list-range-difference
+ (range-list-difference
existing (gnus-active group))))))
(when (> (car active) 1)
- (setq unexists (gnus-range-add
+ (setq unexists (range-concat
(cons 1 (1- (car active)))
unexists)))
(if old-unexists
@@ -1718,10 +1740,9 @@ If LIMIT, first try to limit the search to the N last articles."
(defun nnimap-update-qresync-info (info existing vanished flags)
;; Add all the vanished articles to the list of read articles.
(setf (gnus-info-read info)
- (gnus-add-to-range
- (gnus-add-to-range
- (gnus-range-add (gnus-info-read info)
- vanished)
+ (range-add-list
+ (range-add-list
+ (range-concat (gnus-info-read info) vanished)
(cdr (assq '%Flagged flags)))
(cdr (assq '%Seen flags))))
(let ((marks (gnus-info-marks info)))
@@ -1735,9 +1756,9 @@ If LIMIT, first try to limit the search to the N last articles."
(setq marks (delq ticks marks))
(pop ticks)
;; Add the new marks we got.
- (setq ticks (gnus-add-to-range ticks new-marks))
+ (setq ticks (range-add-list ticks new-marks))
;; Remove the marks from messages that don't have them.
- (setq ticks (gnus-remove-from-range
+ (setq ticks (range-remove
ticks
(gnus-compress-sequence
(gnus-sorted-complement existing new-marks))))
@@ -1747,7 +1768,7 @@ If LIMIT, first try to limit the search to the N last articles."
;; Add vanished to the list of unexisting articles.
(when vanished
(let* ((old-unexists (assq 'unexist marks))
- (unexists (gnus-range-add (cdr old-unexists) vanished)))
+ (unexists (range-concat (cdr old-unexists) vanished)))
(if old-unexists
(setcdr old-unexists unexists)
(push (cons 'unexist unexists) marks)))
@@ -1937,10 +1958,13 @@ Return the server's response to the SELECT or EXAMINE command."
(when entry
(if (and (buffer-live-p (cadr entry))
(get-buffer-process (cadr entry))
- (memq (process-status (get-buffer-process (cadr entry)))
- '(open run)))
+ (process-live-p (get-buffer-process (cadr entry))))
(get-buffer-process (cadr entry))
- (setq nnimap-connection-alist (delq entry nnimap-connection-alist))
+ (setq nnimap-connection-alist (delq entry nnimap-connection-alist)
+ nnimap-process-buffers
+ (delq (cadr entry) nnimap-process-buffers))
+ (when (buffer-live-p (cadr entry))
+ (kill-buffer (cadr entry)))
nil))))
;; Leave room for `open-network-stream' to issue a couple of IMAP
@@ -2224,7 +2248,7 @@ Return the server's response to the SELECT or EXAMINE command."
(while (re-search-forward "^\\([0-9]+\\) OK\\b" nil t)
(setq sequence (string-to-number (match-string 1)))
(when (setq range (cadr (assq sequence sequences)))
- (push (gnus-uncompress-range range) copied)))
+ (push (range-uncompress range) copied)))
(gnus-compress-sequence (sort (apply #'nconc copied) #'<))))
(defun nnimap-new-articles (flags)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index c71627f83a4..bde0de98924 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1937,9 +1937,7 @@ If TIME is nil, then return the cutoff time for oldness instead."
(and (string-match (cadr regexp-target-pair) to)
(let ((mail-dont-reply-to-names
(message-dont-reply-to-names)))
- (equal (if (fboundp 'rmail-dont-reply-to)
- (rmail-dont-reply-to from)
- (mail-dont-reply-to from)) "")))))
+ (equal (mail-dont-reply-to from) "")))))
(setq target (format-time-string (caddr regexp-target-pair) date)))
((and (not (equal header 'to-from))
(string-match (cadr regexp-target-pair)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 690761a2d6c..30f473b1291 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1006,10 +1006,10 @@ This variable is set by `nnmaildir-request-article'.")
existing (nnmaildir--grp-nlist group)
existing (mapcar #'car existing)
existing (nreverse existing)
- existing (gnus-compress-sequence existing 'always-list)
+ existing (range-compress-list existing)
missing (list (cons 1 (nnmaildir--group-maxnum
nnmaildir--cur-server group)))
- missing (gnus-range-difference missing existing)
+ missing (range-difference missing existing)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
dir (nnmaildir--nndir dir)
@@ -1076,10 +1076,10 @@ This variable is set by `nnmaildir-request-article'.")
(let ((article (nnmaildir--flist-art flist prefix)))
(when article
(push (nnmaildir--art-num article) article-list))))))
- (setq ranges (gnus-add-to-range ranges (sort article-list #'<)))))
+ (setq ranges (range-add-list ranges (sort article-list #'<)))))
(if (eq mark 'read) (setq read ranges)
(if ranges (setq marks (cons (cons mark ranges) marks)))))
- (setf (gnus-info-read info) (gnus-range-add read missing))
+ (setf (gnus-info-read info) (range-concat read missing))
(gnus-info-set-marks info marks 'extend)
(setf (nnmaildir--grp-mmth group) new-mmth)
info)))
@@ -1548,11 +1548,11 @@ This variable is set by `nnmaildir-request-article'.")
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(if gname (concat "No such group: " gname) "No current group"))
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq gname (nnmaildir--grp-name group)
pgname (nnmaildir--pgname nnmaildir--cur-server gname))
(if (nnmaildir--param pgname 'read-only)
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq time (nnmaildir--param pgname 'expire-age))
(unless time
(setq time (or (and nnmail-expiry-wait-function
@@ -1564,7 +1564,7 @@ This variable is set by `nnmaildir-request-article'.")
(setq time (round (* time 86400))))))
(when no-force
(unless (integerp time) ;; handle 'never
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq boundary (time-since time)))
(setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
@@ -1686,7 +1686,7 @@ This variable is set by `nnmaildir-request-article'.")
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(dolist (action actions)
- (setq ranges (gnus-range-add ranges (car action))))
+ (setq ranges (range-concat ranges (car action))))
(throw 'return ranges))
(setq nlist (nnmaildir--grp-nlist group)
marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index 8ca1cf0fe8b..8c811b0c6c0 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -333,7 +333,7 @@ this might lead to problems, especially when used with marks propagation."
(defvar nnmairix-widget-other
'(threads flags)
"Other editable mairix commands when using customization widgets.
-Currently there are 'threads and 'flags.")
+Currently there are `threads' and `flags'.")
(defvar nnmairix-interactive-query-parameters
'((?f "from" "f" "From") (?t "to" "t" "To") (?c "to" "tc" "To or Cc")
@@ -597,7 +597,7 @@ Other back ends might or might not work.")
(dolist (cur actions)
(let ((type (nth 1 cur))
(cmdmarks (nth 2 cur))
- (range (gnus-uncompress-range (nth 0 cur)))
+ (range (range-uncompress (nth 0 cur)))
mid ogroup temp) ;; number method
(when (and corr
(not (zerop (cadr corr))))
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 5a350aac746..96ecc34e156 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -529,7 +529,7 @@
;; add article to index, either by building complete list
;; in reverse order, or as a list of ranges.
(if (not nnmbox-group-building-active-articles)
- (setcdr entry (gnus-add-to-range (cdr entry) (list article)))
+ (setcdr entry (range-add-list (cdr entry) (list article)))
(when (memq article (cdr entry))
(switch-to-buffer nnmbox-mbox-buffer)
(error "Article %s:%d already exists!" group article))
@@ -548,10 +548,10 @@
nnmbox-group-active-articles)
(car nnmbox-group-active-articles)))))
;; remove article from index
- (setcdr entry (gnus-remove-from-range (cdr entry) (list article)))))
+ (setcdr entry (range-remove (cdr entry) (list article)))))
(defun nnmbox-is-article-active-p (article)
- (gnus-member-of-range
+ (range-member-p
article
(cdr (assoc nnmbox-current-group
nnmbox-group-active-articles))))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index afdb0c780a5..7fe2b516cce 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1078,21 +1078,20 @@ Use the nov database for the current group if available."
;; #### doing anything on them.
;; 2 a/ read articles:
(let ((read (gnus-info-read info)))
- (setq read (gnus-remove-from-range read (list new-number)))
- (when (gnus-member-of-range old-number read)
- (setq read (gnus-remove-from-range read (list old-number)))
- (setq read (gnus-add-to-range read (list new-number))))
+ (setq read (range-remove read (list new-number)))
+ (when (range-member-p old-number read)
+ (setq read (range-remove read (list old-number)))
+ (setq read (range-add-list read (list new-number))))
(setf (gnus-info-read info) read))
;; 2 b/ marked articles:
(let ((oldmarks (gnus-info-marks info))
mark newmarks)
(while (setq mark (pop oldmarks))
- (setcdr mark (gnus-remove-from-range (cdr mark)
- (list new-number)))
- (when (gnus-member-of-range old-number (cdr mark))
- (setcdr mark (gnus-remove-from-range (cdr mark)
- (list old-number)))
- (setcdr mark (gnus-add-to-range (cdr mark)
+ (setcdr mark (range-remove (cdr mark) (list new-number)))
+ (when (range-member-p old-number (cdr mark))
+ (setcdr mark (range-remove (cdr mark)
+ (list old-number)))
+ (setcdr mark (range-add-list (cdr mark)
(list new-number))))
(push mark newmarks))
(setf (gnus-info-marks info) newmarks))
diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el
index 36a8bc4581b..092b53298a2 100644
--- a/lisp/gnus/nnnil.el
+++ b/lisp/gnus/nnnil.el
@@ -40,7 +40,7 @@
(defun nnnil-open-server (_server &optional _definitions)
t)
-(defun nnnil-close-server (&optional _server)
+(defun nnnil-close-server (&optional _server _defs)
t)
(defun nnnil-request-close ()
diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el
index d042981ca98..4a799acad98 100644
--- a/lisp/gnus/nnregistry.el
+++ b/lisp/gnus/nnregistry.el
@@ -36,7 +36,7 @@
(nnoo-declare nnregistry)
(deffoo nnregistry-server-opened (_server)
- gnus-registry-enabled)
+ gnus-registry-db)
(deffoo nnregistry-close-server (_server &optional _defs)
t)
@@ -45,7 +45,7 @@
nil)
(deffoo nnregistry-open-server (_server &optional _defs)
- gnus-registry-enabled)
+ gnus-registry-db)
(defvar nnregistry-within-nnregistry nil)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 10b378fd44c..f740af3b6d1 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -450,7 +450,7 @@ nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s"
This function handles the ISO 8601 date format described in
URL `https://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style
which RSS 2.0 allows."
- (let (case-fold-search vector year month day time zone cts given)
+ (let (case-fold-search vector year month day time zone given)
(cond ((null date)) ; do nothing for this case
;; if the date is just digits (unix time stamp):
((string-match "^[0-9]+$" date)
@@ -481,13 +481,13 @@ which RSS 2.0 allows."
0
(decoded-time-zone decoded))))))
(if month
- (progn
- (setq cts (current-time-string (encode-time 0 0 0 day month year)))
- (format "%s, %02d %s %04d %s%s"
- (substring cts 0 3) day (substring cts 4 7) year time
- (if zone
- (concat " " (format-time-string "%z" nil zone))
- "")))
+ (concat (let ((system-time-locale "C"))
+ (format-time-string "%a, %d %b %Y "
+ (encode-time 0 0 0 day month year)))
+ time
+ (if zone
+ (format-time-string " %z" nil zone)
+ ""))
(message-make-date given))))
;;; data functions
@@ -756,8 +756,7 @@ Export subscriptions to a buffer in OPML Format."
(insert " </body>\n"
"</opml>\n"))
(pop-to-buffer "*OPML Export*")
- (when (fboundp 'sgml-mode)
- (sgml-mode)))
+ (sgml-mode))
(defun nnrss-generate-download-script ()
"Generate a download script in the current buffer.
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index e79b080e789..9b8333a7c6c 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -47,7 +47,8 @@
;;; Setup:
(require 'gnus-art)
-(require 'gnus-search)
+(autoload 'gnus-search-run-query "gnus-search")
+(autoload 'gnus-search-server-to-engine "gnus-search")
(eval-when-compile (require 'cl-lib))
@@ -79,33 +80,37 @@
;;; Helper routines.
(defun nnselect-compress-artlist (artlist)
"Compress ARTLIST."
- (let (selection)
- (pcase-dolist (`(,artgroup . ,arts)
- (nnselect-categorize artlist #'nnselect-artitem-group))
- (let (list)
- (pcase-dolist (`(,rsv . ,articles)
- (nnselect-categorize
- arts #'nnselect-artitem-rsv #'nnselect-artitem-number))
- (push (cons rsv (gnus-compress-sequence (sort articles #'<)))
- list))
- (push (cons artgroup list) selection)))
- selection))
+ (if (consp artlist)
+ artlist
+ (let (selection)
+ (pcase-dolist (`(,artgroup . ,arts)
+ (nnselect-categorize artlist #'nnselect-artitem-group))
+ (let (list)
+ (pcase-dolist (`(,rsv . ,articles)
+ (nnselect-categorize
+ arts #'nnselect-artitem-rsv #'nnselect-artitem-number))
+ (push (cons rsv (gnus-compress-sequence (sort articles #'<)))
+ list))
+ (push (cons artgroup list) selection)))
+ selection)))
(defun nnselect-uncompress-artlist (artlist)
"Uncompress ARTLIST."
(if (vectorp artlist)
artlist
(let (selection)
- (pcase-dolist (`(,artgroup (,artrsv . ,artseq)) artlist)
- (setq selection
- (vconcat
- (cl-map 'vector
- (lambda (art)
- (vector artgroup art artrsv))
- (gnus-uncompress-sequence artseq)) selection)))
+ (pcase-dolist (`(,artgroup . ,list) artlist)
+ (pcase-dolist (`(,artrsv . ,artseq) list)
+ (setq selection
+ (vconcat
+ (cl-map 'vector
+ (lambda (art)
+ (vector artgroup art artrsv))
+ (gnus-uncompress-sequence artseq)) selection))))
selection)))
(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
+(make-obsolete 'nnselect-run 'nnselect-generate-artlist "29.1")
;; Data type article list.
@@ -207,7 +212,7 @@ as `(keyfunc member)' and the corresponding element is just
(inline-quote
(cond
((eq ,type 'range)
- (nnselect-categorize (gnus-uncompress-range ,articles)
+ (nnselect-categorize (range-uncompress ,articles)
#'nnselect-article-group #'nnselect-article-number))
((eq ,type 'tuple)
(nnselect-categorize ,articles
@@ -227,11 +232,6 @@ as `(keyfunc member)' and the corresponding element is just
`(gnus-group-prefixed-name
(gnus-group-short-name ,group) '(nnselect "nnselect")))
-(defmacro nnselect-get-artlist (group)
- "Retrieve the list of articles for GROUP."
- `(when (gnus-nnselect-group-p ,group)
- (nnselect-uncompress-artlist
- (gnus-group-get-parameter ,group 'nnselect-artlist t))))
(defmacro nnselect-add-novitem (novitem)
"Add NOVITEM to the list of headers."
@@ -252,16 +252,78 @@ as `(keyfunc member)' and the corresponding element is just
(define-obsolete-variable-alias 'nnir-retrieve-headers-override-function
'nnselect-retrieve-headers-override-function "28.1")
+(defcustom nnselect-allow-ephemeral-expiry nil
+ "If non-nil, articles in ephemeral nnselect groups are subject to expiry."
+ :version "29.1"
+ :type 'boolean)
+
(defcustom nnselect-retrieve-headers-override-function nil
"A function that retrieves article headers for ARTICLES from GROUP.
The retrieved headers should populate the `nntp-server-buffer'.
-Returns either the retrieved header format 'nov or 'headers.
+Returns either the retrieved header format `nov' or `headers'.
If this variable is nil, or if the provided function returns nil,
`gnus-retrieve-headers' will be called instead."
:version "28.1"
:type '(repeat function))
+(defun nnselect-generate-artlist (group &optional specs)
+ "Generate the artlist for GROUP using SPECS.
+SPECS should be an alist including an `nnselect-function' and an
+`nnselect-args'. The former applied to the latter should create
+the artlist. If SPECS is nil retrieve the specs from the group
+parameters."
+ (let* ((specs
+ (or specs (gnus-group-get-parameter group 'nnselect-specs t)))
+ (function (alist-get 'nnselect-function specs))
+ (args (alist-get 'nnselect-args specs)))
+ (condition-case-unless-debug err
+ (funcall function args)
+ ;; Don't swallow gnus-search errors; the user should be made
+ ;; aware of them.
+ (gnus-search-error
+ (signal (car err) (cdr err)))
+ (error
+ (gnus-error
+ 3
+ "nnselect-generate-artlist: %s on %s gave error %s" function args err)
+ []))))
+
+(defmacro nnselect-get-artlist (group)
+ "Get the list of articles for GROUP.
+If the group parameter `nnselect-get-artlist-override-function' is
+non-nil call this function with argument GROUP to get the
+artlist; if the group parameter `nnselect-always-regenerate' is
+non-nil, regenerate the artlist; otherwise retrieve the artlist
+directly from the group parameters."
+ `(when (gnus-nnselect-group-p ,group)
+ (let ((override (gnus-group-get-parameter
+ ,group
+ 'nnselect-get-artlist-override-function)))
+ (cond
+ (override (funcall override ,group))
+ ((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
+ (nnselect-generate-artlist ,group))
+ (t
+ (nnselect-uncompress-artlist
+ (gnus-group-get-parameter ,group 'nnselect-artlist t)))))))
+
+(defmacro nnselect-store-artlist (group artlist)
+ "Store the ARTLIST for GROUP.
+If the group parameter `nnselect-store-artlist-override-function'
+is non-nil call this function on GROUP and ARTLIST; if the group
+parameter `nnselect-always-regenerate' is non-nil don't store the
+artlist; otherwise store the ARTLIST in the group parameters."
+ `(let ((override (gnus-group-get-parameter
+ ,group
+ 'nnselect-store-artlist-override-function)))
+ (cond
+ (override (funcall override ,group ,artlist))
+ ((gnus-group-get-parameter ,group 'nnselect-always-regenerate) t)
+ (t
+ (gnus-group-set-parameter ,group 'nnselect-artlist
+ (nnselect-compress-artlist ,artlist))))))
+
;; Gnus backend interface functions.
(deffoo nnselect-open-server (server &optional definitions)
@@ -287,11 +349,8 @@ If this variable is nil, or if the provided function returns nil,
;; Check for cached select result or run the selection and cache
;; the result.
(unless nnselect-artlist
- (gnus-group-set-parameter
- group 'nnselect-artlist
- (nnselect-compress-artlist (setq nnselect-artlist
- (nnselect-run
- (gnus-group-get-parameter group 'nnselect-specs t)))))
+ (nnselect-store-artlist group
+ (setq nnselect-artlist (nnselect-generate-artlist group)))
(nnselect-request-update-info
group (or info (gnus-get-info group))))
(if (zerop (setq length (nnselect-artlist-length nnselect-artlist)))
@@ -329,6 +388,7 @@ If this variable is nil, or if the provided function returns nil,
(gnus-group-find-parameter artgroup
'gnus-fetch-old-headers t))
fetch-old)))
+ (gnus-request-group artgroup)
(erase-buffer)
(pcase (setq gnus-headers-retrieved-by
(or
@@ -395,8 +455,7 @@ If this variable is nil, or if the provided function returns nil,
(gnus-search-run-query
(list
(cons 'search-query-spec
- (list (cons 'query `((id . ,article)))
- (cons 'criteria "") (cons 'shortcut t)))
+ (list (cons 'query (format "id:%s" article))))
(cons 'search-group-spec servers))))
(unless (zerop (nnselect-artlist-length artlist))
(setq
@@ -454,24 +513,26 @@ If this variable is nil, or if the provided function returns nil,
:test #'equal :count 1)))))
(deffoo nnselect-request-expire-articles
- (articles _group &optional _server force)
- (if force
- (let (not-expired)
- (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles))
- (let ((artlist (sort (mapcar #'cdr artids) #'<)))
- (unless (gnus-check-backend-function 'request-expire-articles
- artgroup)
- (error "Group %s does not support article expiration" artgroup))
- (unless (gnus-check-server (gnus-find-method-for-group artgroup))
- (error "Couldn't open server for group %s" artgroup))
- (push (mapcar (lambda (art)
- (car (rassq art artids)))
- (let ((nnimap-expunge 'immediately))
- (gnus-request-expire-articles
- artlist artgroup force)))
- not-expired)))
- (sort (delq nil not-expired) #'<))
- articles))
+ (articles group &optional _server force)
+ (let ((nnimap-expunge 'immediately) not-deleted)
+ (if (and (not force)
+ (not nnselect-allow-ephemeral-expiry)
+ (gnus-ephemeral-group-p (nnselect-add-prefix group)))
+ articles
+ (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles))
+ (let ((artlist (sort (mapcar #'cdr artids) #'<)))
+ (unless
+ (gnus-check-backend-function 'request-expire-articles artgroup)
+ (error "Group %s does not support article expiration" artgroup))
+ (unless (gnus-check-server (gnus-find-method-for-group artgroup))
+ (error "Couldn't open server for group %s" artgroup))
+ (setq not-deleted
+ (append
+ (mapcar (lambda (art) (car (rassq art artids)))
+ (gnus-request-expire-articles artlist artgroup
+ force))
+ not-deleted))))
+ (sort (delq nil not-deleted) #'<))))
(deffoo nnselect-warp-to-article ()
@@ -529,68 +590,65 @@ If this variable is nil, or if the provided function returns nil,
(deffoo nnselect-request-update-info (group info &optional _server)
(let* ((group (nnselect-add-prefix group))
- (gnus-newsgroup-selection
- (or gnus-newsgroup-selection (nnselect-get-artlist group)))
- newmarks)
+ (gnus-newsgroup-selection
+ (or gnus-newsgroup-selection (nnselect-get-artlist group)))
+ newmarks)
(gnus-info-set-marks info nil)
(setf (gnus-info-read info) nil)
(pcase-dolist (`(,artgroup . ,nartids)
- (ids-by-group
- (number-sequence 1 (nnselect-artlist-length
- gnus-newsgroup-selection))))
+ (ids-by-group
+ (number-sequence 1 (nnselect-artlist-length
+ gnus-newsgroup-selection))))
(let* ((gnus-newsgroup-active nil)
- (artids (cl-sort nartids #'< :key 'car))
- (group-info (gnus-get-info artgroup))
- (marks (gnus-info-marks group-info))
- (unread (gnus-uncompress-sequence
- (gnus-range-difference (gnus-active artgroup)
- (gnus-info-read group-info)))))
+ (idmap (make-hash-table :test 'eql))
+ (gactive (sort (mapcar 'cdr nartids) '<))
+ (group-info (gnus-get-info artgroup))
+ (marks (gnus-info-marks group-info)))
+ (pcase-dolist (`(,val . ,key) nartids)
+ (puthash key val idmap))
(setf (gnus-info-read info)
- (gnus-add-to-range
- (gnus-info-read info)
- (delq nil (mapcar
- (lambda (art)
- (unless (memq (cdr art) unread) (car art)))
- artids))))
- (pcase-dolist (`(,type . ,mark-list) marks)
- (let ((mark-type (gnus-article-mark-to-type type)) new)
- (when
- (setq new
- (delq nil
- (cond
- ((eq mark-type 'tuple)
- (mapcar
- (lambda (id)
- (let (mark)
- (when
- (setq mark (assq (cdr id) mark-list))
- (cons (car id) (cdr mark)))))
- artids))
- (t
- (setq mark-list
- (gnus-uncompress-range mark-list))
- (mapcar
- (lambda (id)
- (when (memq (cdr id) mark-list)
- (car id))) artids)))))
- (let ((previous (alist-get type newmarks)))
- (if previous
- (nconc previous new)
- (push (cons type new) newmarks))))))))
+ (range-add-list
+ (gnus-info-read info)
+ (sort (mapcar (lambda (art) (gethash art idmap))
+ (gnus-sorted-intersection
+ gactive
+ (range-uncompress (gnus-info-read group-info))))
+ '<)))
+ (pcase-dolist (`(,type . ,mark-list) marks)
+ (let ((mark-type (gnus-article-mark-to-type type)) new)
+ (when
+ (setq new
+ (if (not mark-list) nil
+ (cond
+ ((eq mark-type 'tuple)
+ (delq nil
+ (mapcar
+ (lambda (mark)
+ (let ((id (gethash (car mark) idmap)))
+ (when id (cons id (cdr mark)))))
+ mark-list)))
+ (t
+ (mapcar (lambda (art) (gethash art idmap))
+ (gnus-sorted-intersection
+ gactive (range-uncompress mark-list)))))))
+ (let ((previous (alist-get type newmarks)))
+ (if previous
+ (nconc previous new)
+ (push (cons type new) newmarks))))))))
;; Clean up the marks: compress lists;
(pcase-dolist (`(,type . ,mark-list) newmarks)
(let ((mark-type (gnus-article-mark-to-type type)))
- (unless (eq mark-type 'tuple)
- (setf (alist-get type newmarks)
- (gnus-compress-sequence mark-list)))))
+ (unless (eq mark-type 'tuple)
+ (setf (alist-get type newmarks)
+ (gnus-compress-sequence (sort mark-list '<))))))
;; and ensure an unexist key.
(unless (assq 'unexist newmarks)
(push (cons 'unexist nil) newmarks))
(gnus-info-set-marks info newmarks)
(gnus-set-active group (cons 1 (nnselect-artlist-length
- gnus-newsgroup-selection)))))
+ gnus-newsgroup-selection)))))
(deffoo nnselect-request-thread (header &optional group server)
@@ -645,8 +703,15 @@ If this variable is nil, or if the provided function returns nil,
(lambda (article)
(if
(setq seq
- (cl-position article
- gnus-newsgroup-selection :test 'equal))
+ (cl-position
+ article
+ gnus-newsgroup-selection
+ :test
+ (lambda (x y)
+ (and (equal (nnselect-artitem-group x)
+ (nnselect-artitem-group y))
+ (eql (nnselect-artitem-number x)
+ (nnselect-artitem-number y))))))
(push (1+ seq) old-arts)
(setq gnus-newsgroup-selection
(vconcat gnus-newsgroup-selection (vector article)))
@@ -657,10 +722,7 @@ If this variable is nil, or if the provided function returns nil,
(append (sort old-arts #'<)
(number-sequence first last))
nil t))
- (gnus-group-set-parameter
- group
- 'nnselect-artlist
- (nnselect-compress-artlist gnus-newsgroup-selection))
+ (nnselect-store-artlist group gnus-newsgroup-selection)
(when (>= last first)
(let (new-marks)
(pcase-dolist (`(,artgroup . ,artids)
@@ -707,6 +769,7 @@ If this variable is nil, or if the provided function returns nil,
(message "Creating nnselect group %s" group)
(let* ((group (gnus-group-prefixed-name group '(nnselect "nnselect")))
(specs (assq 'nnselect-specs args))
+ (otherargs (assq-delete-all 'nnselect-specs args))
(function-spec
(or (alist-get 'nnselect-function specs)
(intern (completing-read "Function: " obarray #'functionp))))
@@ -716,10 +779,12 @@ If this variable is nil, or if the provided function returns nil,
(nnselect-specs (list (cons 'nnselect-function function-spec)
(cons 'nnselect-args args-spec))))
(gnus-group-set-parameter group 'nnselect-specs nnselect-specs)
- (gnus-group-set-parameter
- group 'nnselect-artlist
- (nnselect-compress-artlist (or (alist-get 'nnselect-artlist args)
- (nnselect-run nnselect-specs))))
+ (dolist (arg otherargs)
+ (gnus-group-set-parameter group (car arg) (cdr arg)))
+ (nnselect-store-artlist
+ group
+ (or (alist-get 'nnselect-artlist args)
+ (nnselect-generate-artlist group nnselect-specs)))
(nnselect-request-update-info group (gnus-get-info group)))
t)
@@ -744,20 +809,17 @@ If this variable is nil, or if the provided function returns nil,
(deffoo nnselect-request-scan (group _method)
(when (and group
- (gnus-group-get-parameter (nnselect-add-prefix group)
+ (gnus-group-find-parameter (nnselect-add-prefix group)
'nnselect-rescan t))
(nnselect-request-group-scan group)))
(deffoo nnselect-request-group-scan (group &optional _server _info)
(let* ((group (nnselect-add-prefix group))
- (artlist (nnselect-run
- (gnus-group-get-parameter group 'nnselect-specs t))))
+ (artlist (nnselect-generate-artlist group)))
(gnus-set-active group (cons 1 (nnselect-artlist-length
artlist)))
- (gnus-group-set-parameter
- group 'nnselect-artlist
- (nnselect-compress-artlist artlist))))
+ (nnselect-store-artlist group artlist)))
;; Add any undefined required backend functions
@@ -772,16 +834,6 @@ If this variable is nil, or if the provided function returns nil,
(eq 'nnselect (car gnus-command-method))))
-(defun nnselect-run (specs)
- "Apply nnselect-function to nnselect-args from SPECS.
-Return an article list."
- (let ((func (alist-get 'nnselect-function specs))
- (args (alist-get 'nnselect-args specs)))
- (condition-case-unless-debug err
- (funcall func args)
- (error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err)
- []))))
-
(defun nnselect-search-thread (header)
"Make an nnselect group containing the thread with article HEADER.
The current server will be searched. If the registry is
@@ -860,19 +912,19 @@ article came from is also searched."
;; When the backend can store marks we collect any
;; changes. Unlike a normal group the mark lists only
;; include marks for articles we retrieved.
- (when (and (gnus-check-backend-function
- 'request-set-mark artgroup)
- (not (gnus-article-unpropagatable-p type)))
- (let* ((old (gnus-list-range-intersection
+ (when (and (gnus-check-backend-function
+ 'request-set-mark gnus-newsgroup-name)
+ (not (gnus-article-unpropagatable-p type)))
+ (let* ((old (range-list-intersection
artlist
(alist-get type (gnus-info-marks group-info))))
- (del (gnus-remove-from-range (copy-tree old) list))
- (add (gnus-remove-from-range (copy-tree list) old)))
+ (del (range-remove (copy-tree old) list))
+ (add (range-remove (copy-tree list) old)))
(when add (push (list add 'add (list type)) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
- (setq del (gnus-sorted-range-intersection
+ (setq del (range-intersection
(gnus-active artgroup) del))
(push (list del 'del (list type)) delta-marks))))
@@ -899,26 +951,29 @@ article came from is also searched."
(setq list (cdr all))))
;; now merge with the original list and sort just to
;; make sure
- (setq list
- (sort (map-merge
- 'list list
- (alist-get type (gnus-info-marks group-info)))
- (lambda (elt1 elt2)
- (< (car elt1) (car elt2))))))
+ (setq
+ list (sort
+ (map-merge
+ 'alist list
+ (delq nil
+ (mapcar
+ (lambda (x) (unless (memq (car x) artlist) x))
+ (alist-get type (gnus-info-marks group-info)))))
+ 'car-less-than-car)))
(t
(setq list
- (gnus-compress-sequence
+ (range-compress-list
(gnus-sorted-union
(gnus-sorted-difference
(gnus-uncompress-sequence
(alist-get type (gnus-info-marks group-info)))
artlist)
- (sort list #'<)) t)))
+ (sort list #'<)))))
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq type 'seen)
- (setq list (gnus-range-add
+ (setq list (range-concat
list (cdr (assoc artgroup select-unseen))))))
(when (or list (eq type 'unexist))
@@ -941,16 +996,20 @@ article came from is also searched."
;; update read and unread
(gnus-update-read-articles
artgroup
- (gnus-uncompress-range
- (gnus-add-to-range
- (gnus-remove-from-range
+ (range-uncompress
+ (range-add-list
+ (range-remove
old-unread
(cdr (assoc artgroup select-reads)))
(sort (cdr (assoc artgroup select-unreads)) #'<))))
(gnus-get-unread-articles-in-group
- group-info (gnus-active artgroup) t)
- (gnus-group-update-group artgroup t t)))))))
-
+ group-info (gnus-active artgroup) t))
+ (gnus-group-update-group
+ artgroup t
+ (equal group-info
+ (setq group-info (copy-sequence (gnus-get-info artgroup))
+ group-info
+ (delq (gnus-info-params group-info) group-info)))))))))
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 038a6d0625f..f047c832931 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -36,6 +36,7 @@
(eval-when-compile (require 'cl-lib))
(autoload 'auth-source-search "auth-source")
+(autoload 'auth-info-password "auth-source")
(defgroup nntp nil
"NNTP access for Gnus."
@@ -305,7 +306,7 @@ backend doesn't catch this error.")
(nntp-record-command string))
(process-send-string process (concat string nntp-end-of-line))
(or (memq (process-status process) '(open run))
- (nntp-report "Server closed connection")))
+ (nntp-report "NNTP server %S closed connection" nntp-address)))
(defun nntp-record-command (string)
"Record the command STRING."
@@ -331,9 +332,7 @@ retried once before actually displaying the error report."
(when nntp-record-commands
(nntp-record-command "*** CALLED nntp-report ***"))
- (nnheader-report 'nntp args)
-
- (apply #'error args)))
+ (nnheader-report 'nntp args)))
(defsubst nntp-copy-to-buffer (buffer start end)
"Copy string from unibyte current buffer to multibyte buffer."
@@ -370,7 +369,7 @@ retried once before actually displaying the error report."
(nntp-snarf-error-message)
nil))
((not (memq (process-status process) '(open run)))
- (nntp-report "Server closed connection"))
+ (nntp-report "NNTP server %S closed connection" nntp-address))
(t
(goto-char (point-max))
(let ((limit (point-min))
@@ -1177,10 +1176,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
"563" "nntps" "snews"))))
(auth-user (plist-get auth-info :user))
(auth-force (plist-get auth-info :force))
- (auth-passwd (plist-get auth-info :secret))
- (auth-passwd (if (functionp auth-passwd)
- (funcall auth-passwd)
- auth-passwd))
+ (auth-passwd (auth-info-password auth-info))
(force (or (netrc-get alist "force")
nntp-authinfo-force
auth-force))
@@ -1229,6 +1225,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(generate-new-buffer
(format " *server %s %s %s*"
nntp-address nntp-port-number buffer))
+ (gnus-add-buffer)
(mm-disable-multibyte)
(setq-local after-change-functions nil
nntp-process-wait-for nil
@@ -1435,7 +1432,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
;; be the process's former output buffer (i.e. now killed)
(or (and process
(memq (process-status process) '(open run)))
- (nntp-report "Server closed connection")))))
+ (nntp-report "NNTP server %S closed connection" nntp-address)))))
(defun nntp-accept-response ()
"Wait for output from the process that outputs to BUFFER."
@@ -1454,7 +1451,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(when group
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(cond ((not entry)
- (nntp-report "Server closed connection"))
+ (nntp-report "NNTP server %S closed connection" nntp-address))
((not (equal group (caddr entry)))
(with-current-buffer (process-buffer (car entry))
(erase-buffer)
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 7478a2dd0af..ae4265de7fb 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -114,14 +114,9 @@ It is computed from the marks of individual component groups.")
(gnus-check-server
(gnus-find-method-for-group cgroup) t)
(gnus-request-group cgroup t)
- (setq prefix (gnus-group-real-prefix cgroup))
- ;; FIX FIX FIX we want to check the cache!
- ;; This is probably evil if people have set
- ;; gnus-use-cache to nil themselves, but I
- ;; have no way of finding the true value of it.
- (let ((gnus-use-cache t))
- (setq result (gnus-retrieve-headers
- articles cgroup nil))))
+ (setq prefix (gnus-group-real-prefix cgroup)
+ result (gnus-retrieve-headers
+ articles cgroup nil)))
(set-buffer nntp-server-buffer)
;; If we got HEAD headers, we convert them into NOV
;; headers. This is slow, inefficient and, come to think
@@ -365,7 +360,7 @@ It is computed from the marks of individual component groups.")
(lambda (article)
(nnvirtual-reverse-map-article
group article))
- (gnus-uncompress-range
+ (range-uncompress
(gnus-group-expire-articles-1 group))))))
(sort (delq nil unexpired) #'<)))
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index ac1e0810417..87b5551d31c 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -119,7 +119,7 @@
;;; Code:
(require 'dig)
-
+(require 'gnutls)
(require 'password-cache)
(eval-when-compile (require 'cl-lib))
@@ -149,10 +149,11 @@ certificate."
:type '(choice (const :tag "none" nil)
directory))
-(defcustom smime-CA-file nil
- "Files containing certificates for CAs you trust.
-File should contain certificates in PEM format."
- :version "22.1"
+(defcustom smime-CA-file (car (gnutls-trustfiles))
+ "File containing certificates for CAs you trust.
+The file should contain certificates in PEM format. By default,
+this is initialized from the `gnutls-trusfiles' variable."
+ :version "29.1"
:type '(choice (const :tag "none" nil)
file))
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index b0d258d67a5..084eb3d7745 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -189,7 +189,7 @@ When using `spam-stat-process-spam-directory' or
been touched in this many days will be considered. Without
this filter, re-training spam-stat with several thousand messages
will start to take a very long time."
- :type 'number)
+ :type 'integer)
(defvar spam-stat-last-saved-at nil
"Time stamp of last change of spam-stat-file on this run")
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 4b12a9a7804..5af29c0a246 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -663,13 +663,13 @@ order for SpamAssassin to recognize the new registered spam."
;;; Key bindings for spam control.
-(gnus-define-keys gnus-summary-mode-map
- "St" spam-generic-score
- "Sx" gnus-summary-mark-as-spam
- "Mst" spam-generic-score
- "Msx" gnus-summary-mark-as-spam
- "\M-d" gnus-summary-mark-as-spam
- "$" gnus-summary-mark-as-spam)
+(define-keymap :keymap gnus-summary-mode-map
+ "S t" #'spam-generic-score
+ "S x" #'gnus-summary-mark-as-spam
+ "M s t" #'spam-generic-score
+ "M s x" #'gnus-summary-mark-as-spam
+ "M-d" #'gnus-summary-mark-as-spam
+ "$" #'gnus-summary-mark-as-spam)
(defvar spam-cache-lookups t
"Whether spam.el will try to cache lookups using `spam-caches'.")
@@ -852,7 +852,7 @@ The value nil means that the check does not yield a decision, and
so, that further checks are needed. The value t means that the
message is definitely not spam, and that further spam checks
should be inhibited. Otherwise, a mailgroup name or the symbol
-'spam (depending on `spam-split-symbolic-return') is returned where
+`spam' (depending on `spam-split-symbolic-return') is returned where
the mail should go, and further checks are also inhibited. The
usual mailgroup name is the value of `spam-split-group', meaning
that the message is definitely a spam."
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index b2ba12bef20..1a6d374db09 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -81,25 +81,37 @@ If this produces no string either, return nil."
(echo (help-at-pt-string)))
(if (and kbd (not (eq kbd t))) kbd echo)))
+(declare-function widget-describe "wid-edit" (&optional widget-or-pos))
+(declare-function widget-at "wid-edit" (&optional pos))
+
;;;###autoload
-(defun display-local-help (&optional arg)
+(defun display-local-help (&optional inhibit-warning describe-button)
"Display local help in the echo area.
-This displays a short help message, namely the string produced by
-the `kbd-help' property at point. If `kbd-help' does not produce
-a string, but the `help-echo' property does, then that string is
-printed instead.
+This command, by default, displays a short help message, namely
+the string produced by the `kbd-help' property at point. If
+`kbd-help' does not produce a string, but the `help-echo'
+property does, then that string is printed instead.
The string is passed through `substitute-command-keys' before it
is displayed.
-A numeric argument ARG prevents display of a message in case
-there is no help. While ARG can be used interactively, it is
-mainly meant for use from Lisp."
- (interactive "P")
+If INHIBIT-WARNING is non-nil, this prevents display of a message
+in case there is no help.
+
+If DESCRIBE-BUTTON in non-nil (interactively, the prefix arg), and
+there's a button/widget at point, pop a buffer describing that
+button/widget instead."
+ (interactive (list nil current-prefix-arg))
(let ((help (help-at-pt-kbd-string)))
- (if help
- (message "%s" (substitute-command-keys help))
- (if (not arg) (message "No local help at point")))))
+ (cond
+ ((and describe-button (button-at (point)))
+ (button-describe))
+ ((and describe-button (widget-at (point)))
+ (widget-describe))
+ (help
+ (message "%s" (substitute-command-keys help)))
+ ((not inhibit-warning)
+ (message "No local help at point")))))
(defvar help-at-pt-timer nil
"Non-nil means that a timer is set that checks for local help.
@@ -229,11 +241,11 @@ this option, or use \"In certain situations\" and specify no text
properties, to enable buffer local values."
never))
:initialize 'custom-initialize-default
- :set #'(lambda (variable value)
- (set-default variable value)
- (if (eq value 'never)
- (help-at-pt-cancel-timer)
- (help-at-pt-set-timer)))
+ :set (lambda (variable value)
+ (set-default variable value)
+ (if (eq value 'never)
+ (help-at-pt-cancel-timer)
+ (help-at-pt-set-timer)))
:set-after '(help-at-pt-timer-delay)
:require 'help-at-pt)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f78c6ab0dfa..fbd40158701 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -33,6 +33,7 @@
;;; Code:
(require 'cl-lib)
+(require 'seq)
(require 'help-mode)
(require 'radix-tree)
(eval-when-compile (require 'subr-x)) ;For when-let.
@@ -132,6 +133,19 @@ with the current prefix. The files are chosen according to
:group 'help
:version "26.3")
+(defcustom help-enable-variable-value-editing nil
+ "If non-nil, allow editing values in *Help* buffers.
+
+To edit the value of a variable, use \\[describe-variable] to
+display a \"*Help*\" buffer, move point after the text
+\"Its value is\" and type \\`e'.
+
+Values that aren't readable by the Emacs Lisp reader can't be
+edited even if this option is enabled."
+ :type 'boolean
+ :group 'help
+ :version "29.1")
+
(defcustom help-enable-symbol-autoload nil
"Perform autoload if docs are missing from autoload objects."
:type 'boolean
@@ -249,7 +263,8 @@ handling of autoloaded functions."
;; calling that.
(let ((describe-function-orig-buffer
(or describe-function-orig-buffer
- (current-buffer))))
+ (current-buffer)))
+ (help-buffer-under-preparation t))
(help-setup-xref
(list (lambda (function buffer)
@@ -394,7 +409,7 @@ if the variable `help-downcase-arguments' is non-nil."
;; `describe-face' (instead of `describe-simplify-lib-file-name').
;;;###autoload
-(defun find-lisp-object-file-name (object type)
+(defun find-lisp-object-file-name (object type &optional also-c-source)
"Guess the file that defined the Lisp object OBJECT, of type TYPE.
OBJECT should be a symbol associated with a function, variable, or face;
alternatively, it can be a function definition.
@@ -405,8 +420,13 @@ If TYPE is not a symbol, search for a function definition.
The return value is the absolute name of a readable file where OBJECT is
defined. If several such files exist, preference is given to a file
found via `load-path'. The return value can also be `C-source', which
-means that OBJECT is a function or variable defined in C. If no
-suitable file is found, return nil."
+means that OBJECT is a function or variable defined in C, but
+it's currently unknown where. If no suitable file is found,
+return nil.
+
+If ALSO-C-SOURCE is non-nil, instead of returning `C-source',
+this function will attempt to locate the definition of OBJECT in
+the C sources, too."
(let* ((autoloaded (autoloadp type))
(file-name (or (and autoloaded (nth 1 type))
(symbol-file
@@ -443,14 +463,18 @@ suitable file is found, return nil."
(cond
((and (not file-name) (subrp type))
;; A built-in function. The form is from `describe-function-1'.
- (if (get-buffer " *DOC*")
+ (if (or (get-buffer " *DOC*")
+ (and also-c-source
+ (get-buffer-create " *DOC*")))
(help-C-file-name type 'subr)
'C-source))
((and (not file-name) (symbolp object)
(eq type 'defvar)
(integerp (get object 'variable-documentation)))
;; A variable defined in C. The form is from `describe-variable'.
- (if (get-buffer " *DOC*")
+ (if (or (get-buffer " *DOC*")
+ (and also-c-source
+ (get-buffer-create " *DOC*")))
(help-C-file-name object 'var)
'C-source))
((not (stringp file-name))
@@ -495,9 +519,16 @@ suitable file is found, return nil."
(let ((pt2 (with-current-buffer standard-output (point)))
(remapped (command-remapping function)))
(unless (memq remapped '(ignore undefined))
- (let ((keys (where-is-internal
- (or remapped function) overriding-local-map nil nil))
- non-modified-keys)
+ (let* ((all-keys (where-is-internal
+ (or remapped function) overriding-local-map nil nil))
+ (seps (seq-group-by
+ (lambda (key)
+ (and (vectorp key)
+ (eq (elt key 0) 'menu-bar)))
+ all-keys))
+ (keys (cdr (assq nil seps)))
+ (menus (cdr (assq t seps)))
+ non-modified-keys)
(if (and (eq function 'self-insert-command)
(vectorp (car-safe keys))
(consp (aref (car keys) 0)))
@@ -521,29 +552,85 @@ suitable file is found, return nil."
;; don't mention them one by one.
(if (< (length non-modified-keys) 10)
(with-current-buffer standard-output
- (insert (mapconcat #'help--key-description-fontified
- keys ", ")))
+ (help-fns--insert-bindings keys))
(dolist (key non-modified-keys)
(setq keys (delq key keys)))
(if keys
(with-current-buffer standard-output
- (insert (mapconcat #'help--key-description-fontified
- keys ", "))
+ (help-fns--insert-bindings keys)
(insert ", and many ordinary text characters"))
- (princ "many ordinary text characters"))))
+ (princ "many ordinary text characters."))))
(when (or remapped keys non-modified-keys)
(princ ".")
- (terpri)))))
+ (terpri)))
- (with-current-buffer standard-output
- (fill-region-as-paragraph pt2 (point))
- (unless (looking-back "\n\n" (- (point) 2))
- (terpri))))))
+ (with-current-buffer standard-output
+ (fill-region-as-paragraph pt2 (point))
+ (unless (bolp)
+ (insert "\n"))
+ (when menus
+ (let ((start (point)))
+ (help-fns--insert-menu-bindings
+ menus
+ (concat "It can " (and keys "also ")
+ "be invoked from the menu: "))
+ (fill-region-as-paragraph start (point))))
+ (ensure-empty-lines)))))))
+
+(defun help-fns--insert-bindings (keys)
+ (seq-do-indexed (lambda (key i)
+ (insert
+ (cond ((zerop i) "")
+ ((= i (1- (length keys))) " and ")
+ (t ", ")))
+ (insert (help--key-description-fontified key)))
+ keys))
+
+(defun help-fns--insert-menu-bindings (menus heading)
+ (seq-do-indexed
+ (lambda (menu i)
+ (insert
+ (cond ((zerop i) "")
+ ((= i (1- (length menus))) " and ")
+ (t ", ")))
+ (let ((map (lookup-key global-map (seq-take menu 1)))
+ (start (point)))
+ (seq-do-indexed
+ (lambda (entry level)
+ (when (symbolp map)
+ (setq map (symbol-function map)))
+ (when-let ((elem (assq entry (cdr map))))
+ (when heading
+ (insert heading)
+ (setq heading nil start (point)))
+ (when (> level 0)
+ (insert
+ (if (char-displayable-p ?→)
+ " → "
+ " => ")))
+ (if (eq (nth 1 elem) 'menu-item)
+ (progn
+ (insert (nth 2 elem))
+ (setq map (cadddr elem)))
+ (insert (nth 1 elem))
+ (setq map (cddr elem)))))
+ (cdr (seq-into menu 'list)))
+ (put-text-property start (point) 'face 'help-key-binding)))
+ menus))
(defun help-fns--compiler-macro (function)
- (let ((handler (function-get function 'compiler-macro)))
+ (pcase-dolist (`(,type . ,handler)
+ (list (cons "compiler macro"
+ (function-get function 'compiler-macro))
+ (cons (substitute-command-keys "`byte-compile' property")
+ (function-get function 'byte-compile))
+ (cons "byte-code optimizer"
+ (function-get function 'byte-optimizer))))
(when handler
- (insert " This function has a compiler macro")
+ (if (bolp)
+ (insert " This function has a ")
+ (insert " and a "))
+ (insert type)
(if (symbolp handler)
(progn
(insert (format-message " `%s'" handler))
@@ -558,8 +645,17 @@ suitable file is found, return nil."
(save-excursion
(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
- (help-xref-button 1 'help-function-cmacro function lib)))))
- (insert ".\n"))))
+ (help-xref-button 1 'help-function-cmacro function lib)))))))
+ (unless (bolp)
+ (insert ". See "
+ (buttonize "the manual"
+ (lambda (_) (info "(elisp)Advice and Byte Code")))
+ " for details.\n")
+ (save-restriction
+ (let ((fill-prefix " "))
+ (narrow-to-region (line-beginning-position -1) (point))
+ (fill-region (point-min) (point-max)))
+ (goto-char (point-max)))))
(defun help-fns--signature (function doc real-def real-function buffer)
"Insert usage at point and return docstring. With highlighting."
@@ -629,19 +725,22 @@ suitable file is found, return nil."
;; Ignore lambda constructs, keyboard macros, etc.
(let* ((obsolete (and (symbolp function)
(get function 'byte-obsolete-info)))
- (use (car obsolete)))
+ (use (car obsolete))
+ (start (point)))
(when obsolete
- (insert " This "
+ (insert "This "
(if (eq (car-safe (symbol-function function)) 'macro)
"macro"
"function")
" is obsolete")
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
- (insert (cond ((stringp use) (concat ";\n " use))
- (use (format-message ";\n use `%s' instead." use))
+ (insert (cond ((stringp use) (concat "; " use))
+ (use (format-message "; use `%s' instead." use))
(t "."))
- "\n"))))
+ "\n")
+ (fill-region-as-paragraph start (point))
+ (ensure-empty-lines))))
(add-hook 'help-fns-describe-function-functions
#'help-fns--globalized-minor-mode)
@@ -652,19 +751,9 @@ suitable file is found, return nil."
(terpri)))
;; We could use `symbol-file' but this is a wee bit more efficient.
-(defun help-fns--autoloaded-p (function file)
- "Return non-nil if FUNCTION has previously been autoloaded.
-FILE is the file where FUNCTION was probably defined."
- (let* ((file (file-name-sans-extension (file-truename file)))
- (load-hist load-history)
- (target (cons t function))
- found)
- (while (and load-hist (not found))
- (and (stringp (caar load-hist))
- (equal (file-name-sans-extension (caar load-hist)) file)
- (setq found (member target (cdar load-hist))))
- (setq load-hist (cdr load-hist)))
- found))
+(defun help-fns--autoloaded-p (function)
+ "Return non-nil if FUNCTION has previously been autoloaded."
+ (seq-some #'autoloadp (get function 'function-history)))
(defun help-fns--interactive-only (function)
"Insert some help blurb if FUNCTION should only be used interactively."
@@ -718,21 +807,23 @@ FILE is the file where FUNCTION was probably defined."
(erase-buffer)
(insert-file-contents f)
(goto-char (point-min))
- (search-forward "\n*")
- (while (re-search-forward re nil t)
- (let ((pos (match-beginning 0)))
- (save-excursion
- ;; Almost all entries are of the form "* ... in Emacs NN.MM."
- ;; but there are also a few in the form "* Emacs NN.MM is a bug
- ;; fix release ...".
- (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)"
- nil t))
- (message "Ref found in non-versioned section in %S"
- (file-name-nondirectory f))
- (let ((version (match-string 1)))
- (when (or (null first) (version< version first))
- (setq place (list f pos))
- (setq first version)))))))))
+ ;; Failed git merges can leave empty files that look like NEWS
+ ;; in etc. Don't error here.
+ (when (search-forward "\n*" nil t)
+ (while (re-search-forward re nil t)
+ (let ((pos (match-beginning 0)))
+ (save-excursion
+ ;; Almost all entries are of the form "* ... in Emacs NN.MM."
+ ;; but there are also a few in the form "* Emacs NN.MM is a bug
+ ;; fix release ...".
+ (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)"
+ nil t))
+ (message "Ref found in non-versioned section in %S"
+ (file-name-nondirectory f))
+ (let ((version (match-string 1)))
+ (when (or (null first) (version< version first))
+ (setq place (list f pos))
+ (setq first version))))))))))
(when first
(make-text-button first nil 'type 'help-news 'help-args place))))
@@ -774,9 +865,10 @@ FILE is the file where FUNCTION was probably defined."
(insert-text-button
(symbol-name group)
'action (lambda (_)
- (shortdoc-display-group group object))
+ (shortdoc-display-group group object
+ help-window-keep-selected))
'follow-link t
- 'help-echo (purecopy "mouse-1, RET: show documentation group")))
+ 'help-echo "mouse-1, RET: show documentation group"))
groups)
(insert (if (= (length groups) 1)
" group.\n"
@@ -828,11 +920,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(symbol-name function)))))))
(real-def (cond
((and aliased (not (subrp def)))
- (let ((f real-function))
- (while (and (fboundp f)
- (symbolp (symbol-function f)))
- (setq f (symbol-function f)))
- f))
+ (car (function-alias-p real-function t)))
((subrp def) (intern (subr-name def)))
(t def))))
@@ -851,13 +939,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
"Print a line describing FUNCTION to `standard-output'."
(pcase-let* ((`(,_real-function ,def ,aliased ,real-def)
(help-fns--analyze-function function))
- (file-name (find-lisp-object-file-name function (if aliased 'defun
- def)))
+ (file-name (find-lisp-object-file-name
+ function (if aliased 'defun def)))
(beg (if (and (or (byte-code-function-p def)
(keymapp def)
(memq (car-safe def) '(macro lambda closure)))
(stringp file-name)
- (help-fns--autoloaded-p function file-name))
+ (help-fns--autoloaded-p function))
(concat
"an autoloaded " (if (commandp def)
"interactive "))
@@ -946,12 +1034,20 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;;;###autoload
(defun describe-function-1 (function)
- (let ((pt1 (with-current-buffer (help-buffer) (point))))
+ (let ((pt1 (with-current-buffer standard-output (point))))
(help-fns-function-description-header function)
- (with-current-buffer (help-buffer)
- (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
- (point))))
- (terpri)(terpri)
+ (with-current-buffer standard-output
+ (let ((inhibit-read-only t))
+ (fill-region-as-paragraph
+ (save-excursion
+ (goto-char pt1)
+ (forward-line 0)
+ (point))
+ (point)
+ nil t)
+ (ensure-empty-lines))))
+
+ (help-fns--obsolete function)
(pcase-let* ((`(,real-function ,def ,_aliased ,real-def)
(help-fns--analyze-function function))
@@ -960,8 +1056,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;; for invalid functions i.s.o. signaling an error.
(documentation function t)
;; E.g. an alias for a not yet defined function.
- ((invalid-function void-function) nil)))
- (key-bindings-buffer (current-buffer)))
+ ((invalid-function void-function) nil))))
;; If the function is autoloaded, and its docstring has
;; key substitution constructs, load the library.
@@ -978,7 +1073,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(help-fns--signature
function doc-raw
(if (subrp def) (indirect-function real-def) real-def)
- real-function key-bindings-buffer)
+ real-function describe-function-orig-buffer)
;; E.g. an alias for a not yet defined function.
((invalid-function void-function) doc-raw))))
(help-fns--ensure-empty-line)
@@ -992,10 +1087,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(set-buffer-file-coding-system 'utf-8)))))
;; Add defaults to `help-fns-describe-function-functions'.
-(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
(add-hook 'help-fns-describe-function-functions #'help-fns--interactive-only)
(add-hook 'help-fns-describe-function-functions #'help-fns--parent-mode)
-(add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro)
+(add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro 100)
;; Variables
@@ -1078,7 +1172,8 @@ it is displayed along with the global value."
(if (symbolp v) (symbol-name v))))
(list (if (equal val "")
v (intern val)))))
- (let (file-name)
+ (let (file-name
+ (help-buffer-under-preparation t))
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
(unless (frame-live-p frame) (setq frame (selected-frame)))
(if (not (symbolp variable))
@@ -1138,24 +1233,28 @@ it is displayed along with the global value."
(let ((rep
(let ((print-quoted t)
(print-circle t))
- (cl-prin1-to-string val))))
- (if (and (symbolp val) (not (booleanp val)))
+ (cl-prin1-to-string val))))
+ (if (and (symbolp val) (not (booleanp val)))
(format-message "`%s'" rep)
- rep))))
+ rep)))
+ (start (point)))
(if (< (+ (length print-rep) (point) (- line-beg)) 68)
(insert " " print-rep)
(terpri)
(let ((buf (current-buffer)))
(with-temp-buffer
- (lisp-mode-variables nil)
+ (lisp-data-mode)
(set-syntax-table emacs-lisp-mode-syntax-table)
(insert print-rep)
(pp-buffer)
+ (font-lock-ensure)
(let ((pp-buffer (current-buffer)))
(with-current-buffer buf
(insert-buffer-substring pp-buffer)))))
;; Remove trailing newline.
(and (= (char-before) ?\n) (delete-char -1)))
+ (help-fns--editable-variable start (point)
+ variable val buffer)
(let* ((sv (get variable 'standard-value))
(origval (and (consp sv)
(condition-case nil
@@ -1175,6 +1274,8 @@ it is displayed along with the global value."
(save-restriction
(narrow-to-region from (point))
(save-excursion (pp-buffer)))
+ (help-fns--editable-variable from (point)
+ variable origval buffer)
(if (< (point) (+ from 20))
(delete-region (1- from) from)))))))
(terpri)
@@ -1207,7 +1308,9 @@ it is displayed along with the global value."
;; See previous comment for this function.
;; (help-xref-on-pp from (point))
(if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
+ (delete-region (1- from) from))
+ (help-fns--editable-variable
+ from (point) variable global-val buffer))))))
(terpri))
;; If the value is large, move it to the end.
@@ -1239,6 +1342,7 @@ it is displayed along with the global value."
alias 'variable-documentation))))
(with-current-buffer standard-output
+ (help-fns--var-obsolete variable)
(insert (or doc "Not documented as a variable.")))
;; Output the indented administrative bits.
@@ -1257,6 +1361,73 @@ it is displayed along with the global value."
;; Return the text we displayed.
(buffer-string))))))))
+(defun help-fns--editable-variable (start end variable value buffer)
+ (when (and (readablep value)
+ help-enable-variable-value-editing)
+ (add-text-properties
+ start end
+ (list 'help-echo "`e' to edit the value"
+ 'help-fns--edit-variable (list variable value buffer
+ (current-buffer))
+ 'keymap (define-keymap
+ :parent button-map
+ "e" #'help-fns-edit-variable)))))
+
+(defvar help-fns--edit-variable)
+
+(put 'help-fns-edit-variable 'disabled t)
+(defun help-fns-edit-variable ()
+ "Edit the variable under point."
+ (declare (completion ignore))
+ (interactive)
+ (let ((var (get-text-property (point) 'help-fns--edit-variable)))
+ (unless var
+ (error "No variable under point"))
+ (pop-to-buffer-same-window (format "*edit %s*" (nth 0 var)))
+ (prin1 (nth 1 var) (current-buffer))
+ (pp-buffer)
+ (goto-char (point-min))
+ (help-fns--edit-value-mode)
+ (insert (format ";; Edit the `%s' variable.\n" (nth 0 var))
+ (substitute-command-keys
+ ";; `\\[help-fns-edit-mode-done]' to update the value and exit; \
+`\\[help-fns-edit-mode-cancel]' to cancel.\n\n"))
+ (setq-local help-fns--edit-variable var)))
+
+(defvar-keymap help-fns--edit-value-mode-map
+ "C-c C-c" #'help-fns-edit-mode-done
+ "C-c C-k" #'help-fns-edit-mode-cancel)
+
+(define-derived-mode help-fns--edit-value-mode emacs-lisp-mode "Elisp"
+ :interactive nil)
+
+(defun help-fns-edit-mode-done (&optional kill)
+ "Update the value of the variable being edited and kill the edit buffer.
+If KILL (the prefix), don't update the value, but just kill the
+current buffer."
+ (interactive "P" help-fns--edit-value-mode)
+ (unless help-fns--edit-variable
+ (error "Invalid buffer"))
+ (goto-char (point-min))
+ (cl-destructuring-bind (variable _ buffer help-buffer)
+ help-fns--edit-variable
+ (unless (buffer-live-p buffer)
+ (error "Original buffer is gone; can't update"))
+ (unless kill
+ (let ((value (read (current-buffer))))
+ (with-current-buffer buffer
+ (set variable value))))
+ (kill-buffer (current-buffer))
+ (when (buffer-live-p help-buffer)
+ (with-current-buffer help-buffer
+ (revert-buffer)))))
+
+(defun help-fns-edit-mode-cancel ()
+ "Kill the edit buffer and cancel editing of the value.
+This cancels value editing without updating the value."
+ (interactive nil help-fns--edit-value-mode)
+ (help-fns-edit-mode-done t))
+
(defun help-fns--run-describe-functions (functions &rest args)
(with-current-buffer standard-output
(unless (bolp)
@@ -1373,19 +1544,21 @@ variable.\n")))
(princ watchpoints)
(terpri))))
-(add-hook 'help-fns-describe-variable-functions #'help-fns--var-obsolete)
(defun help-fns--var-obsolete (variable)
(let* ((obsolete (get variable 'byte-obsolete-variable))
- (use (car obsolete)))
+ (use (car obsolete))
+ (start (point)))
(when obsolete
- (princ " This variable is obsolete")
+ (insert "This variable is obsolete")
(if (nth 2 obsolete)
- (princ (format " since %s" (nth 2 obsolete))))
- (princ (cond ((stringp use) (concat ";\n " use))
- (use (format-message ";\n use `%s' instead."
- (car obsolete)))
- (t ".")))
- (terpri))))
+ (insert (format " since %s" (nth 2 obsolete))))
+ (insert (cond ((stringp use) (concat "; " use))
+ (use (format-message "; use `%s' instead."
+ (car obsolete)))
+ (t "."))
+ "\n")
+ (fill-region-as-paragraph start (point))
+ (ensure-empty-lines))))
(add-hook 'help-fns-describe-variable-functions #'help-fns--var-alias)
(defun help-fns--var-alias (variable)
@@ -1461,77 +1634,78 @@ If FRAME is omitted or nil, use the selected frame."
(interactive (list (read-face-name "Describe face"
(or (face-at-point t) 'default)
t)))
- (help-setup-xref (list #'describe-face face)
- (called-interactively-p 'interactive))
- (unless face
- (setq face 'default))
- (if (not (listp face))
- (setq face (list face)))
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (dolist (f face (buffer-string))
- (if (stringp f) (setq f (intern f)))
- ;; We may get called for anonymous faces (i.e., faces
- ;; expressed using prop-value plists). Those can't be
- ;; usefully customized, so ignore them.
- (when (symbolp f)
- (insert "Face: " (symbol-name f))
- (if (not (facep f))
- (insert " undefined face.\n")
- (let ((customize-label "customize this face")
- file-name)
- (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
- (princ (concat " (" customize-label ")\n"))
- ;; FIXME not sure how much of this belongs here, and
- ;; how much in `face-documentation'. The latter is
- ;; not used much, but needs to return nil for
- ;; undocumented faces.
- (let ((alias (get f 'face-alias))
- (face f)
- obsolete)
- (when alias
- (setq face alias)
- (insert
- (format-message
- "\n %s is an alias for the face `%s'.\n%s"
- f alias
- (if (setq obsolete (get f 'obsolete-face))
- (format-message
- " This face is obsolete%s; use `%s' instead.\n"
- (if (stringp obsolete)
- (format " since %s" obsolete)
- "")
- alias)
- ""))))
- (insert "\nDocumentation:\n"
- (substitute-command-keys
- (or (face-documentation face)
- "Not documented as a face."))
- "\n\n"))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-face f)))
- (setq file-name (find-lisp-object-file-name f 'defface))
- (if (not file-name)
- (setq help-mode--current-data (list :symbol f))
- (setq help-mode--current-data (list :symbol f
- :file file-name))
- (princ (substitute-command-keys "Defined in `"))
- (princ (help-fns-short-filename file-name))
- (princ (substitute-command-keys "'"))
- ;; Make a hyperlink to the library.
- (save-excursion
- (re-search-backward
- (substitute-command-keys "`\\([^`']+\\)'") nil t)
- (help-xref-button 1 'help-face-def f file-name))
- (princ ".")
- (terpri)
- (terpri))))
- (terpri)
- (help-fns--run-describe-functions
- help-fns-describe-face-functions f frame))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-face face)
+ (called-interactively-p 'interactive))
+ (unless face
+ (setq face 'default))
+ (if (not (listp face))
+ (setq face (list face)))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (dolist (f face (buffer-string))
+ (if (stringp f) (setq f (intern f)))
+ ;; We may get called for anonymous faces (i.e., faces
+ ;; expressed using prop-value plists). Those can't be
+ ;; usefully customized, so ignore them.
+ (when (symbolp f)
+ (insert "Face: " (symbol-name f))
+ (if (not (facep f))
+ (insert " undefined face.\n")
+ (let ((customize-label "customize this face")
+ file-name)
+ (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
+ (princ (concat " (" customize-label ")\n"))
+ ;; FIXME not sure how much of this belongs here, and
+ ;; how much in `face-documentation'. The latter is
+ ;; not used much, but needs to return nil for
+ ;; undocumented faces.
+ (let ((alias (get f 'face-alias))
+ (face f)
+ obsolete)
+ (when alias
+ (setq face alias)
+ (insert
+ (format-message
+ "\n %s is an alias for the face `%s'.\n%s"
+ f alias
+ (if (setq obsolete (get f 'obsolete-face))
+ (format-message
+ " This face is obsolete%s; use `%s' instead.\n"
+ (if (stringp obsolete)
+ (format " since %s" obsolete)
+ "")
+ alias)
+ ""))))
+ (insert "\nDocumentation:\n"
+ (substitute-command-keys
+ (or (face-documentation face)
+ "Not documented as a face."))
+ "\n\n"))
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward
+ (concat "\\(" customize-label "\\)") nil t)
+ (help-xref-button 1 'help-customize-face f)))
+ (setq file-name (find-lisp-object-file-name f 'defface))
+ (if (not file-name)
+ (setq help-mode--current-data (list :symbol f))
+ (setq help-mode--current-data (list :symbol f
+ :file file-name))
+ (princ (substitute-command-keys "Defined in `"))
+ (princ (help-fns-short-filename file-name))
+ (princ (substitute-command-keys "'"))
+ ;; Make a hyperlink to the library.
+ (save-excursion
+ (re-search-backward
+ (substitute-command-keys "`\\([^`']+\\)'") nil t)
+ (help-xref-button 1 'help-face-def f file-name))
+ (princ ".")
+ (terpri)
+ (terpri))))
+ (terpri)
+ (help-fns--run-describe-functions
+ help-fns-describe-face-functions f frame)))))))
(add-hook 'help-fns-describe-face-functions
#'help-fns--face-custom-version-info)
@@ -1561,7 +1735,7 @@ If FRAME is omitted or nil, use the selected frame."
(:fontset . "Fontset")
(:extend . "Extend")
(:inherit . "Inherit")))
- (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
+ (max-width (apply #'max (mapcar (lambda (x) (length (cdr x)))
attrs))))
(dolist (a attrs)
(let ((attr (face-attribute face (car a) frame)))
@@ -1602,43 +1776,44 @@ current buffer and the selected frame, respectively."
(if found (symbol-name v-or-f)))))
(list (if (equal val "")
(or v-or-f "") (intern val)))))
- (if (not (symbolp symbol))
- (user-error "You didn't specify a function or variable"))
- (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
- (unless (frame-live-p frame) (setq frame (selected-frame)))
- (with-current-buffer (help-buffer)
- ;; Push the previous item on the stack before clobbering the output buffer.
- (help-setup-xref nil nil)
- (let* ((docs
- (nreverse
- (delq nil
- (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
- (when (funcall testfn symbol)
- ;; Don't record the current entry in the stack.
- (setq help-xref-stack-item nil)
- (cons name
- (funcall descfn symbol buffer frame))))
- describe-symbol-backends))))
- (single (null (cdr docs))))
- (while (cdr docs)
- (goto-char (point-min))
- (let ((inhibit-read-only t)
- (name (caar docs)) ;Name of doc currently at BOB.
- (doc (cdr (cadr docs)))) ;Doc to add at BOB.
- (when doc
- (insert doc)
- (delete-region (point)
- (progn (skip-chars-backward " \t\n") (point)))
- (insert "\n\n" (make-separator-line) "\n")
- (when name
- (insert (symbol-name symbol)
- " is also a " name "." "\n\n"))))
- (setq docs (cdr docs)))
- (unless single
- ;; Don't record the `describe-variable' item in the stack.
- (setq help-xref-stack-item nil)
- (help-setup-xref (list #'describe-symbol symbol) nil))
- (goto-char (point-min)))))
+ (let ((help-buffer-under-preparation t))
+ (if (not (symbolp symbol))
+ (user-error "You didn't specify a function or variable"))
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+ (with-current-buffer (help-buffer)
+ ;; Push the previous item on the stack before clobbering the output buffer.
+ (help-setup-xref nil nil)
+ (let* ((docs
+ (nreverse
+ (delq nil
+ (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
+ (when (funcall testfn symbol)
+ ;; Don't record the current entry in the stack.
+ (setq help-xref-stack-item nil)
+ (cons name
+ (funcall descfn symbol buffer frame))))
+ describe-symbol-backends))))
+ (single (null (cdr docs))))
+ (while (cdr docs)
+ (goto-char (point-min))
+ (let ((inhibit-read-only t)
+ (name (caar docs)) ;Name of doc currently at BOB.
+ (doc (cdr (cadr docs)))) ;Doc to add at BOB.
+ (when doc
+ (insert doc)
+ (delete-region (point)
+ (progn (skip-chars-backward " \t\n") (point)))
+ (insert "\n\n" (make-separator-line) "\n")
+ (when name
+ (insert (symbol-name symbol)
+ " is also a " name "." "\n\n"))))
+ (setq docs (cdr docs)))
+ (unless single
+ ;; Don't record the `describe-variable' item in the stack.
+ (setq help-xref-stack-item nil)
+ (help-setup-xref (list #'describe-symbol symbol) nil))
+ (goto-char (point-min))))))
;;;###autoload
(defun describe-syntax (&optional buffer)
@@ -1647,15 +1822,16 @@ The descriptions are inserted in a help buffer, which is then displayed.
BUFFER defaults to the current buffer."
(interactive)
(setq buffer (or buffer (current-buffer)))
- (help-setup-xref (list #'describe-syntax buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (let ((table (with-current-buffer buffer (syntax-table))))
- (with-current-buffer standard-output
- (describe-vector table 'internal-describe-syntax-value)
- (while (setq table (char-table-parent table))
- (insert "\nThe parent syntax table is:")
- (describe-vector table 'internal-describe-syntax-value))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-syntax buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (let ((table (with-current-buffer buffer (syntax-table))))
+ (with-current-buffer standard-output
+ (describe-vector table 'internal-describe-syntax-value)
+ (while (setq table (char-table-parent table))
+ (insert "\nThe parent syntax table is:")
+ (describe-vector table 'internal-describe-syntax-value)))))))
(defun help-describe-category-set (value)
(insert (cond
@@ -1672,59 +1848,60 @@ The descriptions are inserted in a buffer, which is then displayed.
If BUFFER is non-nil, then describe BUFFER's category table instead.
BUFFER should be a buffer or a buffer name."
(interactive)
- (setq buffer (or buffer (current-buffer)))
- (help-setup-xref (list #'describe-categories buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (let* ((table (with-current-buffer buffer (category-table)))
- (docs (char-table-extra-slot table 0)))
- (if (or (not (vectorp docs)) (/= (length docs) 95))
- (error "Invalid first extra slot in this category table\n"))
- (with-current-buffer standard-output
- (setq-default help-button-cache (make-marker))
- (insert "Legend of category mnemonics ")
- (insert-button "(longer descriptions at the bottom)"
- 'action help-button-cache
- 'follow-link t
- 'help-echo "mouse-2, RET: show full legend")
- (insert "\n")
- (let ((pos (point)) (items 0) lines n)
- (dotimes (i 95)
- (if (aref docs i) (setq items (1+ items))))
- (setq lines (1+ (/ (1- items) 4)))
- (setq n 0)
+ (let ((help-buffer-under-preparation t))
+ (setq buffer (or buffer (current-buffer)))
+ (help-setup-xref (list #'describe-categories buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (let* ((table (with-current-buffer buffer (category-table)))
+ (docs (char-table-extra-slot table 0)))
+ (if (or (not (vectorp docs)) (/= (length docs) 95))
+ (error "Invalid first extra slot in this category table\n"))
+ (with-current-buffer standard-output
+ (setq-default help-button-cache (make-marker))
+ (insert "Legend of category mnemonics ")
+ (insert-button "(longer descriptions at the bottom)"
+ 'action help-button-cache
+ 'follow-link t
+ 'help-echo "mouse-2, RET: show full legend")
+ (insert "\n")
+ (let ((pos (point)) (items 0) lines n)
+ (dotimes (i 95)
+ (if (aref docs i) (setq items (1+ items))))
+ (setq lines (1+ (/ (1- items) 4)))
+ (setq n 0)
+ (dotimes (i 95)
+ (let ((elt (aref docs i)))
+ (when elt
+ (string-match ".*" elt)
+ (setq elt (match-string 0 elt))
+ (if (>= (length elt) 17)
+ (setq elt (concat (substring elt 0 14) "...")))
+ (if (< (point) (point-max))
+ (move-to-column (* 20 (/ n lines)) t))
+ (insert (+ i ?\s) ?: elt)
+ (if (< (point) (point-max))
+ (forward-line 1)
+ (insert "\n"))
+ (setq n (1+ n))
+ (if (= (% n lines) 0)
+ (goto-char pos))))))
+ (goto-char (point-max))
+ (insert "\n"
+ "character(s)\tcategory mnemonics\n"
+ "------------\t------------------")
+ (describe-vector table 'help-describe-category-set)
+ (set-marker help-button-cache (point))
+ (insert "Legend of category mnemonics:\n")
(dotimes (i 95)
(let ((elt (aref docs i)))
(when elt
- (string-match ".*" elt)
- (setq elt (match-string 0 elt))
- (if (>= (length elt) 17)
- (setq elt (concat (substring elt 0 14) "...")))
- (if (< (point) (point-max))
- (move-to-column (* 20 (/ n lines)) t))
- (insert (+ i ?\s) ?: elt)
- (if (< (point) (point-max))
- (forward-line 1)
- (insert "\n"))
- (setq n (1+ n))
- (if (= (% n lines) 0)
- (goto-char pos))))))
- (goto-char (point-max))
- (insert "\n"
- "character(s)\tcategory mnemonics\n"
- "------------\t------------------")
- (describe-vector table 'help-describe-category-set)
- (set-marker help-button-cache (point))
- (insert "Legend of category mnemonics:\n")
- (dotimes (i 95)
- (let ((elt (aref docs i)))
- (when elt
- (if (string-match "\n" elt)
- (setq elt (substring elt (match-end 0))))
- (insert (+ i ?\s) ": " elt "\n"))))
- (while (setq table (char-table-parent table))
- (insert "\nThe parent category table is:")
- (describe-vector table 'help-describe-category-set))))))
+ (if (string-match "\n" elt)
+ (setq elt (substring elt (match-end 0))))
+ (insert (+ i ?\s) ": " elt "\n"))))
+ (while (setq table (char-table-parent table))
+ (insert "\nThe parent category table is:")
+ (describe-vector table 'help-describe-category-set)))))))
(defun help-fns-find-keymap-name (keymap)
"Find the name of the variable with value KEYMAP.
@@ -1746,8 +1923,8 @@ variable with value KEYMAP."
The heuristic to determine which keymap is most likely to be
relevant to a user follows this order:
-1. 'keymap' text property at point
-2. 'local-map' text property at point
+1. `keymap' text property at point
+2. `local-map' text property at point
3. the `current-local-map'
This is used to set the default value for the interactive prompt
@@ -1766,7 +1943,10 @@ in `describe-keymap'. See also `Searching the Active Keymaps'."
When called interactively, prompt for a variable that has a
keymap value."
(interactive
- (let* ((km (help-fns--most-relevant-active-keymap))
+ (let* ((sym (symbol-at-point))
+ (km (or (and (keymapp (ignore-errors (symbol-value sym)))
+ sym)
+ (help-fns--most-relevant-active-keymap)))
(val (completing-read
(format-prompt "Keymap" km)
obarray
@@ -1778,7 +1958,8 @@ keymap value."
(unless (and km (keymapp (symbol-value km)))
(user-error "Not a keymap: %s" km))
(list km)))
- (let (used-gentemp)
+ (let (used-gentemp
+ (help-buffer-under-preparation t))
(unless (and (symbolp keymap)
(boundp keymap)
(keymapp (symbol-value keymap)))
@@ -1844,106 +2025,96 @@ whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
documentation for the major and minor modes of that buffer."
(interactive "@")
- (unless buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-mode buffer)
- (called-interactively-p 'interactive))
- ;; For the sake of help-do-xref and help-xref-go-back,
- ;; don't switch buffers before calling `help-buffer'.
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (let (minors)
- ;; Older packages do not register in minor-mode-list but only in
- ;; minor-mode-alist.
- (dolist (x minor-mode-alist)
- (setq x (car x))
- (unless (memq x minor-mode-list)
- (push x minor-mode-list)))
- ;; Find enabled minor mode we will want to mention.
- (dolist (mode minor-mode-list)
- ;; Document a minor mode if it is listed in minor-mode-alist,
- ;; non-nil, and has a function definition.
- (let ((fmode (or (get mode :minor-mode-function) mode)))
- (and (boundp mode) (symbol-value mode)
- (fboundp fmode)
- (let ((pretty-minor-mode
- (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
- (symbol-name fmode))
- (capitalize
- (substring (symbol-name fmode)
- 0 (match-beginning 0)))
- fmode)))
- (push (list fmode pretty-minor-mode
- (format-mode-line (assq mode minor-mode-alist)))
- minors)))))
- ;; Narrowing is not a minor mode, but its indicator is part of
- ;; mode-line-modes.
- (when (buffer-narrowed-p)
- (push '(narrow-to-region "Narrow" " Narrow") minors))
- (setq minors
- (sort minors
- (lambda (a b) (string-lessp (cadr a) (cadr b)))))
- (when minors
- (princ "Enabled minor modes:\n")
- (make-local-variable 'help-button-cache)
- (with-current-buffer standard-output
- (dolist (mode minors)
- (let ((mode-function (nth 0 mode))
- (pretty-minor-mode (nth 1 mode))
- (indicator (nth 2 mode)))
- (save-excursion
- (goto-char (point-max))
- (princ "\n\f\n")
- (push (point-marker) help-button-cache)
- ;; Document the minor modes fully.
- (insert-text-button
- pretty-minor-mode 'type 'help-function
- 'help-args (list mode-function)
- 'button '(t))
- (princ (format " minor mode (%s):\n"
- (if (zerop (length indicator))
- "no indicator"
- (format "indicator%s"
- indicator))))
- (princ (help-split-fundoc (documentation mode-function)
- nil 'doc)))
- (insert-button pretty-minor-mode
- 'action (car help-button-cache)
- 'follow-link t
- 'help-echo "mouse-2, RET: show full information")
- (newline)))
- (forward-line -1)
- (fill-paragraph nil)
- (forward-line 1))
-
- (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
- ;; Document the major mode.
- (let ((mode mode-name))
- (with-current-buffer standard-output
- (let ((start (point)))
- (insert (format-mode-line mode nil nil buffer))
- (add-text-properties start (point) '(face bold)))))
- (princ " mode")
- (let* ((mode major-mode)
- (file-name (find-lisp-object-file-name mode nil)))
- (if (not file-name)
- (setq help-mode--current-data (list :symbol mode))
- (princ (format-message " defined in `%s'"
- (help-fns-short-filename file-name)))
- ;; Make a hyperlink to the library.
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
- (setq help-mode--current-data (list :symbol mode
- :file file-name))
- (help-xref-button 1 'help-function-def mode file-name)))))
- (let ((fundoc (help-split-fundoc (documentation major-mode) nil 'doc)))
- (with-current-buffer standard-output
- (insert ":\n")
- (insert fundoc)
- (insert (help-fns--list-local-commands)))))))
- ;; For the sake of IELM and maybe others
- nil)
+ (unless buffer
+ (setq buffer (current-buffer)))
+ (let ((help-buffer-under-preparation t)
+ (local-minors (buffer-local-value 'local-minor-modes buffer)))
+ (help-setup-xref (list #'describe-mode buffer)
+ (called-interactively-p 'interactive))
+ ;; For the sake of help-do-xref and help-xref-go-back,
+ ;; don't switch buffers before calling `help-buffer'.
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ ;; Add the local minor modes at the start.
+ (when local-minors
+ (insert (format "Minor mode%s enabled in this buffer:"
+ (if (length> local-minors 1)
+ "s" "")))
+ (describe-mode--minor-modes local-minors))
+
+ ;; Document the major mode.
+ (let ((major (buffer-local-value 'major-mode buffer)))
+ (insert "The major mode is "
+ (buttonize
+ (propertize (format-mode-line
+ (buffer-local-value 'mode-name buffer)
+ nil nil buffer)
+ 'face 'bold)
+ (lambda (_)
+ (describe-function major))))
+ (insert " mode")
+ (when-let ((file-name (find-lisp-object-file-name major nil)))
+ (insert (format " defined in %s:\n\n"
+ (buttonize
+ (help-fns-short-filename file-name)
+ (lambda (_)
+ (help-function-def--button-function
+ major file-name))))))
+ (insert (help-split-fundoc (documentation major) nil 'doc)
+ (with-current-buffer buffer
+ (help-fns--list-local-commands)))
+ (ensure-empty-lines 1)
+
+ ;; Insert the global minor modes after the major mode.
+ (when global-minor-modes
+ (insert (format "Global minor mode%s enabled:"
+ (if (length> global-minor-modes 1)
+ "s" "")))
+ (describe-mode--minor-modes global-minor-modes)
+ (when (re-search-forward "^\f")
+ (beginning-of-line)
+ (ensure-empty-lines 1)))
+ ;; For the sake of IELM and maybe others
+ nil)))))
+
+(defun describe-mode--minor-modes (modes)
+ (dolist (mode (seq-sort #'string< modes))
+ (let ((pretty-minor-mode
+ (capitalize
+ (replace-regexp-in-string
+ "\\(\\(-minor\\)?-mode\\)?\\'" ""
+ (symbol-name mode)))))
+ (insert
+ " "
+ (buttonize
+ pretty-minor-mode
+ (lambda (mode)
+ (goto-char (point-min))
+ (text-property-search-forward
+ 'help-minor-mode mode t)
+ (beginning-of-line))
+ mode))
+ (save-excursion
+ (goto-char (point-max))
+ (insert "\n\n\f\n")
+ ;; Document the minor modes fully.
+ (insert (buttonize
+ (propertize pretty-minor-mode 'help-minor-mode mode)
+ (lambda (mode)
+ (describe-function mode))
+ mode))
+ (let ((indicator
+ (format-mode-line (assq mode minor-mode-alist))))
+ (insert (format " minor mode (%s):\n"
+ (if (zerop (length indicator))
+ "no indicator"
+ (format "indicator%s"
+ indicator)))))
+ (insert (help-split-fundoc (documentation mode) nil 'doc)))))
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-paragraph 1)
+ (ensure-empty-lines 1))
(defun help-fns--list-local-commands ()
(let ((functions nil))
@@ -1998,7 +2169,8 @@ one of them returns non-nil."
(event-end key))
((eq key ?\C-g) (signal 'quit nil))
(t (user-error "You didn't specify a widget"))))))
- (let (buf)
+ (let (buf
+ (help-buffer-under-preparation t))
;; Allow describing a widget in a different window.
(when (posnp pos)
(setq buf (window-buffer (posn-window pos))
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 7b6ccdc174e..91c2a804000 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -93,7 +93,8 @@ and then returns."
"Help command."
(interactive)
(let ((line-prompt
- (substitute-command-keys ,help-line)))
+ (substitute-command-keys ,help-line))
+ (help-buffer-under-preparation t))
(when three-step-help
(message "%s" line-prompt))
(let* ((help-screen ,help-text)
@@ -140,6 +141,7 @@ and then returns."
(insert (substitute-command-keys help-screen)))
(let ((minor-mode-map-alist new-minor-mode-map-alist))
(help-mode)
+ (variable-pitch-mode)
(setq new-minor-mode-map-alist minor-mode-map-alist))
(goto-char (point-min))
(while (or (memq char (append help-event-list
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index ee68d253cb8..8b5e48edad1 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -31,22 +31,23 @@
(require 'cl-lib)
-(defvar help-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map (make-composed-keymap button-buffer-map
- special-mode-map))
- (define-key map "l" 'help-go-back)
- (define-key map "r" 'help-go-forward)
- (define-key map "\C-c\C-b" 'help-go-back)
- (define-key map "\C-c\C-f" 'help-go-forward)
- (define-key map [XF86Back] 'help-go-back)
- (define-key map [XF86Forward] 'help-go-forward)
- (define-key map "\C-c\C-c" 'help-follow-symbol)
- (define-key map "s" 'help-view-source)
- (define-key map "i" 'help-goto-info)
- (define-key map "c" 'help-customize)
- map)
- "Keymap for Help mode.")
+(defvar-keymap help-mode-map
+ :doc "Keymap for Help mode."
+ :parent (make-composed-keymap button-buffer-map
+ special-mode-map)
+ "n" #'help-goto-next-page
+ "p" #'help-goto-previous-page
+ "l" #'help-go-back
+ "r" #'help-go-forward
+ "C-c C-b" #'help-go-back
+ "C-c C-f" #'help-go-forward
+ "<XF86Back>" #'help-go-back
+ "<XF86Forward>" #'help-go-forward
+ "C-c C-c" #'help-follow-symbol
+ "s" #'help-view-source
+ "I" #'help-goto-lispref-info
+ "i" #'help-goto-info
+ "c" #'help-customize)
(easy-menu-define help-mode-menu help-mode-map
"Menu for Help mode."
@@ -265,7 +266,9 @@ The format is (FUNCTION ARGS...).")
(let* ((location
(find-function-search-for-symbol fun type file))
(position (cdr location)))
- (pop-to-buffer (car location))
+ (if help-window-keep-selected
+ (pop-to-buffer-same-window (car location))
+ (pop-to-buffer (car location)))
(run-hooks 'find-function-after-hook)
(if position
(progn
@@ -273,6 +276,10 @@ The format is (FUNCTION ARGS...).")
(when (or (< position (point-min))
(> position (point-max)))
(widen))
+ ;; Save mark for the old location, unless the point is not
+ ;; actually going to move.
+ (unless (= (point) position)
+ (push-mark nil t))
(goto-char position))
(message "Unable to find location in file")))))
@@ -287,7 +294,10 @@ The format is (FUNCTION ARGS...).")
(setq file (locate-library file t))
(if (and file (file-readable-p file))
(progn
- (pop-to-buffer (find-file-noselect file))
+ (if help-window-keep-selected
+ (pop-to-buffer-same-window
+ (find-file-noselect file))
+ (pop-to-buffer (find-file-noselect file)))
(widen)
(goto-char (point-min))
(if (re-search-forward
@@ -306,7 +316,9 @@ The format is (FUNCTION ARGS...).")
(setq file (help-C-file-name var 'var)))
(let* ((location (find-variable-noselect var file))
(position (cdr location)))
- (pop-to-buffer (car location))
+ (if help-window-keep-selected
+ (pop-to-buffer-same-window (car location))
+ (pop-to-buffer (car location)))
(run-hooks 'find-function-after-hook)
(if position
(progn
@@ -327,7 +339,9 @@ The format is (FUNCTION ARGS...).")
(let* ((location
(find-function-search-for-symbol fun 'defface file))
(position (cdr location)))
- (pop-to-buffer (car location))
+ (if help-window-keep-selected
+ (pop-to-buffer-same-window (car location))
+ (pop-to-buffer (car location)))
(if position
(progn
;; Widen the buffer if necessary to go to this position.
@@ -369,9 +383,18 @@ The format is (FUNCTION ARGS...).")
:supertype 'help-xref
'help-function
(lambda (file pos)
- (view-buffer-other-window (find-file-noselect file))
+ (if help-window-keep-selected
+ (view-buffer (find-file-noselect file))
+ (view-buffer-other-window (find-file-noselect file)))
(goto-char pos))
'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
+
+;;;###autoload
+(defun help-mode--add-function-link (str fun)
+ (make-text-button (copy-sequence str) nil
+ 'type 'help-function
+ 'help-args (list fun)))
+
(defvar bookmark-make-record-function)
(defvar help-mode--current-data nil)
@@ -379,7 +402,8 @@ The format is (FUNCTION ARGS...).")
;;;###autoload
(define-derived-mode help-mode special-mode "Help"
"Major mode for viewing help text and navigating references in it.
-Entry to this mode runs the normal hook `help-mode-hook'.
+Also see the `help-enable-variable-value-editing' variable.
+
Commands:
\\{help-mode-map}"
(setq-local revert-buffer-function
@@ -389,17 +413,21 @@ Commands:
help-mode-tool-bar-map)
(setq-local help-mode--current-data nil)
(setq-local bookmark-make-record-function
- #'help-bookmark-make-record))
+ #'help-bookmark-make-record)
+ (unless search-default-mode
+ (isearch-fold-quotes-mode)))
;;;###autoload
(defun help-mode-setup ()
"Enter Help mode in the current buffer."
+ (declare (obsolete nil "29.1"))
(help-mode)
(setq buffer-read-only nil))
;;;###autoload
(defun help-mode-finish ()
"Finalize Help mode setup in current buffer."
+ (declare (obsolete nil "29.1"))
(when (derived-mode-p 'help-mode)
(setq buffer-read-only t)
(help-make-xrefs (current-buffer))))
@@ -424,6 +452,7 @@ Commands:
"\\(symbol\\|program\\|property\\)\\|" ; Don't link
"\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
"[ \t\n]+\\)?"
+ "\\(\\\\\\+\\)?"
"['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]"))
"Regexp matching doc string references to symbols.
@@ -484,17 +513,16 @@ restore it properly when going back."
;;;###autoload
(defun help-buffer ()
"Return the name of a buffer for inserting help.
-If `help-xref-following' is non-nil, this is the name of the
-current buffer. Signal an error if this buffer is not derived
-from `help-mode'.
+If `help-xref-following' is non-nil and the current buffer is
+derived from `help-mode', this is the name of the current buffer.
+
Otherwise, return \"*Help*\", creating a buffer with that name if
it does not already exist."
- (buffer-name ;for with-output-to-temp-buffer
- (if (not help-xref-following)
- (get-buffer-create "*Help*")
- (unless (derived-mode-p 'help-mode)
- (error "Current buffer is not in Help mode"))
- (current-buffer))))
+ (buffer-name ;for with-output-to-temp-buffer
+ (if (and help-xref-following
+ (derived-mode-p 'help-mode))
+ (current-buffer)
+ (get-buffer-create "*Help*"))))
(defvar describe-symbol-backends
`((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
@@ -513,6 +541,12 @@ Each element has the form (NAME TESTFUN DESCFUN) where:
and a frame), inserts the description of that symbol in the current buffer
and returns that text as well.")
+(defcustom help-clean-buttons nil
+ "If non-nil, remove quotes around link buttons."
+ :version "29.1"
+ :type 'boolean
+ :group 'help)
+
;;;###autoload
(defun help-make-xrefs (&optional buffer)
"Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -600,27 +634,28 @@ that."
;; Quoted symbols
(save-excursion
(while (re-search-forward help-xref-symbol-regexp nil t)
- (let* ((data (match-string 8))
- (sym (intern-soft data)))
- (if sym
- (cond
- ((match-string 3) ; `variable' &c
- (and (or (boundp sym) ; `variable' doesn't ensure
+ (when-let ((sym (intern-soft (match-string 9))))
+ (if (match-string 8)
+ (delete-region (match-beginning 8)
+ (match-end 8))
+ (cond
+ ((match-string 3) ; `variable' &c
+ (and (or (boundp sym) ; `variable' doesn't ensure
; it's actually bound
- (get sym 'variable-documentation))
- (help-xref-button 8 'help-variable sym)))
- ((match-string 4) ; `function' &c
- (and (fboundp sym) ; similarly
- (help-xref-button 8 'help-function sym)))
- ((match-string 5) ; `face'
- (and (facep sym)
- (help-xref-button 8 'help-face sym)))
- ((match-string 6)) ; nothing for `symbol'
- ((match-string 7)
- (help-xref-button 8 'help-function-def sym))
- ((cl-some (lambda (x) (funcall (nth 1 x) sym))
- describe-symbol-backends)
- (help-xref-button 8 'help-symbol sym)))))))
+ (get sym 'variable-documentation))
+ (help-xref-button 9 'help-variable sym)))
+ ((match-string 4) ; `function' &c
+ (and (fboundp sym) ; similarly
+ (help-xref-button 9 'help-function sym)))
+ ((match-string 5) ; `face'
+ (and (facep sym)
+ (help-xref-button 9 'help-face sym)))
+ ((match-string 6)) ; nothing for `symbol'
+ ((match-string 7)
+ (help-xref-button 9 'help-function-def sym))
+ ((cl-some (lambda (x) (funcall (nth 1 x) sym))
+ describe-symbol-backends)
+ (help-xref-button 9 'help-symbol sym)))))))
;; An obvious case of a key substitution:
(save-excursion
(while (re-search-forward
@@ -631,34 +666,7 @@ that."
"\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
(let ((sym (intern-soft (match-string 1))))
(if (fboundp sym)
- (help-xref-button 1 'help-function sym)))))
- ;; Look for commands in whole keymap substitutions:
- (save-excursion
- ;; Make sure to find the first keymap.
- (goto-char (point-min))
- ;; Find a header and the column at which the command
- ;; name will be found.
-
- ;; If the keymap substitution isn't the last thing in
- ;; the doc string, and if there is anything on the same
- ;; line after it, this code won't recognize the end of it.
- (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
- nil t)
- (let ((col (- (match-end 1) (match-beginning 1))))
- (while
- (and (not (eobp))
- ;; Stop at a pair of blank lines.
- (not (looking-at-p "\n\\s-*\n")))
- ;; Skip a single blank line.
- (and (eolp) (forward-line))
- (end-of-line)
- (skip-chars-backward "^ \t\n")
- (if (and (>= (current-column) col)
- (looking-at "\\(\\sw\\|\\s_\\)+$"))
- (let ((sym (intern-soft (match-string 0))))
- (if (fboundp sym)
- (help-xref-button 0 'help-function sym))))
- (forward-line))))))
+ (help-xref-button 1 'help-function sym))))))
(set-syntax-table stab))
;; Delete extraneous newlines at the end of the docstring
(goto-char (point-max))
@@ -687,12 +695,26 @@ that."
MATCH-NUMBER is the subexpression of interest in the last matched
regexp. TYPE is the type of button to use. Any remaining arguments are
passed to the button's help-function when it is invoked.
-See `help-make-xrefs'."
+See `help-make-xrefs'.
+
+This function removes quotes surrounding the match if the
+variable `help-clean-buttons' is non-nil."
;; Don't mung properties we've added specially in some instances.
- (unless (button-at (match-beginning match-number))
- (make-text-button (match-beginning match-number)
- (match-end match-number)
- 'type type 'help-args args)))
+ (let ((beg (match-beginning match-number))
+ (end (match-end match-number)))
+ (unless (button-at beg)
+ (make-text-button beg end 'type type 'help-args args)
+ (when (and help-clean-buttons
+ (> beg (point-min))
+ (save-excursion
+ (goto-char (1- beg))
+ (looking-at "['`‘]"))
+ (< end (point-max))
+ (save-excursion
+ (goto-char end)
+ (looking-at "['’]")))
+ (delete-region end (1+ end))
+ (delete-region (1- beg) beg)))))
;;;###autoload
(defun help-insert-xref-button (string type &rest args)
@@ -795,6 +817,26 @@ See `help-make-xrefs'."
(help-xref-go-forward (current-buffer))
(user-error "No next help buffer")))
+(defun help-goto-next-page ()
+ "Go to the next page (if any) in the current buffer.
+The help buffers are divided into \"pages\" by the ^L character."
+ (interactive nil help-mode)
+ (push-mark)
+ (forward-page)
+ (unless (eobp)
+ (forward-line 1)))
+
+(defun help-goto-previous-page ()
+ "Go to the previous page (if any) in the current buffer.
+(If not at the start of a page, go to the start of the current page.)
+
+The help buffers are divided into \"pages\" by the ^L character."
+ (interactive nil help-mode)
+ (push-mark)
+ (backward-page (if (looking-back "\f\n" (- (point) 5)) 2 1))
+ (unless (bobp)
+ (forward-line 1)))
+
(defun help-view-source ()
"View the source of the current help item."
(interactive nil help-mode)
@@ -811,7 +853,16 @@ See `help-make-xrefs'."
(unless help-mode--current-data
(error "No symbol to look up in the current buffer"))
(info-lookup-symbol (plist-get help-mode--current-data :symbol)
- 'emacs-lisp-mode))
+ 'emacs-lisp-mode
+ help-window-keep-selected))
+
+(defun help-goto-lispref-info ()
+ "View the Emacs Lisp manual *info* node of the current help item."
+ (interactive nil help-mode)
+ (unless help-mode--current-data
+ (error "No symbol to look up in the current buffer"))
+ (info-lookup-symbol (plist-get help-mode--current-data :symbol)
+ 'emacs-lisp-only))
(defun help-customize ()
"Customize variable or face whose doc string is shown in the current buffer."
@@ -921,6 +972,7 @@ BOOKMARK is a bookmark name or a bookmark record."
(pop-to-buffer "*Help*")
(goto-char position)))
+(put 'help-bookmark-jump 'bookmark-handler-type "Help")
(provide 'help-mode)
diff --git a/lisp/help.el b/lisp/help.el
index fd331ac0d48..abe17fa4ce2 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -50,6 +50,11 @@
(defvar help-window-old-frame nil
"Frame selected at the time `with-help-window' is invoked.")
+(defvar help-buffer-under-preparation nil
+ "Whether a *Help* buffer is being prepared.
+This variable is bound to t during the preparation of a *Help*
+buffer.")
+
(defvar help-map
(let ((map (make-sparse-keymap)))
(define-key map (char-to-string help-char) 'help-for-help)
@@ -387,16 +392,23 @@ If that doesn't give a function, return nil."
The prefix described consists of all but the last event
of the key sequence that ran this command."
(interactive)
- (let ((key (this-command-keys)))
- (describe-bindings
- (if (stringp key)
- (substring key 0 (1- (length key)))
- (let ((prefix (make-vector (1- (length key)) nil))
- (i 0))
- (while (< i (length prefix))
- (aset prefix i (aref key i))
- (setq i (1+ i)))
- prefix)))))
+ (let* ((key (this-command-keys))
+ (prefix
+ (if (stringp key)
+ (substring key 0 (1- (length key)))
+ (let ((prefix (make-vector (1- (length key)) nil))
+ (i 0))
+ (while (< i (length prefix))
+ (aset prefix i (aref key i))
+ (setq i (1+ i)))
+ prefix))))
+ (describe-bindings prefix)
+ (with-current-buffer (help-buffer)
+ (when (< (buffer-size) 10)
+ (let ((inhibit-read-only t))
+ (insert (format "No commands with a binding that start with %s."
+ (help--key-description-fontified prefix))))))))
+
;; Make C-h after a prefix, when not specifically bound,
;; run describe-prefix-bindings.
(setq prefix-help-command 'describe-prefix-bindings)
@@ -448,8 +460,8 @@ With argument, display info only for the selected version."
((< vn 18) "NEWS.1-17")
(t (format "NEWS.%d" vn))))
res)
- (view-file (expand-file-name file data-directory))
- (widen)
+ (find-file (expand-file-name file data-directory))
+ (emacs-news-view-mode)
(goto-char (point-min))
(when (stringp version)
(when (re-search-forward
@@ -524,30 +536,31 @@ See `lossage-size' to update the number of recorded keystrokes.
To record all your input, use `open-dribble-file'."
(interactive)
- (help-setup-xref (list #'view-lossage)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (princ " ")
- (princ (mapconcat (lambda (key)
- (cond
- ((and (consp key) (null (car key)))
- (format ";; %s\n" (if (symbolp (cdr key)) (cdr key)
- "anonymous-command")))
- ((or (integerp key) (symbolp key) (listp key))
- (single-key-description key))
- (t
- (prin1-to-string key nil))))
- (recent-keys 'include-cmds)
- " "))
- (with-current-buffer standard-output
- (goto-char (point-min))
- (let ((comment-start ";; ")
- (comment-column 24))
- (while (not (eobp))
- (comment-indent)
- (forward-line 1)))
- ;; Show point near the end of "lossage", as we did in Emacs 24.
- (set-marker help-window-point-marker (point)))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'view-lossage)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (princ " ")
+ (princ (mapconcat (lambda (key)
+ (cond
+ ((and (consp key) (null (car key)))
+ (format ";; %s\n" (if (symbolp (cdr key)) (cdr key)
+ "anonymous-command")))
+ ((or (integerp key) (symbolp key) (listp key))
+ (single-key-description key))
+ (t
+ (prin1-to-string key nil))))
+ (recent-keys 'include-cmds)
+ " "))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (let ((comment-start ";; ")
+ (comment-column 24))
+ (while (not (eobp))
+ (comment-indent)
+ (forward-line 1)))
+ ;; Show point near the end of "lossage", as we did in Emacs 24.
+ (set-marker help-window-point-marker (point))))))
;; Key bindings
@@ -561,11 +574,13 @@ To record all your input, use `open-dribble-file'."
'font-lock-face 'help-key-binding
'face 'help-key-binding))
-(defcustom describe-bindings-outline nil
+(defcustom describe-bindings-outline t
"Non-nil enables outlines in the output buffer of `describe-bindings'."
:type 'boolean
:group 'help
- :version "28.1")
+ :version "29.1")
+
+(declare-function outline-hide-subtree "outline")
(defun describe-bindings (&optional prefix buffer)
"Display a buffer showing a list of all defined keys, and their definitions.
@@ -577,33 +592,32 @@ The optional argument BUFFER specifies which buffer's bindings
to display (default, the current buffer). BUFFER can be a buffer
or a buffer name."
(interactive)
- (or buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-bindings prefix buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- ;; Be aware that `describe-buffer-bindings' puts its output into
- ;; the current buffer.
- (with-current-buffer (help-buffer)
- (describe-buffer-bindings buffer prefix)
-
- (when describe-bindings-outline
- (setq-local outline-regexp ".*:$")
- (setq-local outline-heading-end-regexp ":\n")
- (setq-local outline-level (lambda () 1))
- (setq-local outline-minor-mode-cycle t
- outline-minor-mode-highlight t)
- (outline-minor-mode 1)
- (save-excursion
- (let ((inhibit-read-only t))
+ (let ((help-buffer-under-preparation t))
+ (or buffer (setq buffer (current-buffer)))
+ (help-setup-xref (list #'describe-bindings prefix buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (describe-buffer-bindings buffer prefix)
+
+ (when describe-bindings-outline
+ (setq-local outline-regexp ".*:$")
+ (setq-local outline-heading-end-regexp ":\n")
+ (setq-local outline-level (lambda () 1))
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t)
+ (setq-local outline-minor-mode-use-buttons t)
+ (outline-minor-mode 1)
+ (save-excursion
(goto-char (point-min))
- (insert (substitute-command-keys
- (concat "\\<outline-minor-mode-cycle-map>Type "
- "\\[outline-cycle] or \\[outline-cycle-buffer] "
- "on headings to cycle their visibility.\n\n")))
- ;; Hide the longest body
- (when (and (re-search-forward "Key translations" nil t)
- (fboundp 'outline-cycle))
- (outline-cycle))))))))
+ (let ((inhibit-read-only t))
+ ;; Hide the longest body.
+ (when (re-search-forward "Key translations" nil t)
+ (outline-hide-subtree))
+ ;; Hide ^Ls.
+ (while (search-forward "\n\f\n" nil t)
+ (put-text-property (1+ (match-beginning 0)) (1- (match-end 0))
+ 'invisible t)))))))))
(defun where-is (definition &optional insert)
"Print message listing key sequences that invoke the command DEFINITION.
@@ -614,7 +628,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(enable-recursive-minibuffers t)
val)
(setq val (completing-read (format-prompt "Where is command" fn)
- obarray 'commandp t nil nil
+ obarray #'commandp t nil nil
(and fn (symbol-name fn))))
(list (unless (equal val "") (intern val))
current-prefix-arg)))
@@ -643,15 +657,21 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(if insert
(if (> (length keys) 0)
(if remapped
- (format "%s (%s) (remapped from %s)"
- keys remapped symbol)
- (format "%s (%s)" keys symbol))
+ (format "%s, remapped to %s (%s)"
+ symbol remapped keys)
+ (format "%s (%s)" symbol keys))
(format "M-x %s RET" symbol))
(if (> (length keys) 0)
(if remapped
- (format "%s is remapped to %s which is on %s"
- symbol remapped keys)
- (format "%s is on %s" symbol keys))
+ (if (eq symbol (symbol-function definition))
+ (format
+ "%s, which is remapped to %s, which is on %s"
+ symbol remapped keys)
+ (format "%s is remapped to %s, which is on %s"
+ symbol remapped keys))
+ (if (eq symbol (symbol-function definition))
+ (format "%s, which is on %s" symbol keys)
+ (format "%s is on %s" symbol keys)))
;; If this is the command the user asked about,
;; and it is not on any key, say so.
;; For other symbols, its aliases, say nothing
@@ -660,7 +680,9 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(format "%s is not on any key" symbol)))))
(when string
(unless (eq symbol definition)
- (princ ";\n its alias "))
+ (if (eq definition (symbol-function symbol))
+ (princ ";\n its alias ")
+ (princ ";\n it's an alias for ")))
(princ string)))))
nil)
@@ -852,7 +874,7 @@ with `mouse-movement' events."
(memq 'down last-modifiers)
;; After a click, see if a double click is on the way.
(and (memq 'click last-modifiers)
- (not (sit-for (/ double-click-time 1000.0) t))))
+ (not (sit-for (/ (mouse-double-click-time) 1000.0) t))))
(let* ((seq (read-key-sequence "\
Describe the following key, mouse click, or menu item: "
nil nil 'can-return-switch-frame))
@@ -881,6 +903,9 @@ Describe the following key, mouse click, or menu item: "
(setq yank-menu (copy-sequence saved-yank-menu))
(fset 'yank-menu (cons 'keymap yank-menu))))))
+;; Defined in help-fns.el.
+(defvar describe-function-orig-buffer)
+
(defun describe-key (&optional key-list buffer up-event)
"Display documentation of the function invoked by KEY-LIST.
KEY-LIST can be any kind of a key sequence; it can include keyboard events,
@@ -892,6 +917,12 @@ While reading KEY-LIST interactively, this command temporarily enables
menu items or tool-bar buttons that are disabled to allow getting help
on them.
+Interactively, this command can't describe prefix commands, but
+will always wait for the user to type the complete key sequence.
+For instance, entering \"C-x\" will wait until the command has
+been completed, but `M-: (describe-key (kbd \"C-x\")) RET' will
+tell you what this prefix command is bound to.
+
BUFFER is the buffer in which to lookup those keys; it defaults to the
current buffer."
(declare (advertised-calling-convention (key-list &optional buffer) "27.1"))
@@ -903,7 +934,9 @@ current buffer."
(let ((raw (if (numberp buffer) (this-single-command-raw-keys) buffer)))
(setf (cdar (last key-list)) raw)))
(setq buffer nil))
- (let* ((buf (or buffer (current-buffer)))
+ (let* ((help-buffer-under-preparation t)
+ (buf (or buffer (current-buffer)))
+ (describe-function-orig-buffer buf)
(on-link
(mapcar (lambda (kr)
(let ((raw (cdr kr)))
@@ -937,16 +970,16 @@ current buffer."
(with-help-window (help-buffer)
(when (> (length info-list) 1)
;; FIXME: Make this into clickable hyperlinks.
- (princ "There were several key-sequences:\n\n")
- (princ (mapconcat (lambda (info)
- (pcase-let ((`(,_seq ,brief-desc ,_defn ,_locus)
- info))
- (concat " " brief-desc)))
- info-list
- "\n"))
+ (insert "There were several key-sequences:\n\n")
+ (insert (mapconcat (lambda (info)
+ (pcase-let ((`(,_seq ,brief-desc ,_defn ,_locus)
+ info))
+ (concat " " brief-desc)))
+ info-list
+ "\n"))
(when (delq nil on-link)
- (princ "\n\nThose are influenced by `mouse-1-click-follows-link'"))
- (princ "\n\nThey're all described below."))
+ (insert "\n\nThose are influenced by `mouse-1-click-follows-link'"))
+ (insert "\n\nThey're all described below."))
(pcase-dolist (`(,_seq ,brief-desc ,defn ,locus)
info-list)
(when defn
@@ -954,10 +987,10 @@ current buffer."
(with-current-buffer standard-output
(insert "\n\n" (make-separator-line) "\n")))
- (princ brief-desc)
+ (insert brief-desc)
(when locus
- (princ (format " (found in %s)" locus)))
- (princ ", which is ")
+ (insert (format " (found in %s)" locus)))
+ (insert ", which is ")
(describe-function-1 defn)))))))
(defun search-forward-help-for-help ()
@@ -1060,25 +1093,38 @@ is currently activated with completion."
result))
-(defun substitute-command-keys (string &optional no-face)
+(defcustom help-link-key-to-documentation t
+ "Non-nil means link keys to their command in *Help* buffers.
+This affects \\\\=\\[command] substitutions in documentation
+strings done by `substitute-command-keys'."
+ :type 'boolean
+ :version "29.1"
+ :group 'help)
+
+(defun substitute-command-keys (string &optional no-face include-menus)
"Substitute key descriptions for command names in STRING.
Each substring of the form \\\\=[COMMAND] is replaced by either a
keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
is not on any keys. Keybindings will use the face `help-key-binding',
unless the optional argument NO-FACE is non-nil.
-Each substring of the form \\\\={MAPVAR} is replaced by a summary of
-the value of MAPVAR as a keymap. This summary is similar to the one
-produced by ‘describe-bindings’. The summary ends in two newlines
-(used by the helper function ‘help-make-xrefs’ to find the end of the
-summary).
+Each substring of the form \\\\=`KEYBINDING' will be replaced by
+KEYBINDING and use the `help-key-binding' face.
+
+Each substring of the form \\\\={MAPVAR} is replaced by a summary
+of the value of MAPVAR as a keymap. This summary is similar to
+the one produced by `describe-bindings'. This will normally
+exclude menu bindings, but if the optional INCLUDE-MENUS argument
+is non-nil, also include menu bindings. The summary ends in two
+newlines (used by the helper function `help-make-xrefs' to find
+the end of the summary).
Each substring of the form \\\\=<MAPVAR> specifies the use of MAPVAR
as the keymap for future \\\\=[COMMAND] substrings.
Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
is replaced by right quote. Left and right quote characters are
-specified by ‘text-quoting-style’.
+specified by `text-quoting-style'.
\\\\== quotes the following character and is discarded; thus, \\\\==\\\\== puts \\\\==
into the output, \\\\==\\[ puts \\[ into the output, and \\\\==\\=` puts \\=` into the
@@ -1119,7 +1165,24 @@ Otherwise, return a new string."
(delete-char 2)
(ignore-errors
(forward-char 1)))
- ;; 1C. \[foo] is replaced with the keybinding.
+ ;; 1C. \`f' is replaced with a fontified f.
+ ((and (= (following-char) ?`)
+ (save-excursion
+ (prog1 (search-forward "'" nil t)
+ (setq end-point (1- (point))))))
+ (let ((k (buffer-substring-no-properties (+ orig-point 2)
+ end-point)))
+ (when (or (key-valid-p k)
+ (string-match-p "\\`M-x " k))
+ (goto-char orig-point)
+ (delete-char 2)
+ (goto-char (- end-point 2)) ; nb. take deletion into account
+ (delete-char 1)
+ (unless no-face
+ (add-text-properties orig-point (point)
+ '( face help-key-binding
+ font-lock-face help-key-binding))))))
+ ;; 1D. \[foo] is replaced with the keybinding.
((and (= (following-char) ?\[)
(save-excursion
(prog1 (search-forward "]" nil t)
@@ -1129,14 +1192,6 @@ Otherwise, return a new string."
(let* ((fun (intern (buffer-substring (point) (1- end-point))))
(key (with-current-buffer orig-buf
(where-is-internal fun keymap t))))
- ;; If this a command remap, we need to follow it.
- (when (and (vectorp key)
- (> (length key) 1)
- (eq (aref key 0) 'remap)
- (symbolp (aref key 1)))
- (setq fun (aref key 1))
- (setq key (with-current-buffer orig-buf
- (where-is-internal fun keymap t))))
(if (not key)
;; Function is not on any key.
(let ((op (point)))
@@ -1150,10 +1205,20 @@ Otherwise, return a new string."
(delete-char 1))
;; Function is on a key.
(delete-char (- end-point (point)))
- (insert (if no-face
- (key-description key)
- (help--key-description-fontified key))))))
- ;; 1D. \{foo} is replaced with a summary of the keymap
+
+ (insert
+ (if no-face
+ (key-description key)
+ (let ((key (help--key-description-fontified key)))
+ (if (and help-link-key-to-documentation
+ help-buffer-under-preparation
+ (functionp fun))
+ ;; The `fboundp' fixes bootstrap.
+ (if (fboundp 'help-mode--add-function-link)
+ (help-mode--add-function-link key fun)
+ key)
+ key)))))))
+ ;; 1E. \{foo} is replaced with a summary of the keymap
;; (symbol-value foo).
;; \<foo> just sets the keymap used for \[cmd].
((and (or (and (= (following-char) ?{)
@@ -1193,9 +1258,11 @@ Otherwise, return a new string."
(t
;; Get the list of active keymaps that precede this one.
;; If this one's not active, get nil.
- (let ((earlier-maps (cdr (memq this-keymap (reverse active-maps)))))
+ (let ((earlier-maps
+ (cdr (memq this-keymap (reverse active-maps)))))
(describe-map-tree this-keymap t (nreverse earlier-maps)
- nil nil t nil nil t))))))))
+ nil nil (not include-menus)
+ nil nil t))))))))
;; 2. Handle quotes.
((and (eq (text-quoting-style) 'curve)
(or (and (= (following-char) ?\`)
@@ -1212,8 +1279,9 @@ Otherwise, return a new string."
(buffer-string)))))
(defvar help--keymaps-seen nil)
-(defun describe-map-tree (startmap partial shadow prefix title no-menu
- transl always-title mention-shadow)
+(defun describe-map-tree (startmap &optional partial shadow prefix title
+ no-menu transl always-title mention-shadow
+ buffer)
"Insert a description of the key bindings in STARTMAP.
This is followed by the key bindings of all maps reachable
through STARTMAP.
@@ -1241,8 +1309,8 @@ If MENTION-SHADOW is non-nil, then when something is shadowed by
SHADOW, don't omit it; instead, mention it but say it is
shadowed.
-Any inserted text ends in two newlines (used by
-`help-make-xrefs')."
+If BUFFER, lookup keys while in that buffer. This only affects
+things like :filters for menu bindings."
(let* ((amaps (accessible-keymaps startmap prefix))
(orig-maps (if no-menu
(progn
@@ -1259,17 +1327,8 @@ Any inserted text ends in two newlines (used by
result))
amaps))
(maps orig-maps)
- (print-title (or maps always-title)))
- ;; Print title.
- (when print-title
- (insert (concat (if title
- (concat title
- (if prefix
- (concat " Starting With "
- (help--key-description-fontified prefix)))
- ":\n"))
- "key binding\n"
- "--- -------\n")))
+ (print-title (or maps always-title))
+ (start-point (point)))
;; Describe key bindings.
(setq help--keymaps-seen nil)
(while (consp maps)
@@ -1292,10 +1351,27 @@ Any inserted text ends in two newlines (used by
(setq sub-shadows (cons (cdr (car tail)) sub-shadows)))
(setq tail (cdr tail))))
(describe-map (cdr elt) elt-prefix transl partial
- sub-shadows no-menu mention-shadow)))
+ sub-shadows no-menu mention-shadow
+ buffer)))
(setq maps (cdr maps)))
- (when print-title
- (insert "\n"))))
+ ;; Print title...
+ (when (and print-title
+ ;; ... unless the keymap was empty.
+ (/= (point) start-point))
+ (save-excursion
+ (goto-char start-point)
+ (when (eolp)
+ (delete-region (point) (1+ (point))))
+ (insert
+ (concat
+ (if title
+ (concat title
+ (if prefix
+ (concat " Starting With "
+ (help--key-description-fontified prefix)))
+ ":\n"))
+ "\nKey Binding\n"
+ (make-separator-line)))))))
(defun help--shadow-lookup (keymap key accept-default remap)
"Like `lookup-key', but with command remapping.
@@ -1308,48 +1384,38 @@ Return nil if the key sequence is too long."
value))
(t value))))
-(defvar help--previous-description-column 0)
-(defun help--describe-command (definition)
- ;; Converted from describe_command in keymap.c.
- ;; If column 16 is no good, go to col 32;
- ;; but don't push beyond that--go to next line instead.
- (let* ((column (current-column))
- (description-column (cond ((> column 30)
- (insert "\n")
- 32)
- ((or (> column 14)
- (and (> column 10)
- (= help--previous-description-column 32)))
- 32)
- (t 16))))
- ;; Avoid using the `help-keymap' face.
- (let ((op (point)))
- (indent-to description-column 1)
- (set-text-properties op (point) '( face nil
- font-lock-face nil)))
- (setq help--previous-description-column description-column)
- (cond ((symbolp definition)
- (insert (symbol-name definition) "\n"))
- ((or (stringp definition) (vectorp definition))
- (insert "Keyboard Macro\n"))
- ((keymapp definition)
- (insert "Prefix Command\n"))
- (t (insert "??\n")))))
-
-(defun help--describe-translation (definition)
- ;; Converted from describe_translation in keymap.c.
- ;; Avoid using the `help-keymap' face.
- (let ((op (point)))
- (indent-to 16 1)
- (set-text-properties op (point) '( face nil
- font-lock-face nil)))
+(defun help--describe-command (definition &optional translation)
(cond ((symbolp definition)
- (insert (symbol-name definition) "\n"))
+ (if (and (fboundp definition)
+ help-buffer-under-preparation)
+ (insert-text-button (symbol-name definition)
+ 'type 'help-function
+ 'help-args (list definition))
+ (insert (symbol-name definition)))
+ (insert "\n"))
((or (stringp definition) (vectorp definition))
- (insert (key-description definition nil) "\n"))
+ (if translation
+ (insert (key-description definition nil) "\n")
+ (insert "Keyboard Macro\n")))
((keymapp definition)
(insert "Prefix Command\n"))
- (t (insert "??\n"))))
+ ((byte-code-function-p definition)
+ (insert (format "[%s]\n"
+ (buttonize "byte-code" #'disassemble definition))))
+ ((and (consp definition)
+ (memq (car definition) '(closure lambda)))
+ (insert (format "[%s]\n"
+ (buttonize
+ (symbol-name (car definition))
+ (lambda (_)
+ (pp-display-expression
+ definition "*Help Source*" t))
+ nil "View definition"))))
+ (t
+ (insert "??\n"))))
+
+(define-obsolete-function-alias 'help--describe-translation
+ #'help--describe-command "29.1")
(defun help--describe-map-compare (a b)
(let ((a (car a))
@@ -1363,26 +1429,35 @@ Return nil if the key sequence is too long."
(string-version-lessp (symbol-name a) (symbol-name b)))
(t nil))))
-(defun describe-map (map prefix transl partial shadow nomenu mention-shadow)
+(defun describe-map (map &optional prefix transl partial shadow
+ nomenu mention-shadow buffer)
"Describe the contents of keymap MAP.
Assume that this keymap itself is reached by the sequence of
prefix keys PREFIX (a string or vector).
-TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
-`describe-map-tree'."
+TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW and BUFFER are as
+in `describe-map-tree'."
;; Converted from describe_map in keymap.c.
(let* ((suppress (and partial 'suppress-keymap))
(map (keymap-canonicalize map))
(tail map)
(first t)
- (describer (if transl
- #'help--describe-translation
- #'help--describe-command))
done vect)
(while (and (consp tail) (not done))
(cond ((or (vectorp (car tail)) (char-table-p (car tail)))
- (help--describe-vector (car tail) prefix describer partial
- shadow map mention-shadow))
+ (let ((columns ()))
+ (help--describe-vector
+ (car tail) prefix
+ (lambda (def)
+ (let ((start-line (line-beginning-position))
+ (end-key (point))
+ (column (current-column)))
+ (help--describe-command def transl)
+ (push (list column start-line end-key (1- (point)))
+ columns)))
+ partial shadow map mention-shadow)
+ (when columns
+ (describe-map--align-section columns))))
((consp (car tail))
(let ((event (caar tail))
definition this-shadowed)
@@ -1412,7 +1487,10 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
((and mention-shadow (not (eq tem definition)))
(setq this-shadowed t))
(t nil))))
- (eq definition (lookup-key tail (vector event) t))
+ (eq definition (if buffer
+ (with-current-buffer buffer
+ (lookup-key tail (vector event) t))
+ (lookup-key tail (vector event) t)))
(push (list event definition this-shadowed) vect))))
((eq (car tail) 'keymap)
;; The same keymap might be in the structure twice, if
@@ -1425,18 +1503,17 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
(push (cons tail prefix) help--keymaps-seen)))))
(setq tail (cdr tail)))
;; If we found some sparse map events, sort them.
- (let ((vect (sort vect 'help--describe-map-compare)))
+ (let ((vect (sort vect 'help--describe-map-compare))
+ (columns ())
+ line-start key-end column)
;; Now output them in sorted order.
(while vect
(let* ((elem (car vect))
- (start (car elem))
- (definition (cadr elem))
- (shadowed (caddr elem))
- (end start))
- (when first
- (setq help--previous-description-column 0)
- (insert "\n")
- (setq first nil))
+ (start (nth 0 elem))
+ (definition (nth 1 elem))
+ (shadowed (nth 2 elem))
+ (end start)
+ remapped)
;; Find consecutive chars that are identically defined.
(when (fixnump start)
(while (and (cdr vect)
@@ -1451,26 +1528,98 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
(eq this-shadowed next-shadowed))))
(setq vect (cdr vect))
(setq end (caar vect))))
- ;; Now START .. END is the range to describe next.
- ;; Insert the string to describe the event START.
- (insert (help--key-description-fontified (vector start) prefix))
- (when (not (eq start end))
- (insert " .. " (help--key-description-fontified (vector end) prefix)))
- ;; Print a description of the definition of this character.
- ;; Called function will take care of spacing out far enough
- ;; for alignment purposes.
- (if transl
- (help--describe-translation definition)
- (help--describe-command definition))
- ;; Print a description of the definition of this character.
- ;; elt_describer will take care of spacing out far enough for
- ;; alignment purposes.
- (when shadowed
- (goto-char (max (1- (point)) (point-min)))
- (insert "\n (this binding is currently shadowed)")
- (goto-char (min (1+ (point)) (point-max)))))
+ (when (or (not (eq start end))
+ ;; Don't output keymap prefixes.
+ (not (keymapp definition)))
+ (when first
+ (insert "\n")
+ (setq first nil))
+ ;; Now START .. END is the range to describe next.
+ ;; Insert the string to describe the event START.
+ (setq line-start (point))
+ ;; If we're in a <remap> section of the output, then also
+ ;; display the bindings of the keys that we've remapped from.
+ ;; This enables the user to actually see what keys to tap to
+ ;; execute the remapped commands.
+ (if (setq remapped
+ (and (equal prefix [remap])
+ (not (eq definition 'self-insert-command))
+ (car (where-is-internal definition))))
+ (insert (help--key-description-fontified
+ (vector (elt remapped (1- (length remapped))))
+ (seq-into (butlast (seq-into remapped 'list))
+ 'vector)))
+ (insert (help--key-description-fontified (vector start) prefix)))
+ (when (not (eq start end))
+ (insert " .. " (help--key-description-fontified (vector end)
+ prefix)))
+ (setq key-end (point)
+ column (current-column))
+ ;; Print a description of the definition of this character.
+ ;; Called function will take care of spacing out far enough
+ ;; for alignment purposes.
+ (help--describe-command definition transl)
+ (push (list column line-start key-end (1- (point))) columns)
+ ;; Print a description of the definition of this character.
+ ;; elt_describer will take care of spacing out far enough for
+ ;; alignment purposes.
+ (when (or shadowed remapped)
+ (goto-char (max (1- (point)) (point-min)))
+ (when shadowed
+ (insert "\n (this binding is currently shadowed)"))
+ (when remapped
+ (insert (format
+ "\n (Remapped via %s)"
+ (help--key-description-fontified
+ (vector start) prefix))))
+ (goto-char (min (1+ (point)) (point-max))))))
;; Next item in list.
- (setq vect (cdr vect))))))
+ (setq vect (cdr vect)))
+ (when columns
+ (describe-map--align-section columns)))))
+
+(defun describe-map--align-section (columns)
+ (save-excursion
+ (let ((max-key (apply #'max (mapcar #'car columns))))
+ (cond
+ ;; It's fine to use the minimum, so just do it, but quantize to
+ ;; two different widths, because having each block align slightly
+ ;; differently looks untidy.
+ ((< max-key 16)
+ (describe-map--fill-columns columns 16))
+ ((< max-key 24)
+ (describe-map--fill-columns columns 24))
+ ((< max-key 32)
+ (describe-map--fill-columns columns 32))
+ ;; We have some really wide ones in this block.
+ (t
+ (let ((window-width (window-width))
+ (max-def (apply #'max (mapcar
+ (lambda (elem)
+ (- (nth 3 elem) (nth 2 elem)))
+ columns))))
+ (if (< (+ max-def (max 16 max-key)) window-width)
+ ;; Can we do the block without continuation lines? Then do that.
+ (describe-map--fill-columns columns (1+ (max 16 max-key)))
+ ;; No, do continuation lines for some definitions.
+ (dolist (elem columns)
+ (goto-char (caddr elem))
+ (if (< (+ (car elem) (- (nth 3 elem) (nth 2 elem))) window-width)
+ ;; Indent.
+ (insert-char ?\s (- (1+ max-key) (car elem)))
+ ;; Continuation.
+ (insert "\n")
+ (insert-char ?\t 2))))))))))
+
+(defun describe-map--fill-columns (columns width)
+ (dolist (elem columns)
+ (goto-char (caddr elem))
+ (let ((tabs (- (/ width tab-width)
+ (/ (car elem) tab-width))))
+ (insert-char ?\t tabs)
+ (insert-char ?\s (if (zerop tabs)
+ (- width (car elem))
+ (mod width tab-width))))))
;;;; This Lisp version is 100 times slower than its C equivalent:
;;
@@ -1606,10 +1755,16 @@ and some others."
(add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
(remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
+(defvar resize-temp-buffer-window-inhibit nil
+ "Non-nil means `resize-temp-buffer-window' should not resize.")
+
(defun resize-temp-buffer-window (&optional window)
"Resize WINDOW to fit its contents.
WINDOW must be a live window and defaults to the selected one.
-Do not resize if WINDOW was not created by `display-buffer'.
+Do not resize if WINDOW was not created by `display-buffer'. Do
+not resize either if a `window-height', `window-width' or
+`window-size' entry in `display-buffer-alist' prescribes some
+alternative resizing for WINDOW's buffer.
If WINDOW is part of a vertical combination, restrain its new
size by `temp-buffer-max-height' and do not resize if its minimum
@@ -1624,27 +1779,33 @@ provided `fit-frame-to-buffer' is non-nil.
This function may call `preserve-window-size' to preserve the
size of WINDOW."
(setq window (window-normalize-window window t))
- (let ((height (if (functionp temp-buffer-max-height)
+ (let* ((buffer (window-buffer window))
+ (height (if (functionp temp-buffer-max-height)
+ (with-selected-window window
+ (funcall temp-buffer-max-height buffer))
+ temp-buffer-max-height))
+ (width (if (functionp temp-buffer-max-width)
(with-selected-window window
- (funcall temp-buffer-max-height (window-buffer)))
- temp-buffer-max-height))
- (width (if (functionp temp-buffer-max-width)
- (with-selected-window window
- (funcall temp-buffer-max-width (window-buffer)))
- temp-buffer-max-width))
- (quit-cadr (cadr (window-parameter window 'quit-restore))))
- ;; Resize WINDOW iff it was made by `display-buffer'.
+ (funcall temp-buffer-max-width buffer))
+ temp-buffer-max-width))
+ (quit-cadr (cadr (window-parameter window 'quit-restore))))
+ ;; Resize WINDOW only if it was made by `display-buffer'.
(when (or (and (eq quit-cadr 'window)
(or (and (window-combined-p window)
(not (eq fit-window-to-buffer-horizontally
'only))
- (pos-visible-in-window-p (point-min) window))
+ (pos-visible-in-window-p
+ (with-current-buffer buffer (point-min))
+ window)
+ (not resize-temp-buffer-window-inhibit))
(and (window-combined-p window t)
- fit-window-to-buffer-horizontally)))
+ fit-window-to-buffer-horizontally
+ (not resize-temp-buffer-window-inhibit))))
(and (eq quit-cadr 'frame)
fit-frame-to-buffer
- (eq window (frame-root-window window))))
- (fit-window-to-buffer window height nil width nil t))))
+ (eq window (frame-root-window window))
+ (not resize-temp-buffer-window-inhibit)))
+ (fit-window-to-buffer window height nil width nil t))))
;;; Help windows.
(defcustom help-window-select nil
@@ -1667,13 +1828,25 @@ the help window appears on another frame, it may get selected and
its frame get input focus even if this option is nil.
This option has effect if and only if the help window was created
-by `with-help-window'."
+by `with-help-window'.
+
+Also see `help-window-keep-selected'."
:type '(choice (const :tag "never (nil)" nil)
(const :tag "other" other)
(const :tag "always (t)" t))
:group 'help
:version "23.1")
+(defcustom help-window-keep-selected nil
+ "If non-nil, navigation commands in the *Help* buffer will reuse the window.
+If nil, many commands in the *Help* buffer, like \\<help-mode-map>\\[help-view-source] and \\[help-goto-info], will
+pop to a different window to display the results.
+
+Also see `help-window-select'."
+ :type 'boolean
+ :group 'help
+ :version "29.1")
+
(define-obsolete-variable-alias 'help-enable-auto-load
'help-enable-autoload "27.1")
@@ -1754,13 +1927,13 @@ Return VALUE."
(cond
((eq help-setup 'window)
;; ... and is new, ...
- "Type \"q\" to delete help window")
+ "Type \\<help-map>\\[help-quit] to delete help window")
((eq help-setup 'frame)
;; ... on a new frame, ...
- "Type \"q\" to quit the help frame")
+ "Type \\<help-map>\\[help-quit] to quit the help frame")
((eq help-setup 'other)
;; ... or displayed some other buffer before.
- "Type \"q\" to restore previous buffer"))
+ "Type \\<help-map>\\[help-quit] to restore previous buffer"))
window t))
((and (eq (window-frame window) help-window-old-frame)
(= (length (window-list nil 'no-mini)) 2))
@@ -1771,7 +1944,7 @@ Return VALUE."
((eq help-setup 'window)
"Type \\[delete-other-windows] to delete the help window")
((eq help-setup 'other)
- "Type \"q\" in help window to restore its previous buffer"))
+ "Type \\<help-map>\\[help-quit] in help window to restore its previous buffer"))
window 'other))
(t
;; The help window is not selected ...
@@ -1779,48 +1952,49 @@ Return VALUE."
(cond
((eq help-setup 'window)
;; ... and is new, ...
- "Type \"q\" in help window to delete it")
+ "Type \\<help-map>\\[help-quit] in help window to delete it")
((eq help-setup 'other)
;; ... or displayed some other buffer before.
- "Type \"q\" in help window to restore previous buffer"))
+ "Type \\<help-map>\\[help-quit] in help window to restore previous buffer"))
window))))
;; Return VALUE.
value))
-;; `with-help-window' is a wrapper for `with-temp-buffer-window'
-;; providing the following additional twists:
-
-;; (1) It puts the buffer in `help-mode' (via `help-mode-setup') and
-;; adds cross references (via `help-mode-finish').
-
-;; (2) It issues a message telling how to scroll and quit the help
-;; window (via `help-window-setup').
-
-;; (3) An option (customizable via `help-window-select') to select the
-;; help window automatically.
-
-;; (4) A marker (`help-window-point-marker') to move point in the help
-;; window to an arbitrary buffer position.
(defmacro with-help-window (buffer-or-name &rest body)
"Evaluate BODY, send output to BUFFER-OR-NAME and show in a help window.
-This construct is like `with-temp-buffer-window', which see, but unlike
-that, it puts the buffer specified by BUFFER-OR-NAME in `help-mode' and
-displays a message about how to delete the help window when it's no
-longer needed. The help window will be selected if
-`help-window-select' is non-nil.
-Most of this is done by `help-window-setup', which see."
+The return value from BODY will be returned.
+
+The help window will be selected if `help-window-select' is
+non-nil.
+
+The `temp-buffer-window-setup-hook' hook is called."
(declare (indent 1) (debug t))
- `(progn
- ;; Make `help-window-point-marker' point nowhere. The only place
- ;; where this should be set to a buffer position is within BODY.
- (set-marker help-window-point-marker nil)
- (let ((temp-buffer-window-setup-hook
- (cons 'help-mode-setup temp-buffer-window-setup-hook))
- (temp-buffer-window-show-hook
- (cons 'help-mode-finish temp-buffer-window-show-hook)))
- (setq help-window-old-frame (selected-frame))
- (with-temp-buffer-window
- ,buffer-or-name nil 'help-window-setup (progn ,@body)))))
+ `(help--window-setup ,buffer-or-name (lambda () ,@body)))
+
+(defun help--window-setup (buffer callback)
+ ;; Make `help-window-point-marker' point nowhere. The only place
+ ;; where this should be set to a buffer position is within BODY.
+ (set-marker help-window-point-marker nil)
+ (with-current-buffer (get-buffer-create buffer)
+ (unless (derived-mode-p 'help-mode)
+ (help-mode))
+ (setq buffer-read-only t
+ buffer-file-name nil)
+ (setq-local help-mode--current-data nil)
+ (buffer-disable-undo)
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (erase-buffer)
+ (delete-all-overlays)
+ (prog1
+ (let ((standard-output (current-buffer)))
+ (prog1
+ (funcall callback)
+ (run-hooks 'temp-buffer-window-setup-hook)))
+ (help-make-xrefs (current-buffer))
+ ;; This must be done after the buffer has been completely
+ ;; generated, since `temp-buffer-resize-mode' may be enabled.
+ (help-window-setup (temp-buffer-window-show (current-buffer)))))))
;; Called from C, on encountering `help-char' when reading a char.
;; Don't print to *Help*; that would clobber Help history.
@@ -1904,7 +2078,7 @@ the same names as used in the original source code, when possible."
(if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
;; Advice wrappers have "catch all" args, so fetch the actual underlying
;; function to find the real arguments.
- (while (advice--p def) (setq def (advice--cdr def)))
+ (setq def (advice--cd*r def))
;; If definition is a macro, find the function inside it.
(if (eq (car-safe def) 'macro) (setq def (cdr def)))
(cond
@@ -1957,7 +2131,7 @@ the same names as used in the original source code, when possible."
((symbolp arg)
(let ((name (symbol-name arg)))
(cond
- ((string-match "\\`&" name) arg)
+ ((string-match "\\`&" name) (bare-symbol arg))
((string-match "\\`_." name)
(intern (upcase (substring name 1))))
(t (intern (upcase name))))))
@@ -2020,7 +2194,10 @@ the suggested string to use instead. See
confusables ", ")
string))))
-(defun help-command-error-confusable-suggestions (data _context _signal)
+(defun help-command-error-confusable-suggestions (data context signal)
+ ;; Delegate most of the work to the original default value of
+ ;; `command-error-function' implemented in C.
+ (command-error-default-function data context signal)
(pcase data
(`(void-variable ,var)
(let ((suggestions (help-uni-confusable-suggestions
@@ -2029,8 +2206,12 @@ the suggested string to use instead. See
(princ (concat "\n " suggestions) t))))
(_ nil)))
-(add-function :after command-error-function
- #'help-command-error-confusable-suggestions)
+(when (eq command-error-function #'command-error-default-function)
+ ;; Override the default set in the C code.
+ ;; This is not done using `add-function' so as to loosen the bootstrap
+ ;; dependencies.
+ (setq command-error-function
+ #'help-command-error-confusable-suggestions))
(define-obsolete-function-alias 'help-for-help-internal #'help-for-help "28.1")
diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el
index 258502bfe70..c08359696d5 100644
--- a/lisp/hfy-cmap.el
+++ b/lisp/hfy-cmap.el
@@ -859,8 +859,4 @@ Loads the variable `hfy-rgb-txt-color-map', which is used by
(provide 'hfy-cmap)
-;; Local Variables:
-;; generated-autoload-file: "htmlfontify-loaddefs.el"
-;; End:
-
;;; hfy-cmap.el ends here
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index fbd698e234a..a45e74eca26 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -69,12 +69,12 @@
;; You might also want to bind the hi-lock commands to more
;; finger-friendly sequences:
-;; (define-key hi-lock-map "\C-z\C-h" 'highlight-lines-matching-regexp)
-;; (define-key hi-lock-map "\C-zi" 'hi-lock-find-patterns)
-;; (define-key hi-lock-map "\C-zh" 'highlight-regexp)
-;; (define-key hi-lock-map "\C-zp" 'highlight-phrase)
-;; (define-key hi-lock-map "\C-zr" 'unhighlight-regexp)
-;; (define-key hi-lock-map "\C-zb" 'hi-lock-write-interactive-patterns))
+;; (keymap-set hi-lock-map "C-z C-h" 'highlight-lines-matching-regexp)
+;; (keymap-set hi-lock-map "C-z i" 'hi-lock-find-patterns)
+;; (keymap-set hi-lock-map "C-z h" 'highlight-regexp)
+;; (keymap-set hi-lock-map "C-z p" 'highlight-phrase)
+;; (keymap-set hi-lock-map "C-z r" 'unhighlight-regexp)
+;; (keymap-set hi-lock-map "C-z b" 'hi-lock-write-interactive-patterns))
;; See the documentation for hi-lock-mode `C-h f hi-lock-mode' for
;; additional instructions.
@@ -97,7 +97,7 @@
When a file is visited and hi-lock mode is on, patterns starting
up to this limit are added to font-lock's patterns. See documentation
of functions `hi-lock-mode' and `hi-lock-find-patterns'."
- :type 'integer
+ :type 'natnum
:group 'hi-lock)
(defcustom hi-lock-highlight-range 2000000
@@ -107,7 +107,7 @@ such as the buffer created by `list-colors-display'. In those buffers
hi-lock patterns will only be applied over a range of
`hi-lock-highlight-range' characters. If font-lock is active then
highlighting will be applied throughout the buffer."
- :type 'integer
+ :type 'natnum
:group 'hi-lock)
(defcustom hi-lock-exclude-modes
@@ -128,11 +128,10 @@ patterns."
(const :tag "Ask about file patterns" ask)
(function :tag "Function to check file patterns"))
:group 'hi-lock
+ ;; It can have a function value.
+ :risky t
:version "22.1")
-;; It can have a function value.
-(put 'hi-lock-file-patterns-policy 'risky-local-variable t)
-
(defcustom hi-lock-auto-select-face nil
"When nil, highlighting commands prompt for the face to use.
When non-nil, highlighting command determine the faces to use
@@ -235,10 +234,12 @@ by cycling through the faces in `hi-lock-face-defaults'."
"Human-readable lighters for `hi-lock-interactive-patterns'.")
(put 'hi-lock-interactive-lighters 'permanent-local t)
-(defvar hi-lock-face-defaults
+(defcustom hi-lock-face-defaults
'("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-salmon" "hi-aquamarine"
"hi-black-b" "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
- "Default faces for hi-lock interactive functions.")
+ "Default face names for hi-lock interactive functions."
+ :type '(repeat string)
+ :version "29.1")
(defvar hi-lock-file-patterns-prefix "Hi-lock"
"String used to identify hi-lock patterns at the start of files.")
@@ -274,17 +275,16 @@ a library is being loaded.")
["Patterns from Buffer" hi-lock-find-patterns
:help "Use patterns (if any) near top of buffer."]))
-(defvar hi-lock-map
- (let ((map (make-sparse-keymap "Hi Lock")))
- (define-key map "\C-xwi" 'hi-lock-find-patterns)
- (define-key map "\C-xwl" 'highlight-lines-matching-regexp)
- (define-key map "\C-xwp" 'highlight-phrase)
- (define-key map "\C-xwh" 'highlight-regexp)
- (define-key map "\C-xw." 'highlight-symbol-at-point)
- (define-key map "\C-xwr" 'unhighlight-regexp)
- (define-key map "\C-xwb" 'hi-lock-write-interactive-patterns)
- map)
- "Key map for hi-lock.")
+(defvar-keymap hi-lock-map
+ :doc "Keymap for `hi-lock-mode'."
+ :name "Hi Lock"
+ "C-x w i" #'hi-lock-find-patterns
+ "C-x w l" #'highlight-lines-matching-regexp
+ "C-x w p" #'highlight-phrase
+ "C-x w h" #'highlight-regexp
+ "C-x w ." #'highlight-symbol-at-point
+ "C-x w r" #'unhighlight-regexp
+ "C-x w b" #'hi-lock-write-interactive-patterns)
;; Visible Functions
@@ -723,21 +723,32 @@ with completion and history."
(when hi-lock-interactive-patterns
(face-name (hi-lock-keyword->face
(car hi-lock-interactive-patterns)))))
- (defaults (append hi-lock--unused-faces
- (cdr (member last-used-face hi-lock-face-defaults))
- hi-lock-face-defaults))
+ (defaults (seq-uniq
+ (append hi-lock--unused-faces
+ (cdr (member last-used-face hi-lock-face-defaults))
+ hi-lock-face-defaults)
+ #'equal))
face)
- (if (and hi-lock-auto-select-face (not current-prefix-arg))
+ (if (and hi-lock-auto-select-face (not current-prefix-arg))
(setq face (or (pop hi-lock--unused-faces) (car defaults)))
- (setq face (completing-read
- (format-prompt "Highlight using face" (car defaults))
- obarray 'facep t nil 'face-name-history defaults))
+ (setq face (symbol-name (read-face-name "Highlight using face" defaults)))
;; Update list of un-used faces.
(setq hi-lock--unused-faces (remove face hi-lock--unused-faces))
;; Grow the list of defaults.
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
+(defvar hi-lock-use-overlays nil
+ "Whether to always use overlays instead of font-lock rules.
+When font-lock-mode is enabled and the buffer specifies font-lock rules,
+highlighting is performed by adding new font-lock rules to the existing ones,
+so when new matching strings are added, they are highlighted by font-lock.
+Otherwise, overlays are used, but new highlighting overlays are not added
+when new matching strings are inserted to the buffer.
+However, sometimes overlays are still preferable even in buffers
+where font-lock is enabled, when hi-lock overlays take precedence
+over other overlays in the same buffer.")
+
(defun hi-lock-set-pattern (regexp face &optional subexp lighter case-fold spaces-regexp)
"Highlight SUBEXP of REGEXP with face FACE.
If omitted or nil, SUBEXP defaults to zero, i.e. the entire
@@ -759,7 +770,8 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search."
(add-to-list 'hi-lock--unused-faces (face-name face))
(push pattern hi-lock-interactive-patterns)
(push (cons (or lighter regexp) pattern) hi-lock-interactive-lighters)
- (if (and font-lock-mode (font-lock-specified-p major-mode))
+ (if (and font-lock-mode (font-lock-specified-p major-mode)
+ (not hi-lock-use-overlays))
(progn
(font-lock-add-keywords nil (list pattern) t)
(font-lock-flush))
@@ -781,6 +793,8 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search."
(match-end subexp))))
(overlay-put overlay 'hi-lock-overlay t)
(overlay-put overlay 'hi-lock-overlay-regexp (or lighter regexp))
+ ;; Use priority higher than default used by e.g. diff-refine.
+ (overlay-put overlay 'priority 1)
(overlay-put overlay 'face face))
(goto-char (match-end 0)))
(when no-matches
@@ -854,6 +868,27 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search."
;; continue standard unloading
nil)
+;;; Mouse support
+(defalias 'highlight-symbol-at-mouse 'hi-lock-face-symbol-at-mouse)
+(defun hi-lock-face-symbol-at-mouse (event)
+ "Highlight symbol at mouse click EVENT."
+ (interactive "e")
+ (save-excursion
+ (mouse-set-point event)
+ (highlight-symbol-at-point)))
+
+;;;###autoload
+(defun hi-lock-context-menu (menu click)
+ "Populate MENU with a menu item to highlight symbol at CLICK."
+ (when (thing-at-mouse click 'symbol)
+ (define-key-after menu [highlight-search-separator] menu-bar-separator
+ 'middle-separator)
+ (define-key-after menu [highlight-search-mouse]
+ '(menu-item "Highlight Symbol" highlight-symbol-at-mouse
+ :help "Highlight symbol at point")
+ 'highlight-search-separator))
+ menu)
+
(provide 'hi-lock)
;;; hi-lock.el ends here
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 10e2512e9d9..4832dd9023a 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -669,7 +669,7 @@ This removes all saved change information."
;;;###autoload
(defun highlight-changes-rotate-faces ()
- "Rotate the faces if in Highlight Changes mode and the changes are visible.
+ "\"Age\" changes if in Highlight Changes mode and the changes are visible.
Current changes are displayed in the face described by the first element
of `highlight-changes-face-list', one level older changes are shown in
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 8e60ddf6b07..e5ca6819f0d 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -102,7 +102,16 @@ This variable has no effect in Global Highlight Line mode.
For that, use `global-hl-line-sticky-flag'."
:type 'boolean
:version "22.1"
- :group 'hl-line)
+ :group 'hl-line
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when (featurep 'hl-line)
+ (unless value
+ (let ((selected (window-buffer (selected-window))))
+ (dolist (buffer (buffer-list))
+ (unless (eq buffer selected)
+ (with-current-buffer buffer
+ (hl-line-unhighlight)))))))))
(defcustom global-hl-line-sticky-flag nil
"Non-nil means the Global HL-Line mode highlight appears in all windows.
@@ -125,8 +134,11 @@ This variable is expected to be made buffer-local by modes.")
(defvar hl-line-overlay-buffer nil
"Most recently visited buffer in which Hl-Line mode is enabled.")
-(defvar hl-line-overlay-priority -50
- "Priority used on the overlay used by hl-line.")
+(defcustom hl-line-overlay-priority -50
+ "Priority used on the overlay used by hl-line."
+ :type 'integer
+ :version "28.1"
+ :group 'hl-line)
;;;###autoload
(define-minor-mode hl-line-mode
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 115f67c9560..dbcc152c15d 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -77,11 +77,10 @@
;; Changes: moved to changelog (CHANGES) file.
;;; Code:
+
(eval-when-compile (require 'cl-lib))
(require 'cus-edit)
-(require 'htmlfontify-loaddefs)
-
(defconst htmlfontify-version 0.21)
(defconst hfy-meta-tags
@@ -363,7 +362,7 @@ the etags output on stdout.
Two canned commands are provided - they drive Emacs's etags and
exuberant-ctags' etags respectively."
:tag "etags-command"
- :type (let ((clist (list '(string))))
+ :type (let ((clist (list '(string) '(const :tag "None" nil))))
(dolist (C hfy-etags-cmd-alist)
(push (list 'const :tag (car C) (cdr C)) clist))
(cons 'choice clist)))
@@ -1156,14 +1155,6 @@ The default handler is `hfy-face-to-css-default'.
See also `hfy-face-to-style'.")
-(defalias 'hfy-prop-invisible-p
- (if (fboundp 'invisible-p) #'invisible-p
- (lambda (prop)
- "Is text property PROP an active invisibility property?"
- (or (and (eq buffer-invisibility-spec t) prop)
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec))))))
-
(defun hfy-find-invisible-ranges ()
"Return a list of (start-point . end-point) cons cells of invisible regions."
(save-excursion
@@ -1253,8 +1244,8 @@ return a `defface' style list of face properties instead of a face symbol."
(when face-name (setq base-face face-name))
(dolist (P overlay-data)
(let ((iprops (cadr (memq 'invisible P)))) ;FIXME: plist-get?
- ;;(message "(hfy-prop-invisible-p %S)" iprops)
- (when (and iprops (hfy-prop-invisible-p iprops))
+ ;;(message "(invisible-p %S)" iprops)
+ (when (and iprops (invisible-p iprops))
(setq extra-props
(cons :invisible (cons t extra-props))) ))
(let ((fprops (cadr (or (memq 'face P)
@@ -2307,10 +2298,6 @@ See also `hfy-load-tags-cache'."
(interactive "D source directory: ")
(hfy-load-tags-cache (directory-file-name srcdir)))
-;;(defun hfy-test-read-args (foo bar)
-;; (interactive "D source directory: \nD target directory: ")
-;; (message "foo: %S\nbar: %S" foo bar))
-
(defun hfy-save-kill-buffers (buffer-list &optional dstdir)
(dolist (B buffer-list)
(set-buffer B)
@@ -2412,6 +2399,8 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
(declare (obsolete seq-intersection "28.1"))
(nreverse (seq-intersection set-a set-b #'eq)))
+(define-obsolete-function-alias 'hfy-prop-invisible-p #'invisible-p "29.1")
+
(provide 'htmlfontify)
;;; htmlfontify.el ends here
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 0e9f952221f..822ecbdd99d 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1211,7 +1211,9 @@ Interactively, prompt for NAME, and use the current filters."
(let ((type (assq (car qualifier) ibuffer-filtering-alist)))
(unless qualifier
(error "Ibuffer: Bad qualifier %s" qualifier))
- (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
+ (if (cdr qualifier)
+ (format " [%s: %s]" (cadr type) (cdr qualifier))
+ (format " [%s]" (cadr type)))))))
(defun ibuffer-list-buffer-modes (&optional include-parents)
"Create a completion table of buffer modes currently in use.
@@ -1597,7 +1599,10 @@ to move by. The default is `ibuffer-marked-char'."
"Hide all of the currently marked lines."
(interactive)
(if (= (ibuffer-count-marked-lines) 0)
- (message "No buffers marked; use `m' to mark a buffer")
+ (message (substitute-command-keys
+ (concat
+ "No buffers marked; use \\<ibuffer-mode-map>"
+ "\\[ibuffer-mark-forward] to mark a buffer")))
(let ((count
(ibuffer-map-marked-lines
(lambda (_buf _mark)
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 5d2dd479455..51b206d7c48 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -321,10 +321,15 @@ bound to the current value of the filter.
(when (cdr qualifier) ; Compose individual filters with `or'.
(setq ,filter `(or ,@(mapcar (lambda (m) (cons ',name m)) qualifier))))))
(if (null (ibuffer-push-filter ,filter))
- (message ,(format "Filter by %s already applied: %%s" description)
- ,qualifier-str)
- (message ,(format "Filter by %s added: %%s" description)
- ,qualifier-str)
+ (if ,qualifier-str
+ (message ,(format "Filter by %s already applied: %%s"
+ description)
+ ,qualifier-str)
+ (message ,(format "Filter by %s already applied" description)))
+ (if ,qualifier-str
+ (message ,(format "Filter by %s added: %%s" description)
+ ,qualifier-str)
+ (message ,(format "Filter by %s added" description)))
(ibuffer-update nil t))))
(push (list ',name ,description
(lambda (buf qualifier)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 42576f09cbf..742d21d0b0f 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -34,7 +34,7 @@
;; you might be interested in replacing the default `list-buffers' key
;; binding by adding the following to your init file:
;;
-;; (global-set-key (kbd "C-x C-b") 'ibuffer)
+;; (keymap-global-set "C-x C-b" 'ibuffer)
;;
;; See also the various customization options, not least the
;; documentation for `ibuffer-formats'.
@@ -364,173 +364,170 @@ directory, like `default-directory'."
(regexp :tag "From")
(regexp :tag "To"))))
-(defvar ibuffer--filter-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'ibuffer-filter-by-mode)
- (define-key map (kbd "SPC") 'ibuffer-filter-chosen-by-completion)
- (define-key map (kbd "m") 'ibuffer-filter-by-used-mode)
- (define-key map (kbd "M") 'ibuffer-filter-by-derived-mode)
- (define-key map (kbd "n") 'ibuffer-filter-by-name)
- (define-key map (kbd "E") 'ibuffer-filter-by-process)
- (define-key map (kbd "*") 'ibuffer-filter-by-starred-name)
- (define-key map (kbd "f") 'ibuffer-filter-by-filename)
- (define-key map (kbd "F") 'ibuffer-filter-by-directory)
- (define-key map (kbd "b") 'ibuffer-filter-by-basename)
- (define-key map (kbd ".") 'ibuffer-filter-by-file-extension)
- (define-key map (kbd "<") 'ibuffer-filter-by-size-lt)
- (define-key map (kbd ">") 'ibuffer-filter-by-size-gt)
- (define-key map (kbd "i") 'ibuffer-filter-by-modified)
- (define-key map (kbd "v") 'ibuffer-filter-by-visiting-file)
- (define-key map (kbd "c") 'ibuffer-filter-by-content)
- (define-key map (kbd "e") 'ibuffer-filter-by-predicate)
-
- (define-key map (kbd "r") 'ibuffer-switch-to-saved-filters)
- (define-key map (kbd "a") 'ibuffer-add-saved-filters)
- (define-key map (kbd "x") 'ibuffer-delete-saved-filters)
- (define-key map (kbd "d") 'ibuffer-decompose-filter)
- (define-key map (kbd "s") 'ibuffer-save-filters)
- (define-key map (kbd "p") 'ibuffer-pop-filter)
- (define-key map (kbd "<up>") 'ibuffer-pop-filter)
- (define-key map (kbd "!") 'ibuffer-negate-filter)
- (define-key map (kbd "t") 'ibuffer-exchange-filters)
- (define-key map (kbd "TAB") 'ibuffer-exchange-filters)
- (define-key map (kbd "o") 'ibuffer-or-filter)
- (define-key map (kbd "|") 'ibuffer-or-filter)
- (define-key map (kbd "&") 'ibuffer-and-filter)
- (define-key map (kbd "g") 'ibuffer-filters-to-filter-group)
- (define-key map (kbd "P") 'ibuffer-pop-filter-group)
- (define-key map (kbd "S-<up>") 'ibuffer-pop-filter-group)
- (define-key map (kbd "D") 'ibuffer-decompose-filter-group)
- (define-key map (kbd "/") 'ibuffer-filter-disable)
-
- (define-key map (kbd "S") 'ibuffer-save-filter-groups)
- (define-key map (kbd "R") 'ibuffer-switch-to-saved-filter-groups)
- (define-key map (kbd "X") 'ibuffer-delete-saved-filter-groups)
- (define-key map (kbd "\\") 'ibuffer-clear-filter-groups)
- map))
-
-(defvar ibuffer-mode-map
- (let ((map (make-keymap)))
- (define-key map (kbd "0") 'digit-argument)
- (define-key map (kbd "1") 'digit-argument)
- (define-key map (kbd "2") 'digit-argument)
- (define-key map (kbd "3") 'digit-argument)
- (define-key map (kbd "4") 'digit-argument)
- (define-key map (kbd "5") 'digit-argument)
- (define-key map (kbd "6") 'digit-argument)
- (define-key map (kbd "7") 'digit-argument)
- (define-key map (kbd "8") 'digit-argument)
- (define-key map (kbd "9") 'digit-argument)
-
- (define-key map (kbd "m") 'ibuffer-mark-forward)
- (define-key map (kbd "t") 'ibuffer-toggle-marks)
- (define-key map (kbd "u") 'ibuffer-unmark-forward)
- (define-key map (kbd "=") 'ibuffer-diff-with-file)
- (define-key map (kbd "j") 'ibuffer-jump-to-buffer)
- (define-key map (kbd "M-g") 'ibuffer-jump-to-buffer)
- (define-key map (kbd "M-s a C-s") 'ibuffer-do-isearch)
- (define-key map (kbd "M-s a M-C-s") 'ibuffer-do-isearch-regexp)
- (define-key map (kbd "M-s a C-o") 'ibuffer-do-occur)
- (define-key map (kbd "DEL") 'ibuffer-unmark-backward)
- (define-key map (kbd "M-DEL") 'ibuffer-unmark-all)
- (define-key map (kbd "* *") 'ibuffer-unmark-all)
- (define-key map (kbd "* c") 'ibuffer-change-marks)
- (define-key map (kbd "U") 'ibuffer-unmark-all-marks)
- (define-key map (kbd "* M") 'ibuffer-mark-by-mode)
- (define-key map (kbd "* m") 'ibuffer-mark-modified-buffers)
- (define-key map (kbd "* u") 'ibuffer-mark-unsaved-buffers)
- (define-key map (kbd "* s") 'ibuffer-mark-special-buffers)
- (define-key map (kbd "* r") 'ibuffer-mark-read-only-buffers)
- (define-key map (kbd "* /") 'ibuffer-mark-dired-buffers)
- (define-key map (kbd "* e") 'ibuffer-mark-dissociated-buffers)
- (define-key map (kbd "* h") 'ibuffer-mark-help-buffers)
- (define-key map (kbd "* z") 'ibuffer-mark-compressed-file-buffers)
- (define-key map (kbd ".") 'ibuffer-mark-old-buffers)
-
- (define-key map (kbd "d") 'ibuffer-mark-for-delete)
- (define-key map (kbd "C-d") 'ibuffer-mark-for-delete-backwards)
- (define-key map (kbd "k") 'ibuffer-mark-for-delete)
- (define-key map (kbd "x") 'ibuffer-do-kill-on-deletion-marks)
-
- ;; immediate operations
- (define-key map (kbd "n") 'ibuffer-forward-line)
- (define-key map (kbd "SPC") 'forward-line)
- (define-key map (kbd "p") 'ibuffer-backward-line)
- (define-key map (kbd "M-}") 'ibuffer-forward-next-marked)
- (define-key map (kbd "M-{") 'ibuffer-backwards-next-marked)
- (define-key map (kbd "l") 'ibuffer-redisplay)
- (define-key map (kbd "g") 'ibuffer-update)
- (define-key map "`" 'ibuffer-switch-format)
- (define-key map "-" 'ibuffer-add-to-tmp-hide)
- (define-key map "+" 'ibuffer-add-to-tmp-show)
- (define-key map "b" 'ibuffer-bury-buffer)
- (define-key map (kbd ",") 'ibuffer-toggle-sorting-mode)
- (define-key map (kbd "s i") 'ibuffer-invert-sorting)
- (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic)
- (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency)
- (define-key map (kbd "s s") 'ibuffer-do-sort-by-size)
- (define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process)
- (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode)
-
- (define-key map (kbd "M-n") 'ibuffer-forward-filter-group)
- (define-key map "\t" 'ibuffer-forward-filter-group)
- (define-key map (kbd "M-p") 'ibuffer-backward-filter-group)
- (define-key map [backtab] 'ibuffer-backward-filter-group)
- (define-key map (kbd "M-j") 'ibuffer-jump-to-filter-group)
- (define-key map (kbd "C-k") 'ibuffer-kill-line)
- (define-key map (kbd "C-y") 'ibuffer-yank)
-
- (define-key map (kbd "% n") 'ibuffer-mark-by-name-regexp)
- (define-key map (kbd "% m") 'ibuffer-mark-by-mode-regexp)
- (define-key map (kbd "% f") 'ibuffer-mark-by-file-name-regexp)
- (define-key map (kbd "% g") 'ibuffer-mark-by-content-regexp)
- (define-key map (kbd "% L") 'ibuffer-mark-by-locked)
-
- (define-key map (kbd "C-t") 'ibuffer-visit-tags-table)
-
- (define-key map (kbd "|") 'ibuffer-do-shell-command-pipe)
- (define-key map (kbd "!") 'ibuffer-do-shell-command-file)
- (define-key map (kbd "~") 'ibuffer-do-toggle-modified)
- ;; marked operations
- (define-key map (kbd "A") 'ibuffer-do-view)
- (define-key map (kbd "D") 'ibuffer-do-delete)
- (define-key map (kbd "E") 'ibuffer-do-eval)
- (define-key map (kbd "F") 'ibuffer-do-shell-command-file)
- (define-key map (kbd "I") 'ibuffer-do-query-replace-regexp)
- (define-key map (kbd "H") 'ibuffer-do-view-other-frame)
- (define-key map (kbd "N") 'ibuffer-do-shell-command-pipe-replace)
- (define-key map (kbd "M") 'ibuffer-do-toggle-modified)
- (define-key map (kbd "O") 'ibuffer-do-occur)
- (define-key map (kbd "P") 'ibuffer-do-print)
- (define-key map (kbd "Q") 'ibuffer-do-query-replace)
- (define-key map (kbd "R") 'ibuffer-do-rename-uniquely)
- (define-key map (kbd "S") 'ibuffer-do-save)
- (define-key map (kbd "T") 'ibuffer-do-toggle-read-only)
- (define-key map (kbd "L") 'ibuffer-do-toggle-lock)
- (define-key map (kbd "r") 'ibuffer-do-replace-regexp)
- (define-key map (kbd "V") 'ibuffer-do-revert)
- (define-key map (kbd "W") 'ibuffer-do-view-and-eval)
- (define-key map (kbd "X") 'ibuffer-do-shell-command-pipe)
-
- (define-key map (kbd "k") 'ibuffer-do-kill-lines)
- (define-key map (kbd "w") 'ibuffer-copy-filename-as-kill)
- (define-key map (kbd "B") 'ibuffer-copy-buffername-as-kill)
-
- (define-key map (kbd "RET") 'ibuffer-visit-buffer)
- (define-key map (kbd "e") 'ibuffer-visit-buffer)
- (define-key map (kbd "f") 'ibuffer-visit-buffer)
- (define-key map (kbd "C-x C-f") 'ibuffer-find-file)
- (define-key map (kbd "o") 'ibuffer-visit-buffer-other-window)
- (define-key map (kbd "C-o") 'ibuffer-visit-buffer-other-window-noselect)
- (define-key map (kbd "M-o") 'ibuffer-visit-buffer-1-window)
- (define-key map (kbd "v") 'ibuffer-do-view)
- (define-key map (kbd "C-x v") 'ibuffer-do-view-horizontally)
- (define-key map (kbd "C-c C-a") 'ibuffer-auto-mode)
- (define-key map (kbd "C-x 4 RET") 'ibuffer-visit-buffer-other-window)
- (define-key map (kbd "C-x 5 RET") 'ibuffer-visit-buffer-other-frame)
-
- (define-key map (kbd "/") ibuffer--filter-map)
- map))
+(defvar-keymap ibuffer--filter-map
+ "RET" #'ibuffer-filter-by-mode
+ "SPC" #'ibuffer-filter-chosen-by-completion
+ "m" #'ibuffer-filter-by-used-mode
+ "M" #'ibuffer-filter-by-derived-mode
+ "n" #'ibuffer-filter-by-name
+ "E" #'ibuffer-filter-by-process
+ "*" #'ibuffer-filter-by-starred-name
+ "f" #'ibuffer-filter-by-filename
+ "F" #'ibuffer-filter-by-directory
+ "b" #'ibuffer-filter-by-basename
+ "." #'ibuffer-filter-by-file-extension
+ "<" #'ibuffer-filter-by-size-lt
+ ">" #'ibuffer-filter-by-size-gt
+ "i" #'ibuffer-filter-by-modified
+ "v" #'ibuffer-filter-by-visiting-file
+ "c" #'ibuffer-filter-by-content
+ "e" #'ibuffer-filter-by-predicate
+
+ "r" #'ibuffer-switch-to-saved-filters
+ "a" #'ibuffer-add-saved-filters
+ "x" #'ibuffer-delete-saved-filters
+ "d" #'ibuffer-decompose-filter
+ "s" #'ibuffer-save-filters
+ "p" #'ibuffer-pop-filter
+ "<up>" #'ibuffer-pop-filter
+ "!" #'ibuffer-negate-filter
+ "t" #'ibuffer-exchange-filters
+ "TAB" #'ibuffer-exchange-filters
+ "o" #'ibuffer-or-filter
+ "|" #'ibuffer-or-filter
+ "&" #'ibuffer-and-filter
+ "g" #'ibuffer-filters-to-filter-group
+ "P" #'ibuffer-pop-filter-group
+ "S-<up>" #'ibuffer-pop-filter-group
+ "D" #'ibuffer-decompose-filter-group
+ "/" #'ibuffer-filter-disable
+
+ "S" #'ibuffer-save-filter-groups
+ "R" #'ibuffer-switch-to-saved-filter-groups
+ "X" #'ibuffer-delete-saved-filter-groups
+ "\\" #'ibuffer-clear-filter-groups)
+
+(defvar-keymap ibuffer-mode-map
+ :full t
+ "0" #'digit-argument
+ "1" #'digit-argument
+ "2" #'digit-argument
+ "3" #'digit-argument
+ "4" #'digit-argument
+ "5" #'digit-argument
+ "6" #'digit-argument
+ "7" #'digit-argument
+ "8" #'digit-argument
+ "9" #'digit-argument
+
+ "m" #'ibuffer-mark-forward
+ "t" #'ibuffer-toggle-marks
+ "u" #'ibuffer-unmark-forward
+ "=" #'ibuffer-diff-with-file
+ "j" #'ibuffer-jump-to-buffer
+ "M-g" #'ibuffer-jump-to-buffer
+ "M-s a C-s" #'ibuffer-do-isearch
+ "M-s a C-M-s" #'ibuffer-do-isearch-regexp
+ "M-s a C-o" #'ibuffer-do-occur
+ "DEL" #'ibuffer-unmark-backward
+ "M-DEL" #'ibuffer-unmark-all
+ "* *" #'ibuffer-unmark-all
+ "* c" #'ibuffer-change-marks
+ "U" #'ibuffer-unmark-all-marks
+ "* M" #'ibuffer-mark-by-mode
+ "* m" #'ibuffer-mark-modified-buffers
+ "* u" #'ibuffer-mark-unsaved-buffers
+ "* s" #'ibuffer-mark-special-buffers
+ "* r" #'ibuffer-mark-read-only-buffers
+ "* /" #'ibuffer-mark-dired-buffers
+ "* e" #'ibuffer-mark-dissociated-buffers
+ "* h" #'ibuffer-mark-help-buffers
+ "* z" #'ibuffer-mark-compressed-file-buffers
+ "." #'ibuffer-mark-old-buffers
+
+ "d" #'ibuffer-mark-for-delete
+ "C-d" #'ibuffer-mark-for-delete-backwards
+ "k" #'ibuffer-mark-for-delete
+ "x" #'ibuffer-do-kill-on-deletion-marks
+
+ ;; immediate operations
+ "n" #'ibuffer-forward-line
+ "SPC" #'forward-line
+ "p" #'ibuffer-backward-line
+ "M-}" #'ibuffer-forward-next-marked
+ "M-{" #'ibuffer-backwards-next-marked
+ "l" #'ibuffer-redisplay
+ "g" #'ibuffer-update
+ "`" #'ibuffer-switch-format
+ "-" #'ibuffer-add-to-tmp-hide
+ "+" #'ibuffer-add-to-tmp-show
+ "b" #'ibuffer-bury-buffer
+ "," #'ibuffer-toggle-sorting-mode
+ "s i" #'ibuffer-invert-sorting
+ "s a" #'ibuffer-do-sort-by-alphabetic
+ "s v" #'ibuffer-do-sort-by-recency
+ "s s" #'ibuffer-do-sort-by-size
+ "s f" #'ibuffer-do-sort-by-filename/process
+ "s m" #'ibuffer-do-sort-by-major-mode
+
+ "M-n" #'ibuffer-forward-filter-group
+ "TAB" #'ibuffer-forward-filter-group
+ "M-p" #'ibuffer-backward-filter-group
+ "<backtab>" #'ibuffer-backward-filter-group
+ "M-j" #'ibuffer-jump-to-filter-group
+ "C-k" #'ibuffer-kill-line
+ "C-y" #'ibuffer-yank
+
+ "% n" #'ibuffer-mark-by-name-regexp
+ "% m" #'ibuffer-mark-by-mode-regexp
+ "% f" #'ibuffer-mark-by-file-name-regexp
+ "% g" #'ibuffer-mark-by-content-regexp
+ "% L" #'ibuffer-mark-by-locked
+
+ "C-t" #'ibuffer-visit-tags-table
+
+ "|" #'ibuffer-do-shell-command-pipe
+ "!" #'ibuffer-do-shell-command-file
+ "~" #'ibuffer-do-toggle-modified
+ ;; marked operations
+ "A" #'ibuffer-do-view
+ "D" #'ibuffer-do-delete
+ "E" #'ibuffer-do-eval
+ "F" #'ibuffer-do-shell-command-file
+ "I" #'ibuffer-do-query-replace-regexp
+ "H" #'ibuffer-do-view-other-frame
+ "N" #'ibuffer-do-shell-command-pipe-replace
+ "M" #'ibuffer-do-toggle-modified
+ "O" #'ibuffer-do-occur
+ "P" #'ibuffer-do-print
+ "Q" #'ibuffer-do-query-replace
+ "R" #'ibuffer-do-rename-uniquely
+ "S" #'ibuffer-do-save
+ "T" #'ibuffer-do-toggle-read-only
+ "L" #'ibuffer-do-toggle-lock
+ "r" #'ibuffer-do-replace-regexp
+ "V" #'ibuffer-do-revert
+ "W" #'ibuffer-do-view-and-eval
+ "X" #'ibuffer-do-shell-command-pipe
+
+ "k" #'ibuffer-do-kill-lines
+ "w" #'ibuffer-copy-filename-as-kill
+ "B" #'ibuffer-copy-buffername-as-kill
+
+ "RET" #'ibuffer-visit-buffer
+ "e" #'ibuffer-visit-buffer
+ "f" #'ibuffer-visit-buffer
+ "C-x C-f" #'ibuffer-find-file
+ "o" #'ibuffer-visit-buffer-other-window
+ "C-o" #'ibuffer-visit-buffer-other-window-noselect
+ "M-o" #'ibuffer-visit-buffer-1-window
+ "v" #'ibuffer-do-view
+ "C-x v" #'ibuffer-do-view-horizontally
+ "C-c C-a" #'ibuffer-auto-mode
+ "C-x 4 RET" #'ibuffer-visit-buffer-other-window
+ "C-x 5 RET" #'ibuffer-visit-buffer-other-frame
+
+ "/" ibuffer--filter-map)
(defun ibuffer-mode--groups-menu-definition (&optional is-popup)
"Build the `ibuffer' \"Filter\" menu. Internal."
@@ -758,46 +755,32 @@ directory, like `default-directory'."
["Diff with file" ibuffer-diff-with-file
:help "View the differences between this buffer and its file"]))
-(defvar ibuffer-name-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark)
- (define-key map [(mouse-2)] 'ibuffer-mouse-visit-buffer)
- (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
- map))
-
-(defvar ibuffer-filename/process-header-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(mouse-1)] 'ibuffer-do-sort-by-filename/process)
- map))
-
-(defvar ibuffer-mode-name-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(mouse-2)] 'ibuffer-mouse-filter-by-mode)
- (define-key map (kbd "RET") 'ibuffer-interactive-filter-by-mode)
- map))
-
-(defvar ibuffer-name-header-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(mouse-1)] 'ibuffer-do-sort-by-alphabetic)
- map))
-
-(defvar ibuffer-size-header-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(mouse-1)] 'ibuffer-do-sort-by-size)
- map))
-
-(defvar ibuffer-mode-header-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(mouse-1)] 'ibuffer-do-sort-by-major-mode)
- map))
-
-(defvar ibuffer-mode-filter-group-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark)
- (define-key map [(mouse-2)] 'ibuffer-mouse-toggle-filter-group)
- (define-key map (kbd "RET") 'ibuffer-toggle-filter-group)
- (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
- map))
+(defvar-keymap ibuffer-name-map
+ "<mouse-1>" #'ibuffer-mouse-toggle-mark
+ "<mouse-2>" #'ibuffer-mouse-visit-buffer
+ "<down-mouse-3>" #'ibuffer-mouse-popup-menu)
+
+(defvar-keymap ibuffer-filename/process-header-map
+ "<mouse-1>" #'ibuffer-do-sort-by-filename/process)
+
+(defvar-keymap ibuffer-mode-name-map
+ "<mouse-2>" #'ibuffer-mouse-filter-by-mode
+ "RET" #'ibuffer-interactive-filter-by-mode)
+
+(defvar-keymap ibuffer-name-header-map
+ "<mouse-1>" #'ibuffer-do-sort-by-alphabetic)
+
+(defvar-keymap ibuffer-size-header-map
+ "<mouse-1>" #'ibuffer-do-sort-by-size)
+
+(defvar-keymap ibuffer-mode-header-map
+ "<mouse-1>" #'ibuffer-do-sort-by-major-mode)
+
+(defvar-keymap ibuffer-mode-filter-group-map
+ "<mouse-1>" #'ibuffer-mouse-toggle-mark
+ "<mouse-2>" #'ibuffer-mouse-toggle-filter-group
+ "RET" #'ibuffer-toggle-filter-group
+ "<down-mouse-3>" #'ibuffer-mouse-popup-menu)
(defvar ibuffer-did-modification nil)
@@ -1257,7 +1240,9 @@ Otherwise, toggle lock status."
"Unmark all buffers with mark MARK."
(interactive "cRemove marks (RET means all):")
(if (= (ibuffer-count-marked-lines t) 0)
- (message "No buffers marked; use `m' to mark a buffer")
+ (message (substitute-command-keys
+ "No buffers marked; use \\<ibuffer-mode-map>\
+\\[ibuffer-mark-forward] to mark a buffer"))
(let ((fn (lambda (_buf mk)
(unless (eq mk ?\s)
(ibuffer-set-mark-1 ?\s)) t)))
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 96172574709..9640d98ca84 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -81,7 +81,7 @@ selection process starts again from the user's $HOME.")
This means to show completions even when the current minibuffer contents
is the same as was the initial input after minibuffer activation.
This also means that if you traverse the list of completions with
-commands like `C-.' and just hit RET without typing any
+commands like \\`C-.' and just hit \\`RET' without typing any
characters, the match under point will be chosen instead of the
default."
:type 'boolean
@@ -139,7 +139,9 @@ See `icomplete-delay-completions-threshold'."
:type 'integer)
(defvar icomplete-in-buffer nil
- "If non-nil, also use Icomplete when completing in non-mini buffers.")
+ "If non-nil, also use Icomplete when completing in non-mini buffers.
+This affects commands like `complete-in-region', but not commands
+that use their own completions setup.")
(defcustom icomplete-minibuffer-setup-hook nil
"Icomplete-specific customization of minibuffer setup.
@@ -153,8 +155,7 @@ with other features and packages. For instance:
will constrain Emacs to a maximum minibuffer height of 3 lines when
icompletion is occurring."
- :type 'hook
- :group 'icomplete)
+ :type 'hook)
;;;_* Initialization
@@ -174,11 +175,11 @@ Used to implement the option `icomplete-show-matches-on-no-input'.")
(defvar icomplete-minibuffer-map
(let ((map (make-sparse-keymap)))
- (define-key map [?\M-\t] 'icomplete-force-complete)
- (define-key map [remap minibuffer-complete-and-exit] 'icomplete-ret)
- (define-key map [?\C-j] 'icomplete-force-complete-and-exit)
- (define-key map [?\C-.] 'icomplete-forward-completions)
- (define-key map [?\C-,] 'icomplete-backward-completions)
+ (define-key map [?\M-\t] #'icomplete-force-complete)
+ (define-key map [remap minibuffer-complete-and-exit] #'icomplete-ret)
+ (define-key map [?\C-j] #'icomplete-force-complete-and-exit)
+ (define-key map [?\C-.] #'icomplete-forward-completions)
+ (define-key map [?\C-,] #'icomplete-backward-completions)
map)
"Keymap used by `icomplete-mode' in the minibuffer.")
@@ -380,28 +381,32 @@ if that doesn't produce a completion match."
(defun icomplete-fido-backward-updir ()
"Delete char before or go up directory, like `ido-mode'."
(interactive)
- (if (and (eq (char-before) ?/)
- (eq (icomplete--category) 'file))
- (save-excursion
- (goto-char (1- (point)))
- (when (search-backward "/" (point-min) t)
- (delete-region (1+ (point)) (point-max))))
- (call-interactively 'backward-delete-char)))
+ (cond ((and (eq (char-before) ?/)
+ (eq (icomplete--category) 'file))
+ (when (string-equal (icomplete--field-string) "~/")
+ (delete-region (icomplete--field-beg) (icomplete--field-end))
+ (insert (expand-file-name "~/"))
+ (goto-char (line-end-position)))
+ (save-excursion
+ (goto-char (1- (point)))
+ (when (search-backward "/" (point-min) t)
+ (delete-region (1+ (point)) (point-max)))))
+ (t (call-interactively 'backward-delete-char))))
(defvar icomplete-fido-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-k") 'icomplete-fido-kill)
- (define-key map (kbd "C-d") 'icomplete-fido-delete-char)
- (define-key map (kbd "RET") 'icomplete-fido-ret)
- (define-key map (kbd "C-m") 'icomplete-fido-ret)
- (define-key map (kbd "DEL") 'icomplete-fido-backward-updir)
- (define-key map (kbd "M-j") 'icomplete-fido-exit)
- (define-key map (kbd "C-s") 'icomplete-forward-completions)
- (define-key map (kbd "C-r") 'icomplete-backward-completions)
- (define-key map (kbd "<right>") 'icomplete-forward-completions)
- (define-key map (kbd "<left>") 'icomplete-backward-completions)
- (define-key map (kbd "C-.") 'icomplete-forward-completions)
- (define-key map (kbd "C-,") 'icomplete-backward-completions)
+ (define-key map (kbd "C-k") #'icomplete-fido-kill)
+ (define-key map (kbd "C-d") #'icomplete-fido-delete-char)
+ (define-key map (kbd "RET") #'icomplete-fido-ret)
+ (define-key map (kbd "C-m") #'icomplete-fido-ret)
+ (define-key map (kbd "DEL") #'icomplete-fido-backward-updir)
+ (define-key map (kbd "M-j") #'icomplete-fido-exit)
+ (define-key map (kbd "C-s") #'icomplete-forward-completions)
+ (define-key map (kbd "C-r") #'icomplete-backward-completions)
+ (define-key map (kbd "<right>") #'icomplete-forward-completions)
+ (define-key map (kbd "<left>") #'icomplete-backward-completions)
+ (define-key map (kbd "C-.") #'icomplete-forward-completions)
+ (define-key map (kbd "C-,") #'icomplete-backward-completions)
map)
"Keymap used by `fido-mode' in the minibuffer.")
@@ -427,7 +432,7 @@ if that doesn't produce a completion match."
This global minor mode makes minibuffer completion behave
more like `ido-mode' than regular `icomplete-mode'."
- :global t :group 'icomplete
+ :global t
(remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup)
(remove-hook 'minibuffer-setup-hook #'icomplete--fido-mode-setup)
(when fido-mode
@@ -453,7 +458,7 @@ You can use the following key bindings to navigate and select
completions:
\\{icomplete-minibuffer-map}"
- :global t :group 'icomplete
+ :global t
(remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup)
(remove-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup)
(when icomplete-mode
@@ -528,7 +533,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(setq icomplete--in-region-buffer nil)
(delete-overlay icomplete-overlay)
(kill-local-variable 'completion-show-inline-help)
- (remove-hook 'post-command-hook 'icomplete-post-command-hook t)
+ (remove-hook 'post-command-hook #'icomplete-post-command-hook t)
(message nil)))
(when (and completion-in-region-mode
icomplete-mode (icomplete-simple-completing-p))
@@ -539,7 +544,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(unless (memq icomplete-minibuffer-map (cdr tem))
(setcdr tem (make-composed-keymap icomplete-minibuffer-map
(cdr tem)))))
- (add-hook 'post-command-hook 'icomplete-post-command-hook nil t)))
+ (add-hook 'post-command-hook #'icomplete-post-command-hook nil t)))
(defun icomplete--sorted-completions ()
(or completion-all-sorted-completions
@@ -554,7 +559,8 @@ Usually run by inclusion in `minibuffer-setup-hook'."
;; predicates" which may vary depending on specific
;; `completing-read' invocations, described below:
for fn in (cond ((and minibuffer-default
- (stringp minibuffer-default) ; bug#38992
+ (stringp (or (car-safe minibuffer-default)
+ minibuffer-default)) ; bug#38992 bug#55800
(equal (icomplete--field-string) icomplete--initial-input))
;; Here, we have a non-nil string default and
;; no input whatsoever. We want to make sure
@@ -572,7 +578,9 @@ Usually run by inclusion in `minibuffer-setup-hook'."
;; Has "bar" at the top, so RET will select
;; it, as desired.
,(lambda (comp)
- (equal minibuffer-default comp))
+ (equal (or (car-safe minibuffer-default)
+ minibuffer-default)
+ comp))
;; Why do we need this second predicate?
;; Because that'll make things like M-x man
;; RET RET, when invoked with point on the
@@ -594,7 +602,9 @@ Usually run by inclusion in `minibuffer-setup-hook'."
;; useful for a very broad spectrum of
;; cases.
,(lambda (comp)
- (string-prefix-p minibuffer-default comp))))
+ (string-prefix-p (or (car-safe minibuffer-default)
+ minibuffer-default)
+ comp))))
((and fido-mode
(not minibuffer-default)
(eq (icomplete--category) 'file))
@@ -626,12 +636,12 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(defvar icomplete-vertical-mode-minibuffer-map
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-n") 'icomplete-forward-completions)
- (define-key map (kbd "C-p") 'icomplete-backward-completions)
- (define-key map (kbd "<down>") 'icomplete-forward-completions)
- (define-key map (kbd "<up>") 'icomplete-backward-completions)
- (define-key map (kbd "M-<") 'icomplete-vertical-goto-first)
- (define-key map (kbd "M->") 'icomplete-vertical-goto-last)
+ (define-key map (kbd "C-n") #'icomplete-forward-completions)
+ (define-key map (kbd "C-p") #'icomplete-backward-completions)
+ (define-key map (kbd "<down>") #'icomplete-forward-completions)
+ (define-key map (kbd "<up>") #'icomplete-backward-completions)
+ (define-key map (kbd "M-<") #'icomplete-vertical-goto-first)
+ (define-key map (kbd "M->") #'icomplete-vertical-goto-last)
map)
"Keymap used by `icomplete-vertical-mode' in the minibuffer.")
@@ -687,7 +697,7 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(icomplete-simple-completing-p)) ;Shouldn't be necessary.
(let ((saved-point (point)))
(save-excursion
- (goto-char (point-max))
+ (goto-char (icomplete--field-end))
; Insert the match-status information:
(when (and (or icomplete-show-matches-on-no-input
(not (equal (icomplete--field-string)
@@ -716,11 +726,6 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(delete-region (overlay-start rfn-eshadow-overlay)
(overlay-end rfn-eshadow-overlay)))
(let* ((field-string (icomplete--field-string))
- ;; Not sure why, but such requests seem to come
- ;; every once in a while. It's not fully
- ;; deterministic but `C-x C-f M-DEL M-DEL ...'
- ;; seems to trigger it fairly often!
- (while-no-input-ignore-events '(selection-request))
(text (while-no-input
(icomplete-completions
field-string
@@ -1044,7 +1049,7 @@ matches exist."
(push first prospects)))
(concat determ
"{"
- (mapconcat 'identity prospects icomplete-separator)
+ (mapconcat #'identity prospects icomplete-separator)
(concat (and limit (concat icomplete-separator ellipsis))
"}")))
;; Restore the base-size info, since completion-all-sorted-completions
diff --git a/lisp/ido.el b/lisp/ido.el
index 57e79500413..134081d6759 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -354,8 +354,8 @@ The following values are possible:
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'."
- :set #'(lambda (_symbol value)
- (ido-mode (or value 0)))
+ :set (lambda (_symbol value)
+ (ido-mode (or value 0)))
:initialize #'custom-initialize-default
:require 'ido
:link '(emacs-commentary-link "ido.el")
@@ -554,7 +554,7 @@ See `ido-last-directory-list' and `ido-save-directory-list-file'."
"Maximum number of working directories to record.
This is the list of directories where files have most recently been opened.
See `ido-work-directory-list' and `ido-save-directory-list-file'."
- :type 'integer)
+ :type 'natnum)
(defcustom ido-work-directory-list-ignore-regexps nil
"List of regexps matching directories which should not be recorded.
@@ -620,9 +620,9 @@ hosts on first use of UNC path."
(function-item :tag "Use `NET VIEW'"
:value ido-unc-hosts-net-view)
(function :tag "Your own function"))
- :set #'(lambda (symbol value)
- (set symbol value)
- (setq ido-unc-hosts-cache t)))
+ :set (lambda (symbol value)
+ (set symbol value)
+ (setq ido-unc-hosts-cache t)))
(defcustom ido-downcase-unc-hosts t
"Non-nil if UNC host names should be downcased."
@@ -920,85 +920,76 @@ The fallback command is passed as an argument to the functions."
;;;; Keymaps
-(defvar ido-common-completion-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "\C-a" 'ido-toggle-ignore)
- (define-key map "\C-c" 'ido-toggle-case)
- (define-key map "\C-e" 'ido-edit-input)
- (define-key map "\t" 'ido-complete)
- (define-key map " " 'ido-complete-space)
- (define-key map "\C-j" 'ido-select-text)
- (define-key map "\C-m" 'ido-exit-minibuffer)
- (define-key map "\C-p" 'ido-toggle-prefix)
- (define-key map "\C-r" 'ido-prev-match)
- (define-key map "\C-s" 'ido-next-match)
- (define-key map [?\C-.] 'ido-next-match)
- (define-key map [?\C-,] 'ido-prev-match)
- (define-key map "\C-t" 'ido-toggle-regexp)
- (define-key map "\C-z" 'ido-undo-merge-work-directory)
- (define-key map [(control ?\s)] 'ido-restrict-to-matches)
- (define-key map [(meta ?\s)] 'ido-take-first-match)
- (define-key map [(control ?@)] 'ido-restrict-to-matches)
- (define-key map [right] 'ido-next-match)
- (define-key map [left] 'ido-prev-match)
- (define-key map "?" 'ido-completion-help)
- (define-key map "\C-b" 'ido-magic-backward-char)
- (define-key map "\C-f" 'ido-magic-forward-char)
- (define-key map "\C-d" 'ido-magic-delete-char)
- map)
- "Keymap for all Ido commands.")
-
-(defvar ido-file-dir-completion-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map ido-common-completion-map)
- (define-key map "\C-x\C-b" 'ido-enter-switch-buffer)
- (define-key map "\C-x\C-f" 'ido-fallback-command)
- (define-key map "\C-x\C-d" 'ido-enter-dired)
- (define-key map [down] 'ido-next-match-dir)
- (define-key map [up] 'ido-prev-match-dir)
- (define-key map [(meta up)] 'ido-prev-work-directory)
- (define-key map [(meta down)] 'ido-next-work-directory)
- (define-key map [backspace] 'ido-delete-backward-updir)
- (define-key map "\d" 'ido-delete-backward-updir)
- (define-key map [remap delete-backward-char] 'ido-delete-backward-updir) ; BS
- (define-key map [remap backward-kill-word] 'ido-delete-backward-word-updir) ; M-DEL
- (define-key map [(control backspace)] 'ido-up-directory)
- (define-key map "\C-l" 'ido-reread-directory)
- (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir)
- (define-key map [(meta ?b)] 'ido-push-dir)
- (define-key map [(meta ?v)] 'ido-push-dir-first)
- (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir)
- (define-key map [(meta ?k)] 'ido-forget-work-directory)
- (define-key map [(meta ?m)] 'ido-make-directory)
- (define-key map [(meta ?n)] 'ido-next-work-directory)
- (define-key map [(meta ?o)] 'ido-prev-work-file)
- (define-key map [(meta control ?o)] 'ido-next-work-file)
- (define-key map [(meta ?p)] 'ido-prev-work-directory)
- (define-key map [(meta ?s)] 'ido-merge-work-directories)
- map)
- "Keymap for Ido file and directory commands.")
-
-(defvar ido-file-completion-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map ido-file-dir-completion-map)
- (define-key map "\C-k" 'ido-delete-file-at-head)
- (define-key map "\C-o" 'ido-copy-current-word)
- (define-key map "\C-w" 'ido-copy-current-file-name)
- (define-key map [(meta ?l)] 'ido-toggle-literal)
- map)
- "Keymap for Ido file commands.")
-
-(defvar ido-buffer-completion-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map ido-common-completion-map)
- (define-key map "\C-x\C-f" 'ido-enter-find-file)
- (define-key map "\C-x\C-b" 'ido-fallback-command)
- (define-key map "\C-k" 'ido-kill-buffer-at-head)
- (define-key map [?\C-\S-b] 'ido-bury-buffer-at-head)
- (define-key map "\C-o" 'ido-toggle-virtual-buffers)
- map)
- "Keymap for Ido buffer commands.")
+(defvar-keymap ido-common-completion-map
+ :doc "Keymap for all Ido commands."
+ :parent minibuffer-local-map
+ "C-a" #'ido-toggle-ignore
+ "C-c" #'ido-toggle-case
+ "C-e" #'ido-edit-input
+ "TAB" #'ido-complete
+ "SPC" #'ido-complete-space
+ "C-j" #'ido-select-text
+ "C-m" #'ido-exit-minibuffer
+ "C-p" #'ido-toggle-prefix
+ "C-r" #'ido-prev-match
+ "C-s" #'ido-next-match
+ "C-." #'ido-next-match
+ "C-," #'ido-prev-match
+ "C-t" #'ido-toggle-regexp
+ "C-z" #'ido-undo-merge-work-directory
+ "C-SPC" #'ido-restrict-to-matches
+ "M-SPC" #'ido-take-first-match
+ "C-@" #'ido-restrict-to-matches
+ "<right>" #'ido-next-match
+ "<left>" #'ido-prev-match
+ "?" #'ido-completion-help
+ "C-b" #'ido-magic-backward-char
+ "C-f" #'ido-magic-forward-char
+ "C-d" #'ido-magic-delete-char)
+
+(defvar-keymap ido-file-dir-completion-map
+ :doc "Keymap for Ido file and directory commands."
+ :parent ido-common-completion-map
+ "C-x C-b" #'ido-enter-switch-buffer
+ "C-x C-f" #'ido-fallback-command
+ "C-x C-d" #'ido-enter-dired
+ "<down>" #'ido-next-match-dir
+ "<up>" #'ido-prev-match-dir
+ "M-<up>" #'ido-prev-work-directory
+ "M-<down>" #'ido-next-work-directory
+ "<backspace>" #'ido-delete-backward-updir
+ "DEL" #'ido-delete-backward-updir
+ "<remap> <delete-backward-char>" #'ido-delete-backward-updir
+ "<remap> <backward-kill-word>" #'ido-delete-backward-word-updir
+ "C-<backspace>" #'ido-up-directory
+ "C-l" #'ido-reread-directory
+ "M-d" #'ido-wide-find-dir-or-delete-dir
+ "M-b" #'ido-push-dir
+ "M-v" #'ido-push-dir-first
+ "M-f" #'ido-wide-find-file-or-pop-dir
+ "M-k" #'ido-forget-work-directory
+ "M-m" #'ido-make-directory
+ "M-n" #'ido-next-work-directory
+ "M-o" #'ido-prev-work-file
+ "C-M-o" #'ido-next-work-file
+ "M-p" #'ido-prev-work-directory
+ "M-s" #'ido-merge-work-directories)
+
+(defvar-keymap ido-file-completion-map
+ :doc "Keymap for Ido file commands."
+ :parent ido-file-dir-completion-map
+ "C-o" #'ido-copy-current-word
+ "C-w" #'ido-copy-current-file-name
+ "M-l" #'ido-toggle-literal)
+
+(defvar-keymap ido-buffer-completion-map
+ :doc "Keymap for Ido buffer commands."
+ :parent ido-common-completion-map
+ "C-x C-f" #'ido-enter-find-file
+ "C-x C-b" #'ido-fallback-command
+ "C-k" #'ido-kill-buffer-at-head
+ "C-S-b" #'ido-bury-buffer-at-head
+ "C-o" #'ido-toggle-virtual-buffers)
;;;; Persistent variables
@@ -2247,8 +2238,7 @@ If cursor is not at the end of the user input, move to end of input."
(t
(add-to-history 'buffer-name-history buf)
(setq buf (get-buffer-create buf))
- (if (fboundp 'set-buffer-major-mode)
- (set-buffer-major-mode buf))
+ (set-buffer-major-mode buf)
(ido-visit-buffer buf method t))))))
(defun ido-record-work-directory (&optional dir)
@@ -3215,12 +3205,18 @@ instead removed from the current item list."
;; File list sorting
(defun ido-file-lessp (a b)
- ;; Simple compare two file names.
+ "Simple compare two file names."
+ (when ido-case-fold
+ (setq a (downcase a)
+ b (downcase b)))
(string-lessp (ido-no-final-slash a) (ido-no-final-slash b)))
(defun ido-file-extension-lessp (a b)
- ;; Compare file names according to ido-file-extensions-order list.
+ "Compare file names according to ido-file-extensions-order list."
+ (when ido-case-fold
+ (setq a (downcase a)
+ b (downcase b)))
(let ((n (compare-strings a 0 nil b 0 nil nil))
lessp p)
(if (eq n t)
@@ -3949,7 +3945,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
;; In the new buffer, go to the first completion.
;; FIXME: Perhaps this should be done in `ido-completion-help'.
(when (bobp)
- (next-completion 1)))))
+ (first-completion)))))
(defun ido-completion-auto-help ()
"Call `ido-completion-help' if `completion-auto-help' is non-nil."
@@ -3986,23 +3982,30 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
(setq display-it t))
(if (and ido-completion-buffer display-it)
(with-output-to-temp-buffer ido-completion-buffer
- (let ((completion-list (sort
- (cond
- (ido-directory-too-big
- (message "Reading directory...")
- (setq ido-directory-too-big nil
- ido-ignored-list nil
- ido-cur-list (ido-all-completions)
- ido-rescan t)
- (ido-set-matches)
- (or ido-matches ido-cur-list))
- (ido-use-merged-list
- (ido-flatten-merged-list (or ido-matches ido-cur-list)))
- ((or full-list ido-completion-buffer-all-completions)
- (ido-all-completions))
- (t
- (copy-sequence (or ido-matches ido-cur-list))))
- #'ido-file-lessp)))
+ (let* ((comps
+ (cond
+ (ido-directory-too-big
+ (message "Reading directory...")
+ (setq ido-directory-too-big nil
+ ido-ignored-list nil
+ ido-cur-list (ido-all-completions)
+ ido-rescan t)
+ (ido-set-matches)
+ (or ido-matches ido-cur-list))
+ (ido-use-merged-list
+ (ido-flatten-merged-list (or ido-matches ido-cur-list)))
+ ((or full-list ido-completion-buffer-all-completions)
+ (ido-all-completions))
+ (t
+ (copy-sequence (or ido-matches ido-cur-list)))))
+ (completion-list
+ ;; If we have an alist COMPLETIONS, transform to a
+ ;; simple list first.
+ (sort (if (and (consp comps)
+ (consp (car comps)))
+ (mapcar #'car comps)
+ comps)
+ #'ido-file-lessp)))
;;(add-hook 'completion-setup-hook #'completion-setup-function)
(display-completion-list completion-list))))))
diff --git a/lisp/ielm.el b/lisp/ielm.el
index b20b939e134..47c17921181 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -148,28 +148,28 @@ such as `edebug-defun' to work with such inputs."
This variable is buffer-local.")
(defvar ielm-header
- "*** Welcome to IELM *** Type (describe-mode) for help.\n"
+ (substitute-command-keys
+ "*** Welcome to IELM *** Type (describe-mode) or press \
+\\[describe-mode] for help.\n")
"Message to display when IELM is started.")
(defvaralias 'inferior-emacs-lisp-mode-map 'ielm-map)
-(defvar ielm-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\t" 'ielm-tab)
- (define-key map "\C-m" 'ielm-return)
- (define-key map "\e\C-m" 'ielm-return-for-effect)
- (define-key map "\C-j" 'ielm-send-input)
- (define-key map "\e\C-x" 'eval-defun) ; for consistency with
- (define-key map "\e\t" 'completion-at-point) ; lisp-interaction-mode
- ;; These bindings are from `lisp-mode-shared-map' -- can you inherit
- ;; from more than one keymap??
- (define-key map "\e\C-q" 'indent-sexp)
- (define-key map "\177" 'backward-delete-char-untabify)
- ;; Some convenience bindings for setting the working buffer
- (define-key map "\C-c\C-b" 'ielm-change-working-buffer)
- (define-key map "\C-c\C-f" 'ielm-display-working-buffer)
- (define-key map "\C-c\C-v" 'ielm-print-working-buffer)
- map)
- "Keymap for IELM mode.")
+(defvar-keymap ielm-map
+ :doc "Keymap for IELM mode."
+ "TAB" #'ielm-tab
+ "RET" #'ielm-return
+ "M-RET" #'ielm-return-for-effect
+ "C-j" #'ielm-send-input
+ "C-M-x" #'eval-defun ; for consistency with
+ "M-TAB" #'completion-at-point ; lisp-interaction-mode
+ ;; These bindings are from `lisp-mode-shared-map' -- can you inherit
+ ;; from more than one keymap??
+ "C-M-q" #'indent-sexp
+ "DEL" #'backward-delete-char-untabify
+ ;; Some convenience bindings for setting the working buffer
+ "C-c C-b" #'ielm-change-working-buffer
+ "C-c C-f" #'ielm-display-working-buffer
+ "C-c C-v" #'ielm-print-working-buffer)
(easy-menu-define ielm-menu ielm-map
"IELM mode menu."
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 2fe50d3e3f1..baeb4bb6a7b 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -76,11 +76,9 @@ Examples of image filename patterns to match:
foo.JPG"
:type '(alist :key-type regexp :value-type integer))
-(defvar iimage-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-l" #'iimage-recenter)
- map)
- "Keymap used in `iimage-mode'.")
+(defvar-keymap iimage-mode-map
+ :doc "Keymap used in `iimage-mode'."
+ "C-l" #'iimage-recenter)
(defun iimage-recenter (&optional arg)
"Re-draw images and recenter."
@@ -89,9 +87,6 @@ Examples of image filename patterns to match:
(iimage-mode-buffer t)
(recenter-top-bottom arg))
-;;;###autoload
-(define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1")
-
(defun turn-off-iimage-mode ()
"Unconditionally turn off iimage mode."
(interactive)
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index dd22f1ffa90..9ceaf1bf734 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -1,7 +1,7 @@
;;; image-dired.el --- use dired to browse and manipulate your images -*- lexical-binding: t -*-
-;;
+
;; Copyright (C) 2005-2022 Free Software Foundation, Inc.
-;;
+
;; Version: 0.4.11
;; Keywords: multimedia
;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
@@ -22,7 +22,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; BACKGROUND
;; ==========
;;
@@ -59,19 +59,22 @@
;; PREREQUISITES
;; =============
;;
-;; * The ImageMagick package. Currently, `convert' and `mogrify' are
-;; used. Find it here: https://www.imagemagick.org.
+;; * The GraphicsMagick or ImageMagick package; Image-Dired uses
+;; whichever is available.
+;;
+;; A) For GraphicsMagick, `gm' is used.
+;; Find it here: http://www.graphicsmagick.org/
+;;
+;; B) For ImageMagick, `convert' and `mogrify' are used.
+;; Find it here: https://www.imagemagick.org.
;;
;; * For non-lossy rotation of JPEG images, the JpegTRAN program is
-;; needed.
+;; needed.
;;
-;; * For `image-dired-get-exif-data' and `image-dired-set-exif-data' to work,
-;; the command line tool `exiftool' is needed. It can be found here:
-;; https://exiftool.org/. These two functions are, among other
-;; things, used for writing comments to image files using
-;; `image-dired-thumbnail-set-image-description' and to create
-;; "unique" file names using `image-dired-get-exif-file-name' (used by
-;; `image-dired-copy-with-exif-file-name').
+;; * For `image-dired-set-exif-data' to work, the command line tool `exiftool' is
+;; needed. It can be found here: https://exiftool.org/. This
+;; function is, among other things, used for writing comments to
+;; image files using `image-dired-thumbnail-set-image-description'.
;;
;;
;; USAGE
@@ -89,73 +92,60 @@
;; ===========
;;
;; * Supports all image formats that Emacs and convert supports, but
-;; the thumbnails are hard-coded to JPEG format.
+;; the thumbnails are hard-coded to JPEG or PNG format. It uses
+;; JPEG by default, but can optionally follow the Thumbnail Managing
+;; Standard (v0.9.0, Dec 2020), which mandates PNG. See the user
+;; option `image-dired-thumbnail-storage'.
;;
;; * WARNING: The "database" format used might be changed so keep a
-;; backup of `image-dired-db-file' when testing new versions.
-;;
-;; * `image-dired-display-image-mode' does not support animation
+;; backup of `image-dired-db-file' when testing new versions.
;;
;; TODO
;; ====
;;
-;; * Support gallery creation when using per-directory thumbnail
-;; storage.
-;;
-;; * Some sort of auto-rotate function based on rotate info in the
-;; EXIF data.
-;;
;; * Investigate if it is possible to also write the tags to the image
-;; files.
+;; files.
;;
;; * From thumbs.el: Add an option for clean-up/max-size functionality
;; for thumbnail directory.
;;
;; * From thumbs.el: Add setroot function.
;;
-;; * From thumbs.el: Add image resizing, if useful (image-dired's automatic
-;; "image fit" might be enough)
-;;
-;; * From thumbs.el: Add the "modify" commands (emboss, negate,
-;; monochrome etc).
-;;
-;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find
-;; out which is best, saving old batch just before inserting new, or
-;; saving the current batch in the ring when inserting it. Adding it
-;; probably needs rewriting `image-dired-display-thumbs' to be more general.
+;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find out
+;; which is best, saving old batch just before inserting new, or
+;; saving the current batch in the ring when inserting it. Adding
+;; it probably needs rewriting `image-dired-display-thumbs' to be more general.
;;
;; * Find some way of toggling on and off really nice keybindings in
-;; dired (for example, using C-n or <down> instead of C-S-n). Richard
-;; suggested that we could keep C-t as prefix for image-dired commands
-;; as it is currently not used in dired. He also suggested that
-;; `dired-next-line' and `dired-previous-line' figure out if
-;; image-dired is enabled in the current buffer and, if it is, call
-;; `image-dired-dired-next-line' and
-;; `image-dired-dired-previous-line', respectively. Update: This is
-;; partly done; some bindings have now been added to dired.
-;;
-;; * Enhanced gallery creation with basic CSS-support and pagination
-;; of tag pages with many pictures.
-;;
-;; * Rewrite `image-dired-modify-mark-on-thumb-original-file' to be
-;; less ugly.
+;; Dired (for example, using C-n or <down> instead of C-S-n).
+;; Richard suggested that we could keep C-t as prefix for
+;; image-dired commands as it is currently not used in Dired. He
+;; also suggested that `dired-next-line' and `dired-previous-line'
+;; figure out if image-dired is enabled in the current buffer and,
+;; if it is, call `image-dired-dired-next-line' and `image-dired-dired-previous-line',
+;; respectively. Update: This is partly done; some bindings have
+;; now been added to Dired.
;;
;; * In some way keep track of buffers and windows and stuff so that
-;; it works as the user expects.
-;;
-;; * More/better documentation
-;;
+;; it works as the user expects.
;;
+;; * More/better documentation.
+
;;; Code:
(require 'dired)
+(require 'exif)
(require 'image-mode)
(require 'widget)
+(require 'xdg)
(eval-when-compile
(require 'cl-lib)
(require 'wid-edit))
+
+;;; Customizable variables
+
(defgroup image-dired nil
"Use Dired to browse your images as thumbnails, and more."
:prefix "image-dired-"
@@ -165,108 +155,105 @@
(defcustom image-dired-dir (locate-user-emacs-file "image-dired/")
"Directory where thumbnail images are stored.
-The value of this option will be ignored if Image Dired is
+The value of this option will be ignored if Image-Dired is
customized to use the Thumbnail Managing Standard; they will be
saved in \"$XDG_CACHE_HOME/thumbnails/\" instead. See
`image-dired-thumbnail-storage'."
:type 'directory)
(defcustom image-dired-thumbnail-storage 'use-image-dired-dir
- "How to store image-dired's thumbnail files.
-Image-Dired can store thumbnail files in one of two ways and this is
-controlled by this variable. \"Use image-dired dir\" means that the
-thumbnails are stored in a central directory. \"Per directory\"
-means that each thumbnail is stored in a subdirectory called
-\".image-dired\" in the same directory where the image file is.
-\"Thumbnail Managing Standard\" means that the thumbnails are
-stored and generated according to the Thumbnail Managing Standard
-that allows sharing of thumbnails across different programs."
+ "How `image-dired' stores thumbnail files.
+There are two ways that Image-Dired can store and generate
+thumbnails. If you set this variable to one of the two following
+values, they will be stored in the JPEG format:
+
+- `use-image-dired-dir' means that the thumbnails are stored in a
+ central directory.
+
+- `per-directory' means that each thumbnail is stored in a
+ subdirectory called \".image-dired\" in the same directory
+ where the image file is.
+
+It can also use the \"Thumbnail Managing Standard\", which allows
+sharing of thumbnails across different programs. Thumbnails will
+be stored in \"$XDG_CACHE_HOME/thumbnails/\" instead of in
+`image-dired-dir'. Thumbnails are saved in the PNG format, and
+can be one of the following sizes:
+
+- `standard' means use thumbnails sized 128x128.
+- `standard-large' means use thumbnails sized 256x256.
+- `standard-x-large' means use thumbnails sized 512x512.
+- `standard-xx-large' means use thumbnails sized 1024x1024.
+
+For more information on the Thumbnail Managing Standard, see:
+https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html"
:type '(choice :tag "How to store thumbnail files"
(const :tag "Use image-dired-dir" use-image-dired-dir)
- (const :tag "Thumbnail Managing Standard (normal 128x128)" standard)
- (const :tag "Thumbnail Managing Standard (large 256x256)" standard-large)
- (const :tag "Per-directory" per-directory)))
+ (const :tag "Thumbnail Managing Standard (normal 128x128)"
+ standard)
+ (const :tag "Thumbnail Managing Standard (large 256x256)"
+ standard-large)
+ (const :tag "Thumbnail Managing Standard (larger 512x512)"
+ standard-x-large)
+ (const :tag "Thumbnail Managing Standard (extra large 1024x1024)"
+ standard-xx-large)
+ (const :tag "Per-directory" per-directory))
+ :version "29.1")
+
+(defconst image-dired--thumbnail-standard-sizes
+ '( standard standard-large
+ standard-x-large standard-xx-large)
+ "List of symbols representing thumbnail sizes in Thumbnail Managing Standard.")
(defcustom image-dired-db-file
(expand-file-name ".image-dired_db" image-dired-dir)
"Database file where file names and their associated tags are stored."
:type 'file)
-(defcustom image-dired-temp-image-file
- (expand-file-name ".image-dired_temp" image-dired-dir)
- "Name of temporary image file used by various commands."
- :type 'file)
-
-(defcustom image-dired-gallery-dir
- (expand-file-name ".image-dired_gallery" image-dired-dir)
- "Directory to store generated gallery html pages.
-This path needs to be \"shared\" to the public so that it can access
-the index.html page that image-dired creates."
- :type 'directory)
-
-(defcustom image-dired-gallery-image-root-url
-"https://your.own.server/image-diredpics"
- "URL where the full size images are to be found.
-Note that this path has to be configured in your web server. Image-Dired
-expects to find pictures in this directory."
- :type 'string)
-
-(defcustom image-dired-gallery-thumb-image-root-url
-"https://your.own.server/image-diredthumbs"
- "URL where the thumbnail images are to be found.
-Note that this path has to be configured in your web server. Image-Dired
-expects to find pictures in this directory."
- :type 'string)
-
(defcustom image-dired-cmd-create-thumbnail-program
- "convert"
+ (if (executable-find "gm") "gm" "convert")
"Executable used to create thumbnail.
Used together with `image-dired-cmd-create-thumbnail-options'."
- :type 'file)
+ :type 'file
+ :version "29.1")
(defcustom image-dired-cmd-create-thumbnail-options
- '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
+ (let ((opts '("-size" "%wx%h" "%f[0]"
+ "-resize" "%wx%h>"
+ "-strip" "jpeg:%t")))
+ (if (executable-find "gm") (cons "convert" opts) opts))
"Options of command used to create thumbnail image.
Used with `image-dired-cmd-create-thumbnail-program'.
Available format specifiers are: %w which is replaced by
`image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height',
%f which is replaced by the file name of the original image and %t
which is replaced by the file name of the thumbnail file."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-
-(defcustom image-dired-cmd-create-temp-image-program "convert"
- "Executable used to create temporary image.
-Used together with `image-dired-cmd-create-temp-image-options'."
- :type 'file)
-
-(defcustom image-dired-cmd-create-temp-image-options
- '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
- "Options of command used to create temporary image for display window.
-Used together with `image-dired-cmd-create-temp-image-program',
-Available format specifiers are: %w and %h which are replaced by
-the calculated max size for width and height in the image display window,
-%f which is replaced by the file name of the original image and %t which
-is replaced by the file name of the temporary file."
- :version "26.1"
+ :version "29.1"
:type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-pngnq-program
- (or (executable-find "pngnq")
- (executable-find "pngnq-s9"))
- "The file name of the `pngnq' program.
+ ;; Prefer pngquant to pngnq-s9 as it is faster on my machine.
+ ;; The project also seems more active than the alternatives.
+ ;; Prefer pngnq-s9 to pngnq as it fixes bugs in pngnq.
+ ;; The pngnq project seems dead (?) since 2011 or so.
+ (or (executable-find "pngquant")
+ (executable-find "pngnq-s9")
+ (executable-find "pngnq"))
+ "The file name of the `pngquant' or `pngnq' program.
It quantizes colors of PNG images down to 256 colors or fewer
using the NeuQuant algorithm."
- :version "26.1"
+ :version "29.1"
:type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-pngnq-options
- '("-f" "%t")
+ (if (executable-find "pngquant")
+ '("--ext" "-nq8.png" "%t") ; same extension as "pngnq"
+ '("-f" "%t"))
"Arguments to pass `image-dired-cmd-pngnq-program'.
Available format specifiers are the same as in
`image-dired-cmd-create-thumbnail-options'."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
+ :type '(repeat (string :tag "Argument"))
+ :version "29.1")
(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
"The file name of the `pngcrush' program.
@@ -321,23 +308,6 @@ Available format specifiers are the same as in
:version "26.1"
:type '(repeat (string :tag "Argument")))
-(defcustom image-dired-cmd-rotate-thumbnail-program
- "mogrify"
- "Executable used to rotate thumbnail.
-Used together with `image-dired-cmd-rotate-thumbnail-options'."
- :type 'file)
-
-(defcustom image-dired-cmd-rotate-thumbnail-options
- '("-rotate" "%d" "%t")
- "Arguments of command used to rotate thumbnail image.
-Used with `image-dired-cmd-rotate-thumbnail-program'.
-Available format specifiers are: %d which is replaced by the
-number of (positive) degrees to rotate the image, normally 90 or 270
-\(for 90 degrees right and left), %t which is replaced by the file name
-of the thumbnail file."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-
(defcustom image-dired-cmd-rotate-original-program
"jpegtran"
"Executable used to rotate original image.
@@ -383,37 +353,18 @@ which is replaced by the tag value."
:version "26.1"
:type '(repeat (string :tag "Argument")))
-(defcustom image-dired-cmd-read-exif-data-program
- "exiftool"
- "Program used to read EXIF data to image.
-Used together with `image-dired-cmd-read-exif-data-options'."
- :type 'file)
-
-(defcustom image-dired-cmd-read-exif-data-options
- '("-s" "-s" "-s" "-%t" "%f")
- "Arguments of command used to read EXIF data.
-Used with `image-dired-cmd-read-exif-data-program'.
-Available format specifiers are: %f which is replaced
-by the image file name and %t which is replaced by the tag name."
- :version "26.1"
- :type '(repeat (string :tag "Argument")))
-
-(defcustom image-dired-gallery-hidden-tags
- (list "private" "hidden" "pending")
- "List of \"hidden\" tags.
-Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
- :type '(repeat string))
-
(defcustom image-dired-thumb-size
(cond
((eq 'standard image-dired-thumbnail-storage) 128)
((eq 'standard-large image-dired-thumbnail-storage) 256)
+ ((eq 'standard-x-large image-dired-thumbnail-storage) 512)
+ ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024)
(t 100))
"Size of thumbnails, in pixels.
This is the default size for both `image-dired-thumb-width'
and `image-dired-thumb-height'.
-The value of this option will be ignored if Image Dired is
+The value of this option will be ignored if Image-Dired is
customized to use the Thumbnail Managing Standard; the standard
sizes will be used instead. See `image-dired-thumbnail-storage'."
:type 'integer)
@@ -436,17 +387,28 @@ This is where you see the cursor."
:type 'integer)
(defcustom image-dired-thumb-visible-marks t
- "Make marks visible in thumbnail buffer.
+ "Make marks and flags visible in thumbnail buffer.
If non-nil, apply the `image-dired-thumb-mark' face to marked
-images."
+images and `image-dired-thumb-flagged' to images flagged for
+deletion."
:type 'boolean
:version "28.1")
(defface image-dired-thumb-mark
- '((t (:background "orange")))
- "Background-color for marked images in thumbnail buffer."
- :group 'image-dired
- :version "28.1")
+ '((((class color) (min-colors 16)) :background "DarkOrange")
+ (((class color)) :foreground "yellow"))
+ "Face for marked images in thumbnail buffer."
+ :version "29.1")
+
+(defface image-dired-thumb-flagged
+ '((((class color) (min-colors 88) (background light)) :background "Red3")
+ (((class color) (min-colors 88) (background dark)) :background "Pink")
+ (((class color) (min-colors 16) (background light)) :background "Red3")
+ (((class color) (min-colors 16) (background dark)) :background "Pink")
+ (((class color) (min-colors 8)) :background "red")
+ (t :inverse-video t))
+ "Face for images flagged for deletion in thumbnail buffer."
+ :version "29.1")
(defcustom image-dired-line-up-method 'dynamic
"Default method for line-up of thumbnails in thumbnail buffer.
@@ -465,18 +427,6 @@ and No line-up means that no automatic line-up will be done."
"Number of thumbnails to display per row in thumb buffer."
:type 'integer)
-(defcustom image-dired-display-window-width-correction 1
- "Number to be used to correct image display window width.
-Change if the default (1) does not work (i.e. if the image does not
-completely fit)."
- :type 'integer)
-
-(defcustom image-dired-display-window-height-correction 0
- "Number to be used to correct image display window height.
-Change if the default (0) does not work (i.e. if the image does not
-completely fit)."
- :type 'integer)
-
(defcustom image-dired-track-movement t
"The current state of the tracking and mirroring.
For more information, see the documentation for
@@ -522,15 +472,45 @@ Including parameters. Used when displaying original image from
:type '(choice string
(const :tag "Not Set" nil)))
-(defcustom image-dired-main-image-directory "~/pics/"
+(defcustom image-dired-main-image-directory
+ (or (xdg-user-dir "PICTURES") "~/pics/")
"Name of main image directory, if any.
Used by `image-dired-copy-with-exif-file-name'."
- :type 'string)
+ :type 'string
+ :version "29.1")
+
+(defcustom image-dired-show-all-from-dir-max-files 500
+ "Maximum number of files in directory before prompting.
+
+If there are more image files than this in a selected directory,
+the `image-dired-show-all-from-dir' command will ask for
+confirmation before creating the thumbnail buffer. If this
+variable is nil, it will never ask."
+ :type '(choice integer
+ (const :tag "Disable warning" nil))
+ :version "29.1")
+
+(defcustom image-dired-marking-shows-next t
+ "If non-nil, marking, unmarking or flagging an image shows the next image.
+
+This affects the following commands:
+\\<image-dired-thumbnail-mode-map>
+ `image-dired-flag-thumb-original-file' (bound to \\[image-dired-flag-thumb-original-file])
+ `image-dired-mark-thumb-original-file' (bound to \\[image-dired-mark-thumb-original-file])
+ `image-dired-unmark-thumb-original-file' (bound to \\[image-dired-unmark-thumb-original-file])"
+ :type 'boolean
+ :version "29.1")
-(defcustom image-dired-show-all-from-dir-max-files 50
- "Maximum number of files to show using `image-dired-show-all-from-dir'
-before warning."
- :type 'integer)
+
+;;; Util functions
+
+(defvar image-dired-debug nil
+ "Non-nil means enable debug messages.")
+
+(defun image-dired-debug-message (&rest args)
+ "Display debug message ARGS when `image-dired-debug' is non-nil."
+ (when image-dired-debug
+ (apply #'message args)))
(defmacro image-dired--with-db-file (&rest body)
"Run BODY in a temp buffer containing `image-dired-db-file'.
@@ -542,14 +522,14 @@ Return the last form in BODY."
,@body))
(defun image-dired-dir ()
- "Return the current thumbnails directory (from variable `image-dired-dir').
-Create the thumbnails directory if it does not exist."
+ "Return the current thumbnail directory (from variable `image-dired-dir').
+Create the thumbnail directory if it does not exist."
(let ((image-dired-dir (file-name-as-directory
- (expand-file-name image-dired-dir))))
+ (expand-file-name image-dired-dir))))
(unless (file-directory-p image-dired-dir)
(with-file-modes #o700
(make-directory image-dired-dir t))
- (message "Creating thumbnails directory"))
+ (message "Thumbnail directory created: %s" image-dired-dir))
image-dired-dir))
(defun image-dired-insert-image (file type relief margin)
@@ -562,7 +542,7 @@ Create the thumbnails directory if it does not exist."
(defun image-dired-get-thumbnail-image (file)
"Return the image descriptor for a thumbnail of image file FILE."
- (unless (string-match (image-file-name-regexp) file)
+ (unless (string-match-p (image-file-name-regexp) file)
(error "%s is not a valid image file" file))
(let* ((thumb-file (image-dired-thumb-name file))
(thumb-attr (file-attributes thumb-file)))
@@ -571,11 +551,7 @@ Create the thumbnails directory if it does not exist."
(file-attribute-modification-time
(file-attributes file))))
(image-dired-create-thumb file thumb-file))
- (create-image thumb-file)
-;; (list 'image :type 'jpeg
-;; :file thumb-file
-;; :relief image-dired-thumb-relief :margin image-dired-thumb-margin)
- ))
+ (create-image thumb-file)))
(defun image-dired-insert-thumbnail (file original-file-name
associated-dired-buffer)
@@ -583,13 +559,19 @@ Create the thumbnails directory if it does not exist."
Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER."
(let (beg end)
(setq beg (point))
- (image-dired-insert-image file
- ;; TODO: this should depend on the real file type
- (if (memq image-dired-thumbnail-storage
- '(standard standard-large))
- 'png 'jpeg)
- image-dired-thumb-relief
- image-dired-thumb-margin)
+ (image-dired-insert-image
+ file
+ ;; Thumbnails are created asynchronously, so we might not yet
+ ;; have a file. But if it exists, it might have been cached from
+ ;; before and we should use it instead of our current settings.
+ (or (and (file-exists-p file)
+ (image-type-from-file-header file))
+ (and (memq image-dired-thumbnail-storage
+ image-dired--thumbnail-standard-sizes)
+ 'png)
+ 'jpeg)
+ image-dired-thumb-relief
+ image-dired-thumb-margin)
(setq end (point))
(add-text-properties
beg end
@@ -601,35 +583,37 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER."
'comment (image-dired-get-comment original-file-name)))))
(defun image-dired-thumb-name (file)
- "Return thumbnail file name for FILE.
-Depending on the value of `image-dired-thumbnail-storage', the file
-name will vary. For central thumbnail file storage, make a
-MD5-hash of the image file's directory name and add that to make
-the thumbnail file name unique. For per-directory storage, just
-add a subdirectory. For standard storage, produce the file name
-according to the Thumbnail Managing Standard."
- (cond ((memq image-dired-thumbnail-storage '(standard standard-large))
- (let* ((xdg (getenv "XDG_CACHE_HOME"))
- (dir (if (and xdg (file-name-absolute-p xdg))
- xdg "~/.cache"))
- (thumbdir (cl-case image-dired-thumbnail-storage
- (standard "thumbnails/normal")
- (standard-large "thumbnails/large"))))
+ "Return absolute file name for thumbnail FILE.
+Depending on the value of `image-dired-thumbnail-storage', the
+file name of the thumbnail will vary:
+- For `use-image-dired-dir', make a SHA1-hash of the image file's
+ directory name and add that to make the thumbnail file name
+ unique.
+- For `per-directory' storage, just add a subdirectory.
+- For `standard' storage, produce the file name according to the
+ Thumbnail Managing Standard. Among other things, an MD5-hash
+ of the image file's directory name will be added to the
+ filename.
+See also `image-dired-thumbnail-storage'."
+ (cond ((memq image-dired-thumbnail-storage
+ image-dired--thumbnail-standard-sizes)
+ (let ((thumbdir (cl-case image-dired-thumbnail-storage
+ (standard "thumbnails/normal")
+ (standard-large "thumbnails/large")
+ (standard-x-large "thumbnails/x-large")
+ (standard-xx-large "thumbnails/xx-large"))))
(expand-file-name
+ ;; MD5 is mandated by the Thumbnail Managing Standard.
(concat (md5 (concat "file://" (expand-file-name file))) ".png")
- (expand-file-name thumbdir dir))))
+ (expand-file-name thumbdir (xdg-cache-home)))))
((eq 'use-image-dired-dir image-dired-thumbnail-storage)
(let* ((f (expand-file-name file))
- (md5-hash
- ;; Is MD5 hashes fast enough? The checksum of a
- ;; thumbnail file name need not be that
- ;; "cryptographically" good so a faster one could
- ;; be used here.
+ (hash
(md5 (file-name-as-directory (file-name-directory f)))))
(format "%s%s%s.thumb.%s"
(file-name-as-directory (expand-file-name (image-dired-dir)))
(file-name-base f)
- (if md5-hash (concat "_" md5-hash) "")
+ (if hash (concat "_" hash) "")
(file-name-extension f))))
((eq 'per-directory image-dired-thumbnail-storage)
(let ((f (expand-file-name file)))
@@ -642,16 +626,24 @@ according to the Thumbnail Managing Standard."
(unless (executable-find (symbol-value executable))
(error "Executable %S not found" executable)))
+
+;;; Creating thumbnails
+
(defun image-dired-thumb-size (dimension)
"Return thumb size depending on `image-dired-thumbnail-storage'.
DIMENSION should be either the symbol `width' or `height'."
(cond
((eq 'standard image-dired-thumbnail-storage) 128)
((eq 'standard-large image-dired-thumbnail-storage) 256)
+ ((eq 'standard-x-large image-dired-thumbnail-storage) 512)
+ ((eq 'standard-xx-large image-dired-thumbnail-storage) 1024)
(t (cl-ecase dimension
(width image-dired-thumb-width)
(height image-dired-thumb-height)))))
+(defvar image-dired--generate-thumbs-start nil
+ "Time when `display-thumbs' was called.")
+
(defvar image-dired-queue nil
"List of items in the queue.
Each item has the form (ORIGINAL-FILE TARGET-FILE).")
@@ -659,11 +651,12 @@ Each item has the form (ORIGINAL-FILE TARGET-FILE).")
(defvar image-dired-queue-active-jobs 0
"Number of active jobs in `image-dired-queue'.")
-(defvar image-dired-queue-active-limit 2
+(defvar image-dired-queue-active-limit (min 4 (max 2 (/ (num-processors) 2)))
"Maximum number of concurrent jobs permitted for generating images.
-Increase at own risk.")
-
-(defvar image-dired-tag-history nil "Variable holding the tag history.")
+Increase at own risk. If you want to experiment with this,
+consider setting `image-dired-debug' to a non-nil value to see
+the time spent on generating thumbnails. Run `image-clear-cache'
+and remove the cached thumbnail files between each trial run.")
(defun image-dired-pngnq-thumb (spec)
"Quantize thumbnail described by format SPEC with pngnq(1)."
@@ -750,9 +743,9 @@ Increase at own risk.")
(thumbnail-dir (file-name-directory thumbnail-file))
process)
(when (not (file-exists-p thumbnail-dir))
- (message "Creating thumbnail directory")
(with-file-modes #o700
- (make-directory thumbnail-dir t)))
+ (make-directory thumbnail-dir t))
+ (message "Thumbnail directory created: %s" thumbnail-dir))
;; Thumbnail file creation processes begin here and are marshaled
;; in a queue by `image-dired-create-thumb'.
@@ -762,7 +755,7 @@ Increase at own risk.")
(mapcar
(lambda (arg) (format-spec arg spec))
(if (memq image-dired-thumbnail-storage
- '(standard standard-large))
+ image-dired--thumbnail-standard-sizes)
image-dired-cmd-create-standard-thumbnail-options
image-dired-cmd-create-thumbnail-options))))
@@ -771,6 +764,12 @@ Increase at own risk.")
;; Trigger next in queue once a thumbnail has been created
(cl-decf image-dired-queue-active-jobs)
(image-dired-thumb-queue-run)
+ (when (= image-dired-queue-active-jobs 0)
+ (image-dired-debug-message
+ (format-time-string
+ "Generated thumbnails in %s.%3N seconds"
+ (time-subtract nil
+ image-dired--generate-thumbs-start))))
(if (not (and (eq (process-status process) 'exit)
(zerop (process-exit-status process))))
(message "Thumb could not be created for %s: %s"
@@ -781,7 +780,7 @@ Increase at own risk.")
;; PNG thumbnail has been created since we are
;; following the XDG thumbnail spec, so try to optimize
(when (memq image-dired-thumbnail-storage
- '(standard standard-large))
+ image-dired--thumbnail-standard-sizes)
(cond
((and image-dired-cmd-pngnq-program
(executable-find image-dired-cmd-pngnq-program))
@@ -895,7 +894,7 @@ Otherwise, delete overlays."
(interactive)
(setq image-dired-append-when-browsing
(not image-dired-append-when-browsing))
- (message "Append browsing %s."
+ (message "Append browsing %s"
(if image-dired-append-when-browsing
"on"
"off")))
@@ -934,15 +933,6 @@ Otherwise, delete overlays."
(defvar image-dired-display-image-buffer "*image-dired-display-image*"
"Where larger versions of the images are display.")
-(defun image-dired-create-display-image-buffer ()
- "Create image display buffer and set `image-dired-display-image-mode'."
- (let ((buf (get-buffer-create image-dired-display-image-buffer)))
- (with-current-buffer buf
- (setq buffer-read-only t)
- (if (not (eq major-mode 'image-dired-display-image-mode))
- (image-dired-display-image-mode)))
- buf))
-
(defvar image-dired-saved-window-configuration nil
"Saved window configuration.")
@@ -966,7 +956,7 @@ The current window configuration is saved and can be restored by
calling `image-dired-restore-window-configuration'."
(interactive "DDirectory: \nP")
(let ((buf (image-dired-create-thumbnail-buffer))
- (buf2 (image-dired-create-display-image-buffer)))
+ (buf2 (get-buffer-create image-dired-display-image-buffer)))
(setq image-dired-saved-window-configuration
(current-window-configuration))
(dired dir)
@@ -985,7 +975,7 @@ calling `image-dired-restore-window-configuration'."
"Restore window configuration.
Restore any changes to the window configuration made by calling
`image-dired-dired-with-window-configuration'."
- (interactive)
+ (interactive nil image-dired-thumbnail-mode)
(if image-dired-saved-window-configuration
(set-window-configuration image-dired-saved-window-configuration)
(message "No saved window configuration")))
@@ -1025,6 +1015,7 @@ used or not. If non-nil, use `display-buffer' instead of
`image-dired-previous-line-and-display' where we do not want the
thumbnail buffer to be selected."
(interactive "P")
+ (setq image-dired--generate-thumbs-start (current-time))
(let ((buf (image-dired-create-thumbnail-buffer))
thumb-name files dired-buf)
(if arg
@@ -1048,30 +1039,38 @@ thumbnail buffer to be selected."
;;;###autoload
(defun image-dired-show-all-from-dir (dir)
- "Make a preview buffer for all images in DIR and display it.
-If the number of files in DIR matching `image-file-name-regexp'
-exceeds `image-dired-show-all-from-dir-max-files', a warning will be
-displayed."
- (interactive "DImage Dired: ")
+ "Make a thumbnail buffer for all images in DIR and display it.
+Any file matching `image-file-name-regexp' is considered an image
+file.
+
+If the number of image files in DIR exceeds
+`image-dired-show-all-from-dir-max-files', ask for confirmation
+before creating the thumbnail buffer. If that variable is nil,
+never ask for confirmation."
+ (interactive "DImage-Dired: ")
(dired dir)
(dired-mark-files-regexp (image-file-name-regexp))
- (let ((files (dired-get-marked-files)))
- (if (or (<= (length files) image-dired-show-all-from-dir-max-files)
- (and (> (length files) image-dired-show-all-from-dir-max-files)
- (y-or-n-p
- (format
- "Directory contains more than %d image files. Proceed? "
- image-dired-show-all-from-dir-max-files))))
- (progn
- (image-dired-display-thumbs)
- (pop-to-buffer image-dired-thumbnail-buffer))
- (message "Canceled."))))
+ (let ((files (dired-get-marked-files nil nil nil t)))
+ (cond ((and (null (cdr files)))
+ (message "No image files in directory"))
+ ((or (not image-dired-show-all-from-dir-max-files)
+ (<= (length (cdr files)) image-dired-show-all-from-dir-max-files)
+ (and (> (length (cdr files)) image-dired-show-all-from-dir-max-files)
+ (y-or-n-p
+ (format
+ "Directory contains more than %d image files. Proceed?"
+ image-dired-show-all-from-dir-max-files))))
+ (image-dired-display-thumbs)
+ (pop-to-buffer image-dired-thumbnail-buffer)
+ (setq default-directory dir)
+ (image-dired-unmark-all-marks))
+ (t (message "Image-Dired canceled")))))
;;;###autoload
(defalias 'image-dired 'image-dired-show-all-from-dir)
-;;;###autoload
-(define-obsolete-function-alias 'tumme 'image-dired "24.4")
+
+;;; Tags
(defun image-dired-sane-db-file ()
"Check if `image-dired-db-file' exists.
@@ -1091,6 +1090,8 @@ Signal error if there are problems creating it."
(file-exists-p image-dired-db-file))
(error "Could not create %s" image-dired-db-file)))
+(defvar image-dired-tag-history nil "Variable holding the tag history.")
+
(defun image-dired-write-tags (file-tags)
"Write file tags to database.
Write each file and tag in FILE-TAGS to the database.
@@ -1211,6 +1212,9 @@ With prefix argument ARG, remove tag from file at point."
(image-dired-update-property
'tags (image-dired-list-tags (image-dired-original-file-name))))))
+
+;;; Thumbnail mode (cont.)
+
(defun image-dired-original-file-name ()
"Get original file name for thumbnail or display image at point."
(get-text-property (point) 'original-file-name))
@@ -1254,7 +1258,7 @@ around in the thumbnail or dired buffer will find the matching
position in the other buffer."
(interactive)
(setq image-dired-track-movement (not image-dired-track-movement))
- (message "Tracking %s" (if image-dired-track-movement "on" "off")))
+ (message "Movement tracking %s" (if image-dired-track-movement "on" "off")))
(defun image-dired-track-thumbnail ()
"Track current Dired file's thumb in `image-dired-thumbnail-buffer'.
@@ -1276,7 +1280,7 @@ but the other way around."
(when found
(if (setq window (image-dired-thumbnail-window))
(set-window-point window (point)))
- (image-dired-display-thumb-properties))))))
+ (image-dired-update-header-line))))))
(defun image-dired-dired-next-line (&optional arg)
"Call `dired-next-line', then track thumbnail.
@@ -1296,51 +1300,59 @@ With prefix argument, move ARG lines."
(if image-dired-track-movement
(image-dired-track-thumbnail)))
-(defun image-dired-forward-image (&optional arg)
+(defun image-dired--display-thumb-properties-fun ()
+ (let ((old-buf (current-buffer))
+ (old-point (point)))
+ (lambda ()
+ (when (and (equal (current-buffer) old-buf)
+ (= (point) old-point))
+ (ignore-errors
+ (image-dired-update-header-line))))))
+
+(defun image-dired-forward-image (&optional arg wrap-around)
"Move to next image and display properties.
-Optional prefix ARG says how many images to move; default is one
-image."
+Optional prefix ARG says how many images to move; the default is
+one image. Negative means move backwards.
+On reaching end or beginning of buffer, stop and show a message.
+
+If optional argument WRAP-AROUND is non-nil, wrap around: if
+point is on the last image, move to the last one and vice versa."
(interactive "p")
- (let (pos (steps (or arg 1)))
- (dotimes (_ steps)
- (if (and (not (eobp))
+ (setq arg (or arg 1))
+ (let (pos)
+ (dotimes (_ (abs arg))
+ (if (and (not (if (> arg 0) (eobp) (bobp)))
(save-excursion
- (forward-char)
- (while (and (not (eobp))
+ (forward-char (if (> arg 0) 1 -1))
+ (while (and (not (if (> arg 0) (eobp) (bobp)))
(not (image-dired-image-at-point-p)))
- (forward-char))
+ (forward-char (if (> arg 0) 1 -1)))
(setq pos (point))
(image-dired-image-at-point-p)))
- (goto-char pos)
- (error "At last image"))))
+ (progn (goto-char pos)
+ (image-dired-update-header-line))
+ (if wrap-around
+ (progn (goto-char (if (> arg 0)
+ (point-min)
+ ;; There are two spaces after the last image.
+ (- (point-max) 2)))
+ (image-dired-update-header-line))
+ (message "At %s image" (if (> arg 0) "last" "first"))
+ (run-at-time 1 nil (image-dired--display-thumb-properties-fun))))))
(when image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-display-thumb-properties))
+ (image-dired-track-original-file)))
(defun image-dired-backward-image (&optional arg)
"Move to previous image and display properties.
-Optional prefix ARG says how many images to move; default is one
-image."
+Optional prefix ARG says how many images to move; the default is
+one image. Negative means move forward.
+On reaching end or beginning of buffer, stop and show a message."
(interactive "p")
- (let (pos (steps (or arg 1)))
- (dotimes (_ steps)
- (if (and (not (bobp))
- (save-excursion
- (backward-char)
- (while (and (not (bobp))
- (not (image-dired-image-at-point-p)))
- (backward-char))
- (setq pos (point))
- (image-dired-image-at-point-p)))
- (goto-char pos)
- (error "At first image"))))
- (when image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-display-thumb-properties))
+ (image-dired-forward-image (- (or arg 1))))
(defun image-dired-next-line ()
"Move to next line and display properties."
- (interactive)
+ (interactive nil image-dired-thumbnail-mode)
(let ((goal-column (current-column)))
(forward-line 1)
(move-to-column goal-column))
@@ -1349,12 +1361,12 @@ image."
(image-dired-backward-image))
(if image-dired-track-movement
(image-dired-track-original-file))
- (image-dired-display-thumb-properties))
+ (image-dired-update-header-line))
(defun image-dired-previous-line ()
"Move to previous line and display properties."
- (interactive)
+ (interactive nil image-dired-thumbnail-mode)
(let ((goal-column (current-column)))
(forward-line -1)
(move-to-column goal-column))
@@ -1366,7 +1378,29 @@ image."
(image-dired-backward-image))
(if image-dired-track-movement
(image-dired-track-original-file))
- (image-dired-display-thumb-properties))
+ (image-dired-update-header-line))
+
+(defun image-dired-beginning-of-buffer ()
+ "Move to the first image in the buffer and display properties."
+ (interactive nil image-dired-thumbnail-mode)
+ (goto-char (point-min))
+ (while (and (not (image-at-point-p))
+ (not (eobp)))
+ (forward-char 1))
+ (when image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired-update-header-line))
+
+(defun image-dired-end-of-buffer ()
+ "Move to the last image in the buffer and display properties."
+ (interactive nil image-dired-thumbnail-mode)
+ (goto-char (point-max))
+ (while (and (not (image-at-point-p))
+ (not (bobp)))
+ (forward-char -1))
+ (when image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired-update-header-line))
(defun image-dired-format-properties-string (buf file props comment)
"Format display properties.
@@ -1381,77 +1415,115 @@ comment."
(cons ?t (or props ""))
(cons ?c (or comment "")))))
-(defun image-dired-display-thumb-properties ()
- "Display thumbnail properties in the echo area."
- (if (not (eobp))
- (let ((file-name (file-name-nondirectory (image-dired-original-file-name)))
- (dired-buf (buffer-name (image-dired-associated-dired-buffer)))
- (props (mapconcat #'identity (get-text-property (point) 'tags) ", "))
- (comment (get-text-property (point) 'comment))
- (message-log-max nil))
- (if file-name
- (message "%s"
- (image-dired-format-properties-string
- dired-buf
- file-name
- props
- comment))))))
-
-(defun image-dired-dired-file-marked-p ()
- "Check whether file on current line is marked or not."
+(defun image-dired-update-header-line ()
+ "Update image information in the header line."
+ (when (and (not (eobp))
+ (memq major-mode '(image-dired-thumbnail-mode
+ image-dired-display-image-mode)))
+ (let ((file-name (file-name-nondirectory (image-dired-original-file-name)))
+ (dired-buf (buffer-name (image-dired-associated-dired-buffer)))
+ (props (mapconcat #'identity (get-text-property (point) 'tags) ", "))
+ (comment (get-text-property (point) 'comment))
+ (message-log-max nil))
+ (if file-name
+ (setq header-line-format
+ (image-dired-format-properties-string
+ dired-buf
+ file-name
+ props
+ comment))))))
+
+(defun image-dired-dired-file-marked-p (&optional marker)
+ "In Dired, return t if file on current line is marked.
+If optional argument MARKER is non-nil, it is a character to look
+for. The default is to look for `dired-marker-char'."
+ (setq marker (or marker dired-marker-char))
(save-excursion
(beginning-of-line)
- (looking-at-p dired-re-mark)))
-
-(defun image-dired-modify-mark-on-thumb-original-file (command)
- "Modify mark in Dired buffer.
-COMMAND is one of `mark' for marking file in Dired, `unmark' for
-unmarking file in Dired or `flag' for flagging file for delete in
-Dired."
- (let ((file-name (image-dired-original-file-name))
- (dired-buf (image-dired-associated-dired-buffer)))
- (if (not (and dired-buf file-name))
- (message "No image, or image with correct properties, at point.")
- (with-current-buffer dired-buf
- (message "%s" file-name)
- (when (dired-goto-file file-name)
- (cond ((eq command 'mark) (dired-mark 1))
- ((eq command 'unmark) (dired-unmark 1))
- ((eq command 'toggle)
- (if (image-dired-dired-file-marked-p)
- (dired-unmark 1)
- (dired-mark 1)))
- ((eq command 'flag) (dired-flag-file-deletion 1)))
- (image-dired-thumb-update-marks))))))
+ (and (looking-at dired-re-mark)
+ (= (aref (match-string 0) 0) marker))))
+
+(defun image-dired-dired-file-flagged-p ()
+ "In Dired, return t if file on current line is flagged for deletion."
+ (image-dired-dired-file-marked-p dired-del-marker))
+
+(defmacro image-dired--with-thumbnail-buffer (&rest body)
+ (declare (indent defun) (debug t))
+ `(if-let ((buf (get-buffer image-dired-thumbnail-buffer)))
+ (with-current-buffer buf
+ (if-let ((win (get-buffer-window buf)))
+ (with-selected-window win
+ ,@body)
+ ,@body))
+ (user-error "No such buffer: %s" image-dired-thumbnail-buffer)))
+
+(defmacro image-dired--on-file-in-dired-buffer (&rest body)
+ "Run BODY with point on file at point in Dired buffer.
+Should be called from commands in `image-dired-thumbnail-mode'."
+ (declare (indent defun) (debug t))
+ `(let ((file-name (image-dired-original-file-name))
+ (dired-buf (image-dired-associated-dired-buffer)))
+ (if (not (and dired-buf file-name))
+ (message "No image, or image with correct properties, at point.")
+ (with-current-buffer dired-buf
+ (when (dired-goto-file file-name)
+ ,@body
+ (image-dired-thumb-update-marks))))))
+
+(defmacro image-dired--do-mark-command (maybe-next &rest body)
+ "Helper macro for the mark, unmark and flag commands.
+Run BODY in Dired buffer.
+If optional argument MAYBE-NEXT is non-nil, show next image
+according to `image-dired-marking-shows-next'."
+ (declare (indent defun) (debug t))
+ `(image-dired--with-thumbnail-buffer
+ (image-dired--on-file-in-dired-buffer
+ ,@body)
+ ,(when maybe-next
+ '(if image-dired-marking-shows-next
+ (image-dired-display-next-thumbnail-original)
+ (image-dired-next-line)))))
(defun image-dired-mark-thumb-original-file ()
"Mark original image file in associated Dired buffer."
- (interactive)
- (image-dired-modify-mark-on-thumb-original-file 'mark)
- (image-dired-forward-image))
+ (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
+ (image-dired--do-mark-command t
+ (dired-mark 1)))
(defun image-dired-unmark-thumb-original-file ()
"Unmark original image file in associated Dired buffer."
- (interactive)
- (image-dired-modify-mark-on-thumb-original-file 'unmark)
- (image-dired-forward-image))
+ (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
+ (image-dired--do-mark-command t
+ (dired-unmark 1)))
(defun image-dired-flag-thumb-original-file ()
"Flag original image file for deletion in associated Dired buffer."
- (interactive)
- (image-dired-modify-mark-on-thumb-original-file 'flag)
- (image-dired-forward-image))
+ (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
+ (image-dired--do-mark-command t
+ (dired-flag-file-deletion 1)))
(defun image-dired-toggle-mark-thumb-original-file ()
"Toggle mark on original image file in associated Dired buffer."
- (interactive)
- (image-dired-modify-mark-on-thumb-original-file 'toggle))
+ (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
+ (image-dired--do-mark-command nil
+ (if (image-dired-dired-file-marked-p)
+ (dired-unmark 1)
+ (dired-mark 1))))
+
+(defun image-dired-unmark-all-marks ()
+ "Remove all marks from all files in associated Dired buffer.
+Also update the marks in the thumbnail buffer."
+ (interactive nil image-dired-thumbnail-mode image-dired-display-image-mode)
+ (image-dired--do-mark-command nil
+ (dired-unmark-all-marks))
+ (image-dired--with-thumbnail-buffer
+ (image-dired-thumb-update-marks)))
(defun image-dired-jump-original-dired-buffer ()
"Jump to the Dired buffer associated with the current image file.
You probably want to use this together with
`image-dired-track-original-file'."
- (interactive)
+ (interactive nil image-dired-thumbnail-mode)
(let ((buf (image-dired-associated-dired-buffer))
window frame)
(setq window (image-dired-get-buffer-window buf))
@@ -1478,236 +1550,213 @@ You probably want to use this together with
(defvar image-dired-thumbnail-mode-line-up-map
(let ((map (make-sparse-keymap)))
;; map it to "g" so that the user can press it more quickly
- (define-key map "g" 'image-dired-line-up-dynamic)
+ (define-key map "g" #'image-dired-line-up-dynamic)
;; "f" for "fixed" number of thumbs per row
- (define-key map "f" 'image-dired-line-up)
+ (define-key map "f" #'image-dired-line-up)
;; "i" for "interactive"
- (define-key map "i" 'image-dired-line-up-interactive)
+ (define-key map "i" #'image-dired-line-up-interactive)
map)
"Keymap for line-up commands in `image-dired-thumbnail-mode'.")
(defvar image-dired-thumbnail-mode-tag-map
(let ((map (make-sparse-keymap)))
;; map it to "t" so that the user can press it more quickly
- (define-key map "t" 'image-dired-tag-thumbnail)
+ (define-key map "t" #'image-dired-tag-thumbnail)
;; "r" for "remove"
- (define-key map "r" 'image-dired-tag-thumbnail-remove)
+ (define-key map "r" #'image-dired-tag-thumbnail-remove)
map)
"Keymap for tag commands in `image-dired-thumbnail-mode'.")
(defvar image-dired-thumbnail-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [right] 'image-dired-forward-image)
- (define-key map [left] 'image-dired-backward-image)
- (define-key map [up] 'image-dired-previous-line)
- (define-key map [down] 'image-dired-next-line)
- (define-key map "\C-f" 'image-dired-forward-image)
- (define-key map "\C-b" 'image-dired-backward-image)
- (define-key map "\C-p" 'image-dired-previous-line)
- (define-key map "\C-n" 'image-dired-next-line)
-
- (define-key map "d" 'image-dired-flag-thumb-original-file)
- (define-key map [delete] 'image-dired-flag-thumb-original-file)
- (define-key map "m" 'image-dired-mark-thumb-original-file)
- (define-key map "u" 'image-dired-unmark-thumb-original-file)
- (define-key map "." 'image-dired-track-original-file)
- (define-key map [tab] 'image-dired-jump-original-dired-buffer)
+ (define-key map [right] #'image-dired-forward-image)
+ (define-key map [left] #'image-dired-backward-image)
+ (define-key map [up] #'image-dired-previous-line)
+ (define-key map [down] #'image-dired-next-line)
+ (define-key map "\C-f" #'image-dired-forward-image)
+ (define-key map "\C-b" #'image-dired-backward-image)
+ (define-key map "\C-p" #'image-dired-previous-line)
+ (define-key map "\C-n" #'image-dired-next-line)
+
+ (define-key map "<" #'image-dired-beginning-of-buffer)
+ (define-key map ">" #'image-dired-end-of-buffer)
+ (define-key map (kbd "M-<") #'image-dired-beginning-of-buffer)
+ (define-key map (kbd "M->") #'image-dired-end-of-buffer)
+
+ (define-key map "d" #'image-dired-flag-thumb-original-file)
+ (define-key map [delete] #'image-dired-flag-thumb-original-file)
+ (define-key map "m" #'image-dired-mark-thumb-original-file)
+ (define-key map "u" #'image-dired-unmark-thumb-original-file)
+ (define-key map "U" #'image-dired-unmark-all-marks)
+ (define-key map "." #'image-dired-track-original-file)
+ (define-key map [tab] #'image-dired-jump-original-dired-buffer)
;; add line-up map
(define-key map "g" image-dired-thumbnail-mode-line-up-map)
;; add tag map
(define-key map "t" image-dired-thumbnail-mode-tag-map)
- (define-key map "\C-m" 'image-dired-display-thumbnail-original-image)
- (define-key map [C-return] 'image-dired-thumbnail-display-external)
+ (define-key map "\C-m" #'image-dired-display-thumbnail-original-image)
+ (define-key map [C-return] #'image-dired-thumbnail-display-external)
- (define-key map "l" 'image-dired-rotate-thumbnail-left)
- (define-key map "r" 'image-dired-rotate-thumbnail-right)
- (define-key map "L" 'image-dired-rotate-original-left)
- (define-key map "R" 'image-dired-rotate-original-right)
+ (define-key map "L" #'image-dired-rotate-original-left)
+ (define-key map "R" #'image-dired-rotate-original-right)
- (define-key map "D" 'image-dired-thumbnail-set-image-description)
- (define-key map "\C-d" 'image-dired-delete-char)
- (define-key map " " 'image-dired-display-next-thumbnail-original)
- (define-key map (kbd "DEL") 'image-dired-display-previous-thumbnail-original)
- (define-key map "c" 'image-dired-comment-thumbnail)
+ (define-key map "D" #'image-dired-thumbnail-set-image-description)
+ (define-key map "S" #'image-dired-slideshow-start)
+ (define-key map "\C-d" #'image-dired-delete-char)
+ (define-key map " " #'image-dired-display-next-thumbnail-original)
+ (define-key map (kbd "DEL") #'image-dired-display-previous-thumbnail-original)
+ (define-key map "c" #'image-dired-comment-thumbnail)
;; Mouse
- (define-key map [mouse-2] 'image-dired-mouse-display-image)
- (define-key map [mouse-1] 'image-dired-mouse-select-thumbnail)
+ (define-key map [mouse-2] #'image-dired-mouse-display-image)
+ (define-key map [mouse-1] #'image-dired-mouse-select-thumbnail)
+ (define-key map [mouse-3] #'image-dired-mouse-select-thumbnail)
+ (define-key map [down-mouse-1] #'image-dired-mouse-select-thumbnail)
+ (define-key map [down-mouse-2] #'image-dired-mouse-select-thumbnail)
+ (define-key map [down-mouse-3] #'image-dired-mouse-select-thumbnail)
;; Seems I must first set C-down-mouse-1 to undefined, or else it
;; will trigger the buffer menu. If I try to instead bind
;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message
;; about C-mouse-1 not being defined afterwards. Annoying, but I
;; probably do not completely understand mouse events.
- (define-key map [C-down-mouse-1] 'undefined)
- (define-key map [C-mouse-1] 'image-dired-mouse-toggle-mark)
-
- ;; Menu
- (easy-menu-define nil map
- "Menu for `image-dired-thumbnail-mode'."
- '("Image-Dired"
- ["Display image" image-dired-display-thumbnail-original-image]
- ["Display in external viewer" image-dired-thumbnail-display-external]
-
- ["Mark original" image-dired-mark-thumb-original-file]
- ["Unmark original" image-dired-unmark-thumb-original-file]
- ["Flag original for deletion" image-dired-flag-thumb-original-file]
-
- ["Track original" image-dired-track-original-file]
- ["Jump to dired buffer" image-dired-jump-original-dired-buffer]
-
- ["Toggle movement tracking on/off" image-dired-toggle-movement-tracking]
-
- ["Rotate original right" image-dired-rotate-original-right]
- ["Rotate original left" image-dired-rotate-original-left]
- ["Rotate thumbnail right" image-dired-rotate-thumbnail-right]
- ["Rotate thumbnail left" image-dired-rotate-thumbnail-left]
-
- ["Line up thumbnails" image-dired-line-up]
- ["Dynamic line up" image-dired-line-up-dynamic]
- ["Refresh thumb" image-dired-refresh-thumb]
- ["Comment thumbnail" image-dired-comment-thumbnail]
- ["Tag current or marked thumbnails" image-dired-tag-thumbnail]
- ["Remove tag from current or marked thumbnails"
- image-dired-tag-thumbnail-remove]
- ["Delete marked images" image-dired-delete-marked]
- ["Delete thumbnail from buffer" image-dired-delete-char]
- ["Quit" quit-window]))
+ (define-key map [C-down-mouse-1] #'undefined)
+ (define-key map [C-mouse-1] #'image-dired-mouse-toggle-mark)
map)
"Keymap for `image-dired-thumbnail-mode'.")
+(easy-menu-define image-dired-thumbnail-mode-menu image-dired-thumbnail-mode-map
+ "Menu for `image-dired-thumbnail-mode'."
+ '("Image-Dired"
+ ["Display image" image-dired-display-thumbnail-original-image]
+ ["Display in external viewer" image-dired-thumbnail-display-external]
+ ["Jump to Dired buffer" image-dired-jump-original-dired-buffer]
+ "---"
+ ["Mark image" image-dired-mark-thumb-original-file]
+ ["Unmark image" image-dired-unmark-thumb-original-file]
+ ["Unmark all images" image-dired-unmark-all-marks]
+ ["Flag for deletion" image-dired-flag-thumb-original-file]
+ ["Delete marked images" image-dired-delete-marked]
+ "---"
+ ["Rotate original right" image-dired-rotate-original-right]
+ ["Rotate original left" image-dired-rotate-original-left]
+ "---"
+ ["Comment thumbnail" image-dired-comment-thumbnail]
+ ["Tag current or marked thumbnails" image-dired-tag-thumbnail]
+ ["Remove tag from current or marked thumbnails"
+ image-dired-tag-thumbnail-remove]
+ ["Start slideshow" image-dired-slideshow-start]
+ "---"
+ ("View Options"
+ ["Toggle movement tracking" image-dired-toggle-movement-tracking
+ :style toggle
+ :selected image-dired-track-movement]
+ "---"
+ ["Line up thumbnails" image-dired-line-up]
+ ["Dynamic line up" image-dired-line-up-dynamic]
+ ["Refresh thumb" image-dired-refresh-thumb])
+ ["Quit" quit-window]))
+
(defvar image-dired-display-image-mode-map
(let ((map (make-sparse-keymap)))
- ;; `image-mode-map' has bindings that do not make sense in image-dired
- ;; (set-keymap-parent map image-mode-map)
- (define-key map "f" 'image-dired-display-current-image-full)
- (define-key map "s" 'image-dired-display-current-image-sized)
- (define-key map "g" nil)
-
- ;; Useful bindings from `image-mode-map'
- (define-key map [remap forward-char] 'image-forward-hscroll)
- (define-key map [remap backward-char] 'image-backward-hscroll)
- (define-key map [remap right-char] 'image-forward-hscroll)
- (define-key map [remap left-char] 'image-backward-hscroll)
- (define-key map [remap previous-line] 'image-previous-line)
- (define-key map [remap next-line] 'image-next-line)
- (define-key map [remap scroll-up] 'image-scroll-up)
- (define-key map [remap scroll-down] 'image-scroll-down)
- (define-key map [remap scroll-up-command] 'image-scroll-up)
- (define-key map [remap scroll-down-command] 'image-scroll-down)
- (define-key map [remap scroll-left] 'image-scroll-left)
- (define-key map [remap scroll-right] 'image-scroll-right)
- (define-key map [remap move-beginning-of-line] 'image-bol)
- (define-key map [remap move-end-of-line] 'image-eol)
- (define-key map [remap beginning-of-buffer] 'image-bob)
- (define-key map [remap end-of-buffer] 'image-eob)
-
- (easy-menu-define nil map
- "Menu for `image-dired-display-image-mode-map'."
- '("Image-Dired"
- ["Display original, full size" image-dired-display-current-image-full]
- ["Display original, sized to fit" image-dired-display-current-image-sized]
- ["Quit" quit-window]))
+ (define-key map "S" #'image-dired-slideshow-start)
+ (define-key map (kbd "SPC") #'image-dired-display-next-thumbnail-original)
+ (define-key map (kbd "DEL") #'image-dired-display-previous-thumbnail-original)
+ (define-key map "n" #'image-dired-display-next-thumbnail-original)
+ (define-key map "p" #'image-dired-display-previous-thumbnail-original)
+ (define-key map "m" #'image-dired-mark-thumb-original-file)
+ (define-key map "d" #'image-dired-flag-thumb-original-file)
+ (define-key map "u" #'image-dired-unmark-thumb-original-file)
+ (define-key map "U" #'image-dired-unmark-all-marks)
+ ;; Disable keybindings from `image-mode-map' that doesn't make sense here.
+ (define-key map "o" nil) ; image-save
map)
"Keymap for `image-dired-display-image-mode'.")
-(defun image-dired-display-current-image-full ()
- "Display current image in full size."
- (interactive)
- (let ((file (image-dired-original-file-name)))
- (if file
- (progn
- (image-dired-display-image file t)
- (message "Full size image displayed"))
- (error "No original file name at point"))))
-
-(defun image-dired-display-current-image-sized ()
- "Display current image in sized to fit window dimensions."
- (interactive)
- (let ((file (image-dired-original-file-name)))
- (if file
- (progn
- (image-dired-display-image file)
- (message "Fitted image displayed"))
- (error "No original file name at point"))))
-
(define-derived-mode image-dired-thumbnail-mode
special-mode "image-dired-thumbnail"
"Browse and manipulate thumbnail images using Dired.
Use `image-dired-minor-mode' to get a nice setup."
+ :interactive nil
(buffer-disable-undo)
- (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t))
+ (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)
+ (setq-local window-resize-pixelwise t)
+ (setq-local bookmark-make-record-function #'image-dired-bookmark-make-record)
+ ;; Use approximately as much vertical spacing as horizontal.
+ (setq-local line-spacing (frame-char-width)))
+
+
+;;; Display image mode
(define-derived-mode image-dired-display-image-mode
- special-mode "image-dired-image-display"
+ image-mode "image-dired-image-display"
"Mode for displaying and manipulating original image.
Resized or in full-size."
- (buffer-disable-undo)
- (image-mode-setup-winprops)
- (setq cursor-type nil)
- (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t))
+ :interactive nil
+ (add-hook 'file-name-at-point-functions #'image-dired-file-name-at-point nil t))
(defvar image-dired-minor-mode-map
(let ((map (make-sparse-keymap)))
;; (set-keymap-parent map dired-mode-map)
;; Hijack previous and next line movement. Let C-p and C-b be
;; though...
- (define-key map "p" 'image-dired-dired-previous-line)
- (define-key map "n" 'image-dired-dired-next-line)
- (define-key map [up] 'image-dired-dired-previous-line)
- (define-key map [down] 'image-dired-dired-next-line)
-
- (define-key map (kbd "C-S-n") 'image-dired-next-line-and-display)
- (define-key map (kbd "C-S-p") 'image-dired-previous-line-and-display)
- (define-key map (kbd "C-S-m") 'image-dired-mark-and-display-next)
-
- (define-key map "\C-td" 'image-dired-display-thumbs)
- (define-key map [tab] 'image-dired-jump-thumbnail-buffer)
- (define-key map "\C-ti" 'image-dired-dired-display-image)
- (define-key map "\C-tx" 'image-dired-dired-display-external)
- (define-key map "\C-ta" 'image-dired-display-thumbs-append)
- (define-key map "\C-t." 'image-dired-display-thumb)
- (define-key map "\C-tc" 'image-dired-dired-comment-files)
- (define-key map "\C-tf" 'image-dired-mark-tagged-files)
-
- ;; Menu for dired
- (easy-menu-define nil map
- "Menu for `image-dired-minor-mode'."
- '("Image-dired"
- ["Display thumb for next file" image-dired-next-line-and-display]
- ["Display thumb for previous file" image-dired-previous-line-and-display]
- ["Mark and display next" image-dired-mark-and-display-next]
-
- ["Create thumbnails for marked files" image-dired-create-thumbs]
-
- ["Display thumbnails append" image-dired-display-thumbs-append]
- ["Display this thumbnail" image-dired-display-thumb]
- ["Display image" image-dired-dired-display-image]
- ["Display in external viewer" image-dired-dired-display-external]
-
- ["Toggle display properties" image-dired-toggle-dired-display-properties]
- ["Toggle append browsing" image-dired-toggle-append-browsing]
- ["Toggle movement tracking" image-dired-toggle-movement-tracking]
-
- ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer]
- ["Mark tagged files" image-dired-mark-tagged-files]
- ["Comment files" image-dired-dired-comment-files]
- ["Copy with EXIF file name" image-dired-copy-with-exif-file-name]))
+ (define-key map "p" #'image-dired-dired-previous-line)
+ (define-key map "n" #'image-dired-dired-next-line)
+ (define-key map [up] #'image-dired-dired-previous-line)
+ (define-key map [down] #'image-dired-dired-next-line)
+
+ (define-key map (kbd "C-S-n") #'image-dired-next-line-and-display)
+ (define-key map (kbd "C-S-p") #'image-dired-previous-line-and-display)
+ (define-key map (kbd "C-S-m") #'image-dired-mark-and-display-next)
+
+ (define-key map "\C-td" #'image-dired-display-thumbs)
+ (define-key map [tab] #'image-dired-jump-thumbnail-buffer)
+ (define-key map "\C-ti" #'image-dired-dired-display-image)
+ (define-key map "\C-tx" #'image-dired-dired-display-external)
+ (define-key map "\C-ta" #'image-dired-display-thumbs-append)
+ (define-key map "\C-t." #'image-dired-display-thumb)
+ (define-key map "\C-tc" #'image-dired-dired-comment-files)
+ (define-key map "\C-tf" #'image-dired-mark-tagged-files)
map)
"Keymap for `image-dired-minor-mode'.")
+(easy-menu-define image-dired-minor-mode-menu image-dired-minor-mode-map
+ "Menu for `image-dired-minor-mode'."
+ '("Image-dired"
+ ["Display thumb for next file" image-dired-next-line-and-display]
+ ["Display thumb for previous file" image-dired-previous-line-and-display]
+ ["Mark and display next" image-dired-mark-and-display-next]
+ "---"
+ ["Create thumbnails for marked files" image-dired-create-thumbs]
+ "---"
+ ["Display thumbnails append" image-dired-display-thumbs-append]
+ ["Display this thumbnail" image-dired-display-thumb]
+ ["Display image" image-dired-dired-display-image]
+ ["Display in external viewer" image-dired-dired-display-external]
+ "---"
+ ["Toggle display properties" image-dired-toggle-dired-display-properties
+ :style toggle
+ :selected image-dired-dired-disp-props]
+ ["Toggle append browsing" image-dired-toggle-append-browsing
+ :style toggle
+ :selected image-dired-append-when-browsing]
+ ["Toggle movement tracking" image-dired-toggle-movement-tracking
+ :style toggle
+ :selected image-dired-track-movement]
+ "---"
+ ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer]
+ ["Mark tagged files" image-dired-mark-tagged-files]
+ ["Comment files" image-dired-dired-comment-files]
+ ["Copy with EXIF file name" image-dired-copy-with-exif-file-name]))
+
;;;###autoload
(define-minor-mode image-dired-minor-mode
"Setup easy-to-use keybindings for the commands to be used in Dired mode.
Note that n, p and <down> and <up> will be hijacked and bound to
-`image-dired-dired-x-line'."
+`image-dired-dired-next-line' and `image-dired-dired-previous-line'."
:keymap image-dired-minor-mode-map)
-;;;###autoload
-(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode
- "26.1")
-
(declare-function clear-image-cache "image.c" (&optional filter))
(defun image-dired-create-thumbs (&optional arg)
@@ -1727,46 +1776,69 @@ With prefix argument ARG, create thumbnails even if they already exist
arg)
(image-dired-create-thumb curr-file thumb-name)))))
-(defvar image-dired-slideshow-timer nil
- "Slideshow timer.")
+
+;;; Slideshow
-(defvar image-dired-slideshow-count 0
- "Keeping track on number of images in slideshow.")
+(defcustom image-dired-slideshow-delay 5.0
+ "Seconds to wait before showing the next image in a slideshow.
+This is used by `image-dired-slideshow-start'."
+ :type 'float
+ :version "29.1")
-(defvar image-dired-slideshow-times 0
- "Number of pictures to display in slideshow.")
+(define-obsolete-variable-alias 'image-dired-slideshow-timer
+ 'image-dired--slideshow-timer "29.1")
+(defvar image-dired--slideshow-timer nil
+ "Slideshow timer.")
+
+(defvar image-dired--slideshow-initial nil)
(defun image-dired-slideshow-step ()
- "Step to next file, if `image-dired-slideshow-times' has not been reached."
- (if (< image-dired-slideshow-count image-dired-slideshow-times)
- (progn
- (message "%s" (1+ image-dired-slideshow-count))
- (setq image-dired-slideshow-count (1+ image-dired-slideshow-count))
- (image-dired-next-line-and-display))
+ "Step to next image in a slideshow."
+ (if-let ((buf (get-buffer image-dired-thumbnail-buffer)))
+ (with-current-buffer buf
+ (image-dired-display-next-thumbnail-original))
(image-dired-slideshow-stop)))
-(defun image-dired-slideshow-start ()
- "Start slideshow.
-Ask user for number of images to show and the delay in between."
- (interactive)
- (setq image-dired-slideshow-count 0)
- (setq image-dired-slideshow-times (string-to-number (read-string "How many: ")))
- (let ((repeat (string-to-number
- (read-string
- "Delay, in seconds. Decimals are accepted : " "1"))))
- (setq image-dired-slideshow-timer
+(defun image-dired-slideshow-start (&optional arg)
+ "Start a slideshow, waiting `image-dired-slideshow-delay' between images.
+
+With prefix argument ARG, wait that many seconds before going to
+the next image.
+
+With a negative prefix argument, prompt user for the delay."
+ (interactive "P" image-dired-thumbnail-mode image-dired-display-image-mode)
+ (let ((delay (if (not arg)
+ image-dired-slideshow-delay
+ (if (> arg 0)
+ arg
+ (string-to-number
+ (let ((delay (number-to-string image-dired-slideshow-delay)))
+ (read-string
+ (format-prompt "Delay, in seconds. Decimals are accepted" delay))
+ delay))))))
+ (setq image-dired--slideshow-timer
(run-with-timer
- 0 repeat
- 'image-dired-slideshow-step))))
+ 0 delay
+ 'image-dired-slideshow-step))
+ (add-hook 'post-command-hook 'image-dired-slideshow-stop)
+ (setq image-dired--slideshow-initial t)
+ (message "Running slideshow; use any command to stop")))
(defun image-dired-slideshow-stop ()
"Cancel slideshow."
- (interactive)
- (cancel-timer image-dired-slideshow-timer))
+ ;; Make sure we don't immediately stop after
+ ;; `image-dired-slideshow-start'.
+ (unless image-dired--slideshow-initial
+ (remove-hook 'post-command-hook 'image-dired-slideshow-stop)
+ (cancel-timer image-dired--slideshow-timer))
+ (setq image-dired--slideshow-initial nil))
+
+
+;;; Thumbnail mode (cont. 3)
(defun image-dired-delete-char ()
"Remove current thumbnail from thumbnail buffer and line up."
- (interactive)
+ (interactive nil image-dired-thumbnail-mode)
(let ((inhibit-read-only t))
(delete-char 1)
(when (= (following-char) ?\s)
@@ -1799,18 +1871,26 @@ See also `image-dired-line-up-dynamic'."
(not (eobp)))
(delete-char 1)))
(goto-char (point-min))
- (let ((count 0))
+ (let ((seen 0)
+ (thumb-prev-pos 0)
+ (thumb-width-chars
+ (ceiling (/ (+ (* 2 image-dired-thumb-relief)
+ (* 2 image-dired-thumb-margin)
+ (image-dired-thumb-size 'width))
+ (float (frame-char-width))))))
(while (not (eobp))
(forward-char)
(if (= image-dired-thumbs-per-row 1)
(insert "\n")
- (insert " ")
- (setq count (1+ count))
- (when (and (= count (- image-dired-thumbs-per-row 1))
+ (cl-incf thumb-prev-pos thumb-width-chars)
+ (insert (propertize " " 'display `(space :align-to ,thumb-prev-pos)))
+ (cl-incf seen)
+ (when (and (= seen (- image-dired-thumbs-per-row 1))
(not (eobp)))
(forward-char)
(insert "\n")
- (setq count 0)))))
+ (setq seen 0)
+ (setq thumb-prev-pos 0)))))
(goto-char (point-min))))
(defun image-dired-line-up-dynamic ()
@@ -1860,11 +1940,6 @@ Ask user how many thumbnails should be displayed per row."
"Calculate WINDOW width in pixels."
(* (window-width window) (frame-char-width)))
-(defun image-dired-window-height-pixels (window)
- "Calculate WINDOW height in pixels."
- ;; Note: The mode-line consumes one line
- (* (- (window-height window) 1) (frame-char-height)))
-
(defun image-dired-display-window ()
"Return window where `image-dired-display-image-buffer' is visible."
(get-window-with-predicate
@@ -1890,59 +1965,24 @@ Ask user how many thumbnails should be displayed per row."
(equal (window-buffer window) buf))))
(error "No thumbnail image at point"))))
-(defun image-dired-display-window-width (window)
- "Return width, in pixels, of WINDOW."
- (- (image-dired-window-width-pixels window)
- image-dired-display-window-width-correction))
-
-(defun image-dired-display-window-height (window)
- "Return height, in pixels, of WINDOW."
- (- (image-dired-window-height-pixels window)
- image-dired-display-window-height-correction))
-
-(defun image-dired-display-image (file &optional original-size)
+(defun image-dired-display-image (file &optional _ignored)
"Display image FILE in image buffer.
-Use this when you want to display the image, semi sized, in a new
-window. The image is sized to fit the display window (using a
-temporary file, don't worry). Because of this, it will not be as
-quick as opening it directly, but on most modern systems it
-should feel snappy enough.
-
-If optional argument ORIGINAL-SIZE is non-nil, display image in its
-original size."
- (image-dired--check-executable-exists
- 'image-dired-cmd-create-temp-image-program)
- (let ((new-file (expand-file-name image-dired-temp-image-file))
- (window (image-dired-display-window))
- (image-type 'jpeg))
- (setq file (expand-file-name file))
- (if (not original-size)
- (let* ((spec
- (list
- (cons ?p image-dired-cmd-create-temp-image-program)
- (cons ?w (image-dired-display-window-width window))
- (cons ?h (image-dired-display-window-height window))
- (cons ?f file)
- (cons ?t new-file)))
- (ret
- (apply #'call-process
- image-dired-cmd-create-temp-image-program nil nil nil
- (mapcar
- (lambda (arg) (format-spec arg spec))
- image-dired-cmd-create-temp-image-options))))
- (when (not (zerop ret))
- (error "Could not resize image")))
- (setq image-type (image-type-from-file-name file))
- (copy-file file new-file t))
- (with-current-buffer (image-dired-create-display-image-buffer)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (clear-image-cache)
- (image-dired-insert-image image-dired-temp-image-file image-type 0 0)
- (goto-char (point-min))
- (set-window-vscroll window 0)
- (set-window-hscroll window 0)
- (image-dired-update-property 'original-file-name file)))))
+Use this when you want to display the image, in a new window.
+The window will use `image-dired-display-image-mode' which is
+based on `image-mode'."
+ (declare (advertised-calling-convention (file) "29.1"))
+ (setq file (expand-file-name file))
+ (when (not (file-exists-p file))
+ (error "No such file: %s" file))
+ (let ((buf (get-buffer image-dired-display-image-buffer))
+ (cur-win (selected-window)))
+ (when buf
+ (kill-buffer buf))
+ (when-let ((buf (find-file-other-window file)))
+ (display-buffer buf)
+ (rename-buffer image-dired-display-image-buffer)
+ (image-dired-display-image-mode)
+ (select-window cur-win))))
(defun image-dired-display-thumbnail-original-image (&optional arg)
"Display current thumbnail's original image in display buffer.
@@ -1956,8 +1996,6 @@ With prefix argument ARG, display image in its original size."
(message "No thumbnail at point")
(if (not file)
(message "No original file name found")
- (image-dired-create-display-image-buffer)
- (display-buffer image-dired-display-image-buffer)
(image-dired-display-image file arg))))))
@@ -1967,41 +2005,15 @@ With prefix argument ARG, display image in its original size."
See documentation for `image-dired-display-image' for more information.
With prefix argument ARG, display image in its original size."
(interactive "P")
- (image-dired-create-display-image-buffer)
- (display-buffer image-dired-display-image-buffer)
(image-dired-display-image (dired-get-filename) arg))
(defun image-dired-image-at-point-p ()
"Return non-nil if there is an `image-dired' thumbnail at point."
(get-text-property (point) 'image-dired-thumbnail))
-(defun image-dired-rotate-thumbnail (degrees)
- "Rotate thumbnail DEGREES degrees."
- (image-dired--check-executable-exists
- 'image-dired-cmd-rotate-thumbnail-program)
- (if (not (image-dired-image-at-point-p))
- (message "No thumbnail at point")
- (let* ((file (image-dired-thumb-name (image-dired-original-file-name)))
- (thumb (expand-file-name file))
- (spec (list (cons ?d degrees) (cons ?t thumb))))
- (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-rotate-thumbnail-options))
- (clear-image-cache thumb))))
-
-(defun image-dired-rotate-thumbnail-left ()
- "Rotate thumbnail left (counter clockwise) 90 degrees."
- (interactive)
- (image-dired-rotate-thumbnail "270"))
-
-(defun image-dired-rotate-thumbnail-right ()
- "Rotate thumbnail counter right (clockwise) 90 degrees."
- (interactive)
- (image-dired-rotate-thumbnail "90"))
-
(defun image-dired-refresh-thumb ()
"Force creation of new image for current thumbnail."
- (interactive)
+ (interactive nil image-dired-thumbnail-mode)
(let* ((file (image-dired-original-file-name))
(thumb (expand-file-name (image-dired-thumb-name file))))
(clear-image-cache (expand-file-name thumb))
@@ -2020,7 +2032,7 @@ With prefix argument ARG, display image in its original size."
(cons ?o (expand-file-name file))
(cons ?t image-dired-temp-rotate-image-file))))
(unless (eq 'jpeg (image-type file))
- (error "Only JPEG images can be rotated!"))
+ (user-error "Only JPEG images can be rotated"))
(if (not (= 0 (apply #'call-process image-dired-cmd-rotate-original-program
nil nil nil
(mapcar (lambda (arg) (format-spec arg spec))
@@ -2054,6 +2066,9 @@ overwritten. This confirmation can be turned off using
(interactive)
(image-dired-rotate-original "90"))
+
+;;; EXIF support
+
(defun image-dired-get-exif-file-name (file)
"Use the image's EXIF information to return a unique file name.
The file name should be unique as long as you do not take more than
@@ -2068,8 +2083,8 @@ YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
"%Y:%m:%d %H:%M:%S"
(file-attribute-modification-time
(file-attributes (expand-file-name file)))))
- (setq data (image-dired-get-exif-data (expand-file-name file)
- "DateTimeOriginal")))
+ (setq data (exif-field 'date-time (exif-parse-file
+ (expand-file-name file)))))
(while (string-match "[ :]" data)
(setq data (replace-match "_" nil nil data)))
(format "%s%s%s" data
@@ -2086,7 +2101,7 @@ default value at the prompt."
(if (not (image-dired-image-at-point-p))
(message "No thumbnail at point")
(let* ((file (image-dired-original-file-name))
- (old-value (image-dired-get-exif-data file "ImageDescription")))
+ (old-value (or (exif-field 'description (exif-parse-file file)) "")))
(if (eq 0
(image-dired-set-exif-data file "ImageDescription"
(read-string "Value of ImageDescription: "
@@ -2107,33 +2122,9 @@ default value at the prompt."
(mapcar (lambda (arg) (format-spec arg spec))
image-dired-cmd-write-exif-data-options))))
-(defun image-dired-get-exif-data (file tag-name)
- "From FILE, return EXIF tag TAG-NAME."
- (image-dired--check-executable-exists
- 'image-dired-cmd-read-exif-data-program)
- (let ((buf (get-buffer-create "*image-dired-get-exif-data*"))
- (spec (list (cons ?f file) (cons ?t tag-name)))
- tag-value)
- (with-current-buffer buf
- (delete-region (point-min) (point-max))
- (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program
- nil t nil
- (mapcar
- (lambda (arg) (format-spec arg spec))
- image-dired-cmd-read-exif-data-options))
- 0))
- (error "Could not get EXIF tag")
- (goto-char (point-min))
- ;; Clean buffer from newlines and carriage returns before
- ;; getting final info
- (while (search-forward-regexp "[\n\r]" nil t)
- (replace-match "" nil t))
- (setq tag-value (buffer-substring (point-min) (point-max)))))
- tag-value))
-
(defun image-dired-copy-with-exif-file-name ()
"Copy file with unique name to main image directory.
-Copy current or all marked files in dired to a new file in your
+Copy current or all marked files in Dired to a new file in your
main image directory, using a file name generated by
`image-dired-get-exif-file-name'. A typical usage for this if when
copying images from a digital camera into the image directory.
@@ -2158,17 +2149,24 @@ function. The result is a couple of new files in
(copy-file curr-file new-name))
files)))
-(defun image-dired-display-next-thumbnail-original ()
- "In thumbnail buffer, move to next thumbnail and display the image."
- (interactive)
- (image-dired-forward-image)
- (image-dired-display-thumbnail-original-image))
+;;; Thumbnail mode (cont.)
-(defun image-dired-display-previous-thumbnail-original ()
- "Move to previous thumbnail and display image."
- (interactive)
- (image-dired-backward-image)
- (image-dired-display-thumbnail-original-image))
+(defun image-dired-display-next-thumbnail-original (&optional arg)
+ "Move to the next image in the thumbnail buffer and display it.
+With prefix ARG, move that many thumbnails."
+ (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode)
+ (image-dired--with-thumbnail-buffer
+ (image-dired-forward-image arg t)
+ (image-dired-display-thumbnail-original-image)))
+
+(defun image-dired-display-previous-thumbnail-original (arg)
+ "Move to the previous image in the thumbnail buffer and display it.
+With prefix ARG, move that many thumbnails."
+ (interactive "p" image-dired-thumbnail-mode image-dired-display-image-mode)
+ (image-dired-display-next-thumbnail-original (- arg)))
+
+
+;;; Image Comments
(defun image-dired-write-comments (file-comments)
"Write file comments to database.
@@ -2233,7 +2231,7 @@ FILE-COMMENTS is an alist on the following form:
(comment (image-dired-read-comment file)))
(image-dired-write-comments (list (cons file comment)))
(image-dired-update-property 'comment comment))
- (image-dired-display-thumb-properties))
+ (image-dired-update-header-line))
(defun image-dired-read-comment (&optional file)
"Read comment for an image.
@@ -2263,23 +2261,26 @@ Optionally use old comment from FILE as initial value."
comment)))
;;;###autoload
-(defun image-dired-mark-tagged-files ()
- "Use regexp to mark files with matching tag.
+(defun image-dired-mark-tagged-files (regexp)
+ "Use REGEXP to mark files with matching tag.
A `tag' is a keyword, a piece of meta data, associated with an
image file and stored in image-dired's database file. This command
lets you input a regexp and this will be matched against all tags
on all image files in the database file. The files that have a
matching tag will be marked in the Dired buffer."
- (interactive)
+ (interactive "sMark tagged files (regexp): ")
(image-dired-sane-db-file)
- (let ((tag (read-string "Mark tagged files (regexp): "))
- (hits 0)
+ (let ((hits 0)
files)
(image-dired--with-db-file
- ;; Collect matches
- (while (search-forward-regexp
- (concat "\\(^[^;\n]+\\);.*" tag ".*$") nil t)
- (push (match-string 1) files)))
+ ;; Collect matches
+ (while (search-forward-regexp "\\(^[^;\n]+\\);\\(.*\\)" nil t)
+ (let ((file (match-string 1))
+ (tags (split-string (match-string 2) ";")))
+ (when (seq-find (lambda (tag)
+ (string-match-p regexp tag))
+ tags)
+ (push file files)))))
;; Mark files
(dolist (curr-file files)
;; I tried using `dired-mark-files-regexp' but it was waaaay to
@@ -2296,6 +2297,10 @@ matching tag will be marked in the Dired buffer."
(dired-mark 1))))
(message "%d files with matching tag marked." hits)))
+
+
+;;; Mouse support
+
(defun image-dired-mouse-display-image (event)
"Use mouse EVENT, call `image-dired-display-image' to display image.
Track this in associated Dired buffer if `image-dired-track-movement' is
@@ -2303,12 +2308,12 @@ non-nil."
(interactive "e")
(mouse-set-point event)
(goto-char (posn-point (event-end event)))
+ (unless (image-at-point-p)
+ (image-dired-backward-image))
(let ((file (image-dired-original-file-name)))
(when file
(if image-dired-track-movement
(image-dired-track-original-file))
- (image-dired-create-display-image-buffer)
- (display-buffer image-dired-display-image-buffer)
(image-dired-display-image file))))
(defun image-dired-mouse-select-thumbnail (event)
@@ -2318,26 +2323,41 @@ non-nil."
(interactive "e")
(mouse-set-point event)
(goto-char (posn-point (event-end event)))
+ (unless (image-at-point-p)
+ (image-dired-backward-image))
(if image-dired-track-movement
(image-dired-track-original-file))
- (image-dired-display-thumb-properties))
+ (image-dired-update-header-line))
+
-(defun image-dired-thumb-file-marked-p ()
- "Check if file is marked in associated Dired buffer."
+
+;;; Dired marks and tags
+
+(defun image-dired-thumb-file-marked-p (&optional flagged)
+ "Check if file is marked in associated Dired buffer.
+If optional argument FLAGGED is non-nil, check if file is flagged
+for deletion instead."
(let ((file-name (image-dired-original-file-name))
(dired-buf (image-dired-associated-dired-buffer)))
(when (and dired-buf file-name)
(with-current-buffer dired-buf
(save-excursion
(when (dired-goto-file file-name)
- (image-dired-dired-file-marked-p)))))))
+ (if flagged
+ (image-dired-dired-file-flagged-p)
+ (image-dired-dired-file-marked-p))))))))
+
+(defun image-dired-thumb-file-flagged-p ()
+ "Check if file is flagged for deletion in associated Dired buffer."
+ (image-dired-thumb-file-marked-p t))
(defun image-dired-delete-marked ()
"Delete current or marked thumbnails and associated images."
(interactive)
(image-dired--with-marked
(image-dired-delete-char)
- (backward-char))
+ (unless (bobp)
+ (backward-char)))
(image-dired--line-up-with-method)
(with-current-buffer (image-dired-associated-dired-buffer)
(dired-do-delete)))
@@ -2351,11 +2371,14 @@ non-nil."
(let ((inhibit-read-only t))
(while (not (eobp))
(with-silent-modifications
- (if (image-dired-thumb-file-marked-p)
- (add-face-text-property (point) (1+ (point))
- 'image-dired-thumb-mark)
- (remove-text-properties (point) (1+ (point))
- '(face image-dired-thumb-mark))))
+ (cond ((image-dired-thumb-file-marked-p)
+ (add-face-text-property (point) (1+ (point))
+ 'image-dired-thumb-mark))
+ ((image-dired-thumb-file-flagged-p)
+ (add-face-text-property (point) (1+ (point))
+ 'image-dired-thumb-flagged))
+ (t (remove-text-properties (point) (1+ (point))
+ '(face image-dired-thumb-mark)))))
(forward-char)))))))
(defun image-dired-mouse-toggle-mark-1 ()
@@ -2402,6 +2425,53 @@ Track this in associated Dired buffer if
props
comment)))))
+
+
+;;; Gallery support
+
+;; TODO:
+;; * Support gallery creation when using per-directory thumbnail
+;; storage.
+;; * Enhanced gallery creation with basic CSS-support and pagination
+;; of tag pages with many pictures.
+
+(defgroup image-dired-gallery nil
+ "Image-Dired support for generating a HTML gallery."
+ :prefix "image-dired-"
+ :group 'image-dired
+ :version "29.1")
+
+(defcustom image-dired-gallery-dir
+ (expand-file-name ".image-dired_gallery" image-dired-dir)
+ "Directory to store generated gallery html pages.
+The name of this directory needs to be \"shared\" to the public
+so that it can access the index.html page that image-dired creates."
+ :type 'directory)
+
+(defcustom image-dired-gallery-image-root-url
+ "https://example.org/image-diredpics"
+ "URL where the full size images are to be found on your web server.
+Note that this URL has to be configured on your web server.
+Image-Dired expects to find pictures in this directory.
+This is used by `image-dired-gallery-generate'."
+ :type 'string
+ :version "29.1")
+
+(defcustom image-dired-gallery-thumb-image-root-url
+ "https://example.org/image-diredthumbs"
+ "URL where the thumbnail images are to be found on your web server.
+Note that URL path has to be configured on your web server.
+Image-Dired expects to find pictures in this directory.
+This is used by `image-dired-gallery-generate'."
+ :type 'string
+ :version "29.1")
+
+(defcustom image-dired-gallery-hidden-tags
+ (list "private" "hidden" "pending")
+ "List of \"hidden\" tags.
+Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
+ :type '(repeat string))
+
(defvar image-dired-tag-file-list nil
"List to store tag-file structure.")
@@ -2411,19 +2481,8 @@ Track this in associated Dired buffer if
(defvar image-dired-file-comment-list nil
"List to store file comments.")
-(defun image-dired-add-to-tag-file-list (tag file)
- "Add relation between TAG and FILE."
- (let (curr)
- (if image-dired-tag-file-list
- (if (setq curr (assoc tag image-dired-tag-file-list))
- (if (not (member file curr))
- (setcdr curr (cons file (cdr curr))))
- (setcdr image-dired-tag-file-list
- (cons (list tag file) (cdr image-dired-tag-file-list))))
- (setq image-dired-tag-file-list (list (list tag file))))))
-
-(defun image-dired-add-to-tag-file-lists (tag file)
- "Helper function used from `image-dired-create-gallery-lists'.
+(defun image-dired--add-to-tag-file-lists (tag file)
+ "Helper function used from `image-dired--create-gallery-lists'.
Add TAG to FILE in one list and FILE to TAG in the other.
@@ -2457,8 +2516,8 @@ image-dired-tag-file-list:
(cons (list tag file) (cdr image-dired-tag-file-list))))
(setq image-dired-tag-file-list (list (list tag file))))))
-(defun image-dired-add-to-file-comment-list (file comment)
- "Helper function used from `image-dired-create-gallery-lists'.
+(defun image-dired--add-to-file-comment-list (file comment)
+ "Helper function used from `image-dired--create-gallery-lists'.
For FILE, add COMMENT to list.
@@ -2476,7 +2535,7 @@ image-dired-file-comment-list:
(cdr image-dired-file-comment-list))))
(setq image-dired-file-comment-list (list (cons file comment)))))
-(defun image-dired-create-gallery-lists ()
+(defun image-dired--create-gallery-lists ()
"Create temporary lists used by `image-dired-gallery-generate'."
(image-dired-sane-db-file)
(image-dired--with-db-file
@@ -2497,15 +2556,15 @@ image-dired-file-comment-list:
(setq file (car row-tags))
(dolist (x (cdr row-tags))
(if (not (string-match "^comment:\\(.*\\)" x))
- (image-dired-add-to-tag-file-lists x file)
- (image-dired-add-to-file-comment-list file (match-string 1 x)))))))
+ (image-dired--add-to-tag-file-lists x file)
+ (image-dired--add-to-file-comment-list file (match-string 1 x)))))))
;; Sort tag-file list
(setq image-dired-tag-file-list
(sort image-dired-tag-file-list
(lambda (x y)
(string< (car x) (car y))))))
-(defun image-dired-hidden-p (file)
+(defun image-dired--hidden-p (file)
"Return t if image FILE has a \"hidden\" tag."
(cl-loop for tag in (cdr (assoc file image-dired-file-tag-list))
if (member tag image-dired-gallery-hidden-tags) return t))
@@ -2519,7 +2578,7 @@ it easier to generate, then HTML-files are created in
(if (eq 'per-directory image-dired-thumbnail-storage)
(error "Currently, gallery generation is not supported \
when using per-directory thumbnail file storage"))
- (image-dired-create-gallery-lists)
+ (image-dired--create-gallery-lists)
(let ((tags image-dired-tag-file-list)
(index-file (format "%s/index.html" image-dired-gallery-dir))
count tag tag-file
@@ -2601,6 +2660,9 @@ when using per-directory thumbnail file storage"))
(insert " </body>\n")
(insert "</html>"))))
+
+;;; Tag support
+
(defvar image-dired-widget-list nil
"List to keep track of meta data in edit buffer.")
@@ -2702,6 +2764,286 @@ tags to their respective image file. Internal function used by
(dolist (tag tag-list)
(push (cons file tag) lst))))))
+
+;;; bookmark.el support
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+
+(defun image-dired-bookmark-name ()
+ "Create a default bookmark name for the current EWW buffer."
+ (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory (image-dired-original-file-name)))))
+
+(defun image-dired-bookmark-make-record ()
+ "Create a bookmark for the current EWW buffer."
+ `(,(image-dired-bookmark-name)
+ ,@(bookmark-make-record-default t)
+ (location . ,(file-name-directory (image-dired-original-file-name)))
+ (image-dired-file . ,(file-name-nondirectory (image-dired-original-file-name)))
+ (handler . image-dired-bookmark-jump)))
+
+;;;###autoload
+(defun image-dired-bookmark-jump (bookmark)
+ "Default bookmark handler for Image-Dired buffers."
+ ;; User already cached thumbnails, so disable any checking.
+ (let ((image-dired-show-all-from-dir-max-files nil))
+ (image-dired (bookmark-prop-get bookmark 'location))
+ ;; TODO: Go to the bookmarked file, if it exists.
+ ;; (bookmark-prop-get bookmark 'image-dired-file)
+ (goto-char (point-min))))
+
+(put 'image-dired-bookmark-jump 'bookmark-handler-type "Image-Dired")
+
+;;; Obsolete
+
+;;;###autoload
+(define-obsolete-function-alias 'tumme #'image-dired "24.4")
+
+;;;###autoload
+(define-obsolete-function-alias 'image-dired-setup-dired-keybindings
+ #'image-dired-minor-mode "26.1")
+
+(defcustom image-dired-temp-image-file
+ (expand-file-name ".image-dired_temp" image-dired-dir)
+ "Name of temporary image file used by various commands."
+ :type 'file)
+(make-obsolete-variable 'image-dired-temp-image-file
+ "no longer used." "29.1")
+
+(defcustom image-dired-cmd-create-temp-image-program
+ (if (executable-find "gm") "gm" "convert")
+ "Executable used to create temporary image.
+Used together with `image-dired-cmd-create-temp-image-options'."
+ :type 'file
+ :version "29.1")
+(make-obsolete-variable 'image-dired-cmd-create-temp-image-program
+ "no longer used." "29.1")
+
+(defcustom image-dired-cmd-create-temp-image-options
+ (let ((opts '("-size" "%wx%h" "%f[0]"
+ "-resize" "%wx%h>"
+ "-strip" "jpeg:%t")))
+ (if (executable-find "gm") (cons "convert" opts) opts))
+ "Options of command used to create temporary image for display window.
+Used together with `image-dired-cmd-create-temp-image-program',
+Available format specifiers are: %w and %h which are replaced by
+the calculated max size for width and height in the image display window,
+%f which is replaced by the file name of the original image and %t which
+is replaced by the file name of the temporary file."
+ :version "29.1"
+ :type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'image-dired-cmd-create-temp-image-options
+ "no longer used." "29.1")
+
+(defcustom image-dired-display-window-width-correction 1
+ "Number to be used to correct image display window width.
+Change if the default (1) does not work (i.e. if the image does not
+completely fit)."
+ :type 'integer)
+(make-obsolete-variable 'image-dired-display-window-width-correction
+ "no longer used." "29.1")
+
+(defcustom image-dired-display-window-height-correction 0
+ "Number to be used to correct image display window height.
+Change if the default (0) does not work (i.e. if the image does not
+completely fit)."
+ :type 'integer)
+(make-obsolete-variable 'image-dired-display-window-height-correction
+ "no longer used." "29.1")
+
+(defun image-dired-display-window-width (window)
+ "Return width, in pixels, of WINDOW."
+ (declare (obsolete nil "29.1"))
+ (- (image-dired-window-width-pixels window)
+ image-dired-display-window-width-correction))
+
+(defun image-dired-display-window-height (window)
+ "Return height, in pixels, of WINDOW."
+ (declare (obsolete nil "29.1"))
+ (- (image-dired-window-height-pixels window)
+ image-dired-display-window-height-correction))
+
+(defun image-dired-window-height-pixels (window)
+ "Calculate WINDOW height in pixels."
+ (declare (obsolete nil "29.1"))
+ ;; Note: The mode-line consumes one line
+ (* (- (window-height window) 1) (frame-char-height)))
+
+(defcustom image-dired-cmd-read-exif-data-program "exiftool"
+ "Program used to read EXIF data to image.
+Used together with `image-dired-cmd-read-exif-data-options'."
+ :type 'file)
+(make-obsolete-variable 'image-dired-cmd-read-exif-data-program
+ "use `exif-parse-file' and `exif-field' instead." "29.1")
+
+(defcustom image-dired-cmd-read-exif-data-options '("-s" "-s" "-s" "-%t" "%f")
+ "Arguments of command used to read EXIF data.
+Used with `image-dired-cmd-read-exif-data-program'.
+Available format specifiers are: %f which is replaced
+by the image file name and %t which is replaced by the tag name."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'image-dired-cmd-read-exif-data-options
+ "use `exif-parse-file' and `exif-field' instead." "29.1")
+
+(defun image-dired-get-exif-data (file tag-name)
+ "From FILE, return EXIF tag TAG-NAME."
+ (declare (obsolete "use `exif-parse-file' and `exif-field' instead." "29.1"))
+ (image-dired--check-executable-exists
+ 'image-dired-cmd-read-exif-data-program)
+ (let ((buf (get-buffer-create "*image-dired-get-exif-data*"))
+ (spec (list (cons ?f file) (cons ?t tag-name)))
+ tag-value)
+ (with-current-buffer buf
+ (delete-region (point-min) (point-max))
+ (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program
+ nil t nil
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-read-exif-data-options))
+ 0))
+ (error "Could not get EXIF tag")
+ (goto-char (point-min))
+ ;; Clean buffer from newlines and carriage returns before
+ ;; getting final info
+ (while (search-forward-regexp "[\n\r]" nil t)
+ (replace-match "" nil t))
+ (setq tag-value (buffer-substring (point-min) (point-max)))))
+ tag-value))
+
+(defcustom image-dired-cmd-rotate-thumbnail-program
+ (if (executable-find "gm") "gm" "mogrify")
+ "Executable used to rotate thumbnail.
+Used together with `image-dired-cmd-rotate-thumbnail-options'."
+ :type 'file
+ :version "29.1")
+(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-program nil "29.1")
+
+(defcustom image-dired-cmd-rotate-thumbnail-options
+ (let ((opts '("-rotate" "%d" "%t")))
+ (if (executable-find "gm") (cons "mogrify" opts) opts))
+ "Arguments of command used to rotate thumbnail image.
+Used with `image-dired-cmd-rotate-thumbnail-program'.
+Available format specifiers are: %d which is replaced by the
+number of (positive) degrees to rotate the image, normally 90 or 270
+\(for 90 degrees right and left), %t which is replaced by the file name
+of the thumbnail file."
+ :version "29.1"
+ :type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-options nil "29.1")
+
+(defun image-dired-rotate-thumbnail (degrees)
+ "Rotate thumbnail DEGREES degrees."
+ (declare (obsolete image-dired-refresh-thumb "29.1"))
+ (image-dired--check-executable-exists
+ 'image-dired-cmd-rotate-thumbnail-program)
+ (if (not (image-dired-image-at-point-p))
+ (message "No thumbnail at point")
+ (let* ((file (image-dired-thumb-name (image-dired-original-file-name)))
+ (thumb (expand-file-name file))
+ (spec (list (cons ?d degrees) (cons ?t thumb))))
+ (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-rotate-thumbnail-options))
+ (clear-image-cache thumb))))
+
+(defun image-dired-rotate-thumbnail-left ()
+ "Rotate thumbnail left (counter clockwise) 90 degrees."
+ (declare (obsolete image-dired-refresh-thumb "29.1"))
+ (interactive)
+ (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail))
+ (image-dired-rotate-thumbnail "270")))
+
+(defun image-dired-rotate-thumbnail-right ()
+ "Rotate thumbnail counter right (clockwise) 90 degrees."
+ (declare (obsolete image-dired-refresh-thumb "29.1"))
+ (interactive)
+ (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail))
+ (image-dired-rotate-thumbnail "90")))
+
+(defun image-dired-modify-mark-on-thumb-original-file (command)
+ "Modify mark in Dired buffer.
+COMMAND is one of `mark' for marking file in Dired, `unmark' for
+unmarking file in Dired or `flag' for flagging file for delete in
+Dired."
+ (declare (obsolete image-dired--on-file-in-dired-buffer "29.1"))
+ (let ((file-name (image-dired-original-file-name))
+ (dired-buf (image-dired-associated-dired-buffer)))
+ (if (not (and dired-buf file-name))
+ (message "No image, or image with correct properties, at point.")
+ (with-current-buffer dired-buf
+ (message "%s" file-name)
+ (when (dired-goto-file file-name)
+ (cond ((eq command 'mark) (dired-mark 1))
+ ((eq command 'unmark) (dired-unmark 1))
+ ((eq command 'toggle)
+ (if (image-dired-dired-file-marked-p)
+ (dired-unmark 1)
+ (dired-mark 1)))
+ ((eq command 'flag) (dired-flag-file-deletion 1)))
+ (image-dired-thumb-update-marks))))))
+
+(defun image-dired-display-current-image-full ()
+ "Display current image in full size."
+ (declare (obsolete image-transform-original "29.1"))
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((file (image-dired-original-file-name)))
+ (if file
+ (progn
+ (image-dired-display-image file)
+ (with-current-buffer image-dired-display-image-buffer
+ (image-transform-original)))
+ (error "No original file name at point"))))
+
+(defun image-dired-display-current-image-sized ()
+ "Display current image in sized to fit window dimensions."
+ (declare (obsolete image-mode-fit-frame "29.1"))
+ (interactive nil image-dired-thumbnail-mode)
+ (let ((file (image-dired-original-file-name)))
+ (if file
+ (progn
+ (image-dired-display-image file))
+ (error "No original file name at point"))))
+
+(defun image-dired-add-to-tag-file-list (tag file)
+ "Add relation between TAG and FILE."
+ (declare (obsolete nil "29.1"))
+ (let (curr)
+ (if image-dired-tag-file-list
+ (if (setq curr (assoc tag image-dired-tag-file-list))
+ (if (not (member file curr))
+ (setcdr curr (cons file (cdr curr))))
+ (setcdr image-dired-tag-file-list
+ (cons (list tag file) (cdr image-dired-tag-file-list))))
+ (setq image-dired-tag-file-list (list (list tag file))))))
+
+(defun image-dired-display-thumb-properties ()
+ "Display thumbnail properties in the echo area."
+ (declare (obsolete image-dired-update-header-line "29.1"))
+ (image-dired-update-header-line))
+
+(defvar image-dired-slideshow-count 0
+ "Keeping track on number of images in slideshow.")
+(make-obsolete-variable 'image-dired-slideshow-count "no longer used." "29.1")
+
+(defvar image-dired-slideshow-times 0
+ "Number of pictures to display in slideshow.")
+(make-obsolete-variable 'image-dired-slideshow-times "no longer used." "29.1")
+
+(define-obsolete-function-alias 'image-dired-create-display-image-buffer
+ #'ignore "29.1")
+(define-obsolete-function-alias 'image-dired-create-gallery-lists
+ #'image-dired--create-gallery-lists "29.1")
+(define-obsolete-function-alias 'image-dired-add-to-file-comment-list
+ #'image-dired--add-to-file-comment-list "29.1")
+(define-obsolete-function-alias 'image-dired-add-to-tag-file-lists
+ #'image-dired--add-to-tag-file-lists "29.1")
+(define-obsolete-function-alias 'image-dired-hidden-p
+ #'image-dired--hidden-p "29.1")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; TEST-SECTION ;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2733,23 +3075,6 @@ tags to their respective image file. Internal function used by
;; (setq dirsize (- dirsize (car (cdar files))))
;; (setq files (cdr files)))))
-;;;;;;;;;;;;;;;;;;;;;;,
-
-;; (defun dired-speedbar-buttons (dired-buffer)
-;; (when (and (boundp 'image-dired-use-speedbar)
-;; image-dired-use-speedbar)
-;; (let ((filename (with-current-buffer dired-buffer
-;; (dired-get-filename))))
-;; (when (and (not (string-equal filename (buffer-string)))
-;; (string-match (image-file-name-regexp) filename))
-;; (erase-buffer)
-;; (insert (propertize
-;; filename
-;; 'display
-;; (image-dired-get-thumbnail-image filename)))))))
-
-;; (setq image-dired-use-speedbar t)
-
(provide 'image-dired)
;;; image-dired.el ends here
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 73d32707e34..0ed88e8e749 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -37,7 +37,7 @@
;;;###autoload
(defcustom image-file-name-extensions
- (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg"))
+ (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp"))
"A list of image-file filename extensions.
Filenames having one of these extensions are considered image files,
in addition to those matching `image-file-name-regexps'.
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 1eb7cd58c3d..46c555df278 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -58,16 +58,25 @@ It is called with one argument, the initial WINPROPS.")
"Non-nil to resize the image upon first display.
Its value should be one of the following:
- nil, meaning no resizing.
- - t, meaning to fit the image to the window height and width.
- - `fit-height', meaning to fit the image to the window height.
- - `fit-width', meaning to fit the image to the window width.
- - A number, which is a scale factor (the default size is 1)."
+ - t, meaning to scale the image down to fit in the window.
+ - `fit-window', meaning to fit the image to the window.
+ - A number, which is a scale factor (the default size is 1).
+
+Resizing will always preserve the aspect ratio of the image."
:type '(choice (const :tag "No resizing" nil)
- (other :tag "Fit height and width" t)
- (const :tag "Fit height" fit-height)
- (const :tag "Fit width" fit-width)
+ (const :tag "Fit to window" fit-window)
+ (other :tag "Scale down to fit window" t)
(number :tag "Scale factor" 1))
- :version "27.1"
+ :version "29.1"
+ :group 'image)
+
+(defcustom image-auto-resize-max-scale-percent nil
+ "Max size (in percent) to scale up to when `image-auto-resize' is `fit-window'.
+Can be either a number larger than 100, or nil, which means no
+max size."
+ :type '(choice (const :tag "No max" nil)
+ natnum)
+ :version "29.1"
:group 'image)
(defcustom image-auto-resize-on-window-resize 1
@@ -82,12 +91,18 @@ resizing according to the value specified in `image-auto-resize'."
(defvar-local image-transform-resize nil
"The image resize operation.
+Non-nil to resize the image upon first display.
Its value should be one of the following:
- nil, meaning no resizing.
- - t, meaning to fit the image to the window height and width.
+ - t, meaning to scale the image down to fit in the window.
+ - `fit-window', meaning to fit the image to the window.
+ - A number, which is a scale factor (the default size is 1).
+
+There is also support for these values, obsolete since Emacs 29.1:
- `fit-height', meaning to fit the image to the window height.
- `fit-width', meaning to fit the image to the window width.
- - A number, which is a scale factor (the default size is 1).")
+
+Resizing will always preserve the aspect ratio of the image.")
(defvar-local image-transform-scale 1.0
"The scale factor of the image being displayed.")
@@ -267,10 +282,17 @@ Stop if the top edge of the image is reached."
(defun image-scroll-up (&optional n)
"Scroll image in current window upward by N lines.
Stop if the bottom edge of the image is reached.
-If ARG is omitted or nil, scroll upward by a near full screen.
+
+Interactively, giving this command a numerical prefix will scroll
+up by that many lines (and down by that many lines if the number
+is negative). Without a prefix, scroll up by a full screen.
+If given a \\`C-u -' prefix, scroll a full page down instead.
+
+If N is omitted or nil, scroll upward by a near full screen.
A near full screen is `next-screen-context-lines' less than a full screen.
-Negative ARG means scroll downward.
-If ARG is the atom `-', scroll downward by nearly full screen.
+A negative N means scroll downward.
+
+If N is the atom `-', scroll downward by nearly full screen.
When calling from a program, supply as argument a number, nil, or `-'."
(interactive "P")
(cond ((null n)
@@ -288,10 +310,17 @@ When calling from a program, supply as argument a number, nil, or `-'."
(defun image-scroll-down (&optional n)
"Scroll image in current window downward by N lines.
Stop if the top edge of the image is reached.
-If ARG is omitted or nil, scroll downward by a near full screen.
+
+Interactively, giving this command a numerical prefix will scroll
+down by that many lines (and up by that many lines if the number
+is negative). Without a prefix, scroll down by a full screen.
+If given a \\`C-u -' prefix, scroll a full page up instead.
+
+If N is omitted or nil, scroll downward by a near full screen.
A near full screen is `next-screen-context-lines' less than a full screen.
-Negative ARG means scroll upward.
-If ARG is the atom `-', scroll upward by nearly full screen.
+A negative N means scroll upward.
+
+If N is the atom `-', scroll upward by nearly full screen.
When calling from a program, supply as argument a number, nil, or `-'."
(interactive "P")
(cond ((null n)
@@ -404,42 +433,43 @@ window configuration prior to the last `image-mode-fit-frame'
call."
(interactive (list nil t))
(let* ((buffer (current-buffer))
- (display (image-get-display-property))
- (size (image-display-size display))
(saved (frame-parameter frame 'image-mode-saved-params))
(window-configuration (current-window-configuration frame))
- (width (frame-width frame))
- (height (frame-height frame)))
+ (frame-width (frame-text-width frame))
+ (frame-height (frame-text-height frame)))
(with-selected-frame (or frame (selected-frame))
(if (and toggle saved
- (= (caar saved) width)
- (= (cdar saved) height))
+ (= (caar saved) frame-width)
+ (= (cdar saved) frame-height))
(progn
- (set-frame-width frame (car (nth 1 saved)))
- (set-frame-height frame (cdr (nth 1 saved)))
+ (set-frame-width frame (car (nth 1 saved)) nil t)
+ (set-frame-height frame (cdr (nth 1 saved)) nil t)
(set-window-configuration (nth 2 saved))
(set-frame-parameter frame 'image-mode-saved-params nil))
(delete-other-windows)
(switch-to-buffer buffer t t)
- (let* ((edges (window-inside-edges))
- (inner-width (- (nth 2 edges) (nth 0 edges)))
- (inner-height (- (nth 3 edges) (nth 1 edges))))
- (set-frame-width frame (+ (ceiling (car size))
- width (- inner-width)))
- (set-frame-height frame (+ (ceiling (cdr size))
- height (- inner-height)))
- ;; The frame size after the above `set-frame-*' calls may
- ;; differ from what we specified, due to window manager
- ;; interference. We have to call `frame-width' and
- ;; `frame-height' to get the actual results.
- (set-frame-parameter frame 'image-mode-saved-params
- (list (cons (frame-width)
- (frame-height))
- (cons width height)
- window-configuration)))))))
+ (fit-frame-to-buffer frame)
+ ;; The frame size after the above `set-frame-*' calls may
+ ;; differ from what we specified, due to window manager
+ ;; interference. We have to call `frame-width' and
+ ;; `frame-height' to get the actual results.
+ (set-frame-parameter frame 'image-mode-saved-params
+ (list (cons (frame-text-width frame)
+ (frame-text-height frame))
+ (cons frame-width frame-height)
+ window-configuration))))))
;;; Image Mode setup
+(defcustom image-text-based-formats '(svg xpm)
+ "List of image formats that use a plain text format.
+For such formats, display a message that explains how to edit the
+image as text, when opening such images in `image-mode'."
+ :type '(choice (const :tag "Disable completely" nil)
+ (repeat :tag "List of formats" sexp))
+ :version "29.1"
+ :group 'image)
+
(defvar-local image-type nil
"The image type for the current Image mode buffer.")
@@ -455,8 +485,9 @@ call."
;; Transformation keys
(define-key map "sf" 'image-mode-fit-frame)
+ (define-key map "sw" 'image-transform-fit-to-window)
(define-key map "sh" 'image-transform-fit-to-height)
- (define-key map "sw" 'image-transform-fit-to-width)
+ (define-key map "si" 'image-transform-fit-to-width)
(define-key map "sb" 'image-transform-fit-both)
(define-key map "ss" 'image-transform-set-scale)
(define-key map "sr" 'image-transform-set-rotation)
@@ -511,12 +542,10 @@ call."
"--"
["Fit Frame to Image" image-mode-fit-frame :active t
:help "Resize frame to match image"]
- ["Fit Image to Window (Best Fit)" image-transform-fit-both
- :help "Resize image to match the window height and width"]
- ["Fit to Window Height" image-transform-fit-to-height
- :help "Resize image to match the window height"]
- ["Fit to Window Width" image-transform-fit-to-width
- :help "Resize image to match the window width"]
+ ["Fit Image to Window" image-transform-fit-to-window
+ :help "Resize image to match the window height and width"]
+ ["Fit Image to Window (Scale down only)" image-transform-fit-both
+ :help "Scale image down to match the window height and width"]
["Zoom In" image-increase-size
:help "Enlarge the image"]
["Zoom Out" image-decrease-size
@@ -602,11 +631,14 @@ call."
(put 'image-mode 'mode-class 'special)
+(declare-function image-converter-initialize "image-converter.el")
+
;;;###autoload
(defun image-mode ()
"Major mode for image files.
-You can use \\<image-mode-map>\\[image-toggle-display] or \\<image-mode-map>\\[image-toggle-hex-display]
-to toggle between display as an image and display as text or hex.
+You can use \\<image-mode-map>\\[image-toggle-display] or \
+\\[image-toggle-hex-display] to toggle between display
+as an image and display as text or hex.
Key bindings:
\\{image-mode-map}"
@@ -626,7 +658,12 @@ Key bindings:
"Empty file"
"(New file)")
"Empty buffer"))
- (image-mode--display)))
+ (image-mode--display)
+ ;; Ensure that we recognize externally parsed image formats in
+ ;; commands like `n'.
+ (when image-use-external-converter
+ (require 'image-converter)
+ (image-converter-initialize))))
(defun image-mode--display ()
(if (not (image-get-display-property))
@@ -680,12 +717,10 @@ Key bindings:
(run-mode-hooks 'image-mode-hook)
(let ((image (image-get-display-property))
- (msg1 (substitute-command-keys
- "Type \\[image-toggle-display] or \\[image-toggle-hex-display] to view the image as "))
- animated)
+ msg animated)
(cond
((null image)
- (message "%s" (concat msg1 "an image.")))
+ (setq msg "an image"))
((setq animated (image-multi-frame-p image))
(setq image-multi-frame t
mode-line-process
@@ -703,10 +738,13 @@ Key bindings:
keymap
(down-mouse-1 . image-next-frame)
(down-mouse-3 . image-previous-frame)))))))
- (message "%s"
- (concat msg1 "text. This image has multiple frames.")))
+ (setq msg "text. This image has multiple frames"))
(t
- (message "%s" (concat msg1 "text or hex."))))))
+ (setq msg "text")))
+ (when (memq (plist-get (cdr image) :type) image-text-based-formats)
+ (message (substitute-command-keys
+ "Type \\[image-toggle-display] to view the image as %s")
+ msg))))
;;;###autoload
(define-minor-mode image-minor-mode
@@ -753,11 +791,11 @@ on these modes."
(image-mode-to-text)
;; Turn on hexl-mode
(hexl-mode)
- (message "%s" (concat
- (substitute-command-keys
- "Type \\[image-toggle-hex-display] or \\[image-toggle-display] to view the image as ")
- (if (image-get-display-property)
- "hex" "an image or text") ".")))
+ (message (substitute-command-keys
+ "Type \\[image-toggle-hex-display] or \
+\\[image-toggle-display] to view the image as %s")
+ (if (image-get-display-property)
+ "hex" "an image or text")))
(defun image-mode-as-text ()
"Set a non-image mode as major mode in combination with image minor mode.
@@ -773,11 +811,10 @@ See commands `image-mode' and `image-minor-mode' for more information
on these modes."
(interactive)
(image-mode-to-text)
- (message "%s" (concat
- (substitute-command-keys
- "Type \\[image-toggle-display] or \\[image-toggle-hex-display] to view the image as ")
- (if (image-get-display-property)
- "text" "an image or hex") ".")))
+ (message (substitute-command-keys
+ "Type \\[image-toggle-display] to view the image as %s")
+ (if (image-get-display-property)
+ "text" "an image")))
(defun image-toggle-display-text ()
"Show the image file as text.
@@ -805,6 +842,21 @@ Remove text properties that display the image."
(defvar tar-superior-buffer)
(declare-function image-flush "image.c" (spec &optional frame))
+(defun image--scale-within-limits-p (image)
+ "Return t if `fit-window' will scale image within the customized limits.
+The limits are given by the user option
+`image-auto-resize-max-scale-percent'."
+ (or (not image-auto-resize-max-scale-percent)
+ (let ((scale (/ image-auto-resize-max-scale-percent 100))
+ (mw (plist-get (cdr image) :max-width))
+ (mh (plist-get (cdr image) :max-height))
+ ;; Note: `image-size' looks up and thus caches the
+ ;; untransformed image. There's no easy way to
+ ;; prevent that.
+ (size (image-size image t)))
+ (or (<= mw (* (car size) scale))
+ (<= mh (* (cdr size) scale))))))
+
(defun image-toggle-display-image ()
"Show the image of the image file.
Turn the image data into a real image, but only if the whole file
@@ -839,7 +891,8 @@ was inserted."
filename))
;; If we have a `fit-width' or a `fit-height', don't limit
;; the size of the image to the window size.
- (edges (when (eq image-transform-resize t)
+ (edges (when (or (eq image-transform-resize t)
+ (eq image-transform-resize 'fit-window))
(window-inside-pixel-edges (get-buffer-window))))
(max-width (when edges
(- (nth 2 edges) (nth 0 edges))))
@@ -886,6 +939,14 @@ was inserted."
;; Type hint.
:format (and filename data-p))))
+ ;; Handle `fit-window'.
+ (when (and (eq image-transform-resize 'fit-window)
+ (image--scale-within-limits-p image))
+ (setq image
+ (cons (car image)
+ (plist-put (cdr image) :width
+ (plist-get (cdr image) :max-width)))))
+
;; Discard any stale image data before looking it up again.
(image-flush image)
(setq image (append image (image-transform-properties image)))
@@ -1149,8 +1210,9 @@ replacing the current Image mode buffer."
"Return an alist of type/buffer for all \"parent\" buffers to image FILE.
This is normally a list of Dired buffers, but can also be archive and
tar mode buffers."
- (let ((buffers nil)
- (dir (file-name-directory file)))
+ (let* ((non-essential t) ; Do not block for remote buffers.
+ (buffers nil)
+ (dir (file-name-directory file)))
(cond
((and (boundp 'tar-superior-buffer)
tar-superior-buffer)
@@ -1165,6 +1227,8 @@ tar mode buffers."
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (and (derived-mode-p 'dired-mode)
+ (equal (file-remote-p dir)
+ (file-remote-p default-directory))
(equal (file-truename dir)
(file-truename default-directory)))
(push (cons 'dired (current-buffer)) buffers))))
@@ -1495,22 +1559,30 @@ return value is suitable for appending to an image spec."
(defun image-transform-fit-to-height ()
"Fit the current image to the height of the current window."
+ (declare (obsolete nil "29.1"))
(interactive)
(setq image-transform-resize 'fit-height)
(image-toggle-display-image))
(defun image-transform-fit-to-width ()
"Fit the current image to the width of the current window."
+ (declare (obsolete nil "29.1"))
(interactive)
(setq image-transform-resize 'fit-width)
(image-toggle-display-image))
(defun image-transform-fit-both ()
- "Fit the current image both to the height and width of the current window."
+ "Scale the current image down to fit in the current window."
(interactive)
(setq image-transform-resize t)
(image-toggle-display-image))
+(defun image-transform-fit-to-window ()
+ "Fit the current image to the height and width of the current window."
+ (interactive)
+ (setq image-transform-resize 'fit-window)
+ (image-toggle-display-image))
+
(defun image-transform-set-rotation (rotation)
"Prompt for an angle ROTATION, and rotate the image by that amount.
ROTATION should be in degrees."
diff --git a/lisp/image.el b/lisp/image.el
index ea1a22698c6..bdaaec608ef 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -27,6 +27,8 @@
(defgroup image ()
"Image support."
+ :prefix "image-"
+ :link '(info-link "(emacs) Image Mode")
:group 'multimedia)
(declare-function image-flush "image.c" (spec &optional frame))
@@ -48,6 +50,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm)
("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff)
("\\`[\t\n\r ]*%!PS" . postscript)
("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg)
+ ("\\`RIFF....WEBPVP8" . webp)
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
(comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
(concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
@@ -55,7 +58,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm)
"\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
"[Ss][Vv][Gg]"))
. svg)
- )
+ ("\\`....ftyp\\(heic\\|heix\\|hevc\\|heim\\|heis\\|hevm\\|hevs\\|mif1\\|msf1\\)" . heic))
"Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
When the first bytes of an image file match REGEXP, it is assumed to
be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol,
@@ -67,6 +70,7 @@ a non-nil value, TYPE is the image's type.")
'(("\\.png\\'" . png)
("\\.gif\\'" . gif)
("\\.jpe?g\\'" . jpeg)
+ ("\\.webp\\'" . webp)
("\\.bmp\\'" . bmp)
("\\.xpm\\'" . xpm)
("\\.pbm\\'" . pbm)
@@ -74,7 +78,7 @@ a non-nil value, TYPE is the image's type.")
("\\.ps\\'" . postscript)
("\\.tiff?\\'" . tiff)
("\\.svgz?\\'" . svg)
- )
+ ("\\.hei[cf]s?\\'" . heic))
"Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
When the name of an image file match REGEXP, it is assumed to
be of image type IMAGE-TYPE.")
@@ -92,7 +96,9 @@ be of image type IMAGE-TYPE.")
(jpeg . maybe)
(tiff . maybe)
(svg . maybe)
- (postscript . nil))
+ (webp . maybe)
+ (postscript . nil)
+ (heic . maybe))
"Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files.
\(See `image-type-auto-detected-p').
@@ -165,18 +171,18 @@ or \"ffmpeg\") is installed."
(define-error 'unknown-image-type "Unknown image type")
-;; Map put into text properties on images.
-(defvar image-map
- (let ((map (make-sparse-keymap)))
- (define-key map "-" 'image-decrease-size)
- (define-key map "+" 'image-increase-size)
- (define-key map [C-wheel-down] 'image-mouse-decrease-size)
- (define-key map [C-mouse-5] 'image-mouse-decrease-size)
- (define-key map [C-wheel-up] 'image-mouse-increase-size)
- (define-key map [C-mouse-4] 'image-mouse-increase-size)
- (define-key map "r" 'image-rotate)
- (define-key map "o" 'image-save)
- map))
+(defvar-keymap image-map
+ :doc "Map put into text properties on images."
+ "-" #'image-decrease-size
+ "+" #'image-increase-size
+ "r" #'image-rotate
+ "o" #'image-save
+ "h" #'image-flip-horizontally
+ "v" #'image-flip-vertically
+ "C-<wheel-down>" #'image-mouse-decrease-size
+ "C-<mouse-5>" #'image-mouse-decrease-size
+ "C-<wheel-up>" #'image-mouse-increase-size
+ "C-<mouse-4>" #'image-mouse-increase-size)
(defun image-load-path-for-library (library image &optional path no-error)
"Return a suitable search path for images used by LIBRARY.
@@ -376,6 +382,7 @@ be determined."
"Determine the type of image file FILE from its name.
Value is a symbol specifying the image type, or nil if type cannot
be determined."
+ (declare (obsolete image-supported-file-p "29.1"))
(let (type first (case-fold-search t))
(catch 'found
(dolist (elem image-type-file-name-regexps first)
@@ -385,6 +392,20 @@ be determined."
;; If nothing seems to be supported, return first type that matched.
(or first (setq first type))))))))
+ ;;;###autoload
+(defun image-supported-file-p (file)
+ "Say whether Emacs has native support for displaying TYPE.
+The value is a symbol specifying the image type, or nil if type
+cannot be determined (or if Emacs doesn't have built-in support
+for the image type)."
+ (let ((case-fold-search t)
+ type)
+ (catch 'found
+ (dolist (elem image-type-file-name-regexps)
+ (when (and (string-match-p (car elem) file)
+ (image-type-available-p (setq type (cdr elem))))
+ (throw 'found type))))))
+
(declare-function image-convert-p "image-converter.el"
(source &optional image-format))
(declare-function image-convert "image-converter.el"
@@ -413,7 +434,7 @@ type if we can't otherwise guess it."
(require 'image-converter)
(image-convert-p source data-p))))
(or (image-type-from-file-header source)
- (image-type-from-file-name source)
+ (image-supported-file-p source)
(and image-use-external-converter
(progn
(require 'image-converter)
@@ -425,15 +446,6 @@ type if we can't otherwise guess it."
(error "Invalid image type `%s'" type))
type)
-
-(if (fboundp 'image-metadata) ; eg not --without-x
- (define-obsolete-function-alias 'image-extension-data
- 'image-metadata "24.1"))
-
-(define-obsolete-variable-alias
- 'image-library-alist
- 'dynamic-library-alist "24.1")
-
;;;###autoload
(defun image-type-available-p (type)
"Return t if image type TYPE is available.
@@ -457,6 +469,7 @@ must be available."
(and auto
(or (eq auto t) (image-type-available-p type)))))
+(defvar image-convert-to-format)
;;;###autoload
(defun create-image (file-or-data &optional type data-p &rest props)
@@ -494,7 +507,7 @@ Image file names that are not absolute are searched for in the
(when (eq type 'image-convert)
(require 'image-converter)
(setq file-or-data (image-convert file-or-data data-format)
- type 'png
+ type (intern image-convert-to-format)
data-p t)))
(when (image-type-available-p type)
(let ((image
@@ -556,7 +569,12 @@ If VALUE is nil, PROPERTY is removed from IMAGE."
(declare (gv-setter image--set-property))
(plist-get (cdr image) property))
-(defun image-compute-scaling-factor (scaling)
+(defun image-compute-scaling-factor (&optional scaling)
+ "Compute the scaling factor based on SCALING.
+If a number, use that. If it's `auto', compute the factor.
+If nil, use the `image-scaling-factor' variable."
+ (unless scaling
+ (setq scaling image-scaling-factor))
(cond
((numberp scaling) scaling)
((eq scaling 'auto)
@@ -600,7 +618,7 @@ means display it in the right marginal area."
;;;###autoload
-(defun insert-image (image &optional string area slice)
+(defun insert-image (image &optional string area slice inhibit-isearch)
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
with a `display' property whose value is the image.
@@ -617,7 +635,11 @@ SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
specifying the X and Y positions and WIDTH and HEIGHT of image area
to insert. A float value 0.0 - 1.0 means relative to the width or
-height of the image; integer values are taken as pixel values."
+height of the image; integer values are taken as pixel values.
+
+Normally `isearch' is able to search for STRING in the buffer
+even if it's hidden behind a displayed image. If INHIBIT-ISEARCH
+is non-nil, this is inhibited."
;; Use a space as least likely to cause trouble when it's a hidden
;; character in the buffer.
(unless string (setq string " "))
@@ -641,6 +663,7 @@ height of the image; integer values are taken as pixel values."
(list (cons 'slice slice) image)
image)
rear-nonsticky t
+ inhibit-isearch ,inhibit-isearch
keymap ,image-map))))
@@ -734,13 +757,15 @@ SPECS is a list of image specifications.
Each image specification in SPECS is a property list. The contents of
a specification are image type dependent. All specifications must at
-least contain the properties `:type TYPE' and either `:file FILE' or
-`:data DATA', where TYPE is a symbol specifying the image type,
-e.g. `xbm', FILE is the file to load the image from, and DATA is a
-string containing the actual image data. The specification whose TYPE
-is supported, and FILE exists, is used to construct the image
-specification to be returned. Return nil if no specification is
-satisfied.
+least contain either the property `:file FILE' or `:data DATA',
+where FILE is the file to load the image from, and DATA is a string
+containing the actual image data. If the property `:type TYPE' is
+omitted or nil, try to determine the image type from its first few
+bytes of image data. If that doesn't work, and the property `:file
+FILE' provide a file name, use its file extension as image type.
+If `:type TYPE' is provided, it must match the actual type
+determined for FILE or DATA by `create-image'. Return nil if no
+specification is satisfied.
If CACHE is non-nil, results are cached and returned on subsequent calls.
@@ -755,22 +780,44 @@ Image files should not be larger than specified by `max-image-size'."
(let* ((spec (car specs))
(type (plist-get spec :type))
(data (plist-get spec :data))
- (file (plist-get spec :file))
- found)
- (when (image-type-available-p type)
- (cond ((stringp file)
- (if (setq found (image-search-load-path file))
- (setq image
- (cons 'image (plist-put (copy-sequence spec)
- :file found)))))
- ((not (null data))
- (setq image (cons 'image spec)))))
+ (file (plist-get spec :file)))
+ (cond
+ ((stringp file)
+ (when (setq file (image-search-load-path file))
+ ;; At this point, remove the :type and :file properties.
+ ;; `create-image' will set them depending on image file.
+ (setq image (cons 'image (copy-sequence spec)))
+ (setf (image-property image :type) nil)
+ (setf (image-property image :file) nil)
+ (and (setq image (ignore-errors
+ (apply #'create-image file nil nil
+ (cdr image))))
+ ;; Ensure, if a type has been provided, it is
+ ;; consistent with the type returned by
+ ;; `create-image'. If not, return nil.
+ (not (null type))
+ (not (eq type (image-property image :type)))
+ (setq image nil))))
+ ((not (null data))
+ ;; At this point, remove the :type and :data properties.
+ ;; `create-image' will set them depending on image data.
+ (setq image (cons 'image (copy-sequence spec)))
+ (setf (image-property image :type) nil)
+ (setf (image-property image :data) nil)
+ (and (setq image (ignore-errors
+ (apply #'create-image data nil t
+ (cdr image))))
+ ;; Ensure, if a type has been provided, it is
+ ;; consistent with the type returned by
+ ;; `create-image'. If not, return nil.
+ (not (null type))
+ (not (eq type (image-property image :type)))
+ (setq image nil))))
(setq specs (cdr specs))))
(when cache
(setf (gethash orig-specs find-image--cache) image))
image)))
-
;;;###autoload
(defmacro defimage (symbol specs &optional doc)
"Define SYMBOL as an image, and return SYMBOL.
@@ -791,7 +838,7 @@ Example:
(defimage test-image ((:type xpm :file \"~/test1.xpm\")
(:type xbm :file \"~/test1.xbm\")))"
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
`(defvar ,symbol (find-image ',specs) ,doc))
@@ -823,15 +870,18 @@ in which case you might want to use `image-default-frame-delay'."
(make-obsolete 'image-animated-p 'image-multi-frame-p "24.4")
-;; "Destructively"?
-(defun image-animate (image &optional index limit)
+(defun image-animate (image &optional index limit position)
"Start animating IMAGE.
Animation occurs by destructively altering the IMAGE spec list.
With optional INDEX, begin animating from that animation frame.
LIMIT specifies how long to animate the image. If omitted or
nil, play the animation until the end. If t, loop forever. If a
-number, play until that number of seconds has elapsed."
+number, play until that number of seconds has elapsed.
+
+If POSITION (which should be buffer position where the image is
+displayed), stop the animation if the image is no longer
+displayed."
(let ((animation (image-multi-frame-p image))
timer)
(when animation
@@ -839,6 +889,9 @@ number, play until that number of seconds has elapsed."
(cancel-timer timer))
(plist-put (cdr image) :animate-buffer (current-buffer))
(plist-put (cdr image) :animate-tardiness 0)
+ (when position
+ (plist-put (cdr image) :animate-position
+ (set-marker (make-marker) position (current-buffer))))
;; Stash the data about the animation here so that we don't
;; trigger image recomputation unnecessarily later.
(plist-put (cdr image) :animate-multi-frame-data animation)
@@ -913,40 +966,54 @@ for the animation speed. A negative value means to animate in reverse."
(plist-put (cdr image) :animate-tardiness
(+ (* (plist-get (cdr image) :animate-tardiness) 0.9)
(float-time (time-since target-time))))
- (when (and (buffer-live-p (plist-get (cdr image) :animate-buffer))
- ;; Cumulatively delayed two seconds more than expected.
- (or (< (plist-get (cdr image) :animate-tardiness) 2)
- (progn
- (message "Stopping animation; animation possibly too big")
- nil)))
- (image-show-frame image n t)
- (let* ((speed (image-animate-get-speed image))
- (time (current-time))
- (time-to-load-image (time-since time))
- (stated-delay-time
- (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data))
- image-default-frame-delay)
- (float (abs speed))))
- ;; Subtract off the time we took to load the image from the
- ;; stated delay time.
- (delay (max (float-time (time-subtract stated-delay-time
- time-to-load-image))
- image-minimum-frame-delay))
- done)
- (setq n (if (< speed 0)
- (1- n)
- (1+ n)))
- (if limit
- (cond ((>= n count) (setq n 0))
- ((< n 0) (setq n (1- count))))
- (and (or (>= n count) (< n 0)) (setq done t)))
- (setq time-elapsed (+ delay time-elapsed))
- (if (numberp limit)
- (setq done (>= time-elapsed limit)))
- (unless done
- (run-with-timer delay nil #'image-animate-timeout
- image n count time-elapsed limit
- (+ (float-time) delay))))))
+ (let ((buffer (plist-get (cdr image) :animate-buffer))
+ (position (plist-get (cdr image) :animate-position)))
+ (when (and (buffer-live-p buffer)
+ ;; If we have a :animate-position setting, the caller
+ ;; has requested that the animation be stopped if the
+ ;; image is no longer displayed in the buffer.
+ (or (null position)
+ (with-current-buffer buffer
+ (let ((disp (get-text-property position 'display)))
+ (and (consp disp)
+ (eq (car disp) 'image)
+ ;; We can't check `eq'-ness of the image
+ ;; itself, since that may change.
+ (eq position
+ (plist-get (cdr disp) :animate-position))))))
+ ;; Cumulatively delayed two seconds more than expected.
+ (or (< (plist-get (cdr image) :animate-tardiness) 2)
+ (progn
+ (message "Stopping animation; animation possibly too big")
+ nil)))
+ (let* ((time (prog1 (current-time)
+ (image-show-frame image n t)))
+ (speed (image-animate-get-speed image))
+ (time-to-load-image (time-since time))
+ (stated-delay-time
+ (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data))
+ image-default-frame-delay)
+ (float (abs speed))))
+ ;; Subtract off the time we took to load the image from the
+ ;; stated delay time.
+ (delay (max (float-time (time-subtract stated-delay-time
+ time-to-load-image))
+ image-minimum-frame-delay))
+ done)
+ (setq n (if (< speed 0)
+ (1- n)
+ (1+ n)))
+ (if limit
+ (cond ((>= n count) (setq n 0))
+ ((< n 0) (setq n (1- count))))
+ (and (or (>= n count) (< n 0)) (setq done t)))
+ (setq time-elapsed (+ delay time-elapsed))
+ (if (numberp limit)
+ (setq done (>= time-elapsed limit)))
+ (unless done
+ (run-with-timer delay nil #'image-animate-timeout
+ image n count time-elapsed limit
+ (+ (float-time) delay)))))))
(defvar imagemagick-types-inhibit)
@@ -1138,6 +1205,13 @@ default is 20%."
(error "No image under point"))
image))
+;;;###autoload
+(defun image-at-point-p ()
+ "Return non-nil if there is an image at point."
+ (condition-case nil
+ (prog1 t (image--get-image))
+ (error nil)))
+
(defun image--get-imagemagick-and-warn (&optional position)
(declare-function image-transforms-p "image.c" (&optional frame))
(unless (or (fboundp 'imagemagick-types) (image-transforms-p))
@@ -1207,6 +1281,22 @@ changing the displayed image size does not affect the saved image."
(write-region (point-min) (point-max)
(read-file-name "Write image to file: ")))))
+(defun image-flip-horizontally ()
+ "Horizontally flip the image under point."
+ (interactive)
+ (let ((image (image--get-image)))
+ (image-flush image)
+ (setf (image-property image :flip)
+ (not (image-property image :flip)))))
+
+(defun image-flip-vertically ()
+ "Vertically flip the image under point."
+ (interactive)
+ (let ((image (image--get-image)))
+ (image-rotate 180)
+ (setf (image-property image :flip)
+ (not (image-property image :flip)))))
+
(provide 'image)
;;; image.el ends here
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index 23f11bd87cc..fd4673dc1b6 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -58,6 +58,9 @@
;; (:tag 306 :tag-name date-time :format 2 :format-type ascii
;; :value "2019:09:21 16:22:13")
;; ...)
+;;
+;; (exif-field 'date-time (exif-parse-file "test.jpg")) =>
+;; "2022:09:14 18:46:19"
;;; Code:
@@ -65,6 +68,7 @@
(defvar exif-tag-alist
'((11 processing-software)
+ (270 description)
(271 make)
(272 model)
(274 orientation)
@@ -73,7 +77,8 @@
(296 resolution-unit)
(305 software)
(306 date-time)
- (315 artist))
+ (315 artist)
+ (33432 copyright))
"Alist of tag values and their names.")
(defconst exif--orientation
@@ -95,7 +100,10 @@ mirrored or not.")
"Parse FILE (a JPEG file) and return the Exif data, if any.
The return value is a list of Exif items.
-If the data is invalid, an `exif-error' is signaled."
+If the data is invalid, an `exif-error' is signaled.
+
+Also see the `exif-field' convenience function to extract data
+from the return value of this function."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file)
@@ -105,7 +113,10 @@ If the data is invalid, an `exif-error' is signaled."
"Parse BUFFER (which should be a JPEG file) and return the Exif data, if any.
The return value is a list of Exif items.
-If the data is invalid, an `exif-error' is signaled."
+If the data is invalid, an `exif-error' is signaled.
+
+Also see the `exif-field' convenience function to extract data
+from the return value of this function."
(setq buffer (or buffer (current-buffer)))
(with-current-buffer buffer
(if enable-multibyte-characters
@@ -122,13 +133,20 @@ If the data is invalid, an `exif-error' is signaled."
(when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg)))))
(exif--parse-exif-chunk app1))))))
+(defun exif-field (field data)
+ "Return raw FIELD from EXIF.
+If FIELD is not present in the data, return nil.
+FIELD is a symbol in the cdr of `exif-tag-alist'.
+DATA is the result of calling `exif-parse-file'."
+ (plist-get (seq-find (lambda (e)
+ (eq field (plist-get e :tag-name)))
+ data)
+ :value))
+
(defun exif-orientation (exif)
"Return the orientation (in degrees) in EXIF.
If the orientation isn't present in the data, return nil."
- (let ((code (plist-get (cl-find 'orientation exif
- :key (lambda (e)
- (plist-get e :tag-name)))
- :value)))
+ (let ((code (exif-field 'orientation exif)))
(cadr (assq code exif--orientation))))
(defun exif--parse-jpeg ()
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 8ef8bd8eeed..8c49c1edf28 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -45,7 +45,7 @@
"Time to live in seconds for gravatar cache entries.
If a requested gravatar has been cached for longer than this, it
is retrieved anew. The default value is 30 days."
- :type 'integer
+ :type 'natnum
;; Restricted :type to number of seconds.
:version "27.1"
:group 'gravatar)
@@ -277,7 +277,7 @@ where GRAVATAR is either an image descriptor, or the symbol
;; Store the image in the cache.
(when image
(setf (gethash mail-address gravatar--cache)
- (cons (time-convert (current-time) 'integer)
+ (cons (time-convert nil 'integer)
image)))
(prog1
(apply callback (if data image 'error) cbargs)
@@ -286,7 +286,7 @@ where GRAVATAR is either an image descriptor, or the symbol
(defun gravatar--prune-cache ()
(let ((expired nil)
- (time (- (time-convert (current-time) 'integer)
+ (time (- (time-convert nil 'integer)
;; Twelve hours.
(* 12 60 60))))
(maphash (lambda (key val)
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index d3d560f0219..9ce46f01a33 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -46,6 +46,16 @@ formats that are to be supported: Only the suffixes that map to
:type 'symbol
:version "27.1")
+(defcustom image-convert-to-format "png"
+ "The image format to convert to.
+This should be a string like \"png\" or \"ppm\" or some
+other (preferably lossless) format that Emacs understands
+natively. The converter chosen has to support the format, and if
+not, conversion will fail."
+ :group 'image
+ :version "29.1"
+ :type 'string)
+
(defvar image-converter-regexp nil
"A regexp that matches the file name suffixes that can be converted.")
@@ -58,15 +68,19 @@ formats that are to be supported: Only the suffixes that map to
(imagemagick :command "convert" :probe ("-list" "format")))
"List of supported image converters to try.")
+(defun image-converter-initialize ()
+ "Determine the external image converter to be used.
+This also determines which external formats we can parse."
+ (unless image-converter
+ (image-converter--find-converter)))
+
(defun image-convert-p (source &optional data-p)
"Return `image-convert' if SOURCE is an image that can be converted.
SOURCE can either be a file name or a string containing image
data. In the latter case, DATA-P should be non-nil. If DATA-P
is a string, it should be a MIME format string like
\"image/gif\"."
- ;; Find an installed image converter.
- (unless image-converter
- (image-converter--find-converter))
+ (image-converter-initialize)
;; When image-converter was customized
(when (and image-converter (not image-converter-regexp))
(when-let ((formats (image-converter--probe image-converter)))
@@ -85,22 +99,23 @@ is a string, it should be a MIME format string like
'image-convert))
(defun image-convert (image &optional image-format)
- "Convert IMAGE file to the PNG format.
+ "Convert IMAGE file to an image format Emacs understands.
+This will usually be \"png\", but this is controlled by the
+`image-convert-to-format' user option.
+
IMAGE can either be a file name or image data.
To pass in image data, IMAGE should a string containing the image
data, and IMAGE-FORMAT should be a symbol with a MIME format name
like \"image/webp\". For instance:
- (image-convert data-string 'image/bmp)
+ (image-convert data-string \\='image/bmp)
IMAGE can also be an image object as returned by `create-image'.
-This function converts the image to PNG, and the converted image
-data is returned as a string."
- ;; Find an installed image converter.
- (unless image-converter
- (image-converter--find-converter))
+This function converts the image the preferred format, and the
+converted image data is returned as a string."
+ (image-converter-initialize)
(unless image-converter
(error "No external image converters available"))
(when (and image-format
@@ -120,7 +135,9 @@ data is returned as a string."
(if (listp image)
;; Return an image object that's the same as we were passed,
;; but ignore the :type value.
- (apply #'create-image (buffer-string) 'png t
+ (apply #'create-image (buffer-string)
+ (intern image-convert-to-format)
+ t
(cl-loop for (key val) on (cdr image) by #'cddr
unless (eq key :type)
append (list key val)))
@@ -241,12 +258,15 @@ Only suffixes that map to `image-mode' are returned."
(list (format "%s:-"
(image-converter--mime-type
image-format))
- "png:-")))))
+ (concat image-convert-to-format
+ ":-"))))))
;; SOURCE is a file name.
(apply #'call-process (car command)
nil t nil
(append (cdr command)
- (list (expand-file-name source) "png:-")))))
+ (list (expand-file-name source)
+ (concat image-convert-to-format
+ ":-"))))))
;; If the command failed, hopefully the buffer contains the
;; error message.
(buffer-string))))
@@ -266,14 +286,15 @@ Only suffixes that map to `image-mode' are returned."
(append
(cdr command)
(list "-i" "-"
- "-c:v" "png"
+ "-c:v" image-convert-to-format
"-f" "image2pipe" "-")))))
(apply #'call-process
(car command)
nil '(t nil) nil
(append (cdr command)
(list "-i" (expand-file-name source)
- "-c:v" "png" "-f" "image2pipe"
+ "-c:v" image-convert-to-format
+ "-f" "image2pipe"
"-")))))
"ffmpeg error when converting")))
diff --git a/lisp/imenu.el b/lisp/imenu.el
index a87860f0065..dcd816cb7a8 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -87,7 +87,7 @@ This might not yet be honored by all index-building functions."
(defcustom imenu-auto-rescan-maxout 600000
"Imenu auto-rescan is disabled in buffers larger than this size (in bytes).
Also see `imenu-max-index-time'."
- :type 'integer
+ :type 'natnum
:version "26.2")
(defcustom imenu-use-popup-menu 'on-mouse
@@ -132,7 +132,7 @@ element should come before the second. The arguments are cons cells;
(defcustom imenu-max-items 25
"Maximum number of elements in a mouse menu for Imenu."
- :type 'integer)
+ :type 'natnum)
(defcustom imenu-space-replacement "."
"The replacement string for spaces in index names.
@@ -464,14 +464,14 @@ Non-nil arguments are in recursive calls."
`(keymap ,title
,@(mapcar
(lambda (item)
- `(,(car item) ,(car item)
+ `(,(intern (car item)) ,(car item)
,@(cond
((imenu--subalist-p item)
(imenu--create-keymap (car item) (cdr item) cmd))
(t
(lambda () (interactive)
(if cmd (funcall cmd item) item))))))
- alist)))
+ (seq-filter #'identity alist))))
(defun imenu--in-alist (str alist)
"Check whether the string STR is contained in multi-level ALIST."
@@ -899,6 +899,13 @@ for more information."
(`(,name . ,pos) (imenu (list name pos imenu-default-goto-function)))
(_ (error "Unknown imenu item: %S" index-item)))))
+(defun imenu-flush-cache ()
+ "Flush the current imenu cache.
+This forces a full rescan of the buffer to recreate the index alist
+next time `imenu' is invoked."
+ (imenu--cleanup)
+ (setq imenu--index-alist nil))
+
(provide 'imenu)
;;; imenu.el ends here
diff --git a/lisp/indent.el b/lisp/indent.el
index 071f46fd42a..f52b729051d 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -89,16 +89,20 @@ This variable has no effect unless `tab-always-indent' is `complete'."
indent-relative-first-indent-point)
"Values that are ignored by `indent-according-to-mode'.")
-(defun indent-according-to-mode ()
+(defun indent-according-to-mode (&optional inhibit-widen)
"Indent line in proper way for current major mode.
Normally, this is done by calling the function specified by the
variable `indent-line-function'. However, if the value of that
variable is present in the `indent-line-ignored-functions' variable,
handle it specially (since those functions are used for tabbing);
-in that case, indent by aligning to the previous non-blank line."
+in that case, indent by aligning to the previous non-blank line.
+
+Ignore restriction, unless the optional argument INHIBIT-WIDEN is
+non-nil."
(interactive)
(save-restriction
- (widen)
+ (unless inhibit-widen
+ (widen))
(syntax-propertize (line-end-position))
(if (memq indent-line-function indent-line-ignored-functions)
;; These functions are used for tabbing, but can't be used for
@@ -167,7 +171,7 @@ prefix argument is ignored."
(let ((old-tick (buffer-chars-modified-tick))
(old-point (point))
(old-indent (current-indentation))
- (syn `(,(syntax-after (point)))))
+ (syn (syntax-after (point))))
;; Indent the line.
(or (not (eq (indent--funcall-widened indent-line-function) 'noindent))
@@ -179,21 +183,21 @@ prefix argument is ignored."
(cond
;; If the text was already indented right, try completion.
((and (eq tab-always-indent 'complete)
- (eq old-point (point))
- (eq old-tick (buffer-chars-modified-tick))
+ (eql old-point (point))
+ (eql old-tick (buffer-chars-modified-tick))
(or (null tab-first-completion)
(eq last-command this-command)
- (and (equal tab-first-completion 'eol)
+ (and (eq tab-first-completion 'eol)
(eolp))
- (and (member tab-first-completion
- '(word word-or-paren word-or-paren-or-punct))
- (not (member 2 syn)))
- (and (member tab-first-completion
- '(word-or-paren word-or-paren-or-punct))
- (not (or (member 4 syn)
- (member 5 syn))))
- (and (equal tab-first-completion 'word-or-paren-or-punct)
- (not (member 1 syn)))))
+ (and (memq tab-first-completion
+ '(word word-or-paren word-or-paren-or-punct))
+ (not (eql 2 syn)))
+ (and (memq tab-first-completion
+ '(word-or-paren word-or-paren-or-punct))
+ (not (or (eql 4 syn)
+ (eql 5 syn))))
+ (and (eq tab-first-completion 'word-or-paren-or-punct)
+ (not (eql 1 syn)))))
(completion-at-point))
;; If a prefix argument was given, rigidly indent the following
@@ -236,21 +240,23 @@ Blank lines are ignored."
(current-indentation))))
indent))))
-(defvar indent-rigidly-map
- (let ((map (make-sparse-keymap)))
- (define-key map [left] 'indent-rigidly-left)
- (define-key map [right] 'indent-rigidly-right)
- (define-key map [S-left] 'indent-rigidly-left-to-tab-stop)
- (define-key map [S-right] 'indent-rigidly-right-to-tab-stop)
- map)
- "Transient keymap for adjusting indentation interactively.
-It is activated by calling `indent-rigidly' interactively.")
+(defvar-keymap indent-rigidly-map
+ :doc "Transient keymap for adjusting indentation interactively.
+It is activated by calling `indent-rigidly' interactively."
+ "TAB" #'indent-rigidly-right
+ "<left>" #'indent-rigidly-left
+ "<right>" #'indent-rigidly-right
+ "S-<left>" #'indent-rigidly-left-to-tab-stop
+ "S-<right>" #'indent-rigidly-right-to-tab-stop)
+(put 'indent-rigidly-right :advertised-binding (kbd "<right>"))
(defun indent-rigidly (start end arg &optional interactive)
"Indent all lines starting in the region.
If called interactively with no prefix argument, activate a
transient mode in which the indentation can be adjusted interactively
by typing \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop].
+In addition, \\`TAB' is also bound (and calls `indent-rigidly-right').
+
Typing any other key exits this mode, and this key is then
acted upon as normally. If `transient-mark-mode' is enabled,
exiting also deactivates the mark.
@@ -264,11 +270,8 @@ Negative values of ARG indent backward, so you can remove all
indentation by specifying a large negative ARG."
(interactive "r\nP\np")
(if (and (not arg) interactive)
- (progn
- (message
- (substitute-command-keys
- "Indent region with \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]."))
- (set-transient-map indent-rigidly-map t #'deactivate-mark))
+ (set-transient-map indent-rigidly-map t #'deactivate-mark
+ "Indent region with %k")
(save-excursion
(goto-char end)
(setq end (point-marker))
@@ -602,7 +605,10 @@ column to indent to; if it is nil, use one of the three methods above."
(funcall indent-region-function start end)))
;; Else, use a default implementation that calls indent-line-function on
;; each line.
- (t (indent-region-line-by-line start end)))
+ (t
+ (save-restriction
+ (widen)
+ (indent-region-line-by-line start end))))
;; In most cases, reindenting modifies the buffer, but it may also
;; leave it unmodified, in which case we have to deactivate the mark
;; by hand.
@@ -616,7 +622,7 @@ column to indent to; if it is nil, use one of the three methods above."
(make-progress-reporter "Indenting region..." (point) end))))
(while (< (point) end)
(or (and (bolp) (eolp))
- (indent-according-to-mode))
+ (indent-according-to-mode t))
(forward-line 1)
(and pr (progress-reporter-update pr (point))))
(and pr (progress-reporter-done pr))
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 6742c2806b5..6c8ef091a08 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -43,6 +43,7 @@
(require 'info)
(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
(defgroup info-lookup nil
"Major mode sensitive help agent."
@@ -93,7 +94,10 @@ HELP-DATA is a HELP-TOPIC's public data set.
(HELP-MODE REGEXP IGNORE-CASE DOC-SPEC PARSE-RULE OTHER-MODES)
-HELP-MODE is a mode's symbol.
+HELP-MODE is either a mode's symbol, or a cons cell of the
+form (HELP-MODE . SYMBOL-PREFIX), where SYMBOL-PREFIX is the
+prefix (the part up to the first dash) of names of symbols whose
+documentation is specified by DOC-SPEC.
REGEXP is a regular expression matching those help items whose
documentation can be looked up via DOC-SPEC.
IGNORE-CASE is non-nil if help items are case insensitive.
@@ -123,6 +127,14 @@ OTHER-MODES is a list of cross references to other help modes.")
(defsubst info-lookup->mode-value (topic mode)
(assoc mode (info-lookup->topic-value topic)))
+(defun info-lookup--expand-info (info)
+ ;; We have a dynamic doc-spec function.
+ (when (and (null (nth 3 info))
+ (nth 6 info))
+ (setf (nth 3 info) (funcall (nth 6 info))
+ (nth 6 info) nil))
+ info)
+
(defsubst info-lookup->regexp (topic mode)
(nth 1 (info-lookup->mode-value topic mode)))
@@ -145,9 +157,15 @@ Function arguments are specified as keyword/argument pairs:
(KEYWORD . ARGUMENT)
KEYWORD is either `:topic', `:mode', `:regexp', `:ignore-case',
- `:doc-spec', `:parse-rule', or `:other-modes'.
-ARGUMENT has a value as explained in the documentation of the
- variable `info-lookup-alist'.
+ `:doc-spec', `:parse-rule', `:other-modes' or `:doc-spec-function'.
+ `:doc-spec-function' is used to compute a `:doc-spec', but instead of
+ doing so at load time, this is done when the user asks for info on
+ the mode in question.
+
+ARGUMENT is the value corresponding to KEYWORD. The meaning of the values
+is explained in the documentation of the variable `info-lookup-alist': for
+example, the value corresponding to `:topic' is documented as HELP-TOPIC,
+the value of `:mode' as HELP-MODE, etc..
If no topic or mode option has been specified, then the help topic defaults
to `symbol', and the help mode defaults to the current major mode."
@@ -161,7 +179,8 @@ for more details."
(defun info-lookup-add-help* (maybe &rest arg)
(let (topic mode regexp ignore-case doc-spec
- parse-rule other-modes keyword value)
+ parse-rule other-modes keyword value
+ doc-spec-function)
(setq topic 'symbol
mode major-mode
regexp "\\w+")
@@ -184,6 +203,8 @@ for more details."
(setq ignore-case value))
((eq keyword :doc-spec)
(setq doc-spec value))
+ ((eq keyword :doc-spec-function)
+ (setq doc-spec-function value))
((eq keyword :parse-rule)
(setq parse-rule value))
((eq keyword :other-modes)
@@ -191,7 +212,8 @@ for more details."
(t
(error "Unknown keyword \"%S\"" keyword))))
(or (and maybe (info-lookup->mode-value topic mode))
- (let* ((data (list regexp ignore-case doc-spec parse-rule other-modes))
+ (let* ((data (list regexp ignore-case doc-spec parse-rule other-modes
+ doc-spec-function))
(topic-cell (or (assoc topic info-lookup-alist)
(car (setq info-lookup-alist
(cons (cons topic nil)
@@ -258,36 +280,52 @@ system."
;;;###autoload (put 'info-lookup-symbol 'info-file "emacs")
;;;###autoload
-(defun info-lookup-symbol (symbol &optional mode)
- "Display the definition of SYMBOL, as found in the relevant manual.
-When this command is called interactively, it reads SYMBOL from the
-minibuffer. In the minibuffer, use \\<minibuffer-local-completion-map>\
-\\[next-history-element] to yank the default argument
-value into the minibuffer so you can edit it. The default symbol is the
-one found at point.
-
-With prefix arg MODE a query for the symbol help mode is offered."
+(defun info-lookup-symbol (symbol &optional mode same-window)
+ "Look up and display documentation of SYMBOL in the relevant Info manual.
+SYMBOL should be an identifier: a function or method, a macro, a variable,
+a data type, a class, etc.
+
+Interactively, prompt for SYMBOL; you can use \\<minibuffer-local-completion-map>\\[next-history-element] in the minibuffer
+to yank the default argument value into the minibuffer so you can edit it.
+The default symbol is the one found at point.
+
+MODE is the major mode whose Info manuals to search for the documentation
+of SYMBOL. It defaults to the current buffer's `major-mode'; if that
+mode doesn't have any Info manuals known to Emacs, the command will
+prompt for MODE to use, with completion. With prefix arg, the command
+always prompts for MODE.
+
+Is SAME-WINDOW, try to reuse the current window instead of
+popping up a new one."
(interactive
(info-lookup-interactive-arguments 'symbol current-prefix-arg))
- (info-lookup 'symbol symbol mode))
+ (info-lookup 'symbol symbol mode same-window))
;;;###autoload (put 'info-lookup-file 'info-file "emacs")
;;;###autoload
(defun info-lookup-file (file &optional mode)
- "Display the documentation of a file.
-When this command is called interactively, it reads FILE from the minibuffer.
-In the minibuffer, use \\<minibuffer-local-completion-map>\
-\\[next-history-element] to yank the default file name
-into the minibuffer so you can edit it.
+ "Look up and display documentation of FILE in the relevant Info manual.
+FILE should be the name of a file; a notable example is a standard header
+file that is part of the C or C++ standard library.
+
+Interactively, prompt for FILE; you can use \\<minibuffer-local-completion-map>\\[next-history-element] in the minibuffer
+to yank the default argument value into the minibuffer so you can edit it.
The default file name is the one found at point.
-With prefix arg MODE a query for the file help mode is offered."
+MODE is the major mode whose Info manuals to search for the documentation
+of FILE. It defaults to the current buffer's `major-mode'; if that
+mode doesn't have any Info manuals known to Emacs, the command will
+prompt for MODE to use, with completion. With prefix arg, the command
+always prompts for MODE."
(interactive
(info-lookup-interactive-arguments 'file current-prefix-arg))
(info-lookup 'file file mode))
(defun info-lookup-interactive-arguments (topic &optional query)
- "Read and return argument value (and help mode) for help topic TOPIC.
+ "Read and return argument value (and help mode) for help TOPIC.
+TOPIC should be any known symbol of a help topic, such as `file'
+or `symbol'. See the documentation of HELP-TOPIC in the doc
+string of `info-lookup-alist'.
If optional argument QUERY is non-nil, query for the help mode."
(let* ((mode (cond (query
(info-lookup-change-mode topic))
@@ -330,7 +368,10 @@ If optional argument QUERY is non-nil, query for the help mode."
(defun info-lookup-change-mode (topic)
(let* ((completions (mapcar (lambda (arg)
- (cons (symbol-name (car arg)) (car arg)))
+ (let ((mode-spec (car arg)))
+ (and (consp mode-spec)
+ (setq mode-spec (car mode-spec)))
+ (cons (symbol-name mode-spec) mode-spec)))
(info-lookup->topic-value topic)))
(mode (completing-read
(format "Use %s help mode: " topic)
@@ -341,11 +382,33 @@ If optional argument QUERY is non-nil, query for the help mode."
(error "No %s help available for `%s'" topic mode))
(setq info-lookup-mode mode)))
-(defun info-lookup (topic item mode)
- "Display the documentation of a help item."
+(defun info-lookup--item-to-mode (item mode)
+ (let ((spec (cons mode (car (split-string (if (stringp item)
+ item
+ (symbol-name item))
+ "-")))))
+ (if (assoc spec (cdr (assq 'symbol info-lookup-alist)))
+ spec
+ mode)))
+
+(defun info-lookup (topic item mode &optional same-window)
+ "Display the documentation of TOPIC whose name is ITEM, using MODE's manuals.
+TOPIC should be any known symbol of a help topic type, such as `file'
+or `symbol'. See the documentation of HELP-TOPIC in the doc
+string of `info-lookup-alist'.
+ITEM is the item whose documentation to search: file name if
+TOPIC is `file', a symbol if TOPIC is `symbol', etc.
+MODE is the `major-mode' whose Info manuals to search for documentation
+of ITEM; if it's nil, the function uses `info-lookup-file-name-alist'
+and the current buffer's file name to guess the mode.
+
+If SAME-WINDOW, reuse the current window. If nil, pop to a
+different window."
(or mode (setq mode (info-lookup-select-mode)))
- (or (info-lookup->mode-value topic mode)
- (error "No %s help available for `%s'" topic mode))
+ (setq mode (info-lookup--item-to-mode item mode))
+ (if-let ((info (info-lookup->mode-value topic mode)))
+ (info-lookup--expand-info info)
+ (error "No %s help available for `%s'" topic mode))
(let* ((completions (info-lookup->completions topic mode))
(ignore-case (info-lookup->ignore-case topic mode))
(entry (or (assoc (if ignore-case (downcase item) item) completions)
@@ -366,19 +429,21 @@ If optional argument QUERY is non-nil, query for the help mode."
(if (not info-lookup-other-window-flag)
(info)
(save-window-excursion (info))
- (let* ((info-window (get-buffer-window "*info*" t))
- (info-frame (and info-window (window-frame info-window))))
- (if (and info-frame
- (not (eq info-frame (selected-frame)))
- (display-multi-frame-p)
- (memq info-frame (frames-on-display-list)))
- ;; *info* is visible in another frame on same display.
- ;; Raise that frame and select the window.
- (progn
- (select-window info-window)
- (raise-frame info-frame))
- ;; In any other case, switch to *info* in another window.
- (switch-to-buffer-other-window "*info*")))))
+ (if same-window
+ (pop-to-buffer-same-window "*info*")
+ (let* ((info-window (get-buffer-window "*info*" t))
+ (info-frame (and info-window (window-frame info-window))))
+ (if (and info-frame
+ (not (eq info-frame (selected-frame)))
+ (display-multi-frame-p)
+ (memq info-frame (frames-on-display-list)))
+ ;; *info* is visible in another frame on same display.
+ ;; Raise that frame and select the window.
+ (progn
+ (select-window info-window)
+ (raise-frame info-frame))
+ ;; In any other case, switch to *info* another window.
+ (switch-to-buffer-other-window "*info*"))))))
(while (and (not found) modes)
(setq doc-spec (info-lookup->doc-spec topic (car modes)))
(while (and (not found) doc-spec)
@@ -724,6 +789,8 @@ Return nil if there is nothing appropriate in the buffer near point."
(defun info-complete (topic mode)
"Try to complete a help item."
(barf-if-buffer-read-only)
+ (when-let ((info (info-lookup->mode-value topic mode)))
+ (info-lookup--expand-info info))
(let ((data (info-lookup-completions-at-point topic mode)))
(if (null data)
(error "No %s completion available for `%s' at point" topic mode)
@@ -904,9 +971,16 @@ Return nil if there is nothing appropriate in the buffer near point."
(info-lookup-maybe-add-help
:mode 'python-mode
- :doc-spec `((,(if (Info-find-file "python3.9" t)
- "(python3.9)Index"
- "(python)Index"))))
+ ;; Debian includes Python info files, but they're version-named
+ ;; instead of having a symlink.
+ :doc-spec-function (lambda ()
+ (list
+ (list
+ (cl-loop for version from 20 downto 7
+ for name = (format "python3.%d" version)
+ if (Info-find-file name t)
+ return (format "(%s)Index" name)
+ finally return "(python)Index")))))
(info-lookup-maybe-add-help
:mode 'cperl-mode
@@ -944,6 +1018,75 @@ Return nil if there is nothing appropriate in the buffer near point."
("(cl)Function Index" nil "^ -+ .*: " "\\( \\|$\\)")
("(cl)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)")))
+(info-lookup-maybe-add-help
+ :mode 'emacs-lisp-only
+ :regexp "[^][()`'‘’,\" \t\n]+"
+ :doc-spec '(("(elisp)Index" nil "^ -+ .*: " "\\( \\|$\\)")
+ ("(cl)Function Index" nil "^ -+ .*: " "\\( \\|$\\)")
+ ("(cl)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)")))
+
+(mapc
+ (lambda (elem)
+ (let* ((prefix (car elem)))
+ (info-lookup-add-help
+ :mode (cons 'emacs-lisp-mode prefix)
+ :regexp (concat "\\b" prefix "-[^][()`'‘’,\" \t\n]+")
+ :doc-spec (cl-loop for node in (cdr elem)
+ collect
+ (list (if (string-match-p "^(" node)
+ node
+ (format "(%s)%s" prefix node))
+ nil "^ -+ .*: " "\\( \\|$\\)")))))
+ ;; Below we have a list of prefixes (used to match on symbols in
+ ;; `emacs-lisp-mode') and the nodes where the function/variable
+ ;; indices live. If the prefix is different than the name of the
+ ;; manual, then the full "(manual)Node" name has to be used.
+ '(("auth" "Function Index" "Variable Index")
+ ("autotype" "Command Index" "Variable Index")
+ ("calc" "Lisp Function Index" "Variable Index")
+ ;;("cc-mode" "Variable Index" "Command and Function Index")
+ ("dbus" "Index")
+ ("ediff" "Index")
+ ("eieio" "Function Index")
+ ("gnutls" "(emacs-gnutls)Variable Index" "(emacs-gnutls)Function Index")
+ ("mm" "(emacs-mime)Index")
+ ("epa" "Variable Index" "Function Index")
+ ("ert" "Index")
+ ("eshell" "Function and Variable Index")
+ ("eudc" "Index")
+ ("eww" "Variable Index" "Lisp Function Index")
+ ("flymake" "Index")
+ ("forms" "Index")
+ ("gnus" "Index")
+ ("htmlfontify" "Functions" "Variables & Customization")
+ ("idlwave" "Index")
+ ("ido" "Variable Index" "Function Index")
+ ("info" "Index")
+ ("mairix" "(mairix-el)Variable Index" "(mairix-el)Function Index")
+ ("message" "Index")
+ ("mh" "(mh-e)Option Index" "(mh-e)Command Index")
+ ("newsticker" "Index")
+ ("octave" "(octave-mode)Variable Index" "(octave-mode)Lisp Function Index")
+ ("org" "Variable Index" "Command and Function Index")
+ ("pgg" "Variable Index" "Function Index")
+ ("rcirc" "Variable Index" "Index")
+ ("reftex" "Index")
+ ("sasl" "Variable Index" "Function Index")
+ ("sc" "Variable Index")
+ ("semantic" "Index")
+ ("ses" "Index")
+ ("sieve" "Index")
+ ("smtpmail" "Function and Variable Index")
+ ("srecode" "Index")
+ ("tramp" "Variable Index" "Function Index")
+ ("url" "Variable Index" "Function Index")
+ ("vhdl" "(vhdl-mode)Variable Index" "(vhdl-mode)Command Index")
+ ("viper" "Variable Index" "Function Index")
+ ("vtable" "Index")
+ ("widget" "Index")
+ ("wisent" "Index")
+ ("woman" "Variable Index" "Command Index")))
+
;; docstrings talk about elisp, so have apropos-mode follow emacs-lisp-mode
(info-lookup-maybe-add-help
:mode 'apropos-mode
diff --git a/lisp/info.el b/lisp/info.el
index 739116cceac..7fdb893edc5 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -115,7 +115,9 @@ The Lisp code is executed when the node is selected.")
(defface info-menu-star
'((((class color)) :foreground "red1")
(t :underline t))
- "Face for every third `*' in an Info menu.")
+ "Face used to emphasize `*' in an Info menu.
+The face is assigned to the third, sixth, and ninth `*' for easier
+orientation. See `Info-nth-menu-item'.")
(defface info-xref
'((t :inherit link))
@@ -131,8 +133,6 @@ The Lisp code is executed when the node is selected.")
:version "22.1"
:type 'boolean)
-;; It's unfortunate that nil means no fontification, as opposed to no limit,
-;; since that differs from font-lock-maximum-size.
(defcustom Info-fontify-maximum-menu-size 400000
"Maximum size of menu to fontify if `font-lock-mode' is non-nil.
Set to nil to disable node fontification; set to t for no limit."
@@ -159,59 +159,8 @@ A header-line does not scroll with the rest of the buffer."
"Face used to highlight matches in an index entry."
:version "24.4")
-;; This is a defcustom largely so that we can get the benefit
-;; of `custom-initialize-delay'. Perhaps it would work to make it a
-;; `defvar' and explicitly give it a `standard-value' property, and
-;; call `custom-initialize-delay' on it.
-;; The value is initialized at startup time, when command-line calls
-;; `custom-reevaluate-setting' on all the defcustoms in
-;; `custom-delayed-init-variables'. This is somewhat sub-optimal, as ideally
-;; this should be done when Info mode is first invoked.
;;;###autoload
-(defcustom Info-default-directory-list
- (let* ((config-dir
- (file-name-as-directory
- ;; Self-contained NS build with info/ in the app-bundle.
- (or (and (featurep 'ns)
- (let ((dir (expand-file-name "../info" data-directory)))
- (if (file-directory-p dir) dir)))
- configure-info-directory)))
- (prefixes
- ;; Directory trees in which to look for info subdirectories
- (prune-directory-list '("/usr/local/" "/usr/" "/opt/")))
- (suffixes
- ;; Subdirectories in each directory tree that may contain info
- ;; directories.
- '("share/" ""))
- (standard-info-dirs
- (apply #'nconc
- (mapcar (lambda (pfx)
- (let ((dirs
- (mapcar (lambda (sfx)
- (concat pfx sfx "info/"))
- suffixes)))
- (prune-directory-list dirs)))
- prefixes)))
- ;; If $(prefix)/share/info is not one of the standard info
- ;; directories, they are probably installing an experimental
- ;; version of Emacs, so make sure that experimental version's Info
- ;; files override the ones in standard directories.
- (dirs
- (if (member config-dir standard-info-dirs)
- ;; FIXME? What is the point of adding it again at the end
- ;; when it is already present earlier in the list?
- (nconc standard-info-dirs (list config-dir))
- (cons config-dir standard-info-dirs))))
- (if (not (eq system-type 'windows-nt))
- dirs
- ;; Include the info directory near where Emacs executable was installed.
- (let* ((instdir (file-name-directory invocation-directory))
- (dir1 (expand-file-name "../info/" instdir))
- (dir2 (expand-file-name "../../../info/" instdir)))
- (cond ((file-exists-p dir1) (append dirs (list dir1)))
- ((file-exists-p dir2) (append dirs (list dir2)))
- (t dirs)))))
-
+(defcustom Info-default-directory-list nil
"Default list of directories to search for Info documentation files.
They are searched in the order they are given in the list.
Therefore, the directory of Info files that come with Emacs
@@ -222,15 +171,12 @@ first in this list.
Once Info is started, the list of directories to search
comes from the variable `Info-directory-list'.
-This variable `Info-default-directory-list' is used as the default
-for initializing `Info-directory-list' when Info is started, unless
-the environment variable INFOPATH is set.
-
-Although this is a customizable variable, that is mainly for technical
-reasons. Normally, you should either set INFOPATH or customize
-`Info-additional-directory-list', rather than changing this variable."
- :initialize #'custom-initialize-delay
- :type '(repeat directory))
+
+This variable is used as the default for initializing
+`Info-directory-list' when Info is started, unless the
+environment variable INFOPATH is set."
+ :type '(repeat directory)
+ :version "29.1")
(defvar Info-directory-list nil
"List of directories to search for Info documentation files.
@@ -312,7 +258,7 @@ This only has an effect if `Info-hide-note-references' is non-nil."
"Depth of breadcrumbs to display.
0 means do not display breadcrumbs."
:version "23.1"
- :type 'integer)
+ :type 'natnum)
(defcustom Info-search-whitespace-regexp "\\s-+"
"If non-nil, regular expression to match a sequence of whitespace chars.
@@ -677,6 +623,51 @@ in `Info-file-supports-index-cookies-list'."
(cdr (assoc file Info-file-supports-index-cookies-list)))
+(defun Info--default-directory-list ()
+ "Compute a directory list suitable for Info."
+ (let* ((config-dir
+ (file-name-as-directory
+ ;; Self-contained NS build with info/ in the app-bundle.
+ (or (and (featurep 'ns)
+ (let ((dir (expand-file-name "../info" data-directory)))
+ (if (file-directory-p dir) dir)))
+ configure-info-directory)))
+ (prefixes
+ ;; Directory trees in which to look for info subdirectories
+ (prune-directory-list '("/usr/local/" "/usr/" "/opt/")))
+ (suffixes
+ ;; Subdirectories in each directory tree that may contain info
+ ;; directories.
+ '("share/" ""))
+ (standard-info-dirs
+ (apply #'nconc
+ (mapcar (lambda (pfx)
+ (let ((dirs
+ (mapcar (lambda (sfx)
+ (concat pfx sfx "info/"))
+ suffixes)))
+ (prune-directory-list dirs)))
+ prefixes)))
+ ;; If $(prefix)/share/info is not one of the standard info
+ ;; directories, they are probably installing an experimental
+ ;; version of Emacs, so make sure that experimental version's Info
+ ;; files override the ones in standard directories.
+ (dirs
+ (if (member config-dir standard-info-dirs)
+ ;; FIXME? What is the point of adding it again at the end
+ ;; when it is already present earlier in the list?
+ (nconc standard-info-dirs (list config-dir))
+ (cons config-dir standard-info-dirs))))
+ (if (not (eq system-type 'windows-nt))
+ dirs
+ ;; Include the info directory near where Emacs executable was installed.
+ (let* ((instdir (file-name-directory invocation-directory))
+ (dir1 (expand-file-name "../info/" instdir))
+ (dir2 (expand-file-name "../../../info/" instdir)))
+ (cond ((file-exists-p dir1) (append dirs (list dir1)))
+ ((file-exists-p dir2) (append dirs (list dir2)))
+ (t dirs))))))
+
(defun Info-default-dirs ()
(let ((source (expand-file-name "info/" source-directory))
(sibling (if installation-directory
@@ -699,25 +690,11 @@ in `Info-file-supports-index-cookies-list'."
sibling
;; Uninstalled, builddir == srcdir
source))
- (if (or (member alternative Info-default-directory-list)
- ;; On DOS/NT, we use movable executables always,
- ;; and we must always find the Info dir at run time.
- (if (memq system-type '(ms-dos windows-nt))
- nil
- ;; Use invocation-directory for Info
- ;; only if we used it for exec-directory also.
- (not (string= exec-directory
- (expand-file-name "lib-src/"
- installation-directory))))
- (not (file-exists-p alternative)))
- Info-default-directory-list
- ;; `alternative' contains the Info files that came with this
- ;; version, so we should look there first. `Info-insert-dir'
- ;; currently expects to find `alternative' first on the list.
- (cons alternative
- ;; Don't drop the last part, it might contain non-Emacs stuff.
- ;; (reverse (cdr (reverse
- Info-default-directory-list)))) ;; )))
+ ;; `alternative' contains the Info files that came with this
+ ;; version, so we should look there first. `Info-insert-dir'
+ ;; currently expects to find `alternative' first on the list.
+ (append (cons alternative Info-default-directory-list)
+ (Info--default-directory-list))))
(defun info-initialize ()
"Initialize `Info-directory-list', if that hasn't been done yet."
@@ -928,17 +905,20 @@ find a node."
filename)))
filename))))
-(defun Info-find-node (filename nodename &optional no-going-back strict-case)
+(defun Info-find-node (filename nodename &optional no-going-back strict-case
+ noerror)
"Go to an Info node specified as separate FILENAME and NODENAME.
NO-GOING-BACK is non-nil if recovering from an error in this function;
it says do not attempt further (recursive) error recovery.
This function first looks for a case-sensitive match for NODENAME;
if none is found it then tries a case-insensitive match (unless
-STRICT-CASE is non-nil)."
+STRICT-CASE is non-nil).
+
+If NOERROR, inhibit error messages when we can't find the node."
(info-initialize)
(setq nodename (info--node-canonicalize-whitespace nodename))
- (setq filename (Info-find-file filename))
+ (setq filename (Info-find-file filename noerror))
;; Go into Info buffer.
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
;; Record the node we are leaving, if we were in one.
@@ -1792,7 +1772,46 @@ of NODENAME; if none is found it then tries a case-insensitive match
(if trim (setq nodename (substring nodename 0 trim))))
(if transient-mark-mode (deactivate-mark))
(Info-find-node (if (equal filename "") nil filename)
- (if (equal nodename "") "Top" nodename) nil strict-case)))
+ (if (equal nodename "") "Top" nodename) nil strict-case)))
+
+(defun Info-goto-node-web (node)
+ "Use `browse-url' to go to the gnu.org web server's version of NODE.
+By default, go to the current Info node."
+ (interactive (list (Info-read-node-name
+ "Go to node (default current page): " Info-current-node))
+ Info-mode)
+ (browse-url-button-open-url
+ (Info-url-for-node (format "(%s)%s" (file-name-sans-extension
+ (file-name-nondirectory
+ Info-current-file))
+ node))))
+
+(defun Info-url-for-node (node)
+ "Return a URL for NODE, a node in the GNU Emacs or Elisp manual.
+NODE should be a string on the form \"(manual)Node\". Only emacs
+and elisp manuals are supported."
+ (unless (string-match "\\`(\\(.+\\))\\(.+\\)\\'" node)
+ (error "Invalid node name %s" node))
+ (let ((manual (match-string 1 node))
+ (node (match-string 2 node)))
+ (unless (member manual '("emacs" "elisp"))
+ (error "Only emacs/elisp manuals are supported"))
+ ;; Encode a bunch of characters the way that makeinfo does.
+ (setq node
+ (mapconcat (lambda (ch)
+ (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^-
+ (<= 33 ch 47) ; !"#$%&'()*+,-./
+ (<= 58 ch 64) ; :;<=>?@
+ (<= 91 ch 96) ; [\]_`
+ (<= 123 ch 127)) ; {|}~ DEL
+ (format "_00%x" ch)
+ (char-to-string ch)))
+ node
+ ""))
+ (concat "https://www.gnu.org/software/emacs/manual/html_node/"
+ manual "/"
+ (url-hexify-string (string-replace " " "-" node))
+ ".html")))
(defvar Info-read-node-completion-table)
@@ -1804,41 +1823,22 @@ directories to search if FILENAME is not absolute; SUFFIXES is a
list of valid filename suffixes for Info files. See
`try-completion' for a description of the remaining arguments."
(setq suffixes (remove "" suffixes))
- (when (file-name-absolute-p string)
- (setq dirs (list (file-name-directory string))))
(let ((names nil)
- (names-sans-suffix nil)
- (suffix (concat (regexp-opt suffixes t) "\\'"))
- (string-dir (file-name-directory string)))
+ (suffix (concat (regexp-opt suffixes t) "\\'")))
(dolist (dir dirs)
- (unless dir
- (setq dir default-directory))
- (if string-dir (setq dir (expand-file-name string-dir dir)))
(when (file-directory-p dir)
- (dolist (file (file-name-all-completions
- (file-name-nondirectory string) dir))
- ;; If the file name has no suffix or a standard suffix,
- ;; include it.
- (and (or (null (file-name-extension file))
- (string-match suffix file))
- ;; But exclude subfiles of split Info files.
- (not (string-match "-[0-9]+\\'" file))
- ;; And exclude backup files.
- (not (string-match "~\\'" file))
- (push (if string-dir (concat string-dir file) file) names))
- ;; If the file name ends in a standard suffix,
- ;; add the unsuffixed name as a completion option.
- (when (string-match suffix file)
- (setq file (substring file 0 (match-beginning 0)))
- (push (if string-dir (concat string-dir file) file)
- names-sans-suffix)))))
- ;; If there is just one file, don't duplicate it with suffixes,
- ;; so `Info-read-node-name-1' will be able to complete a single
- ;; candidate and to add the terminating ")".
- (if (and (= (length names) 1) (= (length names-sans-suffix) 1))
- (setq names names-sans-suffix)
- (setq names (append names-sans-suffix names)))
- (complete-with-action action names string pred)))
+ (dolist (file (directory-files dir))
+ ;; If the file name has a standard suffix,
+ ;; include it (without the suffix).
+ (when (and (string-match suffix file)
+ ;; But exclude subfiles of split Info files.
+ (not (string-match "\\.info-[0-9]+" file))
+ ;; And exclude backup files.
+ (not (string-match "~\\'" file)))
+ (push (substring file 0 (match-beginning 0))
+ names)))))
+ (complete-with-action action (delete-dups (nreverse names))
+ string pred)))
(defun Info-read-node-name-1 (string predicate code)
"Internal function used by `Info-read-node-name'.
@@ -1877,7 +1877,7 @@ See `completing-read' for a description of arguments and usage."
code Info-read-node-completion-table string predicate))))
;; Arrange to highlight the proper letters in the completion list buffer.
-(defun Info-read-node-name (prompt)
+(defun Info-read-node-name (prompt &optional default)
"Read an Info node name with completion, prompting with PROMPT.
A node name can have the form \"NODENAME\", referring to a node
in the current Info file, or \"(FILENAME)NODENAME\", referring to
@@ -1885,7 +1885,8 @@ a node in FILENAME. \"(FILENAME)\" is a short format to go to
the Top node in FILENAME."
(let* ((completion-ignore-case t)
(Info-read-node-completion-table (Info-build-node-completions))
- (nodename (completing-read prompt #'Info-read-node-name-1 nil t)))
+ (nodename (completing-read prompt #'Info-read-node-name-1 nil t nil
+ 'Info-minibuf-history default)))
(if (equal nodename "")
(Info-read-node-name prompt)
nodename)))
@@ -2205,7 +2206,7 @@ and is not in the header line or a tag table."
(let ((backward (< found beg-found)))
(not
(or
- (and (not search-invisible)
+ (and (not (eq search-invisible t))
(if backward
(or (text-property-not-all found beg-found 'invisible nil)
(text-property-not-all found beg-found 'display nil))
@@ -2596,7 +2597,8 @@ new buffer."
(if (eq alt-default t) (setq alt-default str))
;; Don't add this string if it's a duplicate.
(or (assoc-string str completions t)
- (push str completions))))
+ (push str completions)))
+ (setq completions (nreverse completions)))
;; If no good default was found, try an alternate.
(or default
(setq default alt-default))
@@ -2604,12 +2606,9 @@ new buffer."
(if (eq (length completions) 1)
(setq default (car completions)))
(if completions
- (let ((input (completing-read (if default
- (concat
- "Follow reference named (default "
- default "): ")
- "Follow reference named: ")
- completions nil t)))
+ (let ((input (completing-read (format-prompt "Follow reference named"
+ default)
+ completions nil t)))
(list (if (equal input "")
default input)
current-prefix-arg))
@@ -3616,13 +3615,16 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.")
(format " (line %s)" (nth 3 entry))
"")))))))))
-(defun Info-apropos-matches (string)
+(defun Info-apropos-matches (string &optional regexp)
"Collect STRING matches from all known Info files on your system.
+If REGEXP, use regexp matching instead of literal matching.
Return a list of matches where each element is in the format
\((FILENAME INDEXTEXT NODENAME LINENUMBER))."
(unless (string= string "")
(let ((pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
- (regexp-quote string)))
+ (if regexp
+ string
+ (regexp-quote string))))
(ohist Info-history)
(ohist-list Info-history-list)
(current-node Info-current-node)
@@ -3647,9 +3649,9 @@ Return a list of matches where each element is in the format
(dolist (manual (nreverse manuals))
(message "Searching %s" manual)
(condition-case err
- (if (setq nodes (Info-index-nodes (Info-find-file manual)))
+ (if (setq nodes (Info-index-nodes (Info-find-file manual t)))
(save-excursion
- (Info-find-node manual (car nodes))
+ (Info-find-node manual (car nodes) nil nil t)
(while
(progn
(goto-char (point-min))
@@ -3676,19 +3678,22 @@ Return a list of matches where each element is in the format
(or (nreverse matches) t))))
;;;###autoload
-(defun info-apropos (string)
- "Grovel indices of all known Info files on your system for STRING.
-Build a menu of the possible matches."
- (interactive "sIndex apropos: ")
+(defun info-apropos (string &optional regexp)
+ "Search indices of all known Info files on your system for STRING.
+If REGEXP (interactively, the prefix), use a regexp match.
+
+Display a menu of the possible matches."
+ (interactive "sIndex apropos: \nP")
(if (equal string "")
(Info-find-node Info-apropos-file "Top")
- (let* ((nodes Info-apropos-nodes) nodename)
+ (let ((nodes Info-apropos-nodes)
+ nodename)
(while (and nodes (not (equal string (nth 1 (car nodes)))))
(setq nodes (cdr nodes)))
(if nodes
- (Info-find-node Info-apropos-file (car (car nodes)))
+ (Info-find-node Info-apropos-file (car (car nodes)) nil nil t)
(setq nodename (format "Index for ‘%s’" string))
- (push (list nodename string (Info-apropos-matches string))
+ (push (list nodename string (Info-apropos-matches string regexp))
Info-apropos-nodes)
(Info-find-node Info-apropos-file nodename)))))
@@ -4049,6 +4054,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "e" 'end-of-buffer)
(define-key map "f" 'Info-follow-reference)
(define-key map "g" 'Info-goto-node)
+ (define-key map "G" 'Info-goto-node-web)
(define-key map "h" 'Info-help)
;; This is for compatibility with standalone info (>~ version 5.2).
;; Though for some time, standalone info had H and h reversed.
@@ -4228,7 +4234,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(Info-history-menu e "Back in history" Info-history 'Info-history-back))
(defun Info-history-forward-menu (e)
- "Pop up the menu with a list of Info nodes visited with ‘Info-history-back’."
+ "Pop up the menu with a list of Info nodes visited with `Info-history-back'."
(interactive "e" Info-mode)
(Info-history-menu e "Forward in history" Info-history-forward 'Info-history-forward))
@@ -4278,7 +4284,8 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(substring str (match-end 0))))
(setq i (1+ i)))
(setq items
- (cons str items))))
+ (cons str items)))
+ (setq items (nreverse items)))
(while (and items (< number 9))
(setq current (car items)
items (cdr items)
@@ -4481,7 +4488,9 @@ Advanced commands:
(setq-local revert-buffer-function #'Info-revert-buffer-function)
(setq-local font-lock-defaults '(Info-mode-font-lock-keywords t t))
(Info-set-mode-line)
- (setq-local bookmark-make-record-function #'Info-bookmark-make-record))
+ (setq-local bookmark-make-record-function #'Info-bookmark-make-record)
+ (unless search-default-mode
+ (isearch-fold-quotes-mode)))
;; When an Info buffer is killed, make sure the associated tags buffer
;; is killed too.
@@ -4653,7 +4662,7 @@ the variable `Info-file-list-for-emacs'."
(defvar Info-link-keymap
(let ((keymap (make-sparse-keymap)))
(define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line)
- (define-key keymap [header-line mouse-1] 'mouse-select-window)
+ (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link)
(define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
(define-key keymap [mouse-2] 'Info-mouse-follow-link)
(define-key keymap [follow-link] 'mouse-face)
@@ -4858,9 +4867,16 @@ first line or header line, and for breadcrumb links.")
;; an end of sentence
(skip-syntax-backward " ("))
(setq other-tag
- (cond ((save-match-data (looking-back "\\(^\\| \\)see"
+ (cond ((save-match-data (looking-back "\\(^\\|[ (]\\)see"
(- (point) 4)))
"")
+ ;; We want "Also *note" to produce
+ ;; "Also see", but "See also *note" to produce
+ ;; "See also", so match case-sensitively.
+ ((save-match-data (let ((case-fold-search nil))
+ (looking-back "\\(^\\| \\)also"
+ (- (point) 5))))
+ "")
((save-match-data (looking-back "\\(^\\| \\)in"
(- (point) 3)))
"")
@@ -5402,6 +5418,7 @@ type returned by `Info-bookmark-make-record', which see."
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+(put 'Info-bookmark-jump 'bookmark-handler-type "Info")
;;;###autoload
(defun info-display-manual (manual)
@@ -5415,7 +5432,8 @@ completion alternatives to currently visited manuals."
(progn
(info-initialize)
(completing-read "Manual name: "
- (info--manual-names current-prefix-arg)
+ (info--filter-manual-names
+ (info--manual-names current-prefix-arg))
nil t))))
(let ((blist (buffer-list))
(manual-re (concat "\\(/\\|\\`\\)" manual "\\(\\.\\|\\'\\)"))
@@ -5443,6 +5461,22 @@ completion alternatives to currently visited manuals."
(info (Info-find-file manual)
(generate-new-buffer-name "*info*")))))
+(defun info--filter-manual-names (names)
+ (cl-flet ((strip (name)
+ (replace-regexp-in-string "\\([-.]info\\)?\\(\\.gz\\)?\\'"
+ "" name)))
+ (seq-uniq (sort (seq-filter
+ (lambda (name)
+ (and (not (string-match-p "info-[0-9]" name))
+ (not (member name '("./" "../" "ChangeLog"
+ "NEWS" "README")))))
+ names)
+ ;; We prefer the shorter names ("foo" over "foo.gz").
+ (lambda (s1 s2)
+ (< (length s1) (length s2))))
+ (lambda (s1 s2)
+ (equal (strip s1) (strip s2))))))
+
(defun info--manual-names (visited-only)
(let (names)
(dolist (buffer (buffer-list))
diff --git a/lisp/informat.el b/lisp/informat.el
index e7595fa541a..c126ab5b1a1 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -158,7 +158,7 @@
;;;###autoload
(defcustom Info-split-threshold 262144
"The number of characters by which `Info-split' splits an info file."
- :type 'integer
+ :type 'natnum
:version "23.1"
:group 'texinfo)
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index e23e059543d..c7d883276db 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -577,7 +577,7 @@ Return register which holds a value of the expression."
(ccl-check-register expr cmd)))
(defun ccl-compile-branch-blocks (code rrr blocks)
- "Compile BLOCKs of BRANCH statement. CODE is 'branch or 'read-branch.
+ "Compile BLOCKs of BRANCH statement. CODE is `branch' or `read-branch'.
REG is a register which holds a value of EXPRESSION part. BLOCKs
is a list of CCL-BLOCKs."
(let ((branches (length blocks))
@@ -1553,7 +1553,7 @@ MAP :=
MAP-IDs := MAP-ID ...
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer"
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
`(let ((prog ,(unwind-protect
(progn
;; To make ,(charset-id CHARSET) works well.
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 7d625d1382a..ca28222c815 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -303,7 +303,8 @@ with L, LRE, or LRO Unicode bidi character type.")
(setq charsets (cdr charsets))))
(modify-category-entry '(#x600 . #x6ff) ?b)
(modify-category-entry '(#x870 . #x8ff) ?b)
-(modify-category-entry '(#xfb50 . #xfdff) ?b)
+(modify-category-entry '(#xfb50 . #xfdcf) ?b)
+(modify-category-entry '(#xfdf0 . #xfdff) ?b)
(modify-category-entry '(#xfe70 . #xfefe) ?b)
;; Cyrillic character set (ISO-8859-5)
@@ -1440,6 +1441,10 @@ Setup `char-width-table' appropriate for non-CJK language environment."
(set-char-table-range char-script-table range 'tibetan))
'tibetan)
+;; Fix some exceptions that blocks.awk/Blocks.txt couldn't get right.
+(set-char-table-range char-script-table '(#x2ea . #x2eb) 'bopomofo)
+(set-char-table-range char-script-table #xab65 'greek)
+
;;; Setting unicode-category-table.
@@ -1493,6 +1498,9 @@ Setup `char-width-table' appropriate for non-CJK language environment."
(aset char-acronym-table #x202D "LRO") ; LEFT-TO-RIGHT OVERRIDE
(aset char-acronym-table #x202E "RLO") ; RIGHT-TO-LEFT OVERRIDE
(aset char-acronym-table #x2060 "WJ") ; WORD JOINER
+(aset char-acronym-table #x2066 "LRI") ; LEFT-TO-RIGHT ISOLATE
+(aset char-acronym-table #x2067 "RLI") ; RIGHT-TO-LEFT ISOLATE
+(aset char-acronym-table #x2069 "PDI") ; POP DIRECTIONAL ISOLATE
(aset char-acronym-table #x206A "ISS") ; INHIBIT SYMMETRIC SWAPPING
(aset char-acronym-table #x206B "ASS") ; ACTIVATE SYMMETRIC SWAPPING
(aset char-acronym-table #x206C "IAFS") ; INHIBIT ARABIC FORM SHAPING
@@ -1517,18 +1525,42 @@ Setup `char-width-table' appropriate for non-CJK language environment."
(aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
(aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
+;; We can't use the \N{name} things here, because this file is used
+;; too early in the build process.
+(defvar bidi-control-characters
+ '(#x200e ; ?\N{left-to-right mark}
+ #x200f ; ?\N{right-to-left mark}
+ #x061c ; ?\N{arabic letter mark}
+ #x202a ; ?\N{left-to-right embedding}
+ #x202b ; ?\N{right-to-left embedding}
+ #x202d ; ?\N{left-to-right override}
+ #x202e ; ?\N{right-to-left override}
+ #x2066 ; ?\N{left-to-right isolate}
+ #x2067 ; ?\N{right-to-left isolate}
+ #x2068 ; ?\N{first strong isolate}
+ #x202c ; ?\N{pop directional formatting}
+ #x2069) ; ?\N{pop directional isolate}
+ "List of bidirectional control characters.")
+
+(defun bidi-string-strip-control-characters (string)
+ "Strip bidi control characters from STRING and return the result."
+ (apply #'string (seq-filter (lambda (char)
+ (not (memq char bidi-control-characters)))
+ string)))
+
(defun update-glyphless-char-display (&optional variable value)
"Make the setting of `glyphless-char-display-control' take effect.
This function updates the char-table `glyphless-char-display',
and is intended to be used in the `:set' attribute of the
option `glyphless-char-display'."
- (when value
+ (when variable
(set-default variable value))
(dolist (elt value)
(let ((target (car elt))
(method (cdr elt)))
- (or (memq method '(zero-width thin-space empty-box acronym hex-code))
- (error "Invalid glyphless character display method: %s" method))
+ (unless (memq method '( zero-width thin-space empty-box
+ acronym hex-code bidi-control))
+ (error "Invalid glyphless character display method: %s" method))
(cond ((eq target 'c0-control)
(glyphless-set-char-table-range glyphless-char-display
#x00 #x1F method)
@@ -1543,24 +1575,28 @@ option `glyphless-char-display'."
((eq target 'variation-selectors)
(glyphless-set-char-table-range glyphless-char-display
#xFE00 #xFE0F method))
- ((eq target 'format-control)
+ ((or (eq target 'format-control)
+ (eq target 'bidi-control))
(when unicode-category-table
(map-char-table
(lambda (char category)
- (if (eq category 'Cf)
- (let ((this-method method)
- from to)
- (if (consp char)
- (setq from (car char) to (cdr char))
- (setq from char to char))
- (while (<= from to)
- (when (/= from #xAD)
- (if (eq method 'acronym)
- (setq this-method
- (aref char-acronym-table from)))
+ (when (eq category 'Cf)
+ (let ((this-method method)
+ from to)
+ (if (consp char)
+ (setq from (car char) to (cdr char))
+ (setq from char to char))
+ (while (<= from to)
+ (when (/= from #xAD)
+ (when (eq method 'acronym)
+ (setq this-method
+ (or (aref char-acronym-table from)
+ "UNK")))
+ (when (or (eq target 'format-control)
+ (memq from bidi-control-characters))
(set-char-table-range glyphless-char-display
- from this-method))
- (setq from (1+ from))))))
+ from this-method)))
+ (setq from (1+ from))))))
unicode-category-table)))
((eq target 'no-font)
(set-char-table-extra-slot glyphless-char-display 0 method))
@@ -1576,6 +1612,19 @@ option `glyphless-char-display'."
(set-char-table-range chartable (cons from to) method)))
;;; Control of displaying glyphless characters.
+(define-widget 'glyphless-char-display-method 'lazy
+ "Display method for glyphless characters."
+ :group 'mule
+ :format "%v"
+ :value 'thin-space
+ :type
+ '(choice
+ (const :tag "Don't display" zero-width)
+ (const :tag "Display as thin space" thin-space)
+ (const :tag "Display as empty box" empty-box)
+ (const :tag "Display acronym" acronym)
+ (const :tag "Display hex code in a box" hex-code)))
+
(defcustom glyphless-char-display-control
'((format-control . thin-space)
(variation-selectors . thin-space)
@@ -1594,12 +1643,17 @@ GROUP must be one of these symbols:
such as U+200C (ZWNJ), U+200E (LRM), but
excluding characters that have graphic images,
such as U+00AD (SHY).
- `variation-selectors': U+FE00..U+FE0F, used for choosing between
- glyph variations (e.g. Emoji vs Text
- presentation).
- `no-font': characters for which no suitable font is found.
- For character terminals, characters that cannot
- be encoded by `terminal-coding-system'.
+ `bidi-control': A subset of `format-control', but only characters
+ that are relevant for bidirectional formatting control,
+ like U+2069 (PDI) and U+202B (RLE).
+ `variation-selectors':
+ Characters in the range U+FE00..U+FE0F, used for
+ selecting alternate glyph presentations, such as
+ Emoji vs Text presentation, of the preceding
+ character(s).
+ `no-font': For GUI frames, characters for which no suitable
+ font is found; for text-mode frames, characters
+ that cannot be encoded by `terminal-coding-system'.
METHOD must be one of these symbols:
`zero-width': don't display.
@@ -1617,36 +1671,12 @@ function (`update-glyphless-char-display'), which updates
:version "28.1"
:type '(alist :key-type (symbol :tag "Character Group")
:value-type (symbol :tag "Display Method"))
- :options '((c0-control
- (choice (const :tag "Don't display" zero-width)
- (const :tag "Display as thin space" thin-space)
- (const :tag "Display as empty box" empty-box)
- (const :tag "Display acronym" acronym)
- (const :tag "Display hex code in a box" hex-code)))
- (c1-control
- (choice (const :tag "Don't display" zero-width)
- (const :tag "Display as thin space" thin-space)
- (const :tag "Display as empty box" empty-box)
- (const :tag "Display acronym" acronym)
- (const :tag "Display hex code in a box" hex-code)))
- (format-control
- (choice (const :tag "Don't display" zero-width)
- (const :tag "Display as thin space" thin-space)
- (const :tag "Display as empty box" empty-box)
- (const :tag "Display acronym" acronym)
- (const :tag "Display hex code in a box" hex-code)))
- (variation-selectors
- (choice (const :tag "Don't display" zero-width)
- (const :tag "Display as thin space" thin-space)
- (const :tag "Display as empty box" empty-box)
- (const :tag "Display acronym" acronym)
- (const :tag "Display hex code in a box" hex-code)))
- (no-font
- (choice (const :tag "Don't display" zero-width)
- (const :tag "Display as thin space" thin-space)
- (const :tag "Display as empty box" empty-box)
- (const :tag "Display acronym" acronym)
- (const :tag "Display hex code in a box" hex-code))))
+ :options '((c0-control glyphless-char-display-method)
+ (c1-control glyphless-char-display-method)
+ (format-control glyphless-char-display-method)
+ (bidi-control glyphless-char-display-method)
+ (variation-selectors glyphless-char-display-method)
+ (no-font (glyphless-char-display-method :value hex-code)))
:set 'update-glyphless-char-display
:group 'display)
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el
new file mode 100644
index 00000000000..4f4d4f48320
--- /dev/null
+++ b/lisp/international/emoji.el
@@ -0,0 +1,733 @@
+;;; emoji.el --- Inserting emojis -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; Author: Lars Ingebrigtsen <larsi@gnus.org>
+;; Keywords: fun
+
+;; Package-Requires: ((emacs "28.0") (transient "0.3.7"))
+;; Package-Version: 0.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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'cl-extra)
+(require 'transient)
+(require 'multisession)
+(require 'generate-lisp-file)
+
+(defgroup emoji nil
+ "Inserting Emojis."
+ :version "29.1"
+ :group 'play)
+
+(defface emoji-list-header
+ '((default :weight bold :inherit variable-pitch))
+ "Face for emoji list headers."
+ :version "29.1")
+
+(defface emoji
+ '((t :height 2.0))
+ "Face used when displaying an emoji."
+ :version "29.1")
+
+(defface emoji-with-derivations
+ '((((background dark))
+ (:background "#202020" :inherit emoji))
+ (((background light))
+ (:background "#e0e0e0" :inherit emoji)))
+ "Face for emojis that have derivations."
+ :version "29.1")
+
+(defvar emoji-alternate-names nil
+ "Alist of emojis and lists of alternate names for the emojis.
+Each element in the alist should have the emoji (as a string) as
+the first element, and the rest of the elements should be strings
+representing names. For instance:
+
+ (\"🤗\" \"hug\" \"hugging\" \"kind\")")
+
+(defvar emoji--labels nil)
+(defvar emoji--all-bases nil)
+(defvar emoji--derived nil)
+(defvar emoji--names (make-hash-table :test #'equal))
+(defvar emoji--done-derived nil)
+(define-multisession-variable emoji--recent (list "😀" "😖"))
+(defvar emoji--insert-buffer)
+
+;;;###autoload
+(defun emoji-insert ()
+ "Choose and insert an emoji glyph."
+ (interactive "*")
+ (emoji--init)
+ (unless (fboundp 'emoji--command-Emoji)
+ (emoji--define-transient))
+ (funcall (intern "emoji--command-Emoji")))
+
+;;;###autoload
+(defun emoji-recent ()
+ "Choose and insert one of the recently-used emoji glyphs."
+ (interactive "*")
+ (emoji--init)
+ (unless (fboundp 'emoji--command-Emoji)
+ (emoji--define-transient))
+ (funcall (emoji--define-transient
+ (cons "Recent" (multisession-value emoji--recent)) t)))
+
+;;;###autoload
+(defun emoji-search ()
+ "Choose and insert an emoji glyph by typing its Unicode name.
+This command prompts for an emoji name, with completion, and
+inserts it. It recognizes the Unicode Standard names of emoji,
+and also consults the `emoji-alternate-names' alist."
+ (interactive "*")
+ (emoji--init)
+ (emoji--choose-emoji))
+
+;;;###autoload
+(defun emoji-list ()
+ "List emojis and insert the one that's selected.
+Select the emoji by typing \\<emoji-list-mode-map>\\[emoji-list-select] on its picture.
+The glyph will be inserted into the buffer that was current
+when the command was invoked."
+ (interactive "*")
+ (let ((buf (current-buffer)))
+ (emoji--init)
+ (switch-to-buffer (get-buffer-create "*Emoji*"))
+ ;; Don't regenerate the buffer if it already exists -- this will
+ ;; leave point where it was the last time it was used.
+ (when (zerop (buffer-size))
+ (let ((inhibit-read-only t))
+ (emoji-list-mode)
+ (setq-local emoji--insert-buffer buf)
+ (emoji--list-generate nil (cons nil emoji--labels))
+ (goto-char (point-min))))))
+
+;;;###autoload
+(defun emoji-describe (glyph &optional interactive)
+ "Display the name of the grapheme cluster composed from GLYPH.
+GLYPH should be a string of one or more characters which together
+produce an emoji. Interactively, GLYPH is the emoji at point (it
+could also be any character, not just emoji).
+
+If called from Lisp, return the name as a string; return nil if
+the name is not known."
+ (interactive
+ (list (if (eobp)
+ (error "No glyph under point")
+ (let ((comp (find-composition (point) (1+ (point)))))
+ (if comp
+ (buffer-substring-no-properties (car comp) (cadr comp))
+ (buffer-substring-no-properties (point) (1+ (point))))))
+ t))
+ (require 'emoji-labels)
+ (if (not interactive)
+ ;; Don't return a name for non-compositions when called
+ ;; non-interactively.
+ (gethash glyph emoji--names)
+ ;; Give a name for (pretty much) any glyph, including non-emojis.
+ (let ((name (emoji--name glyph)))
+ (if (not name)
+ (message "No known name for \"%s\"" glyph)
+ (message "The name of \"%s\" is \"%s\"" glyph name)))))
+
+(defun emoji--list-generate (name alist)
+ (let ((width (/ (window-width) 5))
+ (mname (pop alist)))
+ (if (consp (car alist))
+ ;; Recurse.
+ (mapcar (lambda (elem)
+ (emoji--list-generate (if name
+ (concat name " > " mname)
+ mname)
+ elem))
+ alist)
+ ;; Output this block of emojis.
+ (insert (propertize
+ (if (zerop (length name))
+ mname
+ (concat name " > " mname))
+ 'face 'emoji-list-header)
+ "\n\n")
+ (cl-loop for i from 0
+ for glyph in alist
+ do
+ (when (and (cl-plusp i)
+ (zerop (mod i width)))
+ (insert "\n"))
+ (insert
+ (propertize
+ (emoji--fontify-glyph glyph)
+ 'emoji-glyph glyph
+ 'help-echo (emoji--name glyph))))
+ (insert "\n\n"))))
+
+(defun emoji--fontify-glyph (glyph &optional inhibit-derived)
+ (propertize glyph 'face
+ (if (and (not inhibit-derived)
+ (or (null emoji--done-derived)
+ (not (gethash glyph emoji--done-derived)))
+ (gethash glyph emoji--derived))
+ ;; If this emoji has derivations, use a special face
+ ;; to tell the user.
+ 'emoji-with-derivations
+ ;; Normal emoji.
+ 'emoji)))
+
+(defun emoji--name (glyph)
+ (or (gethash glyph emoji--names)
+ (get-char-code-property (aref glyph 0) 'name)))
+
+(defvar-keymap emoji-list-mode-map
+ "RET" #'emoji-list-select
+ "<mouse-2>" #'emoji-list-select
+ "h" #'emoji-list-help
+ "<follow-link>" 'mouse-face)
+
+(define-derived-mode emoji-list-mode special-mode "Emoji"
+ "Mode to display emojis."
+ :interactive nil
+ (setq-local truncate-lines t))
+
+(defun emoji-list-select (event)
+ "Select the emoji under point."
+ (interactive (list last-nonmenu-event) emoji-list-mode)
+ (mouse-set-point event)
+ (let ((glyph (get-text-property (point) 'emoji-glyph)))
+ (unless glyph
+ (error "No emoji under point"))
+ (let ((derived (gethash glyph emoji--derived))
+ (end-func
+ (lambda ()
+ (let ((buf emoji--insert-buffer))
+ (quit-window)
+ (if (buffer-live-p buf)
+ (switch-to-buffer buf)
+ (error "Buffer disappeared"))))))
+ (if (not derived)
+ ;; Glyph without derivations.
+ (progn
+ (emoji--add-recent glyph)
+ (funcall end-func)
+ (insert glyph))
+ ;; Pop up a transient to choose between derivations.
+ (let ((emoji--done-derived (make-hash-table :test #'equal)))
+ (setf (gethash glyph emoji--done-derived) t)
+ (funcall
+ (emoji--define-transient (cons "Choose Emoji" (cons glyph derived))
+ nil end-func)))))))
+
+(defun emoji-list-help ()
+ "Display the name of the emoji at point."
+ (interactive nil emoji-list-mode)
+ (let ((glyph (get-text-property (point) 'emoji-glyph)))
+ (unless glyph
+ (error "No emoji here"))
+ (let ((name (emoji--name glyph)))
+ (if (not name)
+ (error "Emoji name is unknown")
+ (message "%s" name)))))
+
+(defun emoji--init (&optional force inhibit-adjust)
+ (when (or (not emoji--labels)
+ force)
+ (unless force
+ (ignore-errors (require 'emoji-labels)))
+ ;; The require should define the variable, but in case the .el
+ ;; file doesn't exist (yet), parse the file now.
+ (when (or force
+ (not emoji--labels))
+ (setq emoji--derived (make-hash-table :test #'equal))
+ (emoji--parse-emoji-test)))
+ (when (and (not inhibit-adjust)
+ (not emoji--all-bases))
+ (setq emoji--all-bases (make-hash-table :test #'equal))
+ (emoji--adjust-displayable (cons "Emoji" emoji--labels))))
+
+(defvar emoji--font nil)
+
+(defun emoji--adjust-displayable (alist)
+ "Remove glyphs we don't have fonts for."
+ (let ((emoji--font nil))
+ (emoji--adjust-displayable-1 alist)))
+
+(defun emoji--adjust-displayable-1 (alist)
+ (if (consp (caddr alist))
+ (dolist (child (cdr alist))
+ (emoji--adjust-displayable-1 child))
+ (while (cdr alist)
+ (let ((glyph (cadr alist)))
+ ;; Store all the emojis for later retrieval by
+ ;; the search feature.
+ (when-let ((name (emoji--name glyph)))
+ (setf (gethash (downcase name) emoji--all-bases) glyph))
+ (if (display-graphic-p)
+ ;; Remove glyphs we don't have in graphical displays.
+ (if (let ((char (elt glyph 0)))
+ (if emoji--font
+ (font-has-char-p emoji--font char)
+ (when-let ((font (car (internal-char-font nil char))))
+ (setq emoji--font font))))
+ (setq alist (cdr alist))
+ ;; Remove the element.
+ (setcdr alist (cddr alist)))
+ ;; We don't have font info on non-graphical displays.
+ (if (let ((char (elt glyph 0)))
+ ;; FIXME. Some grapheme clusters display more or less
+ ;; correctly in the terminal, but we don't really know
+ ;; which ones. None of these display totally
+ ;; correctly, though, so should they be filtered out?
+ (char-displayable-p char))
+ (setq alist (cdr alist))
+ ;; Remove the element.
+ (setcdr alist (cddr alist))))))))
+
+(defun emoji--parse-emoji-test ()
+ (setq emoji--labels nil)
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name "../admin/unidata/emoji-test.txt"
+ data-directory))
+ (unless (re-search-forward "^# +group:" nil t)
+ (error "Can't find start of data"))
+ (beginning-of-line)
+ (setq emoji--names (make-hash-table :test #'equal))
+ (let ((derivations (make-hash-table :test #'equal))
+ (case-fold-search t)
+ (glyphs nil)
+ group subgroup)
+ (while (not (eobp))
+ (cond
+ ((looking-at "# +group: \\(.*\\)")
+ (setq group (match-string 1)
+ subgroup nil))
+ ((looking-at "# +subgroup: \\(.*\\)")
+ (setq subgroup (match-string 1)))
+ ((looking-at
+ "\\([[:xdigit:] \t]+\\); *\\([^ \t]+\\)[ \t]+#.*?E[.0-9]+ +\\(.*\\)")
+ (let* ((codes (match-string 1))
+ (qualification (match-string 2))
+ (name (match-string 3))
+ (glyph (mapconcat
+ (lambda (code)
+ (string (string-to-number code 16)))
+ (split-string codes))))
+ (push (list name qualification group subgroup glyph) glyphs))))
+ (forward-line 1))
+ ;; We sort the data so that the "person foo" variant comes
+ ;; first, so that that becomes the key.
+ (setq glyphs
+ (sort (nreverse glyphs)
+ (lambda (g1 g2)
+ (and (equal (nth 2 g1) (nth 2 g2))
+ (equal (nth 3 g1) (nth 3 g2))
+ (< (emoji--score (car g1))
+ (emoji--score (car g2)))))))
+ ;; Get the derivations.
+ (cl-loop for (name qualification group subgroup glyph) in glyphs
+ for base = (emoji--base-name name derivations)
+ do
+ ;; Special-case flags.
+ (when (equal base "flag")
+ (setq base name))
+ ;; Register all glyphs to that we can look up their names
+ ;; later.
+ (setf (gethash glyph emoji--names) name)
+ ;; For the interface, we only care about the fully qualified
+ ;; emojis.
+ (when (equal qualification "fully-qualified")
+ (when (equal base name)
+ (emoji--add-to-group group subgroup glyph))
+ ;; Create mapping from base glyph name to name of
+ ;; derived glyphs.
+ (setf (gethash base derivations)
+ (nconc (gethash base derivations) (list glyph)))))
+ ;; Finally create the mapping from the base glyphs to derived ones.
+ (setq emoji--derived (make-hash-table :test #'equal))
+ (maphash (lambda (_k v)
+ (setf (gethash (car v) emoji--derived)
+ (cdr v)))
+ derivations))))
+
+(defun emoji--score (string)
+ (if (string-match-p "person\\|people"
+ (replace-regexp-in-string ":.*" "" string))
+ 0
+ 1))
+
+(defun emoji--add-to-group (group subgroup glyph)
+ ;; "People & Body" is very large; split it up.
+ (cond
+ ((equal group "People & Body")
+ (if (or (string-match "\\`person" subgroup)
+ (equal subgroup "family"))
+ (emoji--add-glyph glyph "People"
+ (if (equal subgroup "family")
+ (list subgroup)
+ ;; Avoid "Person person".
+ (cdr (emoji--split-subgroup subgroup))))
+ (emoji--add-glyph glyph "Body" (emoji--split-subgroup subgroup))))
+ ;; "Smileys & Emotion" also seems sub-optimal.
+ ((equal group "Smileys & Emotion")
+ (if (equal subgroup "emotion")
+ (emoji--add-glyph glyph "Emotion" nil)
+ (let ((subs (emoji--split-subgroup subgroup)))
+ ;; Remove one level of menus in the face case.
+ (when (equal (car subs) "face")
+ (pop subs))
+ (emoji--add-glyph glyph "Smileys" subs))))
+ ;; Don't modify the rest.
+ (t
+ (emoji--add-glyph glyph group (emoji--split-subgroup subgroup)))))
+
+(defun emoji--generate-file (&optional file)
+ "Generate an .el file with emoji mapping data and write it to FILE."
+ ;; Running from Makefile.
+ (unless file
+ (setq file (pop command-line-args-left)))
+ (emoji--init t t)
+ ;; Weed out the elements that are empty.
+ (let ((glyphs nil))
+ (maphash (lambda (k v)
+ (unless v
+ (push k glyphs)))
+ emoji--derived)
+ (dolist (glyph glyphs)
+ (remhash glyph emoji--derived)))
+ (with-temp-buffer
+ (generate-lisp-file-heading file 'emoji--generate-file)
+ (insert ";; Copyright © 1991-2021 Unicode, Inc.
+;; Generated from Unicode data files by emoji.el.
+;; The source for this file is found in the admin/unidata/emoji-test.txt
+;; file in the Emacs sources. The Unicode data files are used under the
+;; Unicode Terms of Use, as contained in the file copyright.html in that
+;; same directory.\n\n")
+ (dolist (var '(emoji--labels emoji--derived emoji--names))
+ (insert (format "(defconst %s '" var))
+ (pp (symbol-value var) (current-buffer))
+ (insert (format "\n) ;; End %s\n\n" var)))
+ (generate-lisp-file-trailer file)
+ (write-region (point-min) (point-max) file)))
+
+(defun emoji--base-name (name derivations)
+ (let* ((base (replace-regexp-in-string ":.*" "" name)))
+ (catch 'found
+ ;; If we have (for instance) "person golfing", and we're adding
+ ;; "man golfing", make the latter a derivation of the former.
+ (let ((non-binary (replace-regexp-in-string
+ "\\`\\(m[ae]n\\|wom[ae]n\\) " "" base)))
+ (dolist (prefix '("person " "people " ""))
+ (let ((key (concat prefix non-binary)))
+ (when (gethash key derivations)
+ (throw 'found key)))))
+ ;; We can also have the gender at the end of the string, like
+ ;; "merman" and "pregnant woman".
+ (let ((non-binary (replace-regexp-in-string
+ "\\(m[ae]n\\|wom[ae]n\\|maid\\)\\'" "" base)))
+ (dolist (suffix '(" person" "person" ""))
+ (let ((key (concat non-binary suffix)))
+ (when (gethash key derivations)
+ (throw 'found key)))))
+ ;; Just return the base.
+ base)))
+
+(defun emoji--split-subgroup (subgroup)
+ (let ((prefixes '("face" "hand" "person" "animal" "plant"
+ "food" "place")))
+ (cond
+ ((string-match (concat "\\`" (regexp-opt prefixes) "-") subgroup)
+ ;; Split these subgroups into hierarchies.
+ (list (substring subgroup 0 (1- (match-end 0)))
+ (substring subgroup (match-end 0))))
+ ((equal subgroup "person")
+ (list "person" "age"))
+ (t
+ (list subgroup)))))
+
+(defun emoji--add-glyph (glyph main subs)
+ (let (parent elem)
+ ;; Useless category.
+ (unless (member main '("Component"))
+ (unless (setq parent (assoc main emoji--labels))
+ (setq emoji--labels (append emoji--labels
+ (list (setq parent (list main))))))
+ (setq elem parent)
+ (while subs
+ (unless (setq elem (assoc (car subs) parent))
+ (nconc parent (list (setq elem (list (car subs))))))
+ (pop subs)
+ (setq parent elem))
+ (nconc elem (list glyph)))))
+
+(defun emoji--define-transient (&optional alist inhibit-derived
+ end-function)
+ (unless alist
+ (setq alist (cons "Emoji" emoji--labels)))
+ (let* ((mname (pop alist))
+ (name (intern (format "emoji--command-%s" mname)))
+ (emoji--done-derived (or emoji--done-derived
+ (make-hash-table :test #'equal)))
+ (has-subs (consp (cadr alist)))
+ (layout
+ (if has-subs
+ ;; Define sub-maps.
+ (cl-loop for entry in
+ (emoji--compute-prefix
+ (if (equal mname "Emoji")
+ (cons (list "Recent") alist)
+ alist))
+ collect (list
+ (car entry)
+ (emoji--compute-name (cdr entry))
+ (if (equal (cadr entry) "Recent")
+ (emoji--recent-transient end-function)
+ (emoji--define-transient
+ (cons (concat mname " > " (cadr entry))
+ (cddr entry))))))
+ ;; Insert an emoji.
+ (cl-loop for glyph in alist
+ for i in (append (number-sequence ?a ?z)
+ (number-sequence ?A ?Z)
+ (number-sequence ?0 ?9)
+ (number-sequence ?! ?/))
+ collect (let ((this-glyph glyph))
+ (list
+ (string i)
+ (emoji--fontify-glyph
+ glyph inhibit-derived)
+ (let ((derived
+ (and (not inhibit-derived)
+ (not (gethash glyph
+ emoji--done-derived))
+ (gethash glyph emoji--derived))))
+ (if derived
+ ;; We have a derived glyph, so add
+ ;; another level.
+ (progn
+ (setf (gethash glyph
+ emoji--done-derived)
+ t)
+ (emoji--define-transient
+ (cons (concat mname " " glyph)
+ (cons glyph derived))
+ t end-function))
+ ;; Insert the emoji.
+ (lambda ()
+ (interactive nil not-a-mode)
+ ;; Allow switching to the correct
+ ;; buffer.
+ (when end-function
+ (funcall end-function))
+ (emoji--add-recent this-glyph)
+ (insert this-glyph)))))))))
+ (args (apply #'vector mname
+ (emoji--columnize layout
+ (if has-subs 2 8)))))
+ ;; There's probably a better way to do this...
+ (setf (symbol-function name)
+ (lambda ()
+ (interactive nil not-a-mode)
+ (transient-setup name)))
+ (pcase-let ((`(,class ,slots ,suffixes ,docstr ,_body)
+ (transient--expand-define-args (list args))))
+ (put name 'interactive-only t)
+ (put name 'function-documentation docstr)
+ (put name 'transient--prefix
+ (apply (or class 'transient-prefix) :command name
+ (cons :variable-pitch (cons t slots))))
+ (put name 'transient--layout
+ (cl-mapcan (lambda (s) (transient--parse-child name s))
+ suffixes)))
+ name))
+
+(defun emoji--recent-transient (end-function)
+ "Create a function to display a dynamically generated menu."
+ (lambda ()
+ (interactive)
+ (funcall (emoji--define-transient
+ (cons "Recent" (multisession-value emoji--recent))
+ t end-function))))
+
+(defun emoji--add-recent (glyph)
+ "Add GLYPH to the set of recently used emojis."
+ (let ((recent (multisession-value emoji--recent)))
+ (setq recent (delete glyph recent))
+ (push glyph recent)
+ ;; Shorten the list.
+ (when-let ((tail (nthcdr 30 recent)))
+ (setcdr tail nil))
+ (setf (multisession-value emoji--recent) recent)))
+
+(defun emoji--columnize (list columns)
+ "Split LIST into COLUMN columns."
+ (cl-loop with length = (ceiling (/ (float (length list)) columns))
+ for i upto columns
+ for part on list by (lambda (l) (nthcdr length l))
+ collect (apply #'vector (seq-take part length))))
+
+(defun emoji--compute-prefix (alist)
+ "Compute characters to use for entries in ALIST.
+We prefer the earliest unique letter."
+ (cl-loop with taken = (make-hash-table)
+ for entry in alist
+ for name = (car entry)
+ collect (cons (cl-loop for char across (concat
+ (downcase name)
+ (upcase name))
+ while (gethash char taken)
+ finally (progn
+ (setf (gethash char taken) t)
+ (cl-return (string char))))
+ entry)))
+
+(defun emoji--compute-name (entry)
+ "Add example emojis to the name."
+ (let* ((name (concat (car entry) " "))
+ (children (emoji--flatten entry))
+ (length (length name))
+ (max 30))
+ (cl-loop for i from 0 upto 20
+ ;; Choose from all the children.
+ while (< length max)
+ do (cl-loop for child in children
+ for glyph = (elt child i)
+ while (< length max)
+ when glyph
+ do (setq name (concat name glyph)
+ length (+ length 2))))
+ (if (= (length name) max)
+ ;; Make an ellipsis signal that we've not exhausted the
+ ;; possibilities.
+ (concat name "…")
+ name)))
+
+(defun emoji--flatten (alist)
+ (pop alist)
+ (if (consp (cadr alist))
+ (cl-loop for child in alist
+ append (emoji--flatten child))
+ (list alist)))
+
+(defun emoji--split-long-lists (alist)
+ (let ((whole alist))
+ (pop alist)
+ (if (consp (cadr alist))
+ ;; Descend.
+ (cl-loop for child in alist
+ do (emoji--split-long-lists child))
+ ;; We have a list.
+ (when (length> alist 77)
+ (setcdr whole
+ (cl-loop for prefix from ?a
+ for bit on alist by (lambda (l) (nthcdr 77 l))
+ collect (cons (concat (string prefix) "-group")
+ (seq-take bit 77))))))))
+
+(defun emoji--choose-emoji ()
+ ;; Use the list of names.
+ (let* ((table
+ (if (not emoji-alternate-names)
+ ;; If we don't have alternate names, do the efficient version.
+ emoji--all-bases
+ ;; Compute all the (possibly non-unique) names.
+ (let ((table nil))
+ (maphash
+ (lambda (name glyph)
+ (push (concat name "\t" glyph) table))
+ emoji--all-bases)
+ (dolist (elem emoji-alternate-names)
+ (dolist (name (cdr elem))
+ (push (concat name "\t" (car elem)) table)))
+ (sort table #'string<))))
+ (name
+ (completing-read
+ "Insert emoji: "
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ (list 'metadata
+ (cons
+ 'affixation-function
+ ;; Add the glyphs to the start of the displayed
+ ;; strings when TAB-ing.
+ (lambda (strings)
+ (mapcar
+ (lambda (name)
+ (if emoji-alternate-names
+ (list name "" "")
+ (list name
+ (concat
+ (or (gethash name emoji--all-bases) " ")
+ "\t")
+ "")))
+ strings))))
+ (complete-with-action action table string pred)))
+ nil t)))
+ (when (cl-plusp (length name))
+ (let* ((glyph (if emoji-alternate-names
+ (cadr (split-string name "\t"))
+ (gethash name emoji--all-bases)))
+ (derived (gethash glyph emoji--derived)))
+ (if (not derived)
+ ;; Simple glyph with no derivations.
+ (progn
+ (emoji--add-recent glyph)
+ (insert glyph))
+ ;; Choose a derived version.
+ (let ((emoji--done-derived (make-hash-table :test #'equal)))
+ (setf (gethash glyph emoji--done-derived) t)
+ (funcall
+ (emoji--define-transient
+ (cons "Choose Emoji" (cons glyph derived))))))))))
+
+(defvar-keymap emoji-zoom-map
+ "+" #'emoji-zoom-increase
+ "-" #'emoji-zoom-decrease)
+
+;;;###autoload
+(defun emoji-zoom-increase (&optional factor)
+ "Increase the size of the character under point.
+FACTOR is the multiplication factor for the size."
+ (interactive)
+ (set-transient-map emoji-zoom-map t nil "Zoom with %k")
+ (let* ((factor (or factor 1.1))
+ (old (get-text-property (point) 'face))
+ (height (or (and (consp old)
+ (plist-get old :height))
+ 1.0))
+ (inhibit-read-only t))
+ (with-silent-modifications
+ (if (consp old)
+ (add-text-properties
+ (point) (1+ (point))
+ (list 'face (plist-put (copy-sequence old) :height (* height factor))
+ 'rear-nonsticky t))
+ (add-face-text-property (point) (1+ (point))
+ (list :height (* height factor)))
+ (put-text-property (point) (1+ (point))
+ 'rear-nonsticky t)))))
+
+;;;###autoload
+(defun emoji-zoom-decrease ()
+ "Decrease the size of the character under point."
+ (interactive)
+ (emoji-zoom-increase 0.9))
+
+(provide 'emoji)
+
+;;; emoji.el ends here
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 31ffaf157b6..8d34aa99c39 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -182,8 +182,21 @@
(canadian-aboriginal #x14C0)
(ogham #x168F)
(runic #x16A0)
+ (tagalog #x1700)
+ (hanunoo #x1720)
+ (buhid #x1740)
+ (tagbanwa #x1760)
(khmer #x1780)
(mongolian #x1826)
+ (limbu #x1901 #x1920 #x1936)
+ (buginese #x1A00 #x1A1E)
+ (balinese #x1B13 #x1B35 #x1B5E)
+ (sundanese #x1B8A #x1BAB #x1CC4)
+ (batak #x1BC2 #x1BE7 #x1BFF)
+ (lepcha #x1C00 #x1C24 #x1C40)
+ (tai-le #x1950)
+ (tai-lue #x1980)
+ (tai-tham #x1A20 #x1A55 #x1A61 #x1A80)
(symbol . [#x201C #x2200 #x2500])
(braille #x2800)
(ideographic-description #x2FF0)
@@ -193,9 +206,12 @@
(kanbun #x319D)
(han #x5B57)
(yi #xA288)
- (javanese #xA980)
+ (syloti-nagri #xA807 #xA823 #xA82C)
+ (rejang #xA930 #xA947 #xA95F)
+ (javanese #xA98F #xA9B4 #xA9CA)
(cham #xAA00)
(tai-viet #xAA80)
+ (meetei-mayek #xABC0 #xABE3 #xAAE0 #xAAF6)
(hangul #xAC00)
(linear-b #x10000)
(aegean-number #x10100)
@@ -223,22 +239,24 @@
(lydian #x10920)
(kharoshthi #x10A00)
(manichaean #x10AC0)
- (hanifi-rohingya #x10D00)
+ (hanifi-rohingya #x10D00 #x10D24 #x10D39)
(yezidi #x10E80)
(old-sogdian #x10F00)
(sogdian #x10F30)
(chorasmian #x10FB0)
(elymaic #x10FE0)
(old-uyghur #x10F70)
+ (brahmi #x11013 #x11045 #x11052 #x11065)
+ (kaithi #x1108D #x110B0 #x110BD)
(mahajani #x11150)
- (sinhala-archaic-number #x111E1)
+ (sharada #x11191 #x111B3 #x111CD)
(khojki #x11200)
(khudawadi #x112B0)
- (grantha #x11305)
+ (grantha #x11315 #x1133E #x11374)
(newa #x11400)
- (tirhuta #x11481)
- (siddham #x11580)
- (modi #x11600)
+ (tirhuta #x11481 #x1148F #x114D0)
+ (siddham #x1158E #x115AF #x115D4)
+ (modi #x1160E #x11630 #x11655)
(takri #x11680)
(dogra #x11800)
(warang-citi #x118A1)
@@ -251,9 +269,8 @@
(marchen #x11C72)
(masaram-gondi #x11D00)
(gunjala-gondi #x11D60)
- (makasar #x11EE0)
+ (makasar #x11EE0 #x11EF7)
(cuneiform #x12000)
- (cuneiform-numbers-and-punctuation #x12400)
(cypro-minoan #x12F90)
(egyptian #x13000)
(mro #x16A40)
@@ -262,7 +279,6 @@
(pahawh-hmong #x16B11)
(medefaidrin #x16E40)
(tangut #x17000)
- (tangut-components #x18800)
(khitan-small-script #x18B00)
(nushu #x1B170)
(duployan-shorthand #x1BC20)
@@ -285,7 +301,7 @@
(defvar otf-script-alist)
-;; The below was synchronized with the latest Oct 8, 2020 version of
+;; The below was synchronized with the latest Sep 12, 2021 version of
;; https://docs.microsoft.com/en-us/typography/opentype/spec/scripttags
(setq otf-script-alist
'((adlm . adlam)
@@ -318,6 +334,7 @@
(copt . coptic)
(xsux . cuneiform)
(cprt . cypriot)
+ (cpmn . cypro-minoan)
(cyrl . cyrillic)
(dsrt . deseret)
(deva . devanagari)
@@ -341,7 +358,7 @@
(gur2 . gurmukhi)
(hani . han)
(hang . hangul)
- (jamo . hangul)
+ (jamo . hangul) ; Not recommended; use 'hang' instead.
(rohg . hanifi-rohingya)
(hano . hanunoo)
(hatr . hatran)
@@ -364,8 +381,8 @@
(latn . latin)
(lepc . lepcha)
(limb . limbu)
- (lina . linear_a)
- (linb . linear_b)
+ (lina . linear-a)
+ (linb . linear-b)
(lisu . lisu)
(lyci . lycian)
(lydi . lydian)
@@ -391,6 +408,7 @@
(musc . musical-symbol)
(mym2 . burmese)
(mymr . burmese)
+ (nand . nandinagari)
(nbat . nabataean)
(newa . newa)
(nko\ . nko)
@@ -405,6 +423,7 @@
(sogo . old-sogdian)
(sarb . old-south-arabian)
(orkh . old-turkic)
+ (ougr . old-uyghur)
(orya . oriya)
(ory2 . oriya)
(osge . osage)
@@ -430,17 +449,18 @@
(sora . sora-sompeng)
(soyo . soyombo)
(sund . sundanese)
- (sylo . syloti_nagri)
+ (sylo . syloti-nagri)
(syrc . syriac)
(tglg . tagalog)
(tagb . tagbanwa)
- (tale . tai_le)
+ (tale . tai-le)
(talu . tai-lue)
(lana . tai-tham)
(tavt . tai-viet)
(takr . takri)
(taml . tamil)
(tml2 . tamil)
+ (tnsa . tangsa)
(tang . tangut)
(telu . telugu)
(tel2 . telugu)
@@ -449,7 +469,9 @@
(tibt . tibetan)
(tfng . tifinagh)
(tirh . tirhuta)
+ (toto . toto)
(ugar . ugaritic)
+ (vith . vithkuqi)
(vai\ . vai)
(wcho . wancho)
(wara . warang-citi)
@@ -738,11 +760,24 @@
cham
ogham
runic
+ tagalog
+ hanunoo
+ buhid
+ tagbanwa
+ limbu
+ buginese
+ balinese
+ sundanese
+ batak
+ lepcha
symbol
braille
yi
+ syloti-nagri
+ rejang
javanese
tai-viet
+ meetei-mayek
aegean-number
ancient-greek-number
ancient-symbol
@@ -760,15 +795,22 @@
cypriot-syllabary
phoenician
lydian
+ hanifi-rohingya
yezidi
kharoshthi
manichaean
chorasmian
elymaic
old-uyghur
+ brahmi
+ kaithi
+ sharada
+ grantha
+ tirhuta
+ siddham
+ modi
makasar
dives-akuru
- cuneiform-numbers-and-punctuation
cuneiform
egyptian
tangsa
@@ -783,6 +825,7 @@
counting-rod-numeral
toto
adlam
+ tai-tham
mahjong-tile
domino-tile
emoji))
@@ -816,11 +859,16 @@
(#x1D7EC #x1D7F5 mathematical-sans-serif-bold)
(#x1D7F6 #x1D7FF mathematical-monospace)))
(let ((slot (assq (nth 2 math-subgroup) script-representative-chars)))
+ ;; Add both ends of each subgroup to help filter out some
+ ;; incomplete fonts, e.g. those that cover MATHEMATICAL SCRIPT
+ ;; CAPITAL glyphs but not MATHEMATICAL SCRIPT SMALL ones.
(if slot
- (if (vectorp (cdr slot))
- (setcdr slot (vconcat (cdr slot) (vector (car math-subgroup))))
- (setcdr slot (vector (cadr slot) (car math-subgroup))))
- (setq slot (list (nth 2 math-subgroup) (car math-subgroup)))
+ (setcdr slot (append (list (nth 0 math-subgroup)
+ (nth 1 math-subgroup))
+ (cdr slot)))
+ (setq slot (list (nth 2 math-subgroup)
+ (nth 0 math-subgroup)
+ (nth 1 math-subgroup)))
(nconc script-representative-chars (list slot))))
(set-fontset-font
"fontset-default"
@@ -930,6 +978,13 @@
(set-fontset-font "fontset-default" 'emoji
'("Noto Color Emoji" . "iso10646-1") nil 'prepend)
+ ;; This supports the display of Tamil Supplement characters. As
+ ;; these characters are pretty simple and do not need reordering,
+ ;; ligatures, vowel signs, virama etc., neither tml2 nor other OTF
+ ;; features are needed here.
+ (set-fontset-font "fontset-default" '(#x11FC0 . #x11FFF)
+ '("Noto Sans Tamil Supplement" . "iso10646-1") nil 'append)
+
;; Append CJK fonts for characters other than han, kana, cjk-misc.
;; Append fonts for scripts whose name is also a charset name.
(let* ((data (build-default-fontset-data))
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index 92bdee86879..90fdc06b1e4 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -86,33 +86,50 @@
("\"y" . [?ÿ])
("''" . [?´])
("'A" . [?Á])
+ ("'C" . [?Ć])
("'E" . [?É])
("'I" . [?Í])
+ ("'N" . [?Ń])
("'O" . [?Ó])
+ ("'S" . [?Ś])
("'U" . [?Ú])
("'Y" . [?Ý])
+ ("'Z" . [?Ź])
("'a" . [?á])
+ ("'c" . [?ć])
("'e" . [?é])
("'i" . [?í])
+ ("'n" . [?ń])
("'o" . [?ó])
+ ("'s" . [?ś])
("'u" . [?ú])
("'y" . [?ý])
+ ("'z" . [?ź])
("*$" . [?¤])
("$" . [?¤])
("*+" . [?±])
("+" . [?±])
(",," . [?¸])
+ (",A" . [?Ą])
(",C" . [?Ç])
+ (",N" . [?Ņ])
+ (",S" . [?Ş])
+ (",a" . [?ą])
(",c" . [?ç])
+ (",n" . [?ņ])
+ (",s" . [?ş])
("*-" . [?­])
("-" . [?­])
("*." . [?·])
- ("." . [?·])
+ (".." . [?·])
+ (".z" . [?ż])
("//" . [?÷])
("/A" . [?Å])
+ ("/L" . [?Ł])
("/E" . [?Æ])
("/O" . [?Ø])
("/a" . [?å])
+ ("/l" . [?ł])
("/e" . [?æ])
("/o" . [?ø])
("1/2" . [?½])
@@ -121,7 +138,23 @@
("*<" . [?«])
("<" . [?«])
("*=" . [?¯])
- ("=" . [?¯])
+ ("==" . [?¯])
+ ("=A" . [?Ā])
+ ("=a" . [?ā])
+ ("=E" . [?Ē])
+ ("=e" . [?ē])
+ ("=/E" . [?Ǣ])
+ ("=/e" . [?ǣ])
+ ("=G" . [?Ḡ])
+ ("=g" . [?ḡ])
+ ("=I" . [?Ī])
+ ("=i" . [?ī])
+ ("=O" . [?Ō])
+ ("=o" . [?ō])
+ ("=U" . [?Ū])
+ ("=u" . [?ū])
+ ("=Y" . [?Ȳ])
+ ("=y" . [?ȳ])
("*>" . [?»])
(">" . [?»])
("*?" . [?¿])
@@ -136,11 +169,34 @@
("R" . [?®])
("*S" . [?§])
("S" . [?§])
+ ("*T" . [?™])
+ ("T" . [?™])
("*Y" . [?¥])
("Y" . [?¥])
+ ("^0" . [?⁰])
("^1" . [?¹])
("^2" . [?²])
("^3" . [?³])
+ ("^4" . [?⁴])
+ ("^5" . [?⁵])
+ ("^6" . [?⁶])
+ ("^7" . [?⁷])
+ ("^8" . [?⁸])
+ ("^9" . [?⁹])
+ ("^+" . [?⁺])
+ ("^-" . [?⁻])
+ ("_0" . [?₀])
+ ("_1" . [?₁])
+ ("_2" . [?₂])
+ ("_3" . [?₃])
+ ("_4" . [?₄])
+ ("_5" . [?₅])
+ ("_6" . [?₆])
+ ("_7" . [?₇])
+ ("_8" . [?₈])
+ ("_9" . [?₉])
+ ("_+" . [?₊])
+ ("_-" . [?₋])
("^A" . [?Â])
("^E" . [?Ê])
("^I" . [?Î])
@@ -151,6 +207,30 @@
("^i" . [?î])
("^o" . [?ô])
("^u" . [?û])
+ ("^^A" . [?Ǎ])
+ ("^^C" . [?Č])
+ ("^^E" . [?Ě])
+ ("^^G" . [?Ǧ])
+ ("^^I" . [?Ǐ])
+ ("^^K" . [?Ǩ])
+ ("^^N" . [?Ň])
+ ("^^O" . [?Ǒ])
+ ("^^R" . [?Ř])
+ ("^^S" . [?Š])
+ ("^^U" . [?Ǔ])
+ ("^^Z" . [?Ž])
+ ("^^a" . [?ǎ])
+ ("^^c" . [?č])
+ ("^^e" . [?ě])
+ ("^^g" . [?ǧ])
+ ("^^i" . [?ǐ])
+ ("^^k" . [?ǩ])
+ ("^^n" . [?ň])
+ ("^^o" . [?ǒ])
+ ("^^r" . [?ř])
+ ("^^s" . [?š])
+ ("^^u" . [?ǔ])
+ ("^^z" . [?ž])
("_a" . [?ª])
("_o" . [?º])
("`A" . [?À])
@@ -169,10 +249,10 @@
("o" . [?°])
("Oe" . [?œ])
("OE" . [?Œ])
- ("*u" . [?µ])
- ("u" . [?µ])
- ("*m" . [?µ])
- ("m" . [?µ])
+ ("*u" . [?μ])
+ ("u" . [?μ])
+ ("*m" . [?μ])
+ ("m" . [?μ])
("*x" . [?×])
("x" . [?×])
("*|" . [?¦])
@@ -294,6 +374,14 @@ sequence VECTOR. (VECTOR is normally one character long.)")
(setq alist (cdr alist))))
(defun iso-transl-set-language (lang)
+ "Set shorter key bindings for some characters relevant for LANG.
+This affects the \\`C-x 8' prefix.
+
+Note that only a few languages are supported, and for more
+rigorous support it is recommended to use an input method
+instead. Also note that many of these characters can be input
+with the regular \\`C-x 8' map without having to specify a language
+here."
(interactive (list (let ((completion-ignore-case t))
(completing-read "Set which language? "
iso-transl-language-alist nil t))))
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 704f1a1ae62..ec68d8c8046 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -44,6 +44,8 @@
;;; Code:
+(require 'generate-lisp-file)
+
;; Name of a file to generate from SKK dictionary.
(defvar ja-dic-filename "ja-dic.el")
@@ -295,7 +297,7 @@
(setq skkdic-okuri-nasi-entries-count (length skkdic-okuri-nasi-entries))
(progress-reporter-done progress))))
-(defun skkdic-convert-okuri-nasi (skkbuf buf)
+(defun skkdic-convert-okuri-nasi (skkbuf buf &optional no-reduction)
(with-current-buffer buf
(insert ";; Setting okuri-nasi entries.\n"
"(skkdic-set-okuri-nasi\n")
@@ -311,7 +313,9 @@
(setq count (1+ count))
(progress-reporter-update progress count)
(if (setq candidates
- (skkdic-reduced-candidates skkbuf kana candidates))
+ (if no-reduction
+ candidates
+ (skkdic-reduced-candidates skkbuf kana candidates)))
(progn
(insert "\"" kana)
(while candidates
@@ -322,10 +326,11 @@
(progress-reporter-done progress))
(insert ")\n\n")))
-(defun skkdic-convert (filename &optional dirname)
+(defun skkdic-convert (filename &optional dirname no-reduction)
"Generate Emacs Lisp file from Japanese dictionary file FILENAME.
The format of the dictionary file should be the same as SKK dictionaries.
-Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
+Saves the output as `ja-dic-filename', in directory DIRNAME (if specified).
+If NO-REDUCTION is non-nil, do not reduce the dictionary vocabulary."
(interactive "FSKK dictionary file: ")
(let* ((skkbuf (get-buffer-create " *skkdic-unannotated*"))
(buf (get-buffer-create "*skkdic-work*")))
@@ -335,18 +340,15 @@ Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
(insert-file-contents (expand-file-name filename)))
(re-search-forward "^[^;]")
(while (re-search-forward ";[^\n/]*/" nil t)
- (replace-match "/")))
+ (replace-match "/" t t)))
;; Setup and generate the header part of working buffer.
(with-current-buffer buf
(erase-buffer)
(buffer-disable-undo)
- (insert ";;; ja-dic.el --- dictionary for Japanese input method"
- " -*- lexical-binding:t -*-\n"
- ";;\tGenerated by the command `skkdic-convert'\n"
- ";;\tOriginal SKK dictionary file: "
+ (generate-lisp-file-heading ja-dic-filename 'skkdic-convert :code nil)
+ (insert ";; Original SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)
"\n\n"
- ";; This file is part of GNU Emacs.\n\n"
";;; Start of the header of the original SKK dictionary.\n\n")
(set-buffer skkbuf)
(goto-char 1)
@@ -389,18 +391,12 @@ Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
(skkdic-collect-okuri-nasi)
;; Convert okuri-nasi general entries.
- (skkdic-convert-okuri-nasi skkbuf buf)
+ (skkdic-convert-okuri-nasi skkbuf buf no-reduction)
;; Postfix
(with-current-buffer buf
(goto-char (point-max))
- (insert ";;\n(provide 'ja-dic)\n\n"
- ";; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-update-autoloads: t\n"
- ";; coding: utf-8\n"
- ";; End:\n\n"
- ";;; ja-dic.el ends here\n")))
+ (generate-lisp-file-trailer ja-dic-filename :compile t)))
;; Save the working buffer.
(set-buffer buf)
@@ -427,15 +423,21 @@ To get complete usage, invoke:
(message "To convert SKK-JISYO.L into skkdic.el:")
(message " %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert SKK-JISYO.L")
(message "To convert SKK-JISYO.L into DIR/ja-dic.el:")
- (message " %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert -dir DIR SKK-JISYO.L"))
- (let (targetdir filename)
+ (message " %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert -dir DIR SKK-JISYO.L")
+ (message "To convert SKK-JISYO.L into skkdic.el without reducing dictionary vocabulary:")
+ (message " %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert --no-reduction SKK-JISYO.L"))
+ (let (targetdir filename no-reduction)
(if (string= (car command-line-args-left) "-dir")
(progn
(setq command-line-args-left (cdr command-line-args-left))
(setq targetdir (expand-file-name (car command-line-args-left)))
(setq command-line-args-left (cdr command-line-args-left))))
+ (if (string= (car command-line-args-left) "--no-reduction")
+ (progn
+ (setq no-reduction t)
+ (setq command-line-args-left (cdr command-line-args-left))))
(setq filename (expand-file-name (car command-line-args-left)))
- (skkdic-convert filename targetdir)))
+ (skkdic-convert filename targetdir no-reduction)))
(kill-emacs 0))
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index 96a54cc2128..7054077fb02 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -764,2426 +764,2425 @@ turn it off and display Unicode characters literally. The display
isn't changed if the display can render Unicode characters."
(interactive "p")
(if (> arg 0)
- (unless (char-displayable-p #x101) ; a with macron
- ;; It doesn't look as though we have a Unicode font.
- (let ((latin1-display-format "%s"))
- (mapc
- (lambda (l)
- (apply 'latin1-display-char l))
- ;; Table derived by running Lynx on a suitable list of
- ;; characters in a utf-8 file, except for some added by
- ;; hand at the end.
- '((?\Ā "A")
- (?\ā "a")
- (?\Ă "A")
- (?\ă "a")
- (?\Ą "A")
- (?\ą "a")
- (?\Ć "C")
- (?\ć "c")
- (?\Ĉ "C")
- (?\ĉ "c")
- (?\Ċ "C")
- (?\ċ "c")
- (?\Č "C")
- (?\č "c")
- (?\Ď "D")
- (?\ď "d")
- (?\Đ "Ð")
- (?\đ "d/")
- (?\Ē "E")
- (?\ē "e")
- (?\Ĕ "E")
- (?\ĕ "e")
- (?\Ė "E")
- (?\ė "e")
- (?\Ę "E")
- (?\ę "e")
- (?\Ě "E")
- (?\ě "e")
- (?\Ĝ "G")
- (?\ĝ "g")
- (?\Ğ "G")
- (?\ğ "g")
- (?\Ġ "G")
- (?\ġ "g")
- (?\Ģ "G")
- (?\ģ "g")
- (?\Ĥ "H")
- (?\ĥ "h")
- (?\Ħ "H/")
- (?\ħ "H")
- (?\Ĩ "I")
- (?\ĩ "i")
- (?\Ī "I")
- (?\ī "i")
- (?\Ĭ "I")
- (?\ĭ "i")
- (?\Į "I")
- (?\į "i")
- (?\İ "I")
- (?\ı "i")
- (?\IJ "IJ")
- (?\ij "ij")
- (?\Ĵ "J")
- (?\ĵ "j")
- (?\Ķ "K")
- (?\ķ "k")
- (?\ĸ "kk")
- (?\Ĺ "L")
- (?\ĺ "l")
- (?\Ļ "L")
- (?\ļ "l")
- (?\Ľ "L")
- (?\ľ "l")
- (?\Ŀ "L.")
- (?\ŀ "l.")
- (?\Ł "L/")
- (?\ł "l/")
- (?\Ń "N")
- (?\ń "n")
- (?\Ņ "N")
- (?\ņ "n")
- (?\Ň "N")
- (?\ň "n")
- (?\ʼn "'n")
- (?\Ŋ "NG")
- (?\ŋ "N")
- (?\Ō "O")
- (?\ō "o")
- (?\Ŏ "O")
- (?\ŏ "o")
- (?\Ő "O\"")
- (?\ő "o\"")
- (?\Œ "OE")
- (?\œ "oe")
- (?\Ŕ "R")
- (?\ŕ "r")
- (?\Ŗ "R")
- (?\ŗ "r")
- (?\Ř "R")
- (?\ř "r")
- (?\Ś "S")
- (?\ś "s")
- (?\Ŝ "S")
- (?\ŝ "s")
- (?\Ş "S")
- (?\ş "s")
- (?\Š "S")
- (?\š "s")
- (?\Ţ "T")
- (?\ţ "t")
- (?\Ť "T")
- (?\ť "t")
- (?\Ŧ "T/")
- (?\ŧ "t/")
- (?\Ũ "U")
- (?\ũ "u")
- (?\Ū "U")
- (?\ū "u")
- (?\Ŭ "U")
- (?\ŭ "u")
- (?\Ů "U")
- (?\ů "u")
- (?\Ű "U\"")
- (?\ű "u\"")
- (?\Ų "U")
- (?\ų "u")
- (?\Ŵ "W")
- (?\ŵ "w")
- (?\Ŷ "Y")
- (?\ŷ "y")
- (?\Ÿ "Y")
- (?\Ź "Z")
- (?\ź "z")
- (?\Ż "Z")
- (?\ż "z")
- (?\Ž "Z")
- (?\ž "z")
- (?\ſ "s1")
- (?\Ƈ "C2")
- (?\ƈ "c2")
- (?\Ƒ "F2")
- (?\ƒ " f")
- (?\Ƙ "K2")
- (?\ƙ "k2")
- (?\Ơ "O9")
- (?\ơ "o9")
- (?\Ƣ "OI")
- (?\ƣ "oi")
- (?\Ʀ "yr")
- (?\Ư "U9")
- (?\ư "u9")
- (?\Ƶ "Z/")
- (?\ƶ "z/")
- (?\Ʒ "ED")
- (?\Ǎ "A")
- (?\ǎ "a")
- (?\Ǐ "I")
- (?\ǐ "i")
- (?\Ǒ "O")
- (?\ǒ "o")
- (?\Ǔ "U")
- (?\ǔ "u")
- (?\Ǖ "U:-")
- (?\ǖ "u:-")
- (?\Ǘ "U:'")
- (?\ǘ "u:'")
- (?\Ǚ "U:<")
- (?\ǚ "u:<")
- (?\Ǜ "U:!")
- (?\ǜ "u:!")
- (?\Ǟ "A1")
- (?\ǟ "a1")
- (?\Ǡ "A7")
- (?\ǡ "a7")
- (?\Ǣ "A3")
- (?\ǣ "a3")
- (?\Ǥ "G/")
- (?\ǥ "g/")
- (?\Ǧ "G")
- (?\ǧ "g")
- (?\Ǩ "K")
- (?\ǩ "k")
- (?\Ǫ "O")
- (?\ǫ "o")
- (?\Ǭ "O1")
- (?\ǭ "o1")
- (?\Ǯ "EZ")
- (?\ǯ "ez")
- (?\ǰ "j")
- (?\Ǵ "G")
- (?\ǵ "g")
- (?\Ǻ "AA'")
- (?\ǻ "aa'")
- (?\Ǽ "AE'")
- (?\ǽ "ae'")
- (?\Ǿ "O/'")
- (?\ǿ "o/'")
- (?\Ȁ "A!!")
- (?\ȁ "a!!")
- (?\Ȃ "A)")
- (?\ȃ "a)")
- (?\Ȅ "E!!")
- (?\ȅ "e!!")
- (?\Ȇ "E)")
- (?\ȇ "e)")
- (?\Ȉ "I!!")
- (?\ȉ "i!!")
- (?\Ȋ "I)")
- (?\ȋ "i)")
- (?\Ȍ "O!!")
- (?\ȍ "o!!")
- (?\Ȏ "O)")
- (?\ȏ "o)")
- (?\Ȑ "R!!")
- (?\ȑ "r!!")
- (?\Ȓ "R)")
- (?\ȓ "r)")
- (?\Ȕ "U!!")
- (?\ȕ "u!!")
- (?\Ȗ "U)")
- (?\ȗ "u)")
- (?\ȝ "Z")
- (?\ɑ "A")
- (?\ɒ "A.")
- (?\ɓ "b`")
- (?\ɔ "O")
- (?\ɖ "d.")
- (?\ɗ "d`")
- (?\ɘ "@<umd>")
- (?\ə "@")
- (?\ɚ "R")
- (?\ɛ "E")
- (?\ɜ "V\"")
- (?\ɝ "R<umd>")
- (?\ɞ "O\"")
- (?\ɟ "J")
- (?\ɠ "g`")
- (?\ɡ "g")
- (?\ɢ "G")
- (?\ɣ "Q")
- (?\ɤ "o-")
- (?\ɥ "j<rnd>")
- (?\ɦ "h<?>")
- (?\ɨ "i\"")
- (?\ɩ "I")
- (?\ɪ "I")
- (?\ɫ "L")
- (?\ɬ "L")
- (?\ɭ "l.")
- (?\ɮ "z<lat>")
- (?\ɯ "u-")
- (?\ɰ "j<vel>")
- (?\ɱ "M")
- (?\ɳ "n.")
- (?\ɴ "n\"")
- (?\ɵ "@.")
- (?\ɶ "&.")
- (?\ɷ "U")
- (?\ɹ "r")
- (?\ɺ "*<lat>")
- (?\ɻ "r.")
- (?\ɽ "*.")
- (?\ɾ "*")
- (?\ʀ "R")
- (?\ʁ "g\"")
- (?\ʂ "s.")
- (?\ʃ "S")
- (?\ʄ "J`")
- (?\ʇ "t!")
- (?\ʈ "t.")
- (?\ʉ "u\"")
- (?\ʊ "U")
- (?\ʋ "r<lbd>")
- (?\ʌ "V")
- (?\ʍ "w<vls>")
- (?\ʎ "l^")
- (?\ʏ "I.")
- (?\ʐ "z.")
- (?\ʒ "Z")
- (?\ʔ "?")
- (?\ʕ "H<vcd>")
- (?\ʖ "l!")
- (?\ʗ "c!")
- (?\ʘ "p!")
- (?\ʙ "b<trl>")
- (?\ʛ "G`")
- (?\ʝ "j")
- (?\ʞ "k!")
- (?\ʟ "L")
- (?\ʠ "q`")
- (?\ʤ "d3")
- (?\ʦ "ts")
- (?\ʧ "tS")
- (?\ʰ "<h>")
- (?\ʱ "<?>")
- (?\ʲ ";")
- (?\ʳ "<r>")
- (?\ʷ "<w>")
- (?\ʻ ";S")
- (?\ʼ "`")
- (?\ˆ "^")
- (?\ˇ "'<")
- (?\ˈ "|")
- (?\ˉ "1-")
- (?\ˋ "1!")
- (?\ː ":")
- (?\ˑ ":\\")
- (?\˖ "+")
- (?\˗ "-")
- (?\˘ "'(")
- (?\˙ "'.")
- (?\˚ "'0")
- (?\˛ "';")
- (?\˜ "~")
- (?\˝ "'\"")
- (?\˥ "_T")
- (?\˦ "_H")
- (?\˧ "_M")
- (?\˨ "_L")
- (?\˩ "_B")
- (?\ˬ "_v")
- (?\ˮ "''")
- (?\̀ "`")
- (?\́ "'")
- (?\̂ "^")
- (?\̃ "~")
- (?\̄ "¯")
- (?\̇ "·")
- (?\̈ "¨")
- (?\̊ "°")
- (?\̋ "''")
- (?\̍ "|")
- (?\̎ "||")
- (?\̏ "``")
- (?\̡ ";")
- (?\̢ ".")
- (?\̣ ".")
- (?\̤ "<?>")
- (?\̥ "<o>")
- (?\̦ ",")
- (?\̧ "¸")
- (?\̩ "-")
- (?\̪ "[")
- (?\̫ "<w>")
- (?\̴ "~")
- (?\̷ "/")
- (?\̸ "/")
- (?\̀ "`")
- (?\́ "'")
- (?\͂ "~")
- (?\̈́ "'%")
- (?\ͅ "j3")
- (?\͇ "=")
- (?\͠ "~~")
- (?\ʹ "'")
- (?\͵ ",")
- (?\ͺ "j3")
- (?\; "?%")
- (?\΄ "'*")
- (?\΅ "'%")
- (?\Ά "A'")
- (?\· "·")
- (?\Έ "E'")
- (?\Ή "Y%")
- (?\Ί "I'")
- (?\Ό "O'")
- (?\Ύ "U%")
- (?\Ώ "W%")
- (?\ΐ "i3")
- (?\Α "A")
- (?\Β "B")
- (?\Γ "G")
- (?\Δ "D")
- (?\Ε "E")
- (?\Ζ "Z")
- (?\Η "Y")
- (?\Θ "TH")
- (?\Ι "I")
- (?\Κ "K")
- (?\Λ "L")
- (?\Μ "M")
- (?\Ν "N")
- (?\Ξ "C")
- (?\Ο "O")
- (?\Π "P")
- (?\Ρ "R")
- (?\Σ "S")
- (?\Τ "T")
- (?\Υ "U")
- (?\Φ "F")
- (?\Χ "X")
- (?\Ψ "Q")
- (?\Ω "W*")
- (?\Ϊ "J")
- (?\Ϋ "V*")
- (?\ά "a'")
- (?\έ "e'")
- (?\ή "y%")
- (?\ί "i'")
- (?\ΰ "u3")
- (?\α "a")
- (?\β "b")
- (?\γ "g")
- (?\δ "d")
- (?\ε "e")
- (?\ζ "z")
- (?\η "y")
- (?\θ "th")
- (?\ι "i")
- (?\κ "k")
- (?\λ "l")
- (?\μ "µ")
- (?\ν "n")
- (?\ξ "c")
- (?\ο "o")
- (?\π "p")
- (?\ρ "r")
- (?\ς "*s")
- (?\σ "s")
- (?\τ "t")
- (?\υ "u")
- (?\φ "f")
- (?\χ "x")
- (?\ψ "q")
- (?\ω "w")
- (?\ϊ "j")
- (?\ϋ "v*")
- (?\ό "o'")
- (?\ύ "u%")
- (?\ώ "w%")
- (?\ϐ "beta ")
- (?\ϑ "theta ")
- (?\ϒ "upsi ")
- (?\ϕ "phi ")
- (?\ϖ "pi ")
- (?\ϗ "k.")
- (?\Ϛ "T3")
- (?\ϛ "t3")
- (?\Ϝ "M3")
- (?\ϝ "m3")
- (?\Ϟ "K3")
- (?\ϟ "k3")
- (?\Ϡ "P3")
- (?\ϡ "p3")
- (?\ϰ "kappa ")
- (?\ϱ "rho ")
- (?\ϳ "J")
- (?\ϴ "'%")
- (?\ϵ "j3")
- (?\Ё "IO")
- (?\Ђ "D%")
- (?\Ѓ "G%")
- (?\Є "IE")
- (?\Ѕ "DS")
- (?\І "II")
- (?\Ї "YI")
- (?\Ј "J%")
- (?\Љ "LJ")
- (?\Њ "NJ")
- (?\Ћ "Ts")
- (?\Ќ "KJ")
- (?\Ў "V%")
- (?\Џ "DZ")
- (?\А "A")
- (?\Б "B")
- (?\В "V")
- (?\Г "G")
- (?\Д "D")
- (?\Е "E")
- (?\Ж "ZH")
- (?\З "Z")
- (?\И "I")
- (?\Й "J")
- (?\К "K")
- (?\Л "L")
- (?\М "M")
- (?\Н "N")
- (?\О "O")
- (?\П "P")
- (?\Р "R")
- (?\С "S")
- (?\Т "T")
- (?\У "U")
- (?\Ф "F")
- (?\Х "H")
- (?\Ц "C")
- (?\Ч "CH")
- (?\Ш "SH")
- (?\Щ "SCH")
- (?\Ъ "\"")
- (?\Ы "Y")
- (?\Ь "'")
- (?\Э "`E")
- (?\Ю "YU")
- (?\Я "YA")
- (?\а "a")
- (?\б "b")
- (?\в "v")
- (?\г "g")
- (?\д "d")
- (?\е "e")
- (?\ж "zh")
- (?\з "z")
- (?\и "i")
- (?\й "j")
- (?\к "k")
- (?\л "l")
- (?\м "m")
- (?\н "n")
- (?\о "o")
- (?\п "p")
- (?\р "r")
- (?\с "s")
- (?\т "t")
- (?\у "u")
- (?\ф "f")
- (?\х "h")
- (?\ц "c")
- (?\ч "ch")
- (?\ш "sh")
- (?\щ "sch")
- (?\ъ "\"")
- (?\ы "y")
- (?\ь "'")
- (?\э "`e")
- (?\ю "yu")
- (?\я "ya")
- (?\ё "io")
- (?\ђ "d%")
- (?\ѓ "g%")
- (?\є "ie")
- (?\ѕ "ds")
- (?\і "ii")
- (?\ї "yi")
- (?\ј "j%")
- (?\љ "lj")
- (?\њ "nj")
- (?\ћ "ts")
- (?\ќ "kj")
- (?\ў "v%")
- (?\џ "dz")
- (?\Ѣ "Y3")
- (?\ѣ "y3")
- (?\Ѫ "O3")
- (?\ѫ "o3")
- (?\Ѳ "F3")
- (?\ѳ "f3")
- (?\Ѵ "V3")
- (?\ѵ "v3")
- (?\Ҁ "C3")
- (?\ҁ "c3")
- (?\Ґ "G3")
- (?\ґ "g3")
- (?\Ӕ "AE")
- (?\ӕ "ae")
- (?\ִ "i")
- (?\ַ "a")
- (?\ָ "o")
- (?\ּ "u")
- (?\ֿ "h")
- (?\ׂ ":")
- (?\א "#")
- (?\ב "B+")
- (?\ג "G+")
- (?\ד "D+")
- (?\ה "H+")
- (?\ו "W+")
- (?\ז "Z+")
- (?\ח "X+")
- (?\ט "Tj")
- (?\י "J+")
- (?\ך "K%")
- (?\כ "K+")
- (?\ל "L+")
- (?\ם "M%")
- (?\מ "M+")
- (?\ן "N%")
- (?\נ "N+")
- (?\ס "S+")
- (?\ע "E+")
- (?\ף "P%")
- (?\פ "P+")
- (?\ץ "Zj")
- (?\צ "ZJ")
- (?\ק "Q+")
- (?\ר "R+")
- (?\ש "Sh")
- (?\ת "T+")
- (?\װ "v")
- (?\ױ "oy")
- (?\ײ "ey")
- (?\، ",+")
- (?\؛ ";+")
- (?\؟ "?+")
- (?\ء "H'")
- (?\آ "aM")
- (?\أ "aH")
- (?\ؤ "wH")
- (?\إ "ah")
- (?\ئ "yH")
- (?\ا "a+")
- (?\ب "b+")
- (?\ة "tm")
- (?\ت "t+")
- (?\ث "tk")
- (?\ج "g+")
- (?\ح "hk")
- (?\خ "x+")
- (?\د "d+")
- (?\ذ "dk")
- (?\ر "r+")
- (?\ز "z+")
- (?\س "s+")
- (?\ش "sn")
- (?\ص "c+")
- (?\ض "dd")
- (?\ط "tj")
- (?\ظ "zH")
- (?\ع "e+")
- (?\غ "i+")
- (?\ـ "++")
- (?\ف "f+")
- (?\ق "q+")
- (?\ك "k+")
- (?\ل "l+")
- (?\م "m+")
- (?\ن "n+")
- (?\ه "h+")
- (?\و "w+")
- (?\ى "j+")
- (?\ي "y+")
- (?\ً ":+")
- (?\ٌ "\"+")
- (?\ٍ "=+")
- (?\َ "/+")
- (?\ُ "'+")
- (?\ِ "1+")
- (?\ّ "3+")
- (?\ْ "0+")
- (?\٠ "0a")
- (?\١ "1a")
- (?\٢ "2a")
- (?\٣ "3a")
- (?\٤ "4a")
- (?\٥ "5a")
- (?\٦ "6a")
- (?\٧ "7a")
- (?\٨ "8a")
- (?\٩ "9a")
- (?\ٰ "aS")
- (?\پ "p+")
- (?\ځ "hH")
- (?\چ "tc")
- (?\ژ "zj")
- (?\ڤ "v+")
- (?\گ "gf")
- (?\۰ "0a")
- (?\۱ "1a")
- (?\۲ "2a")
- (?\۳ "3a")
- (?\۴ "4a")
- (?\۵ "5a")
- (?\۶ "6a")
- (?\۷ "7a")
- (?\۸ "8a")
- (?\۹ "9a")
- (?\ሀ "he")
- (?\ሁ "hu")
- (?\ሂ "hi")
- (?\ሃ "ha")
- (?\ሄ "hE")
- (?\ህ "h")
- (?\ሆ "ho")
- (?\ለ "le")
- (?\ሉ "lu")
- (?\ሊ "li")
- (?\ላ "la")
- (?\ሌ "lE")
- (?\ል "l")
- (?\ሎ "lo")
- (?\ሏ "lWa")
- (?\ሐ "He")
- (?\ሑ "Hu")
- (?\ሒ "Hi")
- (?\ሓ "Ha")
- (?\ሔ "HE")
- (?\ሕ "H")
- (?\ሖ "Ho")
- (?\ሗ "HWa")
- (?\መ "me")
- (?\ሙ "mu")
- (?\ሚ "mi")
- (?\ማ "ma")
- (?\ሜ "mE")
- (?\ም "m")
- (?\ሞ "mo")
- (?\ሟ "mWa")
- (?\ሠ "`se")
- (?\ሡ "`su")
- (?\ሢ "`si")
- (?\ሣ "`sa")
- (?\ሤ "`sE")
- (?\ሥ "`s")
- (?\ሦ "`so")
- (?\ሧ "`sWa")
- (?\ረ "re")
- (?\ሩ "ru")
- (?\ሪ "ri")
- (?\ራ "ra")
- (?\ሬ "rE")
- (?\ር "r")
- (?\ሮ "ro")
- (?\ሯ "rWa")
- (?\ሰ "se")
- (?\ሱ "su")
- (?\ሲ "si")
- (?\ሳ "sa")
- (?\ሴ "sE")
- (?\ስ "s")
- (?\ሶ "so")
- (?\ሷ "sWa")
- (?\ሸ "xe")
- (?\ሹ "xu")
- (?\ሺ "xi")
- (?\ሻ "xa")
- (?\ሼ "xE")
- (?\ሽ "xa")
- (?\ሾ "xo")
- (?\ሿ "xWa")
- (?\ቀ "qe")
- (?\ቁ "qu")
- (?\ቂ "qi")
- (?\ቃ "qa")
- (?\ቄ "qE")
- (?\ቅ "q")
- (?\ቆ "qo")
- (?\ቈ "qWe")
- (?\ቊ "qWi")
- (?\ቋ "qWa")
- (?\ቌ "qWE")
- (?\ቍ "qW")
- (?\ቐ "Qe")
- (?\ቑ "Qu")
- (?\ቒ "Qi")
- (?\ቓ "Qa")
- (?\ቔ "QE")
- (?\ቕ "Q")
- (?\ቖ "Qo")
- (?\ቘ "QWe")
- (?\ቚ "QWi")
- (?\ቛ "QWa")
- (?\ቜ "QWE")
- (?\ቝ "QW")
- (?\በ "be")
- (?\ቡ "bu")
- (?\ቢ "bi")
- (?\ባ "ba")
- (?\ቤ "bE")
- (?\ብ "b")
- (?\ቦ "bo")
- (?\ቧ "bWa")
- (?\ቨ "ve")
- (?\ቩ "vu")
- (?\ቪ "vi")
- (?\ቫ "va")
- (?\ቬ "vE")
- (?\ቭ "v")
- (?\ቮ "vo")
- (?\ቯ "vWa")
- (?\ተ "te")
- (?\ቱ "tu")
- (?\ቲ "ti")
- (?\ታ "ta")
- (?\ቴ "tE")
- (?\ት "t")
- (?\ቶ "to")
- (?\ቷ "tWa")
- (?\ቸ "ce")
- (?\ቹ "cu")
- (?\ቺ "ci")
- (?\ቻ "ca")
- (?\ቼ "cE")
- (?\ች "c")
- (?\ቾ "co")
- (?\ቿ "cWa")
- (?\ኀ "`he")
- (?\ኁ "`hu")
- (?\ኂ "`hi")
- (?\ኃ "`ha")
- (?\ኄ "`hE")
- (?\ኅ "`h")
- (?\ኆ "`ho")
- (?\ኈ "hWe")
- (?\ኊ "hWi")
- (?\ኋ "hWa")
- (?\ኌ "hWE")
- (?\ኍ "hW")
- (?\ነ "na")
- (?\ኑ "nu")
- (?\ኒ "ni")
- (?\ና "na")
- (?\ኔ "nE")
- (?\ን "n")
- (?\ኖ "no")
- (?\ኗ "nWa")
- (?\ኘ "Ne")
- (?\ኙ "Nu")
- (?\ኚ "Ni")
- (?\ኛ "Na")
- (?\ኜ "NE")
- (?\ኝ "N")
- (?\ኞ "No")
- (?\ኟ "NWa")
- (?\አ "e")
- (?\ኡ "u")
- (?\ኢ "i")
- (?\ኣ "a")
- (?\ኤ "E")
- (?\እ "I")
- (?\ኦ "o")
- (?\ኧ "e3")
- (?\ከ "ke")
- (?\ኩ "ku")
- (?\ኪ "ki")
- (?\ካ "ka")
- (?\ኬ "kE")
- (?\ክ "k")
- (?\ኮ "ko")
- (?\ኰ "kWe")
- (?\ኲ "kWi")
- (?\ኳ "kWa")
- (?\ኴ "kWE")
- (?\ኵ "kW")
- (?\ኸ "Ke")
- (?\ኹ "Ku")
- (?\ኺ "Ki")
- (?\ኻ "Ka")
- (?\ኼ "KE")
- (?\ኽ "K")
- (?\ኾ "Ko")
- (?\ዀ "KWe")
- (?\ዂ "KWi")
- (?\ዃ "KWa")
- (?\ዄ "KWE")
- (?\ዅ "KW")
- (?\ወ "we")
- (?\ዉ "wu")
- (?\ዊ "wi")
- (?\ዋ "wa")
- (?\ዌ "wE")
- (?\ው "w")
- (?\ዎ "wo")
- (?\ዐ "`e")
- (?\ዑ "`u")
- (?\ዒ "`i")
- (?\ዓ "`a")
- (?\ዔ "`E")
- (?\ዕ "`I")
- (?\ዖ "`o")
- (?\ዘ "ze")
- (?\ዙ "zu")
- (?\ዚ "zi")
- (?\ዛ "za")
- (?\ዜ "zE")
- (?\ዝ "z")
- (?\ዞ "zo")
- (?\ዟ "zWa")
- (?\ዠ "Ze")
- (?\ዡ "Zu")
- (?\ዢ "Zi")
- (?\ዣ "Za")
- (?\ዤ "ZE")
- (?\ዥ "Z")
- (?\ዦ "Zo")
- (?\ዧ "ZWa")
- (?\የ "ye")
- (?\ዩ "yu")
- (?\ዪ "yi")
- (?\ያ "ya")
- (?\ዬ "yE")
- (?\ይ "y")
- (?\ዮ "yo")
- (?\ዯ "yWa")
- (?\ደ "de")
- (?\ዱ "du")
- (?\ዲ "di")
- (?\ዳ "da")
- (?\ዴ "dE")
- (?\ድ "d")
- (?\ዶ "do")
- (?\ዷ "dWa")
- (?\ዸ "De")
- (?\ዹ "Du")
- (?\ዺ "Di")
- (?\ዻ "Da")
- (?\ዼ "DE")
- (?\ዽ "D")
- (?\ዾ "Do")
- (?\ዿ "DWa")
- (?\ጀ "je")
- (?\ጁ "ju")
- (?\ጂ "ji")
- (?\ጃ "ja")
- (?\ጄ "jE")
- (?\ጅ "j")
- (?\ጆ "jo")
- (?\ጇ "jWa")
- (?\ገ "ga")
- (?\ጉ "gu")
- (?\ጊ "gi")
- (?\ጋ "ga")
- (?\ጌ "gE")
- (?\ግ "g")
- (?\ጎ "go")
- (?\ጐ "gWu")
- (?\ጒ "gWi")
- (?\ጓ "gWa")
- (?\ጔ "gWE")
- (?\ጕ "gW")
- (?\ጘ "Ge")
- (?\ጙ "Gu")
- (?\ጚ "Gi")
- (?\ጛ "Ga")
- (?\ጜ "GE")
- (?\ጝ "G")
- (?\ጞ "Go")
- (?\ጟ "GWa")
- (?\ጠ "Te")
- (?\ጡ "Tu")
- (?\ጢ "Ti")
- (?\ጣ "Ta")
- (?\ጤ "TE")
- (?\ጥ "T")
- (?\ጦ "To")
- (?\ጧ "TWa")
- (?\ጨ "Ce")
- (?\ጩ "Ca")
- (?\ጪ "Cu")
- (?\ጫ "Ca")
- (?\ጬ "CE")
- (?\ጭ "C")
- (?\ጮ "Co")
- (?\ጯ "CWa")
- (?\ጰ "Pe")
- (?\ጱ "Pu")
- (?\ጲ "Pi")
- (?\ጳ "Pa")
- (?\ጴ "PE")
- (?\ጵ "P")
- (?\ጶ "Po")
- (?\ጷ "PWa")
- (?\ጸ "SWe")
- (?\ጹ "SWu")
- (?\ጺ "SWi")
- (?\ጻ "SWa")
- (?\ጼ "SWE")
- (?\ጽ "SW")
- (?\ጾ "SWo")
- (?\ጿ "SWa")
- (?\ፀ "`Sa")
- (?\ፁ "`Su")
- (?\ፂ "`Si")
- (?\ፃ "`Sa")
- (?\ፄ "`SE")
- (?\ፅ "`S")
- (?\ፆ "`So")
- (?\ፈ "fa")
- (?\ፉ "fu")
- (?\ፊ "fi")
- (?\ፋ "fa")
- (?\ፌ "fE")
- (?\ፍ "o")
- (?\ፎ "fo")
- (?\ፏ "fWa")
- (?\ፐ "pe")
- (?\ፑ "pu")
- (?\ፒ "pi")
- (?\ፓ "pa")
- (?\ፔ "pE")
- (?\ፕ "p")
- (?\ፖ "po")
- (?\ፗ "pWa")
- (?\ፘ "mYa")
- (?\ፙ "rYa")
- (?\ፚ "fYa")
- (?\፠ " ")
- (?\፡ ":")
- (?\። "::")
- (?\፣ ",")
- (?\፤ ";")
- (?\፥ "-:")
- (?\፦ ":-")
- (?\፧ "`?")
- (?\፨ ":|:")
- (?\፩ "`1")
- (?\፪ "`2")
- (?\፫ "`3")
- (?\፬ "`4")
- (?\፭ "`5")
- (?\፮ "`6")
- (?\፯ "`7")
- (?\፰ "`8")
- (?\፱ "`9")
- (?\፲ "`10")
- (?\፳ "`20")
- (?\፴ "`30")
- (?\፵ "`40")
- (?\፶ "`50")
- (?\፷ "`60")
- (?\፸ "`70")
- (?\፹ "`80")
- (?\፺ "`90")
- (?\፻ "`100")
- (?\፼ "`10000")
- (?\Ḁ "A-0")
- (?\ḁ "a-0")
- (?\Ḃ "B.")
- (?\ḃ "b.")
- (?\Ḅ "B-.")
- (?\ḅ "b-.")
- (?\Ḇ "B_")
- (?\ḇ "b_")
- (?\Ḉ "C,'")
- (?\ḉ "c,'")
- (?\Ḋ "D.")
- (?\ḋ "d.")
- (?\Ḍ "D-.")
- (?\ḍ "d-.")
- (?\Ḏ "D_")
- (?\ḏ "d_")
- (?\Ḑ "D,")
- (?\ḑ "d,")
- (?\Ḓ "D->")
- (?\ḓ "d->")
- (?\Ḕ "E-!")
- (?\ḕ "e-!")
- (?\Ḗ "E-'")
- (?\ḗ "e-'")
- (?\Ḙ "E->")
- (?\ḙ "e->")
- (?\Ḛ "E-?")
- (?\ḛ "e-?")
- (?\Ḝ "E,(")
- (?\ḝ "e,(")
- (?\Ḟ "F.")
- (?\ḟ "f.")
- (?\Ḡ "G-")
- (?\ḡ "g-")
- (?\Ḣ "H.")
- (?\ḣ "h.")
- (?\Ḥ "H-.")
- (?\ḥ "h-.")
- (?\Ḧ "H:")
- (?\ḧ "h:")
- (?\Ḩ "H,")
- (?\ḩ "h,")
- (?\Ḫ "H-(")
- (?\ḫ "h-(")
- (?\Ḭ "I-?")
- (?\ḭ "i-?")
- (?\Ḯ "I:'")
- (?\ḯ "i:'")
- (?\Ḱ "K'")
- (?\ḱ "k'")
- (?\Ḳ "K-.")
- (?\ḳ "k-.")
- (?\Ḵ "K_")
- (?\ḵ "k_")
- (?\Ḷ "L-.")
- (?\ḷ "l-.")
- (?\Ḹ "L--.")
- (?\ḹ "l--.")
- (?\Ḻ "L_")
- (?\ḻ "l_")
- (?\Ḽ "L->")
- (?\ḽ "l->")
- (?\Ḿ "M'")
- (?\ḿ "m'")
- (?\Ṁ "M.")
- (?\ṁ "m.")
- (?\Ṃ "M-.")
- (?\ṃ "m-.")
- (?\Ṅ "N.")
- (?\ṅ "n.")
- (?\Ṇ "N-.")
- (?\ṇ "n-.")
- (?\Ṉ "N_")
- (?\ṉ "n_")
- (?\Ṋ "N->")
- (?\ṋ "n->")
- (?\Ṍ "O?'")
- (?\ṍ "o?'")
- (?\Ṏ "O?:")
- (?\ṏ "o?:")
- (?\Ṑ "O-!")
- (?\ṑ "o-!")
- (?\Ṓ "O-'")
- (?\ṓ "o-'")
- (?\Ṕ "P'")
- (?\ṕ "p'")
- (?\Ṗ "P.")
- (?\ṗ "p.")
- (?\Ṙ "R.")
- (?\ṙ "r.")
- (?\Ṛ "R-.")
- (?\ṛ "r-.")
- (?\Ṝ "R--.")
- (?\ṝ "r--.")
- (?\Ṟ "R_")
- (?\ṟ "r_")
- (?\Ṡ "S.")
- (?\ṡ "s.")
- (?\Ṣ "S-.")
- (?\ṣ "s-.")
- (?\Ṥ "S'.")
- (?\ṥ "s'.")
- (?\Ṧ "S<.")
- (?\ṧ "s<.")
- (?\Ṩ "S.-.")
- (?\ṩ "s.-.")
- (?\Ṫ "T.")
- (?\ṫ "t.")
- (?\Ṭ "T-.")
- (?\ṭ "t-.")
- (?\Ṯ "T_")
- (?\ṯ "t_")
- (?\Ṱ "T->")
- (?\ṱ "t->")
- (?\Ṳ "U--:")
- (?\ṳ "u--:")
- (?\Ṵ "U-?")
- (?\ṵ "u-?")
- (?\Ṷ "U->")
- (?\ṷ "u->")
- (?\Ṹ "U?'")
- (?\ṹ "u?'")
- (?\Ṻ "U-:")
- (?\ṻ "u-:")
- (?\Ṽ "V?")
- (?\ṽ "v?")
- (?\Ṿ "V-.")
- (?\ṿ "v-.")
- (?\Ẁ "W!")
- (?\ẁ "w!")
- (?\Ẃ "W'")
- (?\ẃ "w'")
- (?\Ẅ "W:")
- (?\ẅ "w:")
- (?\Ẇ "W.")
- (?\ẇ "w.")
- (?\Ẉ "W-.")
- (?\ẉ "w-.")
- (?\Ẋ "X.")
- (?\ẋ "x.")
- (?\Ẍ "X:")
- (?\ẍ "x:")
- (?\Ẏ "Y.")
- (?\ẏ "y.")
- (?\Ẑ "Z>")
- (?\ẑ "z>")
- (?\Ẓ "Z-.")
- (?\ẓ "z-.")
- (?\Ẕ "Z_")
- (?\ẕ "z_")
- (?\ẖ "h_")
- (?\ẗ "t:")
- (?\ẘ "w0")
- (?\ẙ "y0")
- (?\Ạ "A-.")
- (?\ạ "a-.")
- (?\Ả "A2")
- (?\ả "a2")
- (?\Ấ "A>'")
- (?\ấ "a>'")
- (?\Ầ "A>!")
- (?\ầ "a>!")
- (?\Ẩ "A>2")
- (?\ẩ "a>2")
- (?\Ẫ "A>?")
- (?\ẫ "a>?")
- (?\Ậ "A>-.")
- (?\ậ "a>-.")
- (?\Ắ "A('")
- (?\ắ "a('")
- (?\Ằ "A(!")
- (?\ằ "a(!")
- (?\Ẳ "A(2")
- (?\ẳ "a(2")
- (?\Ẵ "A(?")
- (?\ẵ "a(?")
- (?\Ặ "A(-.")
- (?\ặ "a(-.")
- (?\Ẹ "E-.")
- (?\ẹ "e-.")
- (?\Ẻ "E2")
- (?\ẻ "e2")
- (?\Ẽ "E?")
- (?\ẽ "e?")
- (?\Ế "E>'")
- (?\ế "e>'")
- (?\Ề "E>!")
- (?\ề "e>!")
- (?\Ể "E>2")
- (?\ể "e>2")
- (?\Ễ "E>?")
- (?\ễ "e>?")
- (?\Ệ "E>-.")
- (?\ệ "e>-.")
- (?\Ỉ "I2")
- (?\ỉ "i2")
- (?\Ị "I-.")
- (?\ị "i-.")
- (?\Ọ "O-.")
- (?\ọ "o-.")
- (?\Ỏ "O2")
- (?\ỏ "o2")
- (?\Ố "O>'")
- (?\ố "o>'")
- (?\Ồ "O>!")
- (?\ồ "o>!")
- (?\Ổ "O>2")
- (?\ổ "o>2")
- (?\Ỗ "O>?")
- (?\ỗ "o>?")
- (?\Ộ "O>-.")
- (?\ộ "o>-.")
- (?\Ớ "O9'")
- (?\ớ "o9'")
- (?\Ờ "O9!")
- (?\ờ "o9!")
- (?\Ở "O92")
- (?\ở "o92")
- (?\Ỡ "O9?")
- (?\ỡ "o9?")
- (?\Ợ "O9-.")
- (?\ợ "o9-.")
- (?\Ụ "U-.")
- (?\ụ "u-.")
- (?\Ủ "U2")
- (?\ủ "u2")
- (?\Ứ "U9'")
- (?\ứ "u9'")
- (?\Ừ "U9!")
- (?\ừ "u9!")
- (?\Ử "U92")
- (?\ử "u92")
- (?\Ữ "U9?")
- (?\ữ "u9?")
- (?\Ự "U9-.")
- (?\ự "u9-.")
- (?\Ỳ "Y!")
- (?\ỳ "y!")
- (?\Ỵ "Y-.")
- (?\ỵ "y-.")
- (?\Ỷ "Y2")
- (?\ỷ "y2")
- (?\Ỹ "Y?")
- (?\ỹ "y?")
- (?\ἀ "a")
- (?\ἁ "ha")
- (?\ἂ "`a")
- (?\ἃ "h`a")
- (?\ἄ "a'")
- (?\ἅ "ha'")
- (?\ἆ "a~")
- (?\ἇ "ha~")
- (?\Ἀ "A")
- (?\Ἁ "hA")
- (?\Ἂ "`A")
- (?\Ἃ "h`A")
- (?\Ἄ "A'")
- (?\Ἅ "hA'")
- (?\Ἆ "A~")
- (?\Ἇ "hA~")
- (?\ἑ "he")
- (?\Ἑ "hE")
- (?\ἱ "hi")
- (?\Ἱ "hI")
- (?\ὁ "ho")
- (?\Ὁ "hO")
- (?\ὑ "hu")
- (?\Ὑ "hU")
- (?\᾿ ",,")
- (?\῀ "?*")
- (?\῁ "?:")
- (?\῍ ",!")
- (?\῎ ",'")
- (?\῏ "?,")
- (?\῝ ";!")
- (?\῞ ";'")
- (?\῟ "?;")
- (?\ῥ "rh")
- (?\Ῥ "Rh")
- (?\῭ "!:")
- (?\` "!*")
- (?\῾ ";;")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\  " ")
- (?\‐ "-")
- (?\‑ "-")
- (?\– "-")
- (?\— "--")
- (?\― "-")
- (?\‖ "||")
- (?\‗ "=2")
- (?\‘ "`")
- (?\’ "'")
- (?\‚ "'")
- (?\‛ "'")
- (?\“ "\"")
- (?\” "\"")
- (?\„ "\"")
- (?\‟ "\"")
- (?\† "/-")
- (?\‡ "/=")
- (?\• " o ")
- (?\․ ".")
- (?\‥ "..")
- (?\… "...")
- (?\‧ "·")
- (?\‰ " 0/00")
- (?\′ "'")
- (?\″ "''")
- (?\‴ "'''")
- (?\‵ "`")
- (?\‶ "``")
- (?\‷ "```")
- (?\‸ "Ca")
- (?\‹ "<")
- (?\› ">")
- (?\※ ":X")
- (?\‼ "!!")
- (?\‾ "'-")
- (?\⁃ "-")
- (?\⁄ "/")
- (?\⁈ "?!")
- (?\⁉ "!?")
- (?\⁰ "^0")
- (?\⁴ "^4")
- (?\⁵ "^5")
- (?\⁶ "^6")
- (?\⁷ "^7")
- (?\⁸ "^8")
- (?\⁹ "^9")
- (?\⁺ "^+")
- (?\⁻ "^-")
- (?\⁼ "^=")
- (?\⁽ "^(")
- (?\⁾ "^)")
- (?\ⁿ "^n")
- (?\₀ "_0")
- (?\₁ "_1")
- (?\₂ "_2")
- (?\₃ "_3")
- (?\₄ "_4")
- (?\₅ "_5")
- (?\₆ "_6")
- (?\₇ "_7")
- (?\₈ "_8")
- (?\₉ "_9")
- (?\₊ "_+")
- (?\₋ "_-")
- (?\₌ "_=")
- (?\₍ "(")
- (?\₎ ")")
- (?\₣ "Ff")
- (?\₤ "Li")
- (?\₧ "Pt")
- (?\₩ "W=")
- (?\€ "EUR")
- (?\℀ "a/c")
- (?\℁ "a/s")
- (?\℃ "oC")
- (?\℅ "c/o")
- (?\℆ "c/u")
- (?\℉ "oF")
- (?\ℊ "g")
- (?\ℎ "h")
- (?\ℏ "\\hbar")
- (?\ℑ "Im")
- (?\ℓ "l")
- (?\№ "No.")
- (?\℗ "PO")
- (?\℘ "P")
- (?\ℜ "Re")
- (?\℞ "Rx")
- (?\℠ "(SM)")
- (?\℡ "TEL")
- (?\™ "(TM)")
- (?\Ω "Ohm")
- (?\K "K")
- (?\Å "Ang.")
- (?\℮ "est.")
- (?\ℴ "o")
- (?\ℵ "Aleph ")
- (?\ℶ "Bet ")
- (?\ℷ "Gimel ")
- (?\ℸ "Dalet ")
- (?\⅓ " 1/3")
- (?\⅔ " 2/3")
- (?\⅕ " 1/5")
- (?\⅖ " 2/5")
- (?\⅗ " 3/5")
- (?\⅘ " 4/5")
- (?\⅙ " 1/6")
- (?\⅚ " 5/6")
- (?\⅛ " 1/8")
- (?\⅜ " 3/8")
- (?\⅝ " 5/8")
- (?\⅞ " 7/8")
- (?\⅟ " 1/")
- (?\Ⅰ "I")
- (?\Ⅱ "II")
- (?\Ⅲ "III")
- (?\Ⅳ "IV")
- (?\Ⅴ "V")
- (?\Ⅵ "VI")
- (?\Ⅶ "VII")
- (?\Ⅷ "VIII")
- (?\Ⅸ "IX")
- (?\Ⅹ "X")
- (?\Ⅺ "XI")
- (?\Ⅻ "XII")
- (?\Ⅼ "L")
- (?\Ⅽ "C")
- (?\Ⅾ "D")
- (?\Ⅿ "M")
- (?\ⅰ "i")
- (?\ⅱ "ii")
- (?\ⅲ "iii")
- (?\ⅳ "iv")
- (?\ⅴ "v")
- (?\ⅵ "vi")
- (?\ⅶ "vii")
- (?\ⅷ "viii")
- (?\ⅸ "ix")
- (?\ⅹ "x")
- (?\ⅺ "xi")
- (?\ⅻ "xii")
- (?\ⅼ "l")
- (?\ⅽ "c")
- (?\ⅾ "d")
- (?\ⅿ "m")
- (?\ↀ "1000RCD")
- (?\ↁ "5000R")
- (?\ↂ "10000R")
- (?\← "<-")
- (?\↑ "-^")
- (?\→ "->")
- (?\↓ "-v")
- (?\↔ "<->")
- (?\↕ "UD")
- (?\↖ "<!!")
- (?\↗ "//>")
- (?\↘ "!!>")
- (?\↙ "<//")
- (?\↨ "UD-")
- (?\↵ "RET")
- (?\⇀ ">V")
- (?\⇐ "<=")
- (?\⇑ "^^")
- (?\⇒ "=>")
- (?\⇓ "vv")
- (?\⇔ "<=>")
- (?\∀ "FA")
- (?\∂ "\\partial")
- (?\∃ "TE")
- (?\∅ "{}")
- (?\∆ "Delta")
- (?\∇ "Nabla")
- (?\∈ "(-")
- (?\∉ "!(-")
- (?\∊ "(-")
- (?\∋ "-)")
- (?\∌ "!-)")
- (?\∍ "-)")
- (?\∎ " qed")
- (?\∏ "\\prod")
- (?\∑ "\\sum")
- (?\− " -")
- (?\∓ "-/+")
- (?\∔ ".+")
- (?\∕ "/")
- (?\∖ " - ")
- (?\∗ "*")
- (?\∘ " ° ")
- (?\∙ "sb")
- (?\√ " SQRT ")
- (?\∛ " ROOT³ ")
- (?\∜ " ROOT4 ")
- (?\∝ "0(")
- (?\∞ "infty")
- (?\∟ "-L")
- (?\∠ "-V")
- (?\∥ "PP")
- (?\∦ " !PP ")
- (?\∧ "AND")
- (?\∨ "OR")
- (?\∩ "(U")
- (?\∪ ")U")
- (?\∫ "\\int ")
- (?\∬ "DI")
- (?\∮ "Io")
- (?\∴ ".:")
- (?\∵ ":.")
- (?\∶ ":R")
- (?\∷ "::")
- (?\∼ "?1")
- (?\∾ "CG")
- (?\≃ "?-")
- (?\≅ "?=")
- (?\≈ "~=")
- (?\≉ " !~= ")
- (?\≌ "=?")
- (?\≓ "HI")
- (?\≔ ":=")
- (?\≕ "=:")
- (?\≠ "!=")
- (?\≡ "=3")
- (?\≢ " !=3 ")
- (?\≤ "=<")
- (?\≥ ">=")
- (?\≦ ".LE.")
- (?\≧ ".GE.")
- (?\≨ ".LT.NOT.EQ.")
- (?\≩ ".GT.NOT.EQ.")
- (?\≪ "<<")
- (?\≫ ">>")
- (?\≮ "!<")
- (?\≯ "!>")
- (?\≶ " <> ")
- (?\≷ " >< ")
- (?\⊂ "(C")
- (?\⊃ ")C")
- (?\⊄ " !(C ")
- (?\⊅ " !)C ")
- (?\⊆ "(_")
- (?\⊇ ")_")
- (?\⊕ "(+)")
- (?\⊖ "(-)")
- (?\⊗ "(×)")
- (?\⊘ "(/)")
- (?\⊙ "(·)")
- (?\⊚ "(°)")
- (?\⊛ "(*)")
- (?\⊜ "(=)")
- (?\⊝ "(-)")
- (?\⊞ "[+]")
- (?\⊟ "[-]")
- (?\⊠ "[×]")
- (?\⊡ "[·]")
- (?\⊥ "-T")
- (?\⊧ " MODELS ")
- (?\⊨ " TRUE ")
- (?\⊩ " FORCES ")
- (?\⊬ " !PROVES ")
- (?\⊭ " NOT TRUE ")
- (?\⊮ " !FORCES ")
- (?\⊲ " NORMAL SUBGROUP OF ")
- (?\⊳ " CONTAINS AS NORMAL SUBGROUP ")
- (?\⊴ " NORMAL SUBGROUP OF OR EQUAL TO ")
- (?\⊵ " CONTAINS AS NORMAL SUBGROUP OR EQUAL TO ")
- (?\⊸ " MULTIMAP ")
- (?\⊺ " INTERCALATE ")
- (?\⊻ " XOR ")
- (?\⊼ " NAND ")
- (?\⋅ " · ")
- (?\⋖ "<.")
- (?\⋗ ">.")
- (?\⋘ "<<<")
- (?\⋙ ">>>")
- (?\⋮ ":3")
- (?\⋯ ".3")
- (?\⌂ "Eh")
- (?\⌇ "~~")
- (?\⌈ "<7")
- (?\⌉ ">7")
- (?\⌊ "7<")
- (?\⌋ "7>")
- (?\⌐ "NI")
- (?\⌒ "(A")
- (?\⌕ "TR")
- (?\⌘ "88")
- (?\⌠ "Iu")
- (?\⌡ "Il")
- (?\⌢ ":(")
- (?\⌣ ":)")
- (?\⌤ "|^|")
- (?\⌧ "[X]")
- (?\〈 "</")
- (?\〉 "/>")
- (?\␣ "Vs")
- (?\⑀ "1h")
- (?\⑁ "3h")
- (?\⑂ "2h")
- (?\⑃ "4h")
- (?\⑆ "1j")
- (?\⑇ "2j")
- (?\⑈ "3j")
- (?\⑉ "4j")
- (?\① "1-o")
- (?\② "2-o")
- (?\③ "3-o")
- (?\④ "4-o")
- (?\⑤ "5-o")
- (?\⑥ "6-o")
- (?\⑦ "7-o")
- (?\⑧ "8-o")
- (?\⑨ "9-o")
- (?\⑩ "10-o")
- (?\⑪ "11-o")
- (?\⑫ "12-o")
- (?\⑬ "13-o")
- (?\⑭ "14-o")
- (?\⑮ "15-o")
- (?\⑯ "16-o")
- (?\⑰ "17-o")
- (?\⑱ "18-o")
- (?\⑲ "19-o")
- (?\⑳ "20-o")
- (?\⑴ "(1)")
- (?\⑵ "(2)")
- (?\⑶ "(3)")
- (?\⑷ "(4)")
- (?\⑸ "(5)")
- (?\⑹ "(6)")
- (?\⑺ "(7)")
- (?\⑻ "(8)")
- (?\⑼ "(9)")
- (?\⑽ "(10)")
- (?\⑾ "(11)")
- (?\⑿ "(12)")
- (?\⒀ "(13)")
- (?\⒁ "(14)")
- (?\⒂ "(15)")
- (?\⒃ "(16)")
- (?\⒄ "(17)")
- (?\⒅ "(18)")
- (?\⒆ "(19)")
- (?\⒇ "(20)")
- (?\⒈ "1.")
- (?\⒉ "2.")
- (?\⒊ "3.")
- (?\⒋ "4.")
- (?\⒌ "5.")
- (?\⒍ "6.")
- (?\⒎ "7.")
- (?\⒏ "8.")
- (?\⒐ "9.")
- (?\⒑ "10.")
- (?\⒒ "11.")
- (?\⒓ "12.")
- (?\⒔ "13.")
- (?\⒕ "14.")
- (?\⒖ "15.")
- (?\⒗ "16.")
- (?\⒘ "17.")
- (?\⒙ "18.")
- (?\⒚ "19.")
- (?\⒛ "20.")
- (?\⒜ "(a)")
- (?\⒝ "(b)")
- (?\⒞ "(c)")
- (?\⒟ "(d)")
- (?\⒠ "(e)")
- (?\⒡ "(f)")
- (?\⒢ "(g)")
- (?\⒣ "(h)")
- (?\⒤ "(i)")
- (?\⒥ "(j)")
- (?\⒦ "(k)")
- (?\⒧ "(l)")
- (?\⒨ "(m)")
- (?\⒩ "(n)")
- (?\⒪ "(o)")
- (?\⒫ "(p)")
- (?\⒬ "(q)")
- (?\⒭ "(r)")
- (?\⒮ "(s)")
- (?\⒯ "(t)")
- (?\⒰ "(u)")
- (?\⒱ "(v)")
- (?\⒲ "(w)")
- (?\⒳ "(x)")
- (?\⒴ "(y)")
- (?\⒵ "(z)")
- (?\Ⓐ "A-o")
- (?\Ⓑ "B-o")
- (?\Ⓒ "C-o")
- (?\Ⓓ "D-o")
- (?\Ⓔ "E-o")
- (?\Ⓕ "F-o")
- (?\Ⓖ "G-o")
- (?\Ⓗ "H-o")
- (?\Ⓘ "I-o")
- (?\Ⓙ "J-o")
- (?\Ⓚ "K-o")
- (?\Ⓛ "L-o")
- (?\Ⓜ "M-o")
- (?\Ⓝ "N-o")
- (?\Ⓞ "O-o")
- (?\Ⓟ "P-o")
- (?\Ⓠ "Q-o")
- (?\Ⓡ "R-o")
- (?\Ⓢ "S-o")
- (?\Ⓣ "T-o")
- (?\Ⓤ "U-o")
- (?\Ⓥ "V-o")
- (?\Ⓦ "W-o")
- (?\Ⓧ "X-o")
- (?\Ⓨ "Y-o")
- (?\Ⓩ "Z-o")
- (?\ⓐ "a-o")
- (?\ⓑ "b-o")
- (?\ⓒ "c-o")
- (?\ⓓ "d-o")
- (?\ⓔ "e-o")
- (?\ⓕ "f-o")
- (?\ⓖ "g-o")
- (?\ⓗ "h-o")
- (?\ⓘ "i-o")
- (?\ⓙ "j-o")
- (?\ⓚ "k-o")
- (?\ⓛ "l-o")
- (?\ⓜ "m-o")
- (?\ⓝ "n-o")
- (?\ⓞ "o-o")
- (?\ⓟ "p-o")
- (?\ⓠ "q-o")
- (?\ⓡ "r-o")
- (?\ⓢ "s-o")
- (?\ⓣ "t-o")
- (?\ⓤ "u-o")
- (?\ⓥ "v-o")
- (?\ⓦ "w-o")
- (?\ⓧ "x-o")
- (?\ⓨ "y-o")
- (?\ⓩ "z-o")
- (?\⓪ "0-o")
- (?\─ "-")
- (?\━ "=")
- (?\│ "|")
- (?\┃ "|")
- (?\┄ "-")
- (?\┅ "=")
- (?\┆ "|")
- (?\┇ "|")
- (?\┈ "-")
- (?\┉ "=")
- (?\┊ "|")
- (?\┋ "|")
- (?\┌ "+")
- (?\┍ "+")
- (?\┎ "+")
- (?\┏ "+")
- (?\┐ "+")
- (?\┑ "+")
- (?\┒ "+")
- (?\┓ "+")
- (?\└ "+")
- (?\┕ "+")
- (?\┖ "+")
- (?\┗ "+")
- (?\┘ "+")
- (?\┙ "+")
- (?\┚ "+")
- (?\┛ "+")
- (?\├ "+")
- (?\┝ "+")
- (?\┞ "+")
- (?\┟ "+")
- (?\┠ "+")
- (?\┡ "+")
- (?\┢ "+")
- (?\┣ "+")
- (?\┤ "+")
- (?\┥ "+")
- (?\┦ "+")
- (?\┧ "+")
- (?\┨ "+")
- (?\┩ "+")
- (?\┪ "+")
- (?\┫ "+")
- (?\┬ "+")
- (?\┭ "+")
- (?\┮ "+")
- (?\┯ "+")
- (?\┰ "+")
- (?\┱ "+")
- (?\┲ "+")
- (?\┳ "+")
- (?\┴ "+")
- (?\┵ "+")
- (?\┶ "+")
- (?\┷ "+")
- (?\┸ "+")
- (?\┹ "+")
- (?\┺ "+")
- (?\┻ "+")
- (?\┼ "+")
- (?\┽ "+")
- (?\┾ "+")
- (?\┿ "+")
- (?\╀ "+")
- (?\╁ "+")
- (?\╂ "+")
- (?\╃ "+")
- (?\╄ "+")
- (?\╅ "+")
- (?\╆ "+")
- (?\╇ "+")
- (?\╈ "+")
- (?\╉ "+")
- (?\╊ "+")
- (?\╋ "+")
- (?\╌ "+")
- (?\╍ "+")
- (?\╎ "+")
- (?\╏ "+")
- (?\═ "+")
- (?\║ "+")
- (?\╒ "+")
- (?\╓ "+")
- (?\╔ "+")
- (?\╕ "+")
- (?\╖ "+")
- (?\╗ "+")
- (?\╘ "+")
- (?\╙ "+")
- (?\╚ "+")
- (?\╛ "+")
- (?\╜ "+")
- (?\╝ "+")
- (?\╞ "+")
- (?\╟ "+")
- (?\╠ "+")
- (?\╡ "+")
- (?\╢ "+")
- (?\╣ "+")
- (?\╤ "+")
- (?\╥ "+")
- (?\╦ "+")
- (?\╧ "+")
- (?\╨ "+")
- (?\╩ "+")
- (?\╪ "+")
- (?\╫ "+")
- (?\╬ "+")
- (?\╱ "/")
- (?\╲ "\\")
- (?\▀ "TB")
- (?\▄ "LB")
- (?\█ "FB")
- (?\▌ "lB")
- (?\▐ "RB")
- (?\░ ".S")
- (?\▒ ":S")
- (?\▓ "?S")
- (?\■ "fS")
- (?\□ "OS")
- (?\▢ "RO")
- (?\▣ "Rr")
- (?\▤ "RF")
- (?\▥ "RY")
- (?\▦ "RH")
- (?\▧ "RZ")
- (?\▨ "RK")
- (?\▩ "RX")
- (?\▪ "sB")
- (?\▬ "SR")
- (?\▭ "Or")
- (?\▲ "^")
- (?\△ "uT")
- (?\▶ "|>")
- (?\▷ "Tr")
- (?\► "|>")
- (?\▼ "v")
- (?\▽ "dT")
- (?\◀ "<|")
- (?\◁ "Tl")
- (?\◄ "<|")
- (?\◆ "Db")
- (?\◇ "Dw")
- (?\◊ "LZ")
- (?\○ "0m")
- (?\◎ "0o")
- (?\● "0M")
- (?\◐ "0L")
- (?\◑ "0R")
- (?\◘ "Sn")
- (?\◙ "Ic")
- (?\◢ "Fd")
- (?\◣ "Bd")
- (?\◯ "Ci")
- (?\★ "*2")
- (?\☆ "*1")
- (?\☎ "TEL")
- (?\☏ "tel")
- (?\☜ "<--")
- (?\☞ "-->")
- (?\☡ "CAUTION ")
- (?\☧ "XP")
- (?\☹ ":-(")
- (?\☺ ":-)")
- (?\☻ "(-:")
- (?\☼ "SU")
- (?\♀ "f.")
- (?\♂ "m.")
- (?\♠ "cS")
- (?\♡ "cH")
- (?\♢ "cD")
- (?\♣ "cC")
- (?\♤ "cS-")
- (?\♥ "cH-")
- (?\♦ "cD-")
- (?\♧ "cC-")
- (?\♩ "Md")
- (?\♪ "M8")
- (?\♫ "M2")
- (?\♬ "M16")
- (?\♭ "b")
- (?\♮ "Mx")
- (?\♯ "#")
- (?\✓ "X")
- (?\✗ "X")
- (?\✠ "-X")
- (?\  " ")
- (?\、 ",_")
- (?\。 "._")
- (?\〃 "+\"")
- (?\〄 "JIS")
- (?\々 "*_")
- (?\〆 ";_")
- (?\〇 "0_")
- (?\《 "<+")
- (?\》 ">+")
- (?\「 "<'")
- (?\」 ">'")
- (?\『 "<\"")
- (?\』 ">\"")
- (?\【 "(\"")
- (?\】 ")\"")
- (?\〒 "=T")
- (?\〓 "=_")
- (?\〔 "('")
- (?\〕 ")'")
- (?\〖 "(I")
- (?\〗 ")I")
- (?\〚 "[[")
- (?\〛 "]]")
- (?\〜 "-?")
- (?\〠 "=T:)")
- (?\〿 " ")
- (?\ぁ "A5")
- (?\あ "a5")
- (?\ぃ "I5")
- (?\い "i5")
- (?\ぅ "U5")
- (?\う "u5")
- (?\ぇ "E5")
- (?\え "e5")
- (?\ぉ "O5")
- (?\お "o5")
- (?\か "ka")
- (?\が "ga")
- (?\き "ki")
- (?\ぎ "gi")
- (?\く "ku")
- (?\ぐ "gu")
- (?\け "ke")
- (?\げ "ge")
- (?\こ "ko")
- (?\ご "go")
- (?\さ "sa")
- (?\ざ "za")
- (?\し "si")
- (?\じ "zi")
- (?\す "su")
- (?\ず "zu")
- (?\せ "se")
- (?\ぜ "ze")
- (?\そ "so")
- (?\ぞ "zo")
- (?\た "ta")
- (?\だ "da")
- (?\ち "ti")
- (?\ぢ "di")
- (?\っ "tU")
- (?\つ "tu")
- (?\づ "du")
- (?\て "te")
- (?\で "de")
- (?\と "to")
- (?\ど "do")
- (?\な "na")
- (?\に "ni")
- (?\ぬ "nu")
- (?\ね "ne")
- (?\の "no")
- (?\は "ha")
- (?\ば "ba")
- (?\ぱ "pa")
- (?\ひ "hi")
- (?\び "bi")
- (?\ぴ "pi")
- (?\ふ "hu")
- (?\ぶ "bu")
- (?\ぷ "pu")
- (?\へ "he")
- (?\べ "be")
- (?\ぺ "pe")
- (?\ほ "ho")
- (?\ぼ "bo")
- (?\ぽ "po")
- (?\ま "ma")
- (?\み "mi")
- (?\む "mu")
- (?\め "me")
- (?\も "mo")
- (?\ゃ "yA")
- (?\や "ya")
- (?\ゅ "yU")
- (?\ゆ "yu")
- (?\ょ "yO")
- (?\よ "yo")
- (?\ら "ra")
- (?\り "ri")
- (?\る "ru")
- (?\れ "re")
- (?\ろ "ro")
- (?\ゎ "wA")
- (?\わ "wa")
- (?\ゐ "wi")
- (?\ゑ "we")
- (?\を "wo")
- (?\ん "n5")
- (?\ゔ "vu")
- (?\゛ "\"5")
- (?\゜ "05")
- (?\ゝ "*5")
- (?\ゞ "+5")
- (?\ァ "a6")
- (?\ア "A6")
- (?\ィ "i6")
- (?\イ "I6")
- (?\ゥ "u6")
- (?\ウ "U6")
- (?\ェ "e6")
- (?\エ "E6")
- (?\ォ "o6")
- (?\オ "O6")
- (?\カ "Ka")
- (?\ガ "Ga")
- (?\キ "Ki")
- (?\ギ "Gi")
- (?\ク "Ku")
- (?\グ "Gu")
- (?\ケ "Ke")
- (?\ゲ "Ge")
- (?\コ "Ko")
- (?\ゴ "Go")
- (?\サ "Sa")
- (?\ザ "Za")
- (?\シ "Si")
- (?\ジ "Zi")
- (?\ス "Su")
- (?\ズ "Zu")
- (?\セ "Se")
- (?\ゼ "Ze")
- (?\ソ "So")
- (?\ゾ "Zo")
- (?\タ "Ta")
- (?\ダ "Da")
- (?\チ "Ti")
- (?\ヂ "Di")
- (?\ッ "TU")
- (?\ツ "Tu")
- (?\ヅ "Du")
- (?\テ "Te")
- (?\デ "De")
- (?\ト "To")
- (?\ド "Do")
- (?\ナ "Na")
- (?\ニ "Ni")
- (?\ヌ "Nu")
- (?\ネ "Ne")
- (?\ノ "No")
- (?\ハ "Ha")
- (?\バ "Ba")
- (?\パ "Pa")
- (?\ヒ "Hi")
- (?\ビ "Bi")
- (?\ピ "Pi")
- (?\フ "Hu")
- (?\ブ "Bu")
- (?\プ "Pu")
- (?\ヘ "He")
- (?\ベ "Be")
- (?\ペ "Pe")
- (?\ホ "Ho")
- (?\ボ "Bo")
- (?\ポ "Po")
- (?\マ "Ma")
- (?\ミ "Mi")
- (?\ム "Mu")
- (?\メ "Me")
- (?\モ "Mo")
- (?\ャ "YA")
- (?\ヤ "Ya")
- (?\ュ "YU")
- (?\ユ "Yu")
- (?\ョ "YO")
- (?\ヨ "Yo")
- (?\ラ "Ra")
- (?\リ "Ri")
- (?\ル "Ru")
- (?\レ "Re")
- (?\ロ "Ro")
- (?\ヮ "WA")
- (?\ワ "Wa")
- (?\ヰ "Wi")
- (?\ヱ "We")
- (?\ヲ "Wo")
- (?\ン "N6")
- (?\ヴ "Vu")
- (?\ヵ "KA")
- (?\ヶ "KE")
- (?\ヷ "Va")
- (?\ヸ "Vi")
- (?\ヹ "Ve")
- (?\ヺ "Vo")
- (?\・ ".6")
- (?\ー "-6")
- (?\ヽ "*6")
- (?\ヾ "+6")
- (?\ㄅ "b4")
- (?\ㄆ "p4")
- (?\ㄇ "m4")
- (?\ㄈ "f4")
- (?\ㄉ "d4")
- (?\ㄊ "t4")
- (?\ㄋ "n4")
- (?\ㄌ "l4")
- (?\ㄍ "g4")
- (?\ㄎ "k4")
- (?\ㄏ "h4")
- (?\ㄐ "j4")
- (?\ㄑ "q4")
- (?\ㄒ "x4")
- (?\ㄓ "zh")
- (?\ㄔ "ch")
- (?\ㄕ "sh")
- (?\ㄖ "r4")
- (?\ㄗ "z4")
- (?\ㄘ "c4")
- (?\ㄙ "s4")
- (?\ㄚ "a4")
- (?\ㄛ "o4")
- (?\ㄜ "e4")
- (?\ㄝ "eh4")
- (?\ㄞ "ai")
- (?\ㄟ "ei")
- (?\ㄠ "au")
- (?\ㄡ "ou")
- (?\ㄢ "an")
- (?\ㄣ "en")
- (?\ㄤ "aN")
- (?\ㄥ "eN")
- (?\ㄦ "er")
- (?\ㄧ "i4")
- (?\ㄨ "u4")
- (?\ㄩ "iu")
- (?\ㄪ "v4")
- (?\ㄫ "nG")
- (?\ㄬ "gn")
- (?\㈜ "(JU)")
- (?\㈠ "1c")
- (?\㈡ "2c")
- (?\㈢ "3c")
- (?\㈣ "4c")
- (?\㈤ "5c")
- (?\㈥ "6c")
- (?\㈦ "7c")
- (?\㈧ "8c")
- (?\㈨ "9c")
- (?\㈩ "10c")
- (?\㉿ "KSC")
- (?\㏂ "am")
- (?\㏘ "pm")
- (?\ff "ff")
- (?\fi "fi")
- (?\fl "fl")
- (?\ffi "ffi")
- (?\ffl "ffl")
- (?\ſt "St")
- (?\st "st")
- (?\ﹽ "3+;")
- (?\ﺂ "aM.")
- (?\ﺄ "aH.")
- (?\ﺈ "ah.")
- (?\ﺍ "a+-")
- (?\ﺎ "a+.")
- (?\ﺏ "b+-")
- (?\ﺐ "b+.")
- (?\ﺑ "b+,")
- (?\ﺒ "b+;")
- (?\ﺓ "tm-")
- (?\ﺔ "tm.")
- (?\ﺕ "t+-")
- (?\ﺖ "t+.")
- (?\ﺗ "t+,")
- (?\ﺘ "t+;")
- (?\ﺙ "tk-")
- (?\ﺚ "tk.")
- (?\ﺛ "tk,")
- (?\ﺜ "tk;")
- (?\ﺝ "g+-")
- (?\ﺞ "g+.")
- (?\ﺟ "g+,")
- (?\ﺠ "g+;")
- (?\ﺡ "hk-")
- (?\ﺢ "hk.")
- (?\ﺣ "hk,")
- (?\ﺤ "hk;")
- (?\ﺥ "x+-")
- (?\ﺦ "x+.")
- (?\ﺧ "x+,")
- (?\ﺨ "x+;")
- (?\ﺩ "d+-")
- (?\ﺪ "d+.")
- (?\ﺫ "dk-")
- (?\ﺬ "dk.")
- (?\ﺭ "r+-")
- (?\ﺮ "r+.")
- (?\ﺯ "z+-")
- (?\ﺰ "z+.")
- (?\ﺱ "s+-")
- (?\ﺲ "s+.")
- (?\ﺳ "s+,")
- (?\ﺴ "s+;")
- (?\ﺵ "sn-")
- (?\ﺶ "sn.")
- (?\ﺷ "sn,")
- (?\ﺸ "sn;")
- (?\ﺹ "c+-")
- (?\ﺺ "c+.")
- (?\ﺻ "c+,")
- (?\ﺼ "c+;")
- (?\ﺽ "dd-")
- (?\ﺾ "dd.")
- (?\ﺿ "dd,")
- (?\ﻀ "dd;")
- (?\ﻁ "tj-")
- (?\ﻂ "tj.")
- (?\ﻃ "tj,")
- (?\ﻄ "tj;")
- (?\ﻅ "zH-")
- (?\ﻆ "zH.")
- (?\ﻇ "zH,")
- (?\ﻈ "zH;")
- (?\ﻉ "e+-")
- (?\ﻊ "e+.")
- (?\ﻋ "e+,")
- (?\ﻌ "e+;")
- (?\ﻍ "i+-")
- (?\ﻎ "i+.")
- (?\ﻏ "i+,")
- (?\ﻐ "i+;")
- (?\ﻑ "f+-")
- (?\ﻒ "f+.")
- (?\ﻓ "f+,")
- (?\ﻔ "f+;")
- (?\ﻕ "q+-")
- (?\ﻖ "q+.")
- (?\ﻗ "q+,")
- (?\ﻘ "q+;")
- (?\ﻙ "k+-")
- (?\ﻚ "k+.")
- (?\ﻛ "k+,")
- (?\ﻜ "k+;")
- (?\ﻝ "l+-")
- (?\ﻞ "l+.")
- (?\ﻟ "l+,")
- (?\ﻠ "l+;")
- (?\ﻡ "m+-")
- (?\ﻢ "m+.")
- (?\ﻣ "m+,")
- (?\ﻤ "m+;")
- (?\ﻥ "n+-")
- (?\ﻦ "n+.")
- (?\ﻧ "n+,")
- (?\ﻨ "n+;")
- (?\ﻩ "h+-")
- (?\ﻪ "h+.")
- (?\ﻫ "h+,")
- (?\ﻬ "h+;")
- (?\ﻭ "w+-")
- (?\ﻮ "w+.")
- (?\ﻯ "j+-")
- (?\ﻰ "j+.")
- (?\ﻱ "y+-")
- (?\ﻲ "y+.")
- (?\ﻳ "y+,")
- (?\ﻴ "y+;")
- (?\ﻵ "lM-")
- (?\ﻶ "lM.")
- (?\ﻷ "lH-")
- (?\ﻸ "lH.")
- (?\ﻹ "lh-")
- (?\ﻺ "lh.")
- (?\ﻻ "la-")
- (?\ﻼ "la.")
- (?\! "!")
- (?\" "\"")
- (?\# "#")
- (?\$ "$")
- (?\% "%")
- (?\& "&")
- (?\' "'")
- (?\( "(")
- (?\) ")")
- (?\* "*")
- (?\+ "+")
- (?\, ",")
- (?\- "-")
- (?\. ".")
- (?\/ "/")
- (?\0 "0")
- (?\1 "1")
- (?\2 "2")
- (?\3 "3")
- (?\4 "4")
- (?\5 "5")
- (?\6 "6")
- (?\7 "7")
- (?\8 "8")
- (?\9 "9")
- (?\: ":")
- (?\; ";")
- (?\< "<")
- (?\= "=")
- (?\> ">")
- (?\? "?")
- (?\@ "@")
- (?\A "A")
- (?\B "B")
- (?\C "C")
- (?\D "D")
- (?\E "E")
- (?\F "F")
- (?\G "G")
- (?\H "H")
- (?\I "I")
- (?\J "J")
- (?\K "K")
- (?\L "L")
- (?\M "M")
- (?\N "N")
- (?\O "O")
- (?\P "P")
- (?\Q "Q")
- (?\R "R")
- (?\S "S")
- (?\T "T")
- (?\U "U")
- (?\V "V")
- (?\W "W")
- (?\X "X")
- (?\Y "Y")
- (?\Z "Z")
- (?\[ "[")
- (?\\ "\\")
- (?\] "]")
- (?\^ "^")
- (?\_ "_")
- (?\` "`")
- (?\a "a")
- (?\b "b")
- (?\c "c")
- (?\d "d")
- (?\e "e")
- (?\f "f")
- (?\g "g")
- (?\h "h")
- (?\i "i")
- (?\j "j")
- (?\k "k")
- (?\l "l")
- (?\m "m")
- (?\n "n")
- (?\o "o")
- (?\p "p")
- (?\q "q")
- (?\r "r")
- (?\s "s")
- (?\t "t")
- (?\u "u")
- (?\v "v")
- (?\w "w")
- (?\x "x")
- (?\y "y")
- (?\z "z")
- (?\{ "{")
- (?\| "|")
- (?\} "}")
- (?\~ "~")
- (?\。 ".")
- (?\「 "\"")
- (?\」 "\"")
- (?\、 ",")
- ;; Not from Lynx
- (? "")
- (?� "?")))))
+ (let ((latin1-display-format "%s"))
+ (mapc
+ (lambda (l)
+ (or (char-displayable-p (car l))
+ (apply 'latin1-display-char l)))
+ ;; Table derived by running Lynx on a suitable list of
+ ;; characters in a utf-8 file, except for some added by
+ ;; hand at the end.
+ '((?\Ā "A")
+ (?\ā "a")
+ (?\Ă "A")
+ (?\ă "a")
+ (?\Ą "A")
+ (?\ą "a")
+ (?\Ć "C")
+ (?\ć "c")
+ (?\Ĉ "C")
+ (?\ĉ "c")
+ (?\Ċ "C")
+ (?\ċ "c")
+ (?\Č "C")
+ (?\č "c")
+ (?\Ď "D")
+ (?\ď "d")
+ (?\Đ "Ð")
+ (?\đ "d/")
+ (?\Ē "E")
+ (?\ē "e")
+ (?\Ĕ "E")
+ (?\ĕ "e")
+ (?\Ė "E")
+ (?\ė "e")
+ (?\Ę "E")
+ (?\ę "e")
+ (?\Ě "E")
+ (?\ě "e")
+ (?\Ĝ "G")
+ (?\ĝ "g")
+ (?\Ğ "G")
+ (?\ğ "g")
+ (?\Ġ "G")
+ (?\ġ "g")
+ (?\Ģ "G")
+ (?\ģ "g")
+ (?\Ĥ "H")
+ (?\ĥ "h")
+ (?\Ħ "H/")
+ (?\ħ "H")
+ (?\Ĩ "I")
+ (?\ĩ "i")
+ (?\Ī "I")
+ (?\ī "i")
+ (?\Ĭ "I")
+ (?\ĭ "i")
+ (?\Į "I")
+ (?\į "i")
+ (?\İ "I")
+ (?\ı "i")
+ (?\IJ "IJ")
+ (?\ij "ij")
+ (?\Ĵ "J")
+ (?\ĵ "j")
+ (?\Ķ "K")
+ (?\ķ "k")
+ (?\ĸ "kk")
+ (?\Ĺ "L")
+ (?\ĺ "l")
+ (?\Ļ "L")
+ (?\ļ "l")
+ (?\Ľ "L")
+ (?\ľ "l")
+ (?\Ŀ "L.")
+ (?\ŀ "l.")
+ (?\Ł "L/")
+ (?\ł "l/")
+ (?\Ń "N")
+ (?\ń "n")
+ (?\Ņ "N")
+ (?\ņ "n")
+ (?\Ň "N")
+ (?\ň "n")
+ (?\ʼn "'n")
+ (?\Ŋ "NG")
+ (?\ŋ "N")
+ (?\Ō "O")
+ (?\ō "o")
+ (?\Ŏ "O")
+ (?\ŏ "o")
+ (?\Ő "O\"")
+ (?\ő "o\"")
+ (?\Œ "OE")
+ (?\œ "oe")
+ (?\Ŕ "R")
+ (?\ŕ "r")
+ (?\Ŗ "R")
+ (?\ŗ "r")
+ (?\Ř "R")
+ (?\ř "r")
+ (?\Ś "S")
+ (?\ś "s")
+ (?\Ŝ "S")
+ (?\ŝ "s")
+ (?\Ş "S")
+ (?\ş "s")
+ (?\Š "S")
+ (?\š "s")
+ (?\Ţ "T")
+ (?\ţ "t")
+ (?\Ť "T")
+ (?\ť "t")
+ (?\Ŧ "T/")
+ (?\ŧ "t/")
+ (?\Ũ "U")
+ (?\ũ "u")
+ (?\Ū "U")
+ (?\ū "u")
+ (?\Ŭ "U")
+ (?\ŭ "u")
+ (?\Ů "U")
+ (?\ů "u")
+ (?\Ű "U\"")
+ (?\ű "u\"")
+ (?\Ų "U")
+ (?\ų "u")
+ (?\Ŵ "W")
+ (?\ŵ "w")
+ (?\Ŷ "Y")
+ (?\ŷ "y")
+ (?\Ÿ "Y")
+ (?\Ź "Z")
+ (?\ź "z")
+ (?\Ż "Z")
+ (?\ż "z")
+ (?\Ž "Z")
+ (?\ž "z")
+ (?\ſ "s1")
+ (?\Ƈ "C2")
+ (?\ƈ "c2")
+ (?\Ƒ "F2")
+ (?\ƒ " f")
+ (?\Ƙ "K2")
+ (?\ƙ "k2")
+ (?\Ơ "O9")
+ (?\ơ "o9")
+ (?\Ƣ "OI")
+ (?\ƣ "oi")
+ (?\Ʀ "yr")
+ (?\Ư "U9")
+ (?\ư "u9")
+ (?\Ƶ "Z/")
+ (?\ƶ "z/")
+ (?\Ʒ "ED")
+ (?\Ǎ "A")
+ (?\ǎ "a")
+ (?\Ǐ "I")
+ (?\ǐ "i")
+ (?\Ǒ "O")
+ (?\ǒ "o")
+ (?\Ǔ "U")
+ (?\ǔ "u")
+ (?\Ǖ "U:-")
+ (?\ǖ "u:-")
+ (?\Ǘ "U:'")
+ (?\ǘ "u:'")
+ (?\Ǚ "U:<")
+ (?\ǚ "u:<")
+ (?\Ǜ "U:!")
+ (?\ǜ "u:!")
+ (?\Ǟ "A1")
+ (?\ǟ "a1")
+ (?\Ǡ "A7")
+ (?\ǡ "a7")
+ (?\Ǣ "A3")
+ (?\ǣ "a3")
+ (?\Ǥ "G/")
+ (?\ǥ "g/")
+ (?\Ǧ "G")
+ (?\ǧ "g")
+ (?\Ǩ "K")
+ (?\ǩ "k")
+ (?\Ǫ "O")
+ (?\ǫ "o")
+ (?\Ǭ "O1")
+ (?\ǭ "o1")
+ (?\Ǯ "EZ")
+ (?\ǯ "ez")
+ (?\ǰ "j")
+ (?\Ǵ "G")
+ (?\ǵ "g")
+ (?\Ǻ "AA'")
+ (?\ǻ "aa'")
+ (?\Ǽ "AE'")
+ (?\ǽ "ae'")
+ (?\Ǿ "O/'")
+ (?\ǿ "o/'")
+ (?\Ȁ "A!!")
+ (?\ȁ "a!!")
+ (?\Ȃ "A)")
+ (?\ȃ "a)")
+ (?\Ȅ "E!!")
+ (?\ȅ "e!!")
+ (?\Ȇ "E)")
+ (?\ȇ "e)")
+ (?\Ȉ "I!!")
+ (?\ȉ "i!!")
+ (?\Ȋ "I)")
+ (?\ȋ "i)")
+ (?\Ȍ "O!!")
+ (?\ȍ "o!!")
+ (?\Ȏ "O)")
+ (?\ȏ "o)")
+ (?\Ȑ "R!!")
+ (?\ȑ "r!!")
+ (?\Ȓ "R)")
+ (?\ȓ "r)")
+ (?\Ȕ "U!!")
+ (?\ȕ "u!!")
+ (?\Ȗ "U)")
+ (?\ȗ "u)")
+ (?\ȝ "Z")
+ (?\ɑ "A")
+ (?\ɒ "A.")
+ (?\ɓ "b`")
+ (?\ɔ "O")
+ (?\ɖ "d.")
+ (?\ɗ "d`")
+ (?\ɘ "@<umd>")
+ (?\ə "@")
+ (?\ɚ "R")
+ (?\ɛ "E")
+ (?\ɜ "V\"")
+ (?\ɝ "R<umd>")
+ (?\ɞ "O\"")
+ (?\ɟ "J")
+ (?\ɠ "g`")
+ (?\ɡ "g")
+ (?\ɢ "G")
+ (?\ɣ "Q")
+ (?\ɤ "o-")
+ (?\ɥ "j<rnd>")
+ (?\ɦ "h<?>")
+ (?\ɨ "i\"")
+ (?\ɩ "I")
+ (?\ɪ "I")
+ (?\ɫ "L")
+ (?\ɬ "L")
+ (?\ɭ "l.")
+ (?\ɮ "z<lat>")
+ (?\ɯ "u-")
+ (?\ɰ "j<vel>")
+ (?\ɱ "M")
+ (?\ɳ "n.")
+ (?\ɴ "n\"")
+ (?\ɵ "@.")
+ (?\ɶ "&.")
+ (?\ɷ "U")
+ (?\ɹ "r")
+ (?\ɺ "*<lat>")
+ (?\ɻ "r.")
+ (?\ɽ "*.")
+ (?\ɾ "*")
+ (?\ʀ "R")
+ (?\ʁ "g\"")
+ (?\ʂ "s.")
+ (?\ʃ "S")
+ (?\ʄ "J`")
+ (?\ʇ "t!")
+ (?\ʈ "t.")
+ (?\ʉ "u\"")
+ (?\ʊ "U")
+ (?\ʋ "r<lbd>")
+ (?\ʌ "V")
+ (?\ʍ "w<vls>")
+ (?\ʎ "l^")
+ (?\ʏ "I.")
+ (?\ʐ "z.")
+ (?\ʒ "Z")
+ (?\ʔ "?")
+ (?\ʕ "H<vcd>")
+ (?\ʖ "l!")
+ (?\ʗ "c!")
+ (?\ʘ "p!")
+ (?\ʙ "b<trl>")
+ (?\ʛ "G`")
+ (?\ʝ "j")
+ (?\ʞ "k!")
+ (?\ʟ "L")
+ (?\ʠ "q`")
+ (?\ʤ "d3")
+ (?\ʦ "ts")
+ (?\ʧ "tS")
+ (?\ʰ "<h>")
+ (?\ʱ "<?>")
+ (?\ʲ ";")
+ (?\ʳ "<r>")
+ (?\ʷ "<w>")
+ (?\ʻ ";S")
+ (?\ʼ "`")
+ (?\ˆ "^")
+ (?\ˇ "'<")
+ (?\ˈ "|")
+ (?\ˉ "1-")
+ (?\ˋ "1!")
+ (?\ː ":")
+ (?\ˑ ":\\")
+ (?\˖ "+")
+ (?\˗ "-")
+ (?\˘ "'(")
+ (?\˙ "'.")
+ (?\˚ "'0")
+ (?\˛ "';")
+ (?\˜ "~")
+ (?\˝ "'\"")
+ (?\˥ "_T")
+ (?\˦ "_H")
+ (?\˧ "_M")
+ (?\˨ "_L")
+ (?\˩ "_B")
+ (?\ˬ "_v")
+ (?\ˮ "''")
+ (?\̀ "`")
+ (?\́ "'")
+ (?\̂ "^")
+ (?\̃ "~")
+ (?\̄ "¯")
+ (?\̇ "·")
+ (?\̈ "¨")
+ (?\̊ "°")
+ (?\̋ "''")
+ (?\̍ "|")
+ (?\̎ "||")
+ (?\̏ "``")
+ (?\̡ ";")
+ (?\̢ ".")
+ (?\̣ ".")
+ (?\̤ "<?>")
+ (?\̥ "<o>")
+ (?\̦ ",")
+ (?\̧ "¸")
+ (?\̩ "-")
+ (?\̪ "[")
+ (?\̫ "<w>")
+ (?\̴ "~")
+ (?\̷ "/")
+ (?\̸ "/")
+ (?\̀ "`")
+ (?\́ "'")
+ (?\͂ "~")
+ (?\̈́ "'%")
+ (?\ͅ "j3")
+ (?\͇ "=")
+ (?\͠ "~~")
+ (?\ʹ "'")
+ (?\͵ ",")
+ (?\ͺ "j3")
+ (?\; "?%")
+ (?\΄ "'*")
+ (?\΅ "'%")
+ (?\Ά "A'")
+ (?\· "·")
+ (?\Έ "E'")
+ (?\Ή "Y%")
+ (?\Ί "I'")
+ (?\Ό "O'")
+ (?\Ύ "U%")
+ (?\Ώ "W%")
+ (?\ΐ "i3")
+ (?\Α "A")
+ (?\Β "B")
+ (?\Γ "G")
+ (?\Δ "D")
+ (?\Ε "E")
+ (?\Ζ "Z")
+ (?\Η "Y")
+ (?\Θ "TH")
+ (?\Ι "I")
+ (?\Κ "K")
+ (?\Λ "L")
+ (?\Μ "M")
+ (?\Ν "N")
+ (?\Ξ "C")
+ (?\Ο "O")
+ (?\Π "P")
+ (?\Ρ "R")
+ (?\Σ "S")
+ (?\Τ "T")
+ (?\Υ "U")
+ (?\Φ "F")
+ (?\Χ "X")
+ (?\Ψ "Q")
+ (?\Ω "W*")
+ (?\Ϊ "J")
+ (?\Ϋ "V*")
+ (?\ά "a'")
+ (?\έ "e'")
+ (?\ή "y%")
+ (?\ί "i'")
+ (?\ΰ "u3")
+ (?\α "a")
+ (?\β "b")
+ (?\γ "g")
+ (?\δ "d")
+ (?\ε "e")
+ (?\ζ "z")
+ (?\η "y")
+ (?\θ "th")
+ (?\ι "i")
+ (?\κ "k")
+ (?\λ "l")
+ (?\μ "µ")
+ (?\ν "n")
+ (?\ξ "c")
+ (?\ο "o")
+ (?\π "p")
+ (?\ρ "r")
+ (?\ς "*s")
+ (?\σ "s")
+ (?\τ "t")
+ (?\υ "u")
+ (?\φ "f")
+ (?\χ "x")
+ (?\ψ "q")
+ (?\ω "w")
+ (?\ϊ "j")
+ (?\ϋ "v*")
+ (?\ό "o'")
+ (?\ύ "u%")
+ (?\ώ "w%")
+ (?\ϐ "beta ")
+ (?\ϑ "theta ")
+ (?\ϒ "upsi ")
+ (?\ϕ "phi ")
+ (?\ϖ "pi ")
+ (?\ϗ "k.")
+ (?\Ϛ "T3")
+ (?\ϛ "t3")
+ (?\Ϝ "M3")
+ (?\ϝ "m3")
+ (?\Ϟ "K3")
+ (?\ϟ "k3")
+ (?\Ϡ "P3")
+ (?\ϡ "p3")
+ (?\ϰ "kappa ")
+ (?\ϱ "rho ")
+ (?\ϳ "J")
+ (?\ϴ "'%")
+ (?\ϵ "j3")
+ (?\Ё "IO")
+ (?\Ђ "D%")
+ (?\Ѓ "G%")
+ (?\Є "IE")
+ (?\Ѕ "DS")
+ (?\І "II")
+ (?\Ї "YI")
+ (?\Ј "J%")
+ (?\Љ "LJ")
+ (?\Њ "NJ")
+ (?\Ћ "Ts")
+ (?\Ќ "KJ")
+ (?\Ў "V%")
+ (?\Џ "DZ")
+ (?\А "A")
+ (?\Б "B")
+ (?\В "V")
+ (?\Г "G")
+ (?\Д "D")
+ (?\Е "E")
+ (?\Ж "ZH")
+ (?\З "Z")
+ (?\И "I")
+ (?\Й "J")
+ (?\К "K")
+ (?\Л "L")
+ (?\М "M")
+ (?\Н "N")
+ (?\О "O")
+ (?\П "P")
+ (?\Р "R")
+ (?\С "S")
+ (?\Т "T")
+ (?\У "U")
+ (?\Ф "F")
+ (?\Х "H")
+ (?\Ц "C")
+ (?\Ч "CH")
+ (?\Ш "SH")
+ (?\Щ "SCH")
+ (?\Ъ "\"")
+ (?\Ы "Y")
+ (?\Ь "'")
+ (?\Э "`E")
+ (?\Ю "YU")
+ (?\Я "YA")
+ (?\а "a")
+ (?\б "b")
+ (?\в "v")
+ (?\г "g")
+ (?\д "d")
+ (?\е "e")
+ (?\ж "zh")
+ (?\з "z")
+ (?\и "i")
+ (?\й "j")
+ (?\к "k")
+ (?\л "l")
+ (?\м "m")
+ (?\н "n")
+ (?\о "o")
+ (?\п "p")
+ (?\р "r")
+ (?\с "s")
+ (?\т "t")
+ (?\у "u")
+ (?\ф "f")
+ (?\х "h")
+ (?\ц "c")
+ (?\ч "ch")
+ (?\ш "sh")
+ (?\щ "sch")
+ (?\ъ "\"")
+ (?\ы "y")
+ (?\ь "'")
+ (?\э "`e")
+ (?\ю "yu")
+ (?\я "ya")
+ (?\ё "io")
+ (?\ђ "d%")
+ (?\ѓ "g%")
+ (?\є "ie")
+ (?\ѕ "ds")
+ (?\і "ii")
+ (?\ї "yi")
+ (?\ј "j%")
+ (?\љ "lj")
+ (?\њ "nj")
+ (?\ћ "ts")
+ (?\ќ "kj")
+ (?\ў "v%")
+ (?\џ "dz")
+ (?\Ѣ "Y3")
+ (?\ѣ "y3")
+ (?\Ѫ "O3")
+ (?\ѫ "o3")
+ (?\Ѳ "F3")
+ (?\ѳ "f3")
+ (?\Ѵ "V3")
+ (?\ѵ "v3")
+ (?\Ҁ "C3")
+ (?\ҁ "c3")
+ (?\Ґ "G3")
+ (?\ґ "g3")
+ (?\Ӕ "AE")
+ (?\ӕ "ae")
+ (?\ִ "i")
+ (?\ַ "a")
+ (?\ָ "o")
+ (?\ּ "u")
+ (?\ֿ "h")
+ (?\ׂ ":")
+ (?\א "#")
+ (?\ב "B+")
+ (?\ג "G+")
+ (?\ד "D+")
+ (?\ה "H+")
+ (?\ו "W+")
+ (?\ז "Z+")
+ (?\ח "X+")
+ (?\ט "Tj")
+ (?\י "J+")
+ (?\ך "K%")
+ (?\כ "K+")
+ (?\ל "L+")
+ (?\ם "M%")
+ (?\מ "M+")
+ (?\ן "N%")
+ (?\נ "N+")
+ (?\ס "S+")
+ (?\ע "E+")
+ (?\ף "P%")
+ (?\פ "P+")
+ (?\ץ "Zj")
+ (?\צ "ZJ")
+ (?\ק "Q+")
+ (?\ר "R+")
+ (?\ש "Sh")
+ (?\ת "T+")
+ (?\װ "v")
+ (?\ױ "oy")
+ (?\ײ "ey")
+ (?\، ",+")
+ (?\؛ ";+")
+ (?\؟ "?+")
+ (?\ء "H'")
+ (?\آ "aM")
+ (?\أ "aH")
+ (?\ؤ "wH")
+ (?\إ "ah")
+ (?\ئ "yH")
+ (?\ا "a+")
+ (?\ب "b+")
+ (?\ة "tm")
+ (?\ت "t+")
+ (?\ث "tk")
+ (?\ج "g+")
+ (?\ح "hk")
+ (?\خ "x+")
+ (?\د "d+")
+ (?\ذ "dk")
+ (?\ر "r+")
+ (?\ز "z+")
+ (?\س "s+")
+ (?\ش "sn")
+ (?\ص "c+")
+ (?\ض "dd")
+ (?\ط "tj")
+ (?\ظ "zH")
+ (?\ع "e+")
+ (?\غ "i+")
+ (?\ـ "++")
+ (?\ف "f+")
+ (?\ق "q+")
+ (?\ك "k+")
+ (?\ل "l+")
+ (?\م "m+")
+ (?\ن "n+")
+ (?\ه "h+")
+ (?\و "w+")
+ (?\ى "j+")
+ (?\ي "y+")
+ (?\ً ":+")
+ (?\ٌ "\"+")
+ (?\ٍ "=+")
+ (?\َ "/+")
+ (?\ُ "'+")
+ (?\ِ "1+")
+ (?\ّ "3+")
+ (?\ْ "0+")
+ (?\٠ "0a")
+ (?\١ "1a")
+ (?\٢ "2a")
+ (?\٣ "3a")
+ (?\٤ "4a")
+ (?\٥ "5a")
+ (?\٦ "6a")
+ (?\٧ "7a")
+ (?\٨ "8a")
+ (?\٩ "9a")
+ (?\ٰ "aS")
+ (?\پ "p+")
+ (?\ځ "hH")
+ (?\چ "tc")
+ (?\ژ "zj")
+ (?\ڤ "v+")
+ (?\گ "gf")
+ (?\۰ "0a")
+ (?\۱ "1a")
+ (?\۲ "2a")
+ (?\۳ "3a")
+ (?\۴ "4a")
+ (?\۵ "5a")
+ (?\۶ "6a")
+ (?\۷ "7a")
+ (?\۸ "8a")
+ (?\۹ "9a")
+ (?\ሀ "he")
+ (?\ሁ "hu")
+ (?\ሂ "hi")
+ (?\ሃ "ha")
+ (?\ሄ "hE")
+ (?\ህ "h")
+ (?\ሆ "ho")
+ (?\ለ "le")
+ (?\ሉ "lu")
+ (?\ሊ "li")
+ (?\ላ "la")
+ (?\ሌ "lE")
+ (?\ል "l")
+ (?\ሎ "lo")
+ (?\ሏ "lWa")
+ (?\ሐ "He")
+ (?\ሑ "Hu")
+ (?\ሒ "Hi")
+ (?\ሓ "Ha")
+ (?\ሔ "HE")
+ (?\ሕ "H")
+ (?\ሖ "Ho")
+ (?\ሗ "HWa")
+ (?\መ "me")
+ (?\ሙ "mu")
+ (?\ሚ "mi")
+ (?\ማ "ma")
+ (?\ሜ "mE")
+ (?\ም "m")
+ (?\ሞ "mo")
+ (?\ሟ "mWa")
+ (?\ሠ "`se")
+ (?\ሡ "`su")
+ (?\ሢ "`si")
+ (?\ሣ "`sa")
+ (?\ሤ "`sE")
+ (?\ሥ "`s")
+ (?\ሦ "`so")
+ (?\ሧ "`sWa")
+ (?\ረ "re")
+ (?\ሩ "ru")
+ (?\ሪ "ri")
+ (?\ራ "ra")
+ (?\ሬ "rE")
+ (?\ር "r")
+ (?\ሮ "ro")
+ (?\ሯ "rWa")
+ (?\ሰ "se")
+ (?\ሱ "su")
+ (?\ሲ "si")
+ (?\ሳ "sa")
+ (?\ሴ "sE")
+ (?\ስ "s")
+ (?\ሶ "so")
+ (?\ሷ "sWa")
+ (?\ሸ "xe")
+ (?\ሹ "xu")
+ (?\ሺ "xi")
+ (?\ሻ "xa")
+ (?\ሼ "xE")
+ (?\ሽ "xa")
+ (?\ሾ "xo")
+ (?\ሿ "xWa")
+ (?\ቀ "qe")
+ (?\ቁ "qu")
+ (?\ቂ "qi")
+ (?\ቃ "qa")
+ (?\ቄ "qE")
+ (?\ቅ "q")
+ (?\ቆ "qo")
+ (?\ቈ "qWe")
+ (?\ቊ "qWi")
+ (?\ቋ "qWa")
+ (?\ቌ "qWE")
+ (?\ቍ "qW")
+ (?\ቐ "Qe")
+ (?\ቑ "Qu")
+ (?\ቒ "Qi")
+ (?\ቓ "Qa")
+ (?\ቔ "QE")
+ (?\ቕ "Q")
+ (?\ቖ "Qo")
+ (?\ቘ "QWe")
+ (?\ቚ "QWi")
+ (?\ቛ "QWa")
+ (?\ቜ "QWE")
+ (?\ቝ "QW")
+ (?\በ "be")
+ (?\ቡ "bu")
+ (?\ቢ "bi")
+ (?\ባ "ba")
+ (?\ቤ "bE")
+ (?\ብ "b")
+ (?\ቦ "bo")
+ (?\ቧ "bWa")
+ (?\ቨ "ve")
+ (?\ቩ "vu")
+ (?\ቪ "vi")
+ (?\ቫ "va")
+ (?\ቬ "vE")
+ (?\ቭ "v")
+ (?\ቮ "vo")
+ (?\ቯ "vWa")
+ (?\ተ "te")
+ (?\ቱ "tu")
+ (?\ቲ "ti")
+ (?\ታ "ta")
+ (?\ቴ "tE")
+ (?\ት "t")
+ (?\ቶ "to")
+ (?\ቷ "tWa")
+ (?\ቸ "ce")
+ (?\ቹ "cu")
+ (?\ቺ "ci")
+ (?\ቻ "ca")
+ (?\ቼ "cE")
+ (?\ች "c")
+ (?\ቾ "co")
+ (?\ቿ "cWa")
+ (?\ኀ "`he")
+ (?\ኁ "`hu")
+ (?\ኂ "`hi")
+ (?\ኃ "`ha")
+ (?\ኄ "`hE")
+ (?\ኅ "`h")
+ (?\ኆ "`ho")
+ (?\ኈ "hWe")
+ (?\ኊ "hWi")
+ (?\ኋ "hWa")
+ (?\ኌ "hWE")
+ (?\ኍ "hW")
+ (?\ነ "na")
+ (?\ኑ "nu")
+ (?\ኒ "ni")
+ (?\ና "na")
+ (?\ኔ "nE")
+ (?\ን "n")
+ (?\ኖ "no")
+ (?\ኗ "nWa")
+ (?\ኘ "Ne")
+ (?\ኙ "Nu")
+ (?\ኚ "Ni")
+ (?\ኛ "Na")
+ (?\ኜ "NE")
+ (?\ኝ "N")
+ (?\ኞ "No")
+ (?\ኟ "NWa")
+ (?\አ "e")
+ (?\ኡ "u")
+ (?\ኢ "i")
+ (?\ኣ "a")
+ (?\ኤ "E")
+ (?\እ "I")
+ (?\ኦ "o")
+ (?\ኧ "e3")
+ (?\ከ "ke")
+ (?\ኩ "ku")
+ (?\ኪ "ki")
+ (?\ካ "ka")
+ (?\ኬ "kE")
+ (?\ክ "k")
+ (?\ኮ "ko")
+ (?\ኰ "kWe")
+ (?\ኲ "kWi")
+ (?\ኳ "kWa")
+ (?\ኴ "kWE")
+ (?\ኵ "kW")
+ (?\ኸ "Ke")
+ (?\ኹ "Ku")
+ (?\ኺ "Ki")
+ (?\ኻ "Ka")
+ (?\ኼ "KE")
+ (?\ኽ "K")
+ (?\ኾ "Ko")
+ (?\ዀ "KWe")
+ (?\ዂ "KWi")
+ (?\ዃ "KWa")
+ (?\ዄ "KWE")
+ (?\ዅ "KW")
+ (?\ወ "we")
+ (?\ዉ "wu")
+ (?\ዊ "wi")
+ (?\ዋ "wa")
+ (?\ዌ "wE")
+ (?\ው "w")
+ (?\ዎ "wo")
+ (?\ዐ "`e")
+ (?\ዑ "`u")
+ (?\ዒ "`i")
+ (?\ዓ "`a")
+ (?\ዔ "`E")
+ (?\ዕ "`I")
+ (?\ዖ "`o")
+ (?\ዘ "ze")
+ (?\ዙ "zu")
+ (?\ዚ "zi")
+ (?\ዛ "za")
+ (?\ዜ "zE")
+ (?\ዝ "z")
+ (?\ዞ "zo")
+ (?\ዟ "zWa")
+ (?\ዠ "Ze")
+ (?\ዡ "Zu")
+ (?\ዢ "Zi")
+ (?\ዣ "Za")
+ (?\ዤ "ZE")
+ (?\ዥ "Z")
+ (?\ዦ "Zo")
+ (?\ዧ "ZWa")
+ (?\የ "ye")
+ (?\ዩ "yu")
+ (?\ዪ "yi")
+ (?\ያ "ya")
+ (?\ዬ "yE")
+ (?\ይ "y")
+ (?\ዮ "yo")
+ (?\ዯ "yWa")
+ (?\ደ "de")
+ (?\ዱ "du")
+ (?\ዲ "di")
+ (?\ዳ "da")
+ (?\ዴ "dE")
+ (?\ድ "d")
+ (?\ዶ "do")
+ (?\ዷ "dWa")
+ (?\ዸ "De")
+ (?\ዹ "Du")
+ (?\ዺ "Di")
+ (?\ዻ "Da")
+ (?\ዼ "DE")
+ (?\ዽ "D")
+ (?\ዾ "Do")
+ (?\ዿ "DWa")
+ (?\ጀ "je")
+ (?\ጁ "ju")
+ (?\ጂ "ji")
+ (?\ጃ "ja")
+ (?\ጄ "jE")
+ (?\ጅ "j")
+ (?\ጆ "jo")
+ (?\ጇ "jWa")
+ (?\ገ "ga")
+ (?\ጉ "gu")
+ (?\ጊ "gi")
+ (?\ጋ "ga")
+ (?\ጌ "gE")
+ (?\ግ "g")
+ (?\ጎ "go")
+ (?\ጐ "gWu")
+ (?\ጒ "gWi")
+ (?\ጓ "gWa")
+ (?\ጔ "gWE")
+ (?\ጕ "gW")
+ (?\ጘ "Ge")
+ (?\ጙ "Gu")
+ (?\ጚ "Gi")
+ (?\ጛ "Ga")
+ (?\ጜ "GE")
+ (?\ጝ "G")
+ (?\ጞ "Go")
+ (?\ጟ "GWa")
+ (?\ጠ "Te")
+ (?\ጡ "Tu")
+ (?\ጢ "Ti")
+ (?\ጣ "Ta")
+ (?\ጤ "TE")
+ (?\ጥ "T")
+ (?\ጦ "To")
+ (?\ጧ "TWa")
+ (?\ጨ "Ce")
+ (?\ጩ "Ca")
+ (?\ጪ "Cu")
+ (?\ጫ "Ca")
+ (?\ጬ "CE")
+ (?\ጭ "C")
+ (?\ጮ "Co")
+ (?\ጯ "CWa")
+ (?\ጰ "Pe")
+ (?\ጱ "Pu")
+ (?\ጲ "Pi")
+ (?\ጳ "Pa")
+ (?\ጴ "PE")
+ (?\ጵ "P")
+ (?\ጶ "Po")
+ (?\ጷ "PWa")
+ (?\ጸ "SWe")
+ (?\ጹ "SWu")
+ (?\ጺ "SWi")
+ (?\ጻ "SWa")
+ (?\ጼ "SWE")
+ (?\ጽ "SW")
+ (?\ጾ "SWo")
+ (?\ጿ "SWa")
+ (?\ፀ "`Sa")
+ (?\ፁ "`Su")
+ (?\ፂ "`Si")
+ (?\ፃ "`Sa")
+ (?\ፄ "`SE")
+ (?\ፅ "`S")
+ (?\ፆ "`So")
+ (?\ፈ "fa")
+ (?\ፉ "fu")
+ (?\ፊ "fi")
+ (?\ፋ "fa")
+ (?\ፌ "fE")
+ (?\ፍ "o")
+ (?\ፎ "fo")
+ (?\ፏ "fWa")
+ (?\ፐ "pe")
+ (?\ፑ "pu")
+ (?\ፒ "pi")
+ (?\ፓ "pa")
+ (?\ፔ "pE")
+ (?\ፕ "p")
+ (?\ፖ "po")
+ (?\ፗ "pWa")
+ (?\ፘ "mYa")
+ (?\ፙ "rYa")
+ (?\ፚ "fYa")
+ (?\፠ " ")
+ (?\፡ ":")
+ (?\። "::")
+ (?\፣ ",")
+ (?\፤ ";")
+ (?\፥ "-:")
+ (?\፦ ":-")
+ (?\፧ "`?")
+ (?\፨ ":|:")
+ (?\፩ "`1")
+ (?\፪ "`2")
+ (?\፫ "`3")
+ (?\፬ "`4")
+ (?\፭ "`5")
+ (?\፮ "`6")
+ (?\፯ "`7")
+ (?\፰ "`8")
+ (?\፱ "`9")
+ (?\፲ "`10")
+ (?\፳ "`20")
+ (?\፴ "`30")
+ (?\፵ "`40")
+ (?\፶ "`50")
+ (?\፷ "`60")
+ (?\፸ "`70")
+ (?\፹ "`80")
+ (?\፺ "`90")
+ (?\፻ "`100")
+ (?\፼ "`10000")
+ (?\Ḁ "A-0")
+ (?\ḁ "a-0")
+ (?\Ḃ "B.")
+ (?\ḃ "b.")
+ (?\Ḅ "B-.")
+ (?\ḅ "b-.")
+ (?\Ḇ "B_")
+ (?\ḇ "b_")
+ (?\Ḉ "C,'")
+ (?\ḉ "c,'")
+ (?\Ḋ "D.")
+ (?\ḋ "d.")
+ (?\Ḍ "D-.")
+ (?\ḍ "d-.")
+ (?\Ḏ "D_")
+ (?\ḏ "d_")
+ (?\Ḑ "D,")
+ (?\ḑ "d,")
+ (?\Ḓ "D->")
+ (?\ḓ "d->")
+ (?\Ḕ "E-!")
+ (?\ḕ "e-!")
+ (?\Ḗ "E-'")
+ (?\ḗ "e-'")
+ (?\Ḙ "E->")
+ (?\ḙ "e->")
+ (?\Ḛ "E-?")
+ (?\ḛ "e-?")
+ (?\Ḝ "E,(")
+ (?\ḝ "e,(")
+ (?\Ḟ "F.")
+ (?\ḟ "f.")
+ (?\Ḡ "G-")
+ (?\ḡ "g-")
+ (?\Ḣ "H.")
+ (?\ḣ "h.")
+ (?\Ḥ "H-.")
+ (?\ḥ "h-.")
+ (?\Ḧ "H:")
+ (?\ḧ "h:")
+ (?\Ḩ "H,")
+ (?\ḩ "h,")
+ (?\Ḫ "H-(")
+ (?\ḫ "h-(")
+ (?\Ḭ "I-?")
+ (?\ḭ "i-?")
+ (?\Ḯ "I:'")
+ (?\ḯ "i:'")
+ (?\Ḱ "K'")
+ (?\ḱ "k'")
+ (?\Ḳ "K-.")
+ (?\ḳ "k-.")
+ (?\Ḵ "K_")
+ (?\ḵ "k_")
+ (?\Ḷ "L-.")
+ (?\ḷ "l-.")
+ (?\Ḹ "L--.")
+ (?\ḹ "l--.")
+ (?\Ḻ "L_")
+ (?\ḻ "l_")
+ (?\Ḽ "L->")
+ (?\ḽ "l->")
+ (?\Ḿ "M'")
+ (?\ḿ "m'")
+ (?\Ṁ "M.")
+ (?\ṁ "m.")
+ (?\Ṃ "M-.")
+ (?\ṃ "m-.")
+ (?\Ṅ "N.")
+ (?\ṅ "n.")
+ (?\Ṇ "N-.")
+ (?\ṇ "n-.")
+ (?\Ṉ "N_")
+ (?\ṉ "n_")
+ (?\Ṋ "N->")
+ (?\ṋ "n->")
+ (?\Ṍ "O?'")
+ (?\ṍ "o?'")
+ (?\Ṏ "O?:")
+ (?\ṏ "o?:")
+ (?\Ṑ "O-!")
+ (?\ṑ "o-!")
+ (?\Ṓ "O-'")
+ (?\ṓ "o-'")
+ (?\Ṕ "P'")
+ (?\ṕ "p'")
+ (?\Ṗ "P.")
+ (?\ṗ "p.")
+ (?\Ṙ "R.")
+ (?\ṙ "r.")
+ (?\Ṛ "R-.")
+ (?\ṛ "r-.")
+ (?\Ṝ "R--.")
+ (?\ṝ "r--.")
+ (?\Ṟ "R_")
+ (?\ṟ "r_")
+ (?\Ṡ "S.")
+ (?\ṡ "s.")
+ (?\Ṣ "S-.")
+ (?\ṣ "s-.")
+ (?\Ṥ "S'.")
+ (?\ṥ "s'.")
+ (?\Ṧ "S<.")
+ (?\ṧ "s<.")
+ (?\Ṩ "S.-.")
+ (?\ṩ "s.-.")
+ (?\Ṫ "T.")
+ (?\ṫ "t.")
+ (?\Ṭ "T-.")
+ (?\ṭ "t-.")
+ (?\Ṯ "T_")
+ (?\ṯ "t_")
+ (?\Ṱ "T->")
+ (?\ṱ "t->")
+ (?\Ṳ "U--:")
+ (?\ṳ "u--:")
+ (?\Ṵ "U-?")
+ (?\ṵ "u-?")
+ (?\Ṷ "U->")
+ (?\ṷ "u->")
+ (?\Ṹ "U?'")
+ (?\ṹ "u?'")
+ (?\Ṻ "U-:")
+ (?\ṻ "u-:")
+ (?\Ṽ "V?")
+ (?\ṽ "v?")
+ (?\Ṿ "V-.")
+ (?\ṿ "v-.")
+ (?\Ẁ "W!")
+ (?\ẁ "w!")
+ (?\Ẃ "W'")
+ (?\ẃ "w'")
+ (?\Ẅ "W:")
+ (?\ẅ "w:")
+ (?\Ẇ "W.")
+ (?\ẇ "w.")
+ (?\Ẉ "W-.")
+ (?\ẉ "w-.")
+ (?\Ẋ "X.")
+ (?\ẋ "x.")
+ (?\Ẍ "X:")
+ (?\ẍ "x:")
+ (?\Ẏ "Y.")
+ (?\ẏ "y.")
+ (?\Ẑ "Z>")
+ (?\ẑ "z>")
+ (?\Ẓ "Z-.")
+ (?\ẓ "z-.")
+ (?\Ẕ "Z_")
+ (?\ẕ "z_")
+ (?\ẖ "h_")
+ (?\ẗ "t:")
+ (?\ẘ "w0")
+ (?\ẙ "y0")
+ (?\Ạ "A-.")
+ (?\ạ "a-.")
+ (?\Ả "A2")
+ (?\ả "a2")
+ (?\Ấ "A>'")
+ (?\ấ "a>'")
+ (?\Ầ "A>!")
+ (?\ầ "a>!")
+ (?\Ẩ "A>2")
+ (?\ẩ "a>2")
+ (?\Ẫ "A>?")
+ (?\ẫ "a>?")
+ (?\Ậ "A>-.")
+ (?\ậ "a>-.")
+ (?\Ắ "A('")
+ (?\ắ "a('")
+ (?\Ằ "A(!")
+ (?\ằ "a(!")
+ (?\Ẳ "A(2")
+ (?\ẳ "a(2")
+ (?\Ẵ "A(?")
+ (?\ẵ "a(?")
+ (?\Ặ "A(-.")
+ (?\ặ "a(-.")
+ (?\Ẹ "E-.")
+ (?\ẹ "e-.")
+ (?\Ẻ "E2")
+ (?\ẻ "e2")
+ (?\Ẽ "E?")
+ (?\ẽ "e?")
+ (?\Ế "E>'")
+ (?\ế "e>'")
+ (?\Ề "E>!")
+ (?\ề "e>!")
+ (?\Ể "E>2")
+ (?\ể "e>2")
+ (?\Ễ "E>?")
+ (?\ễ "e>?")
+ (?\Ệ "E>-.")
+ (?\ệ "e>-.")
+ (?\Ỉ "I2")
+ (?\ỉ "i2")
+ (?\Ị "I-.")
+ (?\ị "i-.")
+ (?\Ọ "O-.")
+ (?\ọ "o-.")
+ (?\Ỏ "O2")
+ (?\ỏ "o2")
+ (?\Ố "O>'")
+ (?\ố "o>'")
+ (?\Ồ "O>!")
+ (?\ồ "o>!")
+ (?\Ổ "O>2")
+ (?\ổ "o>2")
+ (?\Ỗ "O>?")
+ (?\ỗ "o>?")
+ (?\Ộ "O>-.")
+ (?\ộ "o>-.")
+ (?\Ớ "O9'")
+ (?\ớ "o9'")
+ (?\Ờ "O9!")
+ (?\ờ "o9!")
+ (?\Ở "O92")
+ (?\ở "o92")
+ (?\Ỡ "O9?")
+ (?\ỡ "o9?")
+ (?\Ợ "O9-.")
+ (?\ợ "o9-.")
+ (?\Ụ "U-.")
+ (?\ụ "u-.")
+ (?\Ủ "U2")
+ (?\ủ "u2")
+ (?\Ứ "U9'")
+ (?\ứ "u9'")
+ (?\Ừ "U9!")
+ (?\ừ "u9!")
+ (?\Ử "U92")
+ (?\ử "u92")
+ (?\Ữ "U9?")
+ (?\ữ "u9?")
+ (?\Ự "U9-.")
+ (?\ự "u9-.")
+ (?\Ỳ "Y!")
+ (?\ỳ "y!")
+ (?\Ỵ "Y-.")
+ (?\ỵ "y-.")
+ (?\Ỷ "Y2")
+ (?\ỷ "y2")
+ (?\Ỹ "Y?")
+ (?\ỹ "y?")
+ (?\ἀ "a")
+ (?\ἁ "ha")
+ (?\ἂ "`a")
+ (?\ἃ "h`a")
+ (?\ἄ "a'")
+ (?\ἅ "ha'")
+ (?\ἆ "a~")
+ (?\ἇ "ha~")
+ (?\Ἀ "A")
+ (?\Ἁ "hA")
+ (?\Ἂ "`A")
+ (?\Ἃ "h`A")
+ (?\Ἄ "A'")
+ (?\Ἅ "hA'")
+ (?\Ἆ "A~")
+ (?\Ἇ "hA~")
+ (?\ἑ "he")
+ (?\Ἑ "hE")
+ (?\ἱ "hi")
+ (?\Ἱ "hI")
+ (?\ὁ "ho")
+ (?\Ὁ "hO")
+ (?\ὑ "hu")
+ (?\Ὑ "hU")
+ (?\᾿ ",,")
+ (?\῀ "?*")
+ (?\῁ "?:")
+ (?\῍ ",!")
+ (?\῎ ",'")
+ (?\῏ "?,")
+ (?\῝ ";!")
+ (?\῞ ";'")
+ (?\῟ "?;")
+ (?\ῥ "rh")
+ (?\Ῥ "Rh")
+ (?\῭ "!:")
+ (?\` "!*")
+ (?\῾ ";;")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\  " ")
+ (?\‐ "-")
+ (?\‑ "-")
+ (?\– "-")
+ (?\— "--")
+ (?\― "-")
+ (?\‖ "||")
+ (?\‗ "=2")
+ (?\‘ "`")
+ (?\’ "'")
+ (?\‚ "'")
+ (?\‛ "'")
+ (?\“ "\"")
+ (?\” "\"")
+ (?\„ "\"")
+ (?\‟ "\"")
+ (?\† "/-")
+ (?\‡ "/=")
+ (?\• " o ")
+ (?\․ ".")
+ (?\‥ "..")
+ (?\… "...")
+ (?\‧ "·")
+ (?\‰ " 0/00")
+ (?\′ "'")
+ (?\″ "''")
+ (?\‴ "'''")
+ (?\‵ "`")
+ (?\‶ "``")
+ (?\‷ "```")
+ (?\‸ "Ca")
+ (?\‹ "<")
+ (?\› ">")
+ (?\※ ":X")
+ (?\‼ "!!")
+ (?\‾ "'-")
+ (?\⁃ "-")
+ (?\⁄ "/")
+ (?\⁈ "?!")
+ (?\⁉ "!?")
+ (?\⁰ "^0")
+ (?\⁴ "^4")
+ (?\⁵ "^5")
+ (?\⁶ "^6")
+ (?\⁷ "^7")
+ (?\⁸ "^8")
+ (?\⁹ "^9")
+ (?\⁺ "^+")
+ (?\⁻ "^-")
+ (?\⁼ "^=")
+ (?\⁽ "^(")
+ (?\⁾ "^)")
+ (?\ⁿ "^n")
+ (?\₀ "_0")
+ (?\₁ "_1")
+ (?\₂ "_2")
+ (?\₃ "_3")
+ (?\₄ "_4")
+ (?\₅ "_5")
+ (?\₆ "_6")
+ (?\₇ "_7")
+ (?\₈ "_8")
+ (?\₉ "_9")
+ (?\₊ "_+")
+ (?\₋ "_-")
+ (?\₌ "_=")
+ (?\₍ "(")
+ (?\₎ ")")
+ (?\₣ "Ff")
+ (?\₤ "Li")
+ (?\₧ "Pt")
+ (?\₩ "W=")
+ (?\€ "EUR")
+ (?\℀ "a/c")
+ (?\℁ "a/s")
+ (?\℃ "oC")
+ (?\℅ "c/o")
+ (?\℆ "c/u")
+ (?\℉ "oF")
+ (?\ℊ "g")
+ (?\ℎ "h")
+ (?\ℏ "\\hbar")
+ (?\ℑ "Im")
+ (?\ℓ "l")
+ (?\№ "No.")
+ (?\℗ "PO")
+ (?\℘ "P")
+ (?\ℜ "Re")
+ (?\℞ "Rx")
+ (?\℠ "(SM)")
+ (?\℡ "TEL")
+ (?\™ "(TM)")
+ (?\Ω "Ohm")
+ (?\K "K")
+ (?\Å "Ang.")
+ (?\℮ "est.")
+ (?\ℴ "o")
+ (?\ℵ "Aleph ")
+ (?\ℶ "Bet ")
+ (?\ℷ "Gimel ")
+ (?\ℸ "Dalet ")
+ (?\⅓ " 1/3")
+ (?\⅔ " 2/3")
+ (?\⅕ " 1/5")
+ (?\⅖ " 2/5")
+ (?\⅗ " 3/5")
+ (?\⅘ " 4/5")
+ (?\⅙ " 1/6")
+ (?\⅚ " 5/6")
+ (?\⅛ " 1/8")
+ (?\⅜ " 3/8")
+ (?\⅝ " 5/8")
+ (?\⅞ " 7/8")
+ (?\⅟ " 1/")
+ (?\Ⅰ "I")
+ (?\Ⅱ "II")
+ (?\Ⅲ "III")
+ (?\Ⅳ "IV")
+ (?\Ⅴ "V")
+ (?\Ⅵ "VI")
+ (?\Ⅶ "VII")
+ (?\Ⅷ "VIII")
+ (?\Ⅸ "IX")
+ (?\Ⅹ "X")
+ (?\Ⅺ "XI")
+ (?\Ⅻ "XII")
+ (?\Ⅼ "L")
+ (?\Ⅽ "C")
+ (?\Ⅾ "D")
+ (?\Ⅿ "M")
+ (?\ⅰ "i")
+ (?\ⅱ "ii")
+ (?\ⅲ "iii")
+ (?\ⅳ "iv")
+ (?\ⅴ "v")
+ (?\ⅵ "vi")
+ (?\ⅶ "vii")
+ (?\ⅷ "viii")
+ (?\ⅸ "ix")
+ (?\ⅹ "x")
+ (?\ⅺ "xi")
+ (?\ⅻ "xii")
+ (?\ⅼ "l")
+ (?\ⅽ "c")
+ (?\ⅾ "d")
+ (?\ⅿ "m")
+ (?\ↀ "1000RCD")
+ (?\ↁ "5000R")
+ (?\ↂ "10000R")
+ (?\← "<-")
+ (?\↑ "-^")
+ (?\→ "->")
+ (?\↓ "-v")
+ (?\↔ "<->")
+ (?\↕ "UD")
+ (?\↖ "<!!")
+ (?\↗ "//>")
+ (?\↘ "!!>")
+ (?\↙ "<//")
+ (?\↨ "UD-")
+ (?\↵ "RET")
+ (?\⇀ ">V")
+ (?\⇐ "<=")
+ (?\⇑ "^^")
+ (?\⇒ "=>")
+ (?\⇓ "vv")
+ (?\⇔ "<=>")
+ (?\∀ "FA")
+ (?\∂ "\\partial")
+ (?\∃ "TE")
+ (?\∅ "{}")
+ (?\∆ "Delta")
+ (?\∇ "Nabla")
+ (?\∈ "(-")
+ (?\∉ "!(-")
+ (?\∊ "(-")
+ (?\∋ "-)")
+ (?\∌ "!-)")
+ (?\∍ "-)")
+ (?\∎ " qed")
+ (?\∏ "\\prod")
+ (?\∑ "\\sum")
+ (?\− " -")
+ (?\∓ "-/+")
+ (?\∔ ".+")
+ (?\∕ "/")
+ (?\∖ " - ")
+ (?\∗ "*")
+ (?\∘ " ° ")
+ (?\∙ "sb")
+ (?\√ " SQRT ")
+ (?\∛ " ROOT³ ")
+ (?\∜ " ROOT4 ")
+ (?\∝ "0(")
+ (?\∞ "infty")
+ (?\∟ "-L")
+ (?\∠ "-V")
+ (?\∥ "PP")
+ (?\∦ " !PP ")
+ (?\∧ "AND")
+ (?\∨ "OR")
+ (?\∩ "(U")
+ (?\∪ ")U")
+ (?\∫ "\\int ")
+ (?\∬ "DI")
+ (?\∮ "Io")
+ (?\∴ ".:")
+ (?\∵ ":.")
+ (?\∶ ":R")
+ (?\∷ "::")
+ (?\∼ "?1")
+ (?\∾ "CG")
+ (?\≃ "?-")
+ (?\≅ "?=")
+ (?\≈ "~=")
+ (?\≉ " !~= ")
+ (?\≌ "=?")
+ (?\≓ "HI")
+ (?\≔ ":=")
+ (?\≕ "=:")
+ (?\≠ "!=")
+ (?\≡ "=3")
+ (?\≢ " !=3 ")
+ (?\≤ "=<")
+ (?\≥ ">=")
+ (?\≦ ".LE.")
+ (?\≧ ".GE.")
+ (?\≨ ".LT.NOT.EQ.")
+ (?\≩ ".GT.NOT.EQ.")
+ (?\≪ "<<")
+ (?\≫ ">>")
+ (?\≮ "!<")
+ (?\≯ "!>")
+ (?\≶ " <> ")
+ (?\≷ " >< ")
+ (?\⊂ "(C")
+ (?\⊃ ")C")
+ (?\⊄ " !(C ")
+ (?\⊅ " !)C ")
+ (?\⊆ "(_")
+ (?\⊇ ")_")
+ (?\⊕ "(+)")
+ (?\⊖ "(-)")
+ (?\⊗ "(×)")
+ (?\⊘ "(/)")
+ (?\⊙ "(·)")
+ (?\⊚ "(°)")
+ (?\⊛ "(*)")
+ (?\⊜ "(=)")
+ (?\⊝ "(-)")
+ (?\⊞ "[+]")
+ (?\⊟ "[-]")
+ (?\⊠ "[×]")
+ (?\⊡ "[·]")
+ (?\⊥ "-T")
+ (?\⊧ " MODELS ")
+ (?\⊨ " TRUE ")
+ (?\⊩ " FORCES ")
+ (?\⊬ " !PROVES ")
+ (?\⊭ " NOT TRUE ")
+ (?\⊮ " !FORCES ")
+ (?\⊲ " NORMAL SUBGROUP OF ")
+ (?\⊳ " CONTAINS AS NORMAL SUBGROUP ")
+ (?\⊴ " NORMAL SUBGROUP OF OR EQUAL TO ")
+ (?\⊵ " CONTAINS AS NORMAL SUBGROUP OR EQUAL TO ")
+ (?\⊸ " MULTIMAP ")
+ (?\⊺ " INTERCALATE ")
+ (?\⊻ " XOR ")
+ (?\⊼ " NAND ")
+ (?\⋅ " · ")
+ (?\⋖ "<.")
+ (?\⋗ ">.")
+ (?\⋘ "<<<")
+ (?\⋙ ">>>")
+ (?\⋮ ":3")
+ (?\⋯ ".3")
+ (?\⌂ "Eh")
+ (?\⌇ "~~")
+ (?\⌈ "<7")
+ (?\⌉ ">7")
+ (?\⌊ "7<")
+ (?\⌋ "7>")
+ (?\⌐ "NI")
+ (?\⌒ "(A")
+ (?\⌕ "TR")
+ (?\⌘ "88")
+ (?\⌠ "Iu")
+ (?\⌡ "Il")
+ (?\⌢ ":(")
+ (?\⌣ ":)")
+ (?\⌤ "|^|")
+ (?\⌧ "[X]")
+ (?\〈 "</")
+ (?\〉 "/>")
+ (?\␣ "Vs")
+ (?\⑀ "1h")
+ (?\⑁ "3h")
+ (?\⑂ "2h")
+ (?\⑃ "4h")
+ (?\⑆ "1j")
+ (?\⑇ "2j")
+ (?\⑈ "3j")
+ (?\⑉ "4j")
+ (?\① "1-o")
+ (?\② "2-o")
+ (?\③ "3-o")
+ (?\④ "4-o")
+ (?\⑤ "5-o")
+ (?\⑥ "6-o")
+ (?\⑦ "7-o")
+ (?\⑧ "8-o")
+ (?\⑨ "9-o")
+ (?\⑩ "10-o")
+ (?\⑪ "11-o")
+ (?\⑫ "12-o")
+ (?\⑬ "13-o")
+ (?\⑭ "14-o")
+ (?\⑮ "15-o")
+ (?\⑯ "16-o")
+ (?\⑰ "17-o")
+ (?\⑱ "18-o")
+ (?\⑲ "19-o")
+ (?\⑳ "20-o")
+ (?\⑴ "(1)")
+ (?\⑵ "(2)")
+ (?\⑶ "(3)")
+ (?\⑷ "(4)")
+ (?\⑸ "(5)")
+ (?\⑹ "(6)")
+ (?\⑺ "(7)")
+ (?\⑻ "(8)")
+ (?\⑼ "(9)")
+ (?\⑽ "(10)")
+ (?\⑾ "(11)")
+ (?\⑿ "(12)")
+ (?\⒀ "(13)")
+ (?\⒁ "(14)")
+ (?\⒂ "(15)")
+ (?\⒃ "(16)")
+ (?\⒄ "(17)")
+ (?\⒅ "(18)")
+ (?\⒆ "(19)")
+ (?\⒇ "(20)")
+ (?\⒈ "1.")
+ (?\⒉ "2.")
+ (?\⒊ "3.")
+ (?\⒋ "4.")
+ (?\⒌ "5.")
+ (?\⒍ "6.")
+ (?\⒎ "7.")
+ (?\⒏ "8.")
+ (?\⒐ "9.")
+ (?\⒑ "10.")
+ (?\⒒ "11.")
+ (?\⒓ "12.")
+ (?\⒔ "13.")
+ (?\⒕ "14.")
+ (?\⒖ "15.")
+ (?\⒗ "16.")
+ (?\⒘ "17.")
+ (?\⒙ "18.")
+ (?\⒚ "19.")
+ (?\⒛ "20.")
+ (?\⒜ "(a)")
+ (?\⒝ "(b)")
+ (?\⒞ "(c)")
+ (?\⒟ "(d)")
+ (?\⒠ "(e)")
+ (?\⒡ "(f)")
+ (?\⒢ "(g)")
+ (?\⒣ "(h)")
+ (?\⒤ "(i)")
+ (?\⒥ "(j)")
+ (?\⒦ "(k)")
+ (?\⒧ "(l)")
+ (?\⒨ "(m)")
+ (?\⒩ "(n)")
+ (?\⒪ "(o)")
+ (?\⒫ "(p)")
+ (?\⒬ "(q)")
+ (?\⒭ "(r)")
+ (?\⒮ "(s)")
+ (?\⒯ "(t)")
+ (?\⒰ "(u)")
+ (?\⒱ "(v)")
+ (?\⒲ "(w)")
+ (?\⒳ "(x)")
+ (?\⒴ "(y)")
+ (?\⒵ "(z)")
+ (?\Ⓐ "A-o")
+ (?\Ⓑ "B-o")
+ (?\Ⓒ "C-o")
+ (?\Ⓓ "D-o")
+ (?\Ⓔ "E-o")
+ (?\Ⓕ "F-o")
+ (?\Ⓖ "G-o")
+ (?\Ⓗ "H-o")
+ (?\Ⓘ "I-o")
+ (?\Ⓙ "J-o")
+ (?\Ⓚ "K-o")
+ (?\Ⓛ "L-o")
+ (?\Ⓜ "M-o")
+ (?\Ⓝ "N-o")
+ (?\Ⓞ "O-o")
+ (?\Ⓟ "P-o")
+ (?\Ⓠ "Q-o")
+ (?\Ⓡ "R-o")
+ (?\Ⓢ "S-o")
+ (?\Ⓣ "T-o")
+ (?\Ⓤ "U-o")
+ (?\Ⓥ "V-o")
+ (?\Ⓦ "W-o")
+ (?\Ⓧ "X-o")
+ (?\Ⓨ "Y-o")
+ (?\Ⓩ "Z-o")
+ (?\ⓐ "a-o")
+ (?\ⓑ "b-o")
+ (?\ⓒ "c-o")
+ (?\ⓓ "d-o")
+ (?\ⓔ "e-o")
+ (?\ⓕ "f-o")
+ (?\ⓖ "g-o")
+ (?\ⓗ "h-o")
+ (?\ⓘ "i-o")
+ (?\ⓙ "j-o")
+ (?\ⓚ "k-o")
+ (?\ⓛ "l-o")
+ (?\ⓜ "m-o")
+ (?\ⓝ "n-o")
+ (?\ⓞ "o-o")
+ (?\ⓟ "p-o")
+ (?\ⓠ "q-o")
+ (?\ⓡ "r-o")
+ (?\ⓢ "s-o")
+ (?\ⓣ "t-o")
+ (?\ⓤ "u-o")
+ (?\ⓥ "v-o")
+ (?\ⓦ "w-o")
+ (?\ⓧ "x-o")
+ (?\ⓨ "y-o")
+ (?\ⓩ "z-o")
+ (?\⓪ "0-o")
+ (?\─ "-")
+ (?\━ "=")
+ (?\│ "|")
+ (?\┃ "|")
+ (?\┄ "-")
+ (?\┅ "=")
+ (?\┆ "|")
+ (?\┇ "|")
+ (?\┈ "-")
+ (?\┉ "=")
+ (?\┊ "|")
+ (?\┋ "|")
+ (?\┌ "+")
+ (?\┍ "+")
+ (?\┎ "+")
+ (?\┏ "+")
+ (?\┐ "+")
+ (?\┑ "+")
+ (?\┒ "+")
+ (?\┓ "+")
+ (?\└ "+")
+ (?\┕ "+")
+ (?\┖ "+")
+ (?\┗ "+")
+ (?\┘ "+")
+ (?\┙ "+")
+ (?\┚ "+")
+ (?\┛ "+")
+ (?\├ "+")
+ (?\┝ "+")
+ (?\┞ "+")
+ (?\┟ "+")
+ (?\┠ "+")
+ (?\┡ "+")
+ (?\┢ "+")
+ (?\┣ "+")
+ (?\┤ "+")
+ (?\┥ "+")
+ (?\┦ "+")
+ (?\┧ "+")
+ (?\┨ "+")
+ (?\┩ "+")
+ (?\┪ "+")
+ (?\┫ "+")
+ (?\┬ "+")
+ (?\┭ "+")
+ (?\┮ "+")
+ (?\┯ "+")
+ (?\┰ "+")
+ (?\┱ "+")
+ (?\┲ "+")
+ (?\┳ "+")
+ (?\┴ "+")
+ (?\┵ "+")
+ (?\┶ "+")
+ (?\┷ "+")
+ (?\┸ "+")
+ (?\┹ "+")
+ (?\┺ "+")
+ (?\┻ "+")
+ (?\┼ "+")
+ (?\┽ "+")
+ (?\┾ "+")
+ (?\┿ "+")
+ (?\╀ "+")
+ (?\╁ "+")
+ (?\╂ "+")
+ (?\╃ "+")
+ (?\╄ "+")
+ (?\╅ "+")
+ (?\╆ "+")
+ (?\╇ "+")
+ (?\╈ "+")
+ (?\╉ "+")
+ (?\╊ "+")
+ (?\╋ "+")
+ (?\╌ "+")
+ (?\╍ "+")
+ (?\╎ "+")
+ (?\╏ "+")
+ (?\═ "+")
+ (?\║ "+")
+ (?\╒ "+")
+ (?\╓ "+")
+ (?\╔ "+")
+ (?\╕ "+")
+ (?\╖ "+")
+ (?\╗ "+")
+ (?\╘ "+")
+ (?\╙ "+")
+ (?\╚ "+")
+ (?\╛ "+")
+ (?\╜ "+")
+ (?\╝ "+")
+ (?\╞ "+")
+ (?\╟ "+")
+ (?\╠ "+")
+ (?\╡ "+")
+ (?\╢ "+")
+ (?\╣ "+")
+ (?\╤ "+")
+ (?\╥ "+")
+ (?\╦ "+")
+ (?\╧ "+")
+ (?\╨ "+")
+ (?\╩ "+")
+ (?\╪ "+")
+ (?\╫ "+")
+ (?\╬ "+")
+ (?\╱ "/")
+ (?\╲ "\\")
+ (?\▀ "TB")
+ (?\▄ "LB")
+ (?\█ "FB")
+ (?\▌ "lB")
+ (?\▐ "RB")
+ (?\░ ".S")
+ (?\▒ ":S")
+ (?\▓ "?S")
+ (?\■ "fS")
+ (?\□ "OS")
+ (?\▢ "RO")
+ (?\▣ "Rr")
+ (?\▤ "RF")
+ (?\▥ "RY")
+ (?\▦ "RH")
+ (?\▧ "RZ")
+ (?\▨ "RK")
+ (?\▩ "RX")
+ (?\▪ "sB")
+ (?\▬ "SR")
+ (?\▭ "Or")
+ (?\▲ "^")
+ (?\△ "uT")
+ (?\▶ "|>")
+ (?\▷ "Tr")
+ (?\► "|>")
+ (?\▼ "v")
+ (?\▽ "dT")
+ (?\◀ "<|")
+ (?\◁ "Tl")
+ (?\◄ "<|")
+ (?\◆ "Db")
+ (?\◇ "Dw")
+ (?\◊ "LZ")
+ (?\○ "0m")
+ (?\◎ "0o")
+ (?\● "0M")
+ (?\◐ "0L")
+ (?\◑ "0R")
+ (?\◘ "Sn")
+ (?\◙ "Ic")
+ (?\◢ "Fd")
+ (?\◣ "Bd")
+ (?\◯ "Ci")
+ (?\★ "*2")
+ (?\☆ "*1")
+ (?\☎ "TEL")
+ (?\☏ "tel")
+ (?\☜ "<--")
+ (?\☞ "-->")
+ (?\☡ "CAUTION ")
+ (?\☧ "XP")
+ (?\☹ ":-(")
+ (?\☺ ":-)")
+ (?\☻ "(-:")
+ (?\☼ "SU")
+ (?\♀ "f.")
+ (?\♂ "m.")
+ (?\♠ "cS")
+ (?\♡ "cH")
+ (?\♢ "cD")
+ (?\♣ "cC")
+ (?\♤ "cS-")
+ (?\♥ "cH-")
+ (?\♦ "cD-")
+ (?\♧ "cC-")
+ (?\♩ "Md")
+ (?\♪ "M8")
+ (?\♫ "M2")
+ (?\♬ "M16")
+ (?\♭ "b")
+ (?\♮ "Mx")
+ (?\♯ "#")
+ (?\✓ "X")
+ (?\✗ "X")
+ (?\✠ "-X")
+ (?\  " ")
+ (?\、 ",_")
+ (?\。 "._")
+ (?\〃 "+\"")
+ (?\〄 "JIS")
+ (?\々 "*_")
+ (?\〆 ";_")
+ (?\〇 "0_")
+ (?\《 "<+")
+ (?\》 ">+")
+ (?\「 "<'")
+ (?\」 ">'")
+ (?\『 "<\"")
+ (?\』 ">\"")
+ (?\【 "(\"")
+ (?\】 ")\"")
+ (?\〒 "=T")
+ (?\〓 "=_")
+ (?\〔 "('")
+ (?\〕 ")'")
+ (?\〖 "(I")
+ (?\〗 ")I")
+ (?\〚 "[[")
+ (?\〛 "]]")
+ (?\〜 "-?")
+ (?\〠 "=T:)")
+ (?\〿 " ")
+ (?\ぁ "A5")
+ (?\あ "a5")
+ (?\ぃ "I5")
+ (?\い "i5")
+ (?\ぅ "U5")
+ (?\う "u5")
+ (?\ぇ "E5")
+ (?\え "e5")
+ (?\ぉ "O5")
+ (?\お "o5")
+ (?\か "ka")
+ (?\が "ga")
+ (?\き "ki")
+ (?\ぎ "gi")
+ (?\く "ku")
+ (?\ぐ "gu")
+ (?\け "ke")
+ (?\げ "ge")
+ (?\こ "ko")
+ (?\ご "go")
+ (?\さ "sa")
+ (?\ざ "za")
+ (?\し "si")
+ (?\じ "zi")
+ (?\す "su")
+ (?\ず "zu")
+ (?\せ "se")
+ (?\ぜ "ze")
+ (?\そ "so")
+ (?\ぞ "zo")
+ (?\た "ta")
+ (?\だ "da")
+ (?\ち "ti")
+ (?\ぢ "di")
+ (?\っ "tU")
+ (?\つ "tu")
+ (?\づ "du")
+ (?\て "te")
+ (?\で "de")
+ (?\と "to")
+ (?\ど "do")
+ (?\な "na")
+ (?\に "ni")
+ (?\ぬ "nu")
+ (?\ね "ne")
+ (?\の "no")
+ (?\は "ha")
+ (?\ば "ba")
+ (?\ぱ "pa")
+ (?\ひ "hi")
+ (?\び "bi")
+ (?\ぴ "pi")
+ (?\ふ "hu")
+ (?\ぶ "bu")
+ (?\ぷ "pu")
+ (?\へ "he")
+ (?\べ "be")
+ (?\ぺ "pe")
+ (?\ほ "ho")
+ (?\ぼ "bo")
+ (?\ぽ "po")
+ (?\ま "ma")
+ (?\み "mi")
+ (?\む "mu")
+ (?\め "me")
+ (?\も "mo")
+ (?\ゃ "yA")
+ (?\や "ya")
+ (?\ゅ "yU")
+ (?\ゆ "yu")
+ (?\ょ "yO")
+ (?\よ "yo")
+ (?\ら "ra")
+ (?\り "ri")
+ (?\る "ru")
+ (?\れ "re")
+ (?\ろ "ro")
+ (?\ゎ "wA")
+ (?\わ "wa")
+ (?\ゐ "wi")
+ (?\ゑ "we")
+ (?\を "wo")
+ (?\ん "n5")
+ (?\ゔ "vu")
+ (?\゛ "\"5")
+ (?\゜ "05")
+ (?\ゝ "*5")
+ (?\ゞ "+5")
+ (?\ァ "a6")
+ (?\ア "A6")
+ (?\ィ "i6")
+ (?\イ "I6")
+ (?\ゥ "u6")
+ (?\ウ "U6")
+ (?\ェ "e6")
+ (?\エ "E6")
+ (?\ォ "o6")
+ (?\オ "O6")
+ (?\カ "Ka")
+ (?\ガ "Ga")
+ (?\キ "Ki")
+ (?\ギ "Gi")
+ (?\ク "Ku")
+ (?\グ "Gu")
+ (?\ケ "Ke")
+ (?\ゲ "Ge")
+ (?\コ "Ko")
+ (?\ゴ "Go")
+ (?\サ "Sa")
+ (?\ザ "Za")
+ (?\シ "Si")
+ (?\ジ "Zi")
+ (?\ス "Su")
+ (?\ズ "Zu")
+ (?\セ "Se")
+ (?\ゼ "Ze")
+ (?\ソ "So")
+ (?\ゾ "Zo")
+ (?\タ "Ta")
+ (?\ダ "Da")
+ (?\チ "Ti")
+ (?\ヂ "Di")
+ (?\ッ "TU")
+ (?\ツ "Tu")
+ (?\ヅ "Du")
+ (?\テ "Te")
+ (?\デ "De")
+ (?\ト "To")
+ (?\ド "Do")
+ (?\ナ "Na")
+ (?\ニ "Ni")
+ (?\ヌ "Nu")
+ (?\ネ "Ne")
+ (?\ノ "No")
+ (?\ハ "Ha")
+ (?\バ "Ba")
+ (?\パ "Pa")
+ (?\ヒ "Hi")
+ (?\ビ "Bi")
+ (?\ピ "Pi")
+ (?\フ "Hu")
+ (?\ブ "Bu")
+ (?\プ "Pu")
+ (?\ヘ "He")
+ (?\ベ "Be")
+ (?\ペ "Pe")
+ (?\ホ "Ho")
+ (?\ボ "Bo")
+ (?\ポ "Po")
+ (?\マ "Ma")
+ (?\ミ "Mi")
+ (?\ム "Mu")
+ (?\メ "Me")
+ (?\モ "Mo")
+ (?\ャ "YA")
+ (?\ヤ "Ya")
+ (?\ュ "YU")
+ (?\ユ "Yu")
+ (?\ョ "YO")
+ (?\ヨ "Yo")
+ (?\ラ "Ra")
+ (?\リ "Ri")
+ (?\ル "Ru")
+ (?\レ "Re")
+ (?\ロ "Ro")
+ (?\ヮ "WA")
+ (?\ワ "Wa")
+ (?\ヰ "Wi")
+ (?\ヱ "We")
+ (?\ヲ "Wo")
+ (?\ン "N6")
+ (?\ヴ "Vu")
+ (?\ヵ "KA")
+ (?\ヶ "KE")
+ (?\ヷ "Va")
+ (?\ヸ "Vi")
+ (?\ヹ "Ve")
+ (?\ヺ "Vo")
+ (?\・ ".6")
+ (?\ー "-6")
+ (?\ヽ "*6")
+ (?\ヾ "+6")
+ (?\ㄅ "b4")
+ (?\ㄆ "p4")
+ (?\ㄇ "m4")
+ (?\ㄈ "f4")
+ (?\ㄉ "d4")
+ (?\ㄊ "t4")
+ (?\ㄋ "n4")
+ (?\ㄌ "l4")
+ (?\ㄍ "g4")
+ (?\ㄎ "k4")
+ (?\ㄏ "h4")
+ (?\ㄐ "j4")
+ (?\ㄑ "q4")
+ (?\ㄒ "x4")
+ (?\ㄓ "zh")
+ (?\ㄔ "ch")
+ (?\ㄕ "sh")
+ (?\ㄖ "r4")
+ (?\ㄗ "z4")
+ (?\ㄘ "c4")
+ (?\ㄙ "s4")
+ (?\ㄚ "a4")
+ (?\ㄛ "o4")
+ (?\ㄜ "e4")
+ (?\ㄝ "eh4")
+ (?\ㄞ "ai")
+ (?\ㄟ "ei")
+ (?\ㄠ "au")
+ (?\ㄡ "ou")
+ (?\ㄢ "an")
+ (?\ㄣ "en")
+ (?\ㄤ "aN")
+ (?\ㄥ "eN")
+ (?\ㄦ "er")
+ (?\ㄧ "i4")
+ (?\ㄨ "u4")
+ (?\ㄩ "iu")
+ (?\ㄪ "v4")
+ (?\ㄫ "nG")
+ (?\ㄬ "gn")
+ (?\㈜ "(JU)")
+ (?\㈠ "1c")
+ (?\㈡ "2c")
+ (?\㈢ "3c")
+ (?\㈣ "4c")
+ (?\㈤ "5c")
+ (?\㈥ "6c")
+ (?\㈦ "7c")
+ (?\㈧ "8c")
+ (?\㈨ "9c")
+ (?\㈩ "10c")
+ (?\㉿ "KSC")
+ (?\㏂ "am")
+ (?\㏘ "pm")
+ (?\ff "ff")
+ (?\fi "fi")
+ (?\fl "fl")
+ (?\ffi "ffi")
+ (?\ffl "ffl")
+ (?\ſt "St")
+ (?\st "st")
+ (?\ﹽ "3+;")
+ (?\ﺂ "aM.")
+ (?\ﺄ "aH.")
+ (?\ﺈ "ah.")
+ (?\ﺍ "a+-")
+ (?\ﺎ "a+.")
+ (?\ﺏ "b+-")
+ (?\ﺐ "b+.")
+ (?\ﺑ "b+,")
+ (?\ﺒ "b+;")
+ (?\ﺓ "tm-")
+ (?\ﺔ "tm.")
+ (?\ﺕ "t+-")
+ (?\ﺖ "t+.")
+ (?\ﺗ "t+,")
+ (?\ﺘ "t+;")
+ (?\ﺙ "tk-")
+ (?\ﺚ "tk.")
+ (?\ﺛ "tk,")
+ (?\ﺜ "tk;")
+ (?\ﺝ "g+-")
+ (?\ﺞ "g+.")
+ (?\ﺟ "g+,")
+ (?\ﺠ "g+;")
+ (?\ﺡ "hk-")
+ (?\ﺢ "hk.")
+ (?\ﺣ "hk,")
+ (?\ﺤ "hk;")
+ (?\ﺥ "x+-")
+ (?\ﺦ "x+.")
+ (?\ﺧ "x+,")
+ (?\ﺨ "x+;")
+ (?\ﺩ "d+-")
+ (?\ﺪ "d+.")
+ (?\ﺫ "dk-")
+ (?\ﺬ "dk.")
+ (?\ﺭ "r+-")
+ (?\ﺮ "r+.")
+ (?\ﺯ "z+-")
+ (?\ﺰ "z+.")
+ (?\ﺱ "s+-")
+ (?\ﺲ "s+.")
+ (?\ﺳ "s+,")
+ (?\ﺴ "s+;")
+ (?\ﺵ "sn-")
+ (?\ﺶ "sn.")
+ (?\ﺷ "sn,")
+ (?\ﺸ "sn;")
+ (?\ﺹ "c+-")
+ (?\ﺺ "c+.")
+ (?\ﺻ "c+,")
+ (?\ﺼ "c+;")
+ (?\ﺽ "dd-")
+ (?\ﺾ "dd.")
+ (?\ﺿ "dd,")
+ (?\ﻀ "dd;")
+ (?\ﻁ "tj-")
+ (?\ﻂ "tj.")
+ (?\ﻃ "tj,")
+ (?\ﻄ "tj;")
+ (?\ﻅ "zH-")
+ (?\ﻆ "zH.")
+ (?\ﻇ "zH,")
+ (?\ﻈ "zH;")
+ (?\ﻉ "e+-")
+ (?\ﻊ "e+.")
+ (?\ﻋ "e+,")
+ (?\ﻌ "e+;")
+ (?\ﻍ "i+-")
+ (?\ﻎ "i+.")
+ (?\ﻏ "i+,")
+ (?\ﻐ "i+;")
+ (?\ﻑ "f+-")
+ (?\ﻒ "f+.")
+ (?\ﻓ "f+,")
+ (?\ﻔ "f+;")
+ (?\ﻕ "q+-")
+ (?\ﻖ "q+.")
+ (?\ﻗ "q+,")
+ (?\ﻘ "q+;")
+ (?\ﻙ "k+-")
+ (?\ﻚ "k+.")
+ (?\ﻛ "k+,")
+ (?\ﻜ "k+;")
+ (?\ﻝ "l+-")
+ (?\ﻞ "l+.")
+ (?\ﻟ "l+,")
+ (?\ﻠ "l+;")
+ (?\ﻡ "m+-")
+ (?\ﻢ "m+.")
+ (?\ﻣ "m+,")
+ (?\ﻤ "m+;")
+ (?\ﻥ "n+-")
+ (?\ﻦ "n+.")
+ (?\ﻧ "n+,")
+ (?\ﻨ "n+;")
+ (?\ﻩ "h+-")
+ (?\ﻪ "h+.")
+ (?\ﻫ "h+,")
+ (?\ﻬ "h+;")
+ (?\ﻭ "w+-")
+ (?\ﻮ "w+.")
+ (?\ﻯ "j+-")
+ (?\ﻰ "j+.")
+ (?\ﻱ "y+-")
+ (?\ﻲ "y+.")
+ (?\ﻳ "y+,")
+ (?\ﻴ "y+;")
+ (?\ﻵ "lM-")
+ (?\ﻶ "lM.")
+ (?\ﻷ "lH-")
+ (?\ﻸ "lH.")
+ (?\ﻹ "lh-")
+ (?\ﻺ "lh.")
+ (?\ﻻ "la-")
+ (?\ﻼ "la.")
+ (?\! "!")
+ (?\" "\"")
+ (?\# "#")
+ (?\$ "$")
+ (?\% "%")
+ (?\& "&")
+ (?\' "'")
+ (?\( "(")
+ (?\) ")")
+ (?\* "*")
+ (?\+ "+")
+ (?\, ",")
+ (?\- "-")
+ (?\. ".")
+ (?\/ "/")
+ (?\0 "0")
+ (?\1 "1")
+ (?\2 "2")
+ (?\3 "3")
+ (?\4 "4")
+ (?\5 "5")
+ (?\6 "6")
+ (?\7 "7")
+ (?\8 "8")
+ (?\9 "9")
+ (?\: ":")
+ (?\; ";")
+ (?\< "<")
+ (?\= "=")
+ (?\> ">")
+ (?\? "?")
+ (?\@ "@")
+ (?\A "A")
+ (?\B "B")
+ (?\C "C")
+ (?\D "D")
+ (?\E "E")
+ (?\F "F")
+ (?\G "G")
+ (?\H "H")
+ (?\I "I")
+ (?\J "J")
+ (?\K "K")
+ (?\L "L")
+ (?\M "M")
+ (?\N "N")
+ (?\O "O")
+ (?\P "P")
+ (?\Q "Q")
+ (?\R "R")
+ (?\S "S")
+ (?\T "T")
+ (?\U "U")
+ (?\V "V")
+ (?\W "W")
+ (?\X "X")
+ (?\Y "Y")
+ (?\Z "Z")
+ (?\[ "[")
+ (?\\ "\\")
+ (?\] "]")
+ (?\^ "^")
+ (?\_ "_")
+ (?\` "`")
+ (?\a "a")
+ (?\b "b")
+ (?\c "c")
+ (?\d "d")
+ (?\e "e")
+ (?\f "f")
+ (?\g "g")
+ (?\h "h")
+ (?\i "i")
+ (?\j "j")
+ (?\k "k")
+ (?\l "l")
+ (?\m "m")
+ (?\n "n")
+ (?\o "o")
+ (?\p "p")
+ (?\q "q")
+ (?\r "r")
+ (?\s "s")
+ (?\t "t")
+ (?\u "u")
+ (?\v "v")
+ (?\w "w")
+ (?\x "x")
+ (?\y "y")
+ (?\z "z")
+ (?\{ "{")
+ (?\| "|")
+ (?\} "}")
+ (?\~ "~")
+ (?\。 ".")
+ (?\「 "\"")
+ (?\」 "\"")
+ (?\、 ",")
+ ;; Not from Lynx
+ (? "")
+ (?� "?"))))
(aset standard-display-table
(make-char 'mule-unicode-0100-24ff) nil)
(aset standard-display-table
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 28be35d65d2..df1c06ec272 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -88,7 +88,7 @@
(bindings--define-key map [separator-3] menu-bar-separator)
(bindings--define-key map [set-terminal-coding-system]
'(menu-item "For Terminal" set-terminal-coding-system
- :enable (null (memq initial-window-system '(x w32 ns)))
+ :enable (null (memq initial-window-system '(x w32 ns haiku pgtk)))
:help "How to encode terminal output"))
(bindings--define-key map [set-keyboard-coding-system]
'(menu-item "For Keyboard" set-keyboard-coding-system
@@ -1411,6 +1411,7 @@ This function is called with no argument.")
Each element has the form:
(INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...)
See the function `register-input-method' for the meanings of the elements.")
+;; Autoload if this file no longer dumped.
;;;###autoload
(put 'input-method-alist 'risky-local-variable t)
@@ -1638,30 +1639,31 @@ If `default-transient-input-method' was not yet defined, prompt for it."
(interactive
(list (read-input-method-name
(format-prompt "Describe input method" current-input-method))))
- (if (and input-method (symbolp input-method))
- (setq input-method (symbol-name input-method)))
- (help-setup-xref (list #'describe-input-method
- (or input-method current-input-method))
- (called-interactively-p 'interactive))
-
- (if (null input-method)
- (describe-current-input-method)
- (let ((current current-input-method))
- (condition-case nil
- (progn
- (save-excursion
- (activate-input-method input-method)
- (describe-current-input-method))
- (activate-input-method current))
- (error
- (activate-input-method current)
- (help-setup-xref (list #'describe-input-method input-method)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (let ((elt (assoc input-method input-method-alist)))
- (princ (format-message
- "Input method: %s (`%s' in mode line) for %s\n %s\n"
- input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (and input-method (symbolp input-method))
+ (setq input-method (symbol-name input-method)))
+ (help-setup-xref (list #'describe-input-method
+ (or input-method current-input-method))
+ (called-interactively-p 'interactive))
+
+ (if (null input-method)
+ (describe-current-input-method)
+ (let ((current current-input-method))
+ (condition-case nil
+ (progn
+ (save-excursion
+ (activate-input-method input-method)
+ (describe-current-input-method))
+ (activate-input-method current))
+ (error
+ (activate-input-method current)
+ (help-setup-xref (list #'describe-input-method input-method)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (let ((elt (assoc input-method input-method-alist)))
+ (princ (format-message
+ "Input method: %s (`%s' in mode line) for %s\n %s\n"
+ input-method (nth 3 elt) (nth 1 elt) (nth 4 elt)))))))))))
(defun describe-current-input-method ()
"Describe the input method currently in use.
@@ -2162,89 +2164,90 @@ See `set-language-info-alist' for use in programs."
(list (read-language-name
'documentation
(format-prompt "Describe language environment" current-language-environment))))
- (if (null language-name)
- (setq language-name current-language-environment))
- (if (or (null language-name)
- (null (get-language-info language-name 'documentation)))
- (error "No documentation for the specified language"))
- (if (symbolp language-name)
- (setq language-name (symbol-name language-name)))
- (dolist (feature (get-language-info language-name 'features))
- (require feature))
- (let ((doc (get-language-info language-name 'documentation)))
- (help-setup-xref (list #'describe-language-environment language-name)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (insert language-name " language environment\n\n")
- (if (stringp doc)
- (insert (substitute-command-keys doc) "\n\n"))
- (condition-case nil
- (let ((str (eval (get-language-info language-name 'sample-text))))
- (if (stringp str)
- (insert "Sample text:\n "
- (string-replace "\n" "\n " str)
- "\n\n")))
- (error nil))
- (let ((input-method (get-language-info language-name 'input-method))
- (l (copy-sequence input-method-alist))
- (first t))
- (when (and input-method
- (setq input-method (assoc input-method l)))
- (insert "Input methods (default " (car input-method) ")\n")
- (setq l (cons input-method (delete input-method l))
- first nil))
- (dolist (elt l)
- (when (or (eq input-method elt)
- (eq t (compare-strings language-name nil nil
- (nth 1 elt) nil nil t)))
- (when first
- (insert "Input methods:\n")
- (setq first nil))
- (insert " " (car elt))
- (search-backward (car elt))
- (help-xref-button 0 'help-input-method (car elt))
- (goto-char (point-max))
- (insert " (\""
- (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
- "\" in mode line)\n")))
- (or first
- (insert "\n")))
- (insert "Character sets:\n")
- (let ((l (get-language-info language-name 'charset)))
- (if (null l)
- (insert " nothing specific to " language-name "\n")
- (while l
- (insert " " (symbol-name (car l)))
- (search-backward (symbol-name (car l)))
- (help-xref-button 0 'help-character-set (car l))
- (goto-char (point-max))
- (insert ": " (charset-description (car l)) "\n")
- (setq l (cdr l)))))
- (insert "\n")
- (insert "Coding systems:\n")
- (let ((l (get-language-info language-name 'coding-system)))
- (if (null l)
- (insert " nothing specific to " language-name "\n")
- (while l
- (insert " " (symbol-name (car l)))
- (search-backward (symbol-name (car l)))
- (help-xref-button 0 'help-coding-system (car l))
- (goto-char (point-max))
- (insert (substitute-command-keys " (`")
- (coding-system-mnemonic (car l))
- (substitute-command-keys "' in mode line):\n\t")
- (substitute-command-keys
- (coding-system-doc-string (car l)))
- "\n")
- (let ((aliases (coding-system-aliases (car l))))
- (when aliases
- (insert "\t(alias:")
- (while aliases
- (insert " " (symbol-name (car aliases)))
- (setq aliases (cdr aliases)))
- (insert ")\n")))
- (setq l (cdr l)))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (null language-name)
+ (setq language-name current-language-environment))
+ (if (or (null language-name)
+ (null (get-language-info language-name 'documentation)))
+ (error "No documentation for the specified language"))
+ (if (symbolp language-name)
+ (setq language-name (symbol-name language-name)))
+ (dolist (feature (get-language-info language-name 'features))
+ (require feature))
+ (let ((doc (get-language-info language-name 'documentation)))
+ (help-setup-xref (list #'describe-language-environment language-name)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (insert language-name " language environment\n\n")
+ (if (stringp doc)
+ (insert (substitute-command-keys doc) "\n\n"))
+ (condition-case nil
+ (let ((str (eval (get-language-info language-name 'sample-text))))
+ (if (stringp str)
+ (insert "Sample text:\n "
+ (string-replace "\n" "\n " str)
+ "\n\n")))
+ (error nil))
+ (let ((input-method (get-language-info language-name 'input-method))
+ (l (copy-sequence input-method-alist))
+ (first t))
+ (when (and input-method
+ (setq input-method (assoc input-method l)))
+ (insert "Input methods (default " (car input-method) ")\n")
+ (setq l (cons input-method (delete input-method l))
+ first nil))
+ (dolist (elt l)
+ (when (or (eq input-method elt)
+ (eq t (compare-strings language-name nil nil
+ (nth 1 elt) nil nil t)))
+ (when first
+ (insert "Input methods:\n")
+ (setq first nil))
+ (insert " " (car elt))
+ (search-backward (car elt))
+ (help-xref-button 0 'help-input-method (car elt))
+ (goto-char (point-max))
+ (insert " (\""
+ (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
+ "\" in mode line)\n")))
+ (or first
+ (insert "\n")))
+ (insert "Character sets:\n")
+ (let ((l (get-language-info language-name 'charset)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-character-set (car l))
+ (goto-char (point-max))
+ (insert ": " (charset-description (car l)) "\n")
+ (setq l (cdr l)))))
+ (insert "\n")
+ (insert "Coding systems:\n")
+ (let ((l (get-language-info language-name 'coding-system)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-coding-system (car l))
+ (goto-char (point-max))
+ (insert (substitute-command-keys " (`")
+ (coding-system-mnemonic (car l))
+ (substitute-command-keys "' in mode line):\n\t")
+ (substitute-command-keys
+ (coding-system-doc-string (car l)))
+ "\n")
+ (let ((aliases (coding-system-aliases (car l))))
+ (when aliases
+ (insert "\t(alias:")
+ (while aliases
+ (insert " " (symbol-name (car aliases)))
+ (setq aliases (cdr aliases)))
+ (insert ")\n")))
+ (setq l (cdr l))))))))))
;;; Locales.
@@ -2665,6 +2668,20 @@ For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
locale))
locale))
+(defvar current-locale-environment nil
+ "The currently set locale environment.")
+
+(defmacro with-locale-environment (locale-name &rest body)
+ "Execute BODY with the locale set to LOCALE-NAME."
+ (declare (indent 1) (debug (sexp def-body)))
+ (let ((current (gensym)))
+ `(let ((,current current-locale-environment))
+ (unwind-protect
+ (progn
+ (set-locale-environment ,locale-name)
+ ,@body)
+ (set-locale-environment ,current)))))
+
(defun set-locale-environment (&optional locale-name frame)
"Set up multilingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority,
@@ -2690,6 +2707,10 @@ If FRAME is non-nil, only set the keyboard coding system and the
terminal coding system for the terminal of that frame, and don't
touch session-global parameters like the language environment.
+This function sets the `current-locale-environment' variable. To
+change the locale temporarily, `with-locale-environment' can be
+used.
+
See also `locale-charset-language-names', `locale-language-names',
`locale-preferred-coding-systems' and `locale-coding-system'."
(interactive (list (completing-read "Set environment for locale: "
@@ -2723,6 +2744,7 @@ See also `locale-charset-language-names', `locale-language-names',
(when locale
(setq locale (locale-translate locale))
+ (setq current-locale-environment locale)
;; Leave the system locales alone if the caller did not specify
;; an explicit locale name, as their defaults are set from
@@ -2927,6 +2949,7 @@ Optional 3rd argument DOCSTRING is a documentation string of the property.
See also the documentation of `get-char-code-property' and
`put-char-code-property'."
+ (declare (indent defun))
(or (symbolp name)
(error "Not a symbol: %s" name))
(if (char-table-p table)
@@ -3061,22 +3084,6 @@ on encoding."
0))
(substring enc2 i0 i2)))))
-;; Backwards compatibility. These might be better with :init-value t,
-;; but that breaks loadup.
-(define-minor-mode unify-8859-on-encoding-mode
- "Exists only for backwards compatibility."
- :group 'mule
- :global t)
-;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
-(make-obsolete 'unify-8859-on-encoding-mode "don't use it." "23.1")
-
-(define-minor-mode unify-8859-on-decoding-mode
- "Exists only for backwards compatibility."
- :group 'mule
- :global t)
-;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
-(make-obsolete 'unify-8859-on-decoding-mode "don't use it." "23.1")
-
(defvar ucs-names nil
"Hash table of cached CHAR-NAME keys to CHAR-CODE values.")
@@ -3244,5 +3251,118 @@ as names, not numbers."
(define-obsolete-function-alias 'ucs-insert 'insert-char "24.3")
(define-key ctl-x-map "8\r" 'insert-char)
+(define-key ctl-x-map "8e"
+ (define-keymap
+ "e" #'emoji-insert
+ "i" #'emoji-insert
+ "s" #'emoji-search
+ "d" #'emoji-describe
+ "r" #'emoji-recent
+ "l" #'emoji-list
+ "+" #'emoji-zoom-increase
+ "-" #'emoji-zoom-decrease))
+
+(defface confusingly-reordered
+ '((((supports :underline (:style wave)))
+ :underline (:style wave :color "Red1"))
+ (t
+ :inherit warning))
+ "Face for highlighting text that was bidi-reordered in confusing ways."
+ :version "29.1")
+
+(defvar reorder-starters "[\u202A\u202B\u202D\u202E\u2066-\u2068]+"
+ "Regular expression for characters that start forced-reordered text.")
+(defvar reorder-enders "[\u202C\u2069]+\\|\n"
+ "Regular expression for characters that end forced-reordered text.")
+
+(autoload 'text-property-search-forward "text-property-search")
+(autoload 'prop-match-beginning "text-property-search")
+(autoload 'prop-match-end "text-property-search")
+
+(defun highlight-confusing-reorderings (beg end &optional remove)
+ "Highlight text in region that might be bidi-reordered in suspicious ways.
+This command find and highlights segments of buffer text that could have
+been reordered on display by using directional control characters, such
+as RLO and LRI, in a way that their display is deliberately meant to
+confuse the reader. These techniques can be used for obfuscating
+malicious source code. The suspicious stretches of buffer text are
+highlighted using the `confusingly-reordered' face.
+
+If the region is active, check the text inside the region. Otherwise
+check the entire buffer. When called from Lisp, pass BEG and END to
+specify the portion of the buffer to check.
+
+Optional argument REMOVE, if non-nil (interactively, prefix argument),
+means remove the highlighting from the region between BEG and END,
+or the active region if that is set."
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end) current-prefix-arg)
+ (list (point-min) (point-max) current-prefix-arg)))
+ (save-excursion
+ (if remove
+ (let (prop-match)
+ (goto-char beg)
+ (while (and
+ (setq prop-match
+ (text-property-search-forward 'font-lock-face
+ 'confusingly-reordered t))
+ (< (prop-match-beginning prop-match) end))
+ (with-silent-modifications
+ (remove-list-of-text-properties (prop-match-beginning prop-match)
+ (prop-match-end prop-match)
+ '(font-lock-face face mouse-face
+ help-echo)))))
+ (let ((count 0)
+ next)
+ (goto-char beg)
+ (while (setq next
+ (bidi-find-overridden-directionality
+ (point) end nil
+ (current-bidi-paragraph-direction)))
+ (goto-char next)
+ ;; We detect the problematic parts by watching directional
+ ;; properties of strong L2R and R2L characters. But
+ ;; malicious reordering in source buffers can, and usuually
+ ;; does, include syntactically-important punctuation
+ ;; characters. Those have "weak" directionality, so we
+ ;; cannot easily detect when they are affected in malicious
+ ;; ways. Therefore, once we find a strong directional
+ ;; character whose directionality was tweaked, we highlight
+ ;; the text around it, between the first bidi control
+ ;; character we find before it that starts an
+ ;; override/embedding/isolate, and the first control after
+ ;; it that ends these. This could sometimes highlight only
+ ;; part of the affected text. An alternative would be to
+ ;; find the first "starter" following BOL and the last
+ ;; "ender" before EOL, and highlight everything in between
+ ;; them -- this could sometimes highlight too much.
+ (let ((start
+ (save-excursion
+ (re-search-backward reorder-starters nil t)))
+ (finish
+ (save-excursion
+ (let ((fin (re-search-forward reorder-enders nil t)))
+ (if fin (1- fin)
+ (point-max))))))
+ (with-silent-modifications
+ (add-text-properties start finish
+ '(font-lock-face
+ confusingly-reordered
+ face confusingly-reordered
+ mouse-face highlight
+ help-echo "\
+This text is reordered on display in a way that could change its semantics;
+use \\[forward-char] and \\[backward-char] to see the actual order of characters.")))
+ (goto-char finish)
+ (setq count (1+ count))))
+ (message
+ (if (> count 0)
+ (ngettext
+ "Highlighted %d confusingly-reordered text string"
+ "Highlighted %d confusingly-reordered text strings"
+ count)
+ "No confusingly-reordered text strings were found")
+ count)))))
;;; mule-cmds.el ends here
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index a056f49e07c..3f3ac6064ae 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -148,6 +148,7 @@
(defmacro define-iso-single-byte-charset (symbol iso-symbol name nickname
iso-ir iso-final
emacs-mule-id map)
+ (declare (indent defun))
`(progn
(define-charset ,symbol
,name
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 16c17b5efa9..6b630c73e8e 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -299,65 +299,66 @@ meanings of these arguments."
(defun describe-character-set (charset)
"Display information about built-in character set CHARSET."
(interactive (list (read-charset "Charset: ")))
- (or (charsetp charset)
- (error "Invalid charset: %S" charset))
- (help-setup-xref (list #'describe-character-set charset)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (insert "Character set: " (symbol-name charset))
- (let ((name (get-charset-property charset :name)))
- (if (not (eq name charset))
- (insert " (alias of " (symbol-name name) ?\))))
- (insert "\n\n" (charset-description charset) "\n\n")
- (insert "Number of contained characters: ")
- (dotimes (i (charset-dimension charset))
- (unless (= i 0)
- (insert ?x))
- (insert (format "%d" (charset-chars charset (1+ i)))))
- (insert ?\n)
- (let ((char (charset-iso-final-char charset)))
- (when (> char 0)
- (insert "Final char of ISO2022 designation sequence: ")
- (insert (format-message "`%c'\n" char))))
- (let (aliases)
- (dolist (c charset-list)
- (if (and (not (eq c charset))
- (eq charset (get-charset-property c :name)))
- (push c aliases)))
- (if aliases
- (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
-
- (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
- (:map "Map file: " identity)
- (:unify-map "Unification map file: " identity)
- (:invalid-code
- nil
- ,(lambda (c)
- (format "Invalid character: %c (code %d)" c c)))
- (:emacs-mule-id "Id in emacs-mule coding system: "
- number-to-string)
- (:parents "Parents: "
- (lambda (parents)
- (mapconcat ,(lambda (elt)
- (format "%s" elt))
- parents
- ", ")))
- (:code-space "Code space: " ,(lambda (c)
- (format "%s" c)))
- (:code-offset "Code offset: " number-to-string)
- (:iso-revision-number "ISO revision number: "
- number-to-string)
- (:supplementary-p
- "Used only as a parent or a subset of some other charset,
+ (let ((help-buffer-under-preparation t))
+ (or (charsetp charset)
+ (error "Invalid charset: %S" charset))
+ (help-setup-xref (list #'describe-character-set charset)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (insert "Character set: " (symbol-name charset))
+ (let ((name (get-charset-property charset :name)))
+ (if (not (eq name charset))
+ (insert " (alias of " (symbol-name name) ?\))))
+ (insert "\n\n" (charset-description charset) "\n\n")
+ (insert "Number of contained characters: ")
+ (dotimes (i (charset-dimension charset))
+ (unless (= i 0)
+ (insert ?x))
+ (insert (format "%d" (charset-chars charset (1+ i)))))
+ (insert ?\n)
+ (let ((char (charset-iso-final-char charset)))
+ (when (> char 0)
+ (insert "Final char of ISO2022 designation sequence: ")
+ (insert (format-message "`%c'\n" char))))
+ (let (aliases)
+ (dolist (c charset-list)
+ (if (and (not (eq c charset))
+ (eq charset (get-charset-property c :name)))
+ (push c aliases)))
+ (if aliases
+ (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
+
+ (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
+ (:map "Map file: " identity)
+ (:unify-map "Unification map file: " identity)
+ (:invalid-code
+ nil
+ ,(lambda (c)
+ (format "Invalid character: %c (code %d)" c c)))
+ (:emacs-mule-id "Id in emacs-mule coding system: "
+ number-to-string)
+ (:parents "Parents: "
+ (lambda (parents)
+ (mapconcat ,(lambda (elt)
+ (format "%s" elt))
+ parents
+ ", ")))
+ (:code-space "Code space: " ,(lambda (c)
+ (format "%s" c)))
+ (:code-offset "Code offset: " number-to-string)
+ (:iso-revision-number "ISO revision number: "
+ number-to-string)
+ (:supplementary-p
+ "Used only as a parent or a subset of some other charset,
or provided just for backward compatibility." nil)))
- (let ((val (get-charset-property charset (car elt))))
- (when val
- (if (cadr elt) (insert (cadr elt)))
- (if (nth 2 elt)
- (let ((print-length 10) (print-level 2))
- (princ (funcall (nth 2 elt) val) (current-buffer))))
- (insert ?\n)))))))
+ (let ((val (get-charset-property charset (car elt))))
+ (when val
+ (if (cadr elt) (insert (cadr elt)))
+ (if (nth 2 elt)
+ (let ((print-length 10) (print-level 2))
+ (princ (funcall (nth 2 elt) val) (current-buffer))))
+ (insert ?\n))))))))
;;; CODING-SYSTEM
@@ -406,89 +407,90 @@ or provided just for backward compatibility." nil)))
(defun describe-coding-system (coding-system)
"Display information about CODING-SYSTEM."
(interactive "zDescribe coding system (default current choices): ")
- (if (null coding-system)
- (describe-current-coding-system)
- (help-setup-xref (list #'describe-coding-system coding-system)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (print-coding-system-briefly coding-system 'doc-string)
- (let ((type (coding-system-type coding-system))
- ;; Fixme: use this
- ;; (extra-spec (coding-system-plist coding-system))
- )
- (princ "Type: ")
- (princ type)
- (cond ((eq type 'undecided)
- (princ " (do automatic conversion)"))
- ((eq type 'utf-8)
- (princ " (UTF-8: Emacs internal multibyte form)"))
- ((eq type 'utf-16)
- ;; (princ " (UTF-16)")
- )
- ((eq type 'shift-jis)
- (princ " (Shift-JIS, MS-KANJI)"))
- ((eq type 'iso-2022)
- (princ " (variant of ISO-2022)\n")
- (princ "Initial designations:\n")
- (print-designation (coding-system-get coding-system
- :designation))
-
- (when (coding-system-get coding-system :flags)
- (princ "Other specifications: \n ")
- (apply #'print-list
- (coding-system-get coding-system :flags))))
- ((eq type 'charset)
- (princ " (charset)"))
- ((eq type 'ccl)
- (princ " (do conversion by CCL program)"))
- ((eq type 'raw-text)
- (princ " (text with random binary characters)"))
- ((eq type 'emacs-mule)
- (princ " (Emacs 21 internal encoding)"))
- ((eq type 'big5))
- (t (princ ": invalid coding-system.")))
- (princ "\nEOL type: ")
- (let ((eol-type (coding-system-eol-type coding-system)))
- (cond ((vectorp eol-type)
- (princ "Automatic selection from:\n\t")
- (princ eol-type)
- (princ "\n"))
- ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
- ((eq eol-type 1) (princ "CRLF\n"))
- ((eq eol-type 2) (princ "CR\n"))
- (t (princ "invalid\n")))))
- (let ((postread (coding-system-get coding-system :post-read-conversion)))
- (when postread
- (princ "After decoding text normally,")
- (princ " perform post-conversion using the function: ")
- (princ "\n ")
- (princ postread)
- (princ "\n")))
- (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
- (when prewrite
- (princ "Before encoding text normally,")
- (princ " perform pre-conversion using the function: ")
- (princ "\n ")
- (princ prewrite)
- (princ "\n")))
- (with-current-buffer standard-output
- (let ((charsets (coding-system-charset-list coding-system)))
- (when (and (not (eq (coding-system-base coding-system) 'raw-text))
- charsets)
- (cond
- ((eq charsets 'iso-2022)
- (insert "This coding system can encode all ISO 2022 charsets."))
- ((eq charsets 'emacs-mule)
- (insert "This coding system can encode all emacs-mule charsets\
+ (let ((help-buffer-under-preparation t))
+ (if (null coding-system)
+ (describe-current-coding-system)
+ (help-setup-xref (list #'describe-coding-system coding-system)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (print-coding-system-briefly coding-system 'doc-string)
+ (let ((type (coding-system-type coding-system))
+ ;; Fixme: use this
+ ;; (extra-spec (coding-system-plist coding-system))
+ )
+ (princ "Type: ")
+ (princ type)
+ (cond ((eq type 'undecided)
+ (princ " (do automatic conversion)"))
+ ((eq type 'utf-8)
+ (princ " (UTF-8: Emacs internal multibyte form)"))
+ ((eq type 'utf-16)
+ ;; (princ " (UTF-16)")
+ )
+ ((eq type 'shift-jis)
+ (princ " (Shift-JIS, MS-KANJI)"))
+ ((eq type 'iso-2022)
+ (princ " (variant of ISO-2022)\n")
+ (princ "Initial designations:\n")
+ (print-designation (coding-system-get coding-system
+ :designation))
+
+ (when (coding-system-get coding-system :flags)
+ (princ "Other specifications: \n ")
+ (apply #'print-list
+ (coding-system-get coding-system :flags))))
+ ((eq type 'charset)
+ (princ " (charset)"))
+ ((eq type 'ccl)
+ (princ " (do conversion by CCL program)"))
+ ((eq type 'raw-text)
+ (princ " (text with random binary characters)"))
+ ((eq type 'emacs-mule)
+ (princ " (Emacs 21 internal encoding)"))
+ ((eq type 'big5))
+ (t (princ ": invalid coding-system.")))
+ (princ "\nEOL type: ")
+ (let ((eol-type (coding-system-eol-type coding-system)))
+ (cond ((vectorp eol-type)
+ (princ "Automatic selection from:\n\t")
+ (princ eol-type)
+ (princ "\n"))
+ ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
+ ((eq eol-type 1) (princ "CRLF\n"))
+ ((eq eol-type 2) (princ "CR\n"))
+ (t (princ "invalid\n")))))
+ (let ((postread (coding-system-get coding-system :post-read-conversion)))
+ (when postread
+ (princ "After decoding text normally,")
+ (princ " perform post-conversion using the function: ")
+ (princ "\n ")
+ (princ postread)
+ (princ "\n")))
+ (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
+ (when prewrite
+ (princ "Before encoding text normally,")
+ (princ " perform pre-conversion using the function: ")
+ (princ "\n ")
+ (princ prewrite)
+ (princ "\n")))
+ (with-current-buffer standard-output
+ (let ((charsets (coding-system-charset-list coding-system)))
+ (when (and (not (eq (coding-system-base coding-system) 'raw-text))
+ charsets)
+ (cond
+ ((eq charsets 'iso-2022)
+ (insert "This coding system can encode all ISO 2022 charsets."))
+ ((eq charsets 'emacs-mule)
+ (insert "This coding system can encode all emacs-mule charsets\
."""))
- (t
- (insert "This coding system encodes the following charsets:\n ")
- (while charsets
- (insert " " (symbol-name (car charsets)))
- (search-backward (symbol-name (car charsets)))
- (help-xref-button 0 'help-character-set (car charsets))
- (goto-char (point-max))
- (setq charsets (cdr charsets)))))))))))
+ (t
+ (insert "This coding system encodes the following charsets:\n ")
+ (while charsets
+ (insert " " (symbol-name (car charsets)))
+ (search-backward (symbol-name (car charsets)))
+ (help-xref-button 0 'help-character-set (car charsets))
+ (goto-char (point-max))
+ (setq charsets (cdr charsets))))))))))))
;;;###autoload
(defun describe-current-coding-system-briefly ()
@@ -833,7 +835,7 @@ The IGNORED argument is ignored."
"Display information about a font whose name is FONTNAME."
(interactive
(list (completing-read
- "Font name (default current choice for ASCII chars): "
+ (format-prompt "Font name" "current choice for ASCII chars")
(and window-system
;; Implied by `window-system'.
(fboundp 'x-list-fonts)
@@ -845,7 +847,8 @@ The IGNORED argument is ignored."
(or (and window-system (fboundp 'fontset-list))
(error "No fonts being used"))
(let ((xref-item (list #'describe-font fontname))
- font-info)
+ font-info
+ (help-buffer-under-preparation t))
(if (or (not fontname) (= (length fontname) 0))
(setq fontname (face-attribute 'default :font)))
(setq font-info (font-info fontname))
@@ -1004,16 +1007,17 @@ This shows which font is used for which character(s)."
(mapcar 'cdr fontset-alias-alist)))
(completion-ignore-case t))
(list (completing-read
- "Fontset (default used by the current frame): "
+ (format-prompt "Fontset" "used by the current frame")
fontset-list nil t)))))
- (if (= (length fontset) 0)
- (setq fontset (face-attribute 'default :fontset))
- (setq fontset (query-fontset fontset)))
- (help-setup-xref (list #'describe-fontset fontset)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (print-fontset fontset t))))
+ (let ((help-buffer-under-preparation t))
+ (if (= (length fontset) 0)
+ (setq fontset (face-attribute 'default :fontset))
+ (setq fontset (query-fontset fontset)))
+ (help-setup-xref (list #'describe-fontset fontset)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (print-fontset fontset t)))))
(declare-function fontset-plain-name "fontset" (fontset))
@@ -1024,39 +1028,41 @@ This shows the name, size, and style of each fontset.
With prefix arg, also list the fonts contained in each fontset;
see the function `describe-fontset' for the format of the list."
(interactive "P")
- (if (not (and window-system (fboundp 'fontset-list)))
- (error "No fontsets being used")
- (help-setup-xref (list #'list-fontsets arg)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- ;; This code is duplicated near the end of mule-diag.
- (let ((fontsets
- (sort (fontset-list)
- (lambda (x y)
- (string< (fontset-plain-name x)
- (fontset-plain-name y))))))
- (while fontsets
- (if arg
- (print-fontset (car fontsets) nil)
- (insert "Fontset: " (car fontsets) "\n"))
- (setq fontsets (cdr fontsets))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (not (and window-system (fboundp 'fontset-list)))
+ (error "No fontsets being used")
+ (help-setup-xref (list #'list-fontsets arg)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ ;; This code is duplicated near the end of mule-diag.
+ (let ((fontsets
+ (sort (fontset-list)
+ (lambda (x y)
+ (string< (fontset-plain-name x)
+ (fontset-plain-name y))))))
+ (while fontsets
+ (if arg
+ (print-fontset (car fontsets) nil)
+ (insert "Fontset: " (car fontsets) "\n"))
+ (setq fontsets (cdr fontsets)))))))))
;;;###autoload
(defun list-input-methods ()
"Display information about all input methods."
(interactive)
- (help-setup-xref '(list-input-methods)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (list-input-methods-1)
- (with-current-buffer standard-output
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- (substitute-command-keys "^ \\([^ ]+\\) (`.*' in mode line)$")
- nil t)
- (help-xref-button 1 'help-input-method (match-string 1)))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref '(list-input-methods)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (list-input-methods-1)
+ (with-current-buffer standard-output
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ (substitute-command-keys "^ \\([^ ]+\\) (`.*' in mode line)$")
+ nil t)
+ (help-xref-button 1 'help-input-method (match-string 1))))))))
(defun list-input-methods-1 ()
(if (not input-method-alist)
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 8978a97e793..ab74c2cffd9 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -218,6 +218,7 @@ corresponding Unicode character code.
If it is a string, it is a name of file that contains the above
information. The file format is the same as what described for `:map'
attribute."
+ (declare (indent defun))
(when (vectorp (car props))
;; Old style code:
;; (define-charset CHARSET-ID CHARSET-SYMBOL INFO-VECTOR)
@@ -297,13 +298,21 @@ attribute."
(defvar hack-read-symbol-shorthands-function nil
"Holds function to compute `read-symbol-shorthands'.")
-(defun load-with-code-conversion (fullname file &optional noerror nomessage)
+(defun load-with-code-conversion (fullname file &optional noerror nomessage
+ eval-function)
"Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
The file contents are decoded before evaluation if necessary.
-If optional third arg NOERROR is non-nil,
- report no error if FILE doesn't exist.
-Print messages at start and end of loading unless
- optional fourth arg NOMESSAGE is non-nil.
+
+If optional third arg NOERROR is non-nil, report no error if FILE
+doesn't exist.
+
+Print messages at start and end of loading unless optional fourth
+arg NOMESSAGE is non-nil.
+
+If EVAL-FUNCTION, call that instead of calling `eval-buffer'
+directly. It is called with two parameters: The buffer object
+and the file name.
+
Return t if file exists."
(if (null (file-readable-p fullname))
(and (null noerror)
@@ -352,10 +361,13 @@ Return t if file exists."
;; Have the original buffer current while we eval,
;; but consider shorthands of the eval'ed one.
(let ((read-symbol-shorthands shorthands))
- (eval-buffer buffer nil
- ;; This is compatible with what `load' does.
- (if dump-mode file fullname)
- nil t)))
+ (if eval-function
+ (funcall eval-function buffer
+ (if dump-mode file fullname))
+ (eval-buffer buffer nil
+ ;; This is compatible with what `load' does.
+ (if dump-mode file fullname)
+ nil t))))
(let (kill-buffer-hook kill-buffer-query-functions)
(kill-buffer buffer)))
(do-after-load-evaluation fullname)
@@ -890,6 +902,7 @@ non-nil.
VALUE non-nil means Emacs prefers UTF-8 on code detection for
non-ASCII files. This attribute is meaningful only when
`:coding-type' is `undecided'."
+ (declare (indent defun))
(let* ((common-attrs (mapcar 'list
'(:mnemonic
:coding-type
@@ -2320,6 +2333,7 @@ This function sets properties `translation-table' and
`translation-table-id' of SYMBOL to the created table itself and the
identification number of the table respectively. It also registers
the table in `translation-table-vector'."
+ (declare (indent defun))
(let ((table (if (and (char-table-p (car args))
(eq (char-table-subtype (car args))
'translation-table))
@@ -2394,6 +2408,7 @@ Value is what BODY returns."
Analogous to `define-translation-table', but updates
`translation-hash-table-vector' and the table is for use in the CCL
`lookup-integer' and `lookup-character' functions."
+ (declare (indent defun))
(unless (and (symbolp symbol)
(hash-table-p table))
(error "Bad args to define-translation-hash-table"))
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 9d9210e9010..529cf97215e 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -412,8 +412,8 @@ If it is nil, the current key is shown.
DOCSTRING is the documentation string of this package. The command
`describe-input-method' shows this string while replacing the form
-\\=\\<VAR> in the string by the value of VAR. That value should be a
-string. For instance, the form \\=\\<quail-translation-docstring> is
+\\=\\=\\=\\<VAR> in the string by the value of VAR. That value should be a
+string. For instance, the form \\=\\=\\=\\<quail-translation-docstring> is
replaced by a description about how to select a translation from a
list of candidates.
@@ -917,7 +917,7 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
The variable `quail-keyboard-layout-type' holds the currently selected
keyboard type."
(interactive
- (list (completing-read "Keyboard type (default current choice): "
+ (list (completing-read (format-prompt "Keyboard type" "current choice")
quail-keyboard-layout-alist
nil t)))
(or (and keyboard-type (> (length keyboard-type) 0))
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index c38cd822693..4c498d7f923 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -529,10 +529,10 @@ Use the longest match method to select a rule."
(insert (cadr tree))
(delete-char (- end begin)))))
-;; for backward compatibility
-
-(fset 'robin-transliterate-region 'robin-convert-region)
-(fset 'robin-transliterate-buffer 'robin-convert-buffer)
+(define-obsolete-function-alias 'robin-transliterate-region
+ #'robin-convert-region "29.1")
+(define-obsolete-function-alias 'robin-transliterate-buffer
+ #'robin-convert-buffer "29.1")
;;; Reverse conversion
diff --git a/lisp/international/textsec-check.el b/lisp/international/textsec-check.el
new file mode 100644
index 00000000000..567ef73feb2
--- /dev/null
+++ b/lisp/international/textsec-check.el
@@ -0,0 +1,78 @@
+;;; textsec-check.el --- Check for suspicious texts -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defgroup textsec nil
+ "Suspicious text identification."
+ :group 'security
+ :version "29.1")
+
+(defcustom textsec-check t
+ "If non-nil, perform some security-related checks on text objects.
+If nil, these checks are disabled."
+ :type 'boolean
+ :version "29.1")
+
+(defface textsec-suspicious
+ '((t (:weight bold :background "red")))
+ "Face used to highlight suspicious strings.")
+
+;;;###autoload
+(defun textsec-suspicious-p (object type)
+ "Say whether OBJECT is suspicious for use as TYPE.
+If OBJECT is suspicious, return a string explaining the reason
+for considering it suspicious, otherwise return nil.
+
+Available values of TYPE and corresponding OBJECTs are:
+
+ `url' -- a URL; OBJECT should be a URL string.
+
+ `link' -- an HTML link; OBJECT should be a cons cell
+ of the form (URL . LINK-TEXT).
+
+ `domain' -- a Web domain; OBJECT should be a string.
+
+ `local-address' -- the local part of an email address; OBJECT
+ should be a string.
+ `name' -- the \"display name\" part of an email address;
+ OBJECT should be a string.
+
+`email-address' -- a full email address; OBJECT should be a string.
+
+ `email-address-header' -- a raw email address header in RFC 2822 format;
+ OBJECT should be a string.
+
+If the user option `textsec-check' is nil, these checks are
+disabled, and this function always returns nil."
+ (if (not textsec-check)
+ nil
+ (require 'textsec)
+ (let ((func (intern (format "textsec-%s-suspicious-p" type))))
+ (unless (fboundp func)
+ (error "%s is not a valid function" func))
+ (funcall func object))))
+
+(provide 'textsec-check)
+
+;;; textsec-check.el ends here
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
new file mode 100644
index 00000000000..82eba1b5d51
--- /dev/null
+++ b/lisp/international/textsec.el
@@ -0,0 +1,467 @@
+;;; textsec.el --- Functions for handling homoglyphs and the like -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'uni-confusable)
+(require 'ucs-normalize)
+(require 'idna-mapping)
+(require 'puny)
+(require 'mail-parse)
+(require 'url)
+
+(defvar textsec--char-scripts nil)
+
+(eval-and-compile
+ (defun textsec--create-script-table (data)
+ "Create the textsec--char-scripts char table."
+ (setq textsec--char-scripts (make-char-table nil))
+ (dolist (scripts data)
+ (dolist (range (cadr scripts))
+ (set-char-table-range textsec--char-scripts
+ range (car scripts)))))
+ (require 'uni-scripts))
+
+(defun textsec-scripts (string)
+ "Return a list of Unicode scripts used in STRING.
+The scripts returned by this function use the Unicode Script property
+as defined by the Unicode Standard Annex 24 (UAX#24)."
+ (seq-map (lambda (char)
+ (elt textsec--char-scripts char))
+ string))
+
+(defun textsec-single-script-p (string)
+ "Return non-nil if STRING is all in a single Unicode script.
+
+Note that the concept of \"single script\" used by this function
+isn't obvious -- some mixtures of scripts count as a \"single
+script\". See
+
+ https://www.unicode.org/reports/tr39/#Mixed_Script_Detection
+
+for details. The Unicode scripts are as defined by the
+Unicode Standard Annex 24 (UAX#24)."
+ (let ((scripts (mapcar
+ (lambda (s)
+ (append s
+ ;; Some scripts used in East Asia are
+ ;; commonly used across borders, so we add
+ ;; those.
+ (mapcan (lambda (script)
+ (copy-sequence
+ (textsec--augment-script script)))
+ s)))
+ (textsec-scripts string))))
+ (catch 'empty
+ (cl-loop for s1 in scripts
+ do (cl-loop for s2 in scripts
+ ;; Common/inherited chars can be used in
+ ;; text with all scripts.
+ when (and (not (memq 'common s1))
+ (not (memq 'common s2))
+ (not (memq 'inherited s1))
+ (not (memq 'inherited s2))
+ (not (seq-intersection s1 s2)))
+ do (throw 'empty nil)))
+ t)))
+
+(defun textsec--augment-script (script)
+ (cond
+ ((eq script 'han)
+ '(hangul japan korea))
+ ((or (eq script 'hiragana)
+ (eq script 'katakana))
+ '(japan))
+ ((or (eq script 'hangul)
+ (eq script 'bopomofo))
+ '(korea))))
+
+(defun textsec-covering-scripts (string)
+ "Return a minimal list of scripts used in STRING.
+Note that a string may have several different minimal cover sets.
+The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+ (let* ((scripts (textsec-scripts string))
+ (set (car scripts)))
+ (dolist (s scripts)
+ (setq set (seq-union set (seq-difference s set))))
+ (sort (delq 'common (delq 'inherited set)) #'string<)))
+
+(defun textsec-restriction-level (string)
+ "Say what restriction level STRING qualifies for.
+Levels are (in decreasing order of restrictiveness) `ascii-only',
+`single-script', `highly-restrictive', `moderately-restrictive',
+`minimally-restrictive' and `unrestricted'."
+ (let ((scripts (textsec-covering-scripts string)))
+ (cond
+ ((string-match "\\`[[:ascii:]]+\\'" string)
+ 'ascii-only)
+ ((textsec-single-script-p string)
+ 'single-script)
+ ((or (null (seq-difference scripts '(latin han hiragana katakana)))
+ (null (seq-difference scripts '(latin han bopomofo)))
+ (null (seq-difference scripts '(latin han hangul))))
+ 'highly-restrictive)
+ ((and (= (length scripts) 2)
+ (memq 'latin scripts)
+ ;; This list comes from
+ ;; https://www.unicode.org/reports/tr31/#Table_Recommended_Scripts
+ ;; (but without latin, cyrillic and greek).
+ (seq-intersection scripts
+ '(arabic
+ armenian
+ bengali
+ bopomofo
+ devanagari
+ ethiopic
+ georgian
+ gujarati
+ gurmukhi
+ hangul
+ han
+ hebrew
+ hiragana
+ katakana
+ kannada
+ khmer
+ lao
+ malayalam
+ myanmar
+ oriya
+ sinhala
+ tamil
+ telugu
+ thaana
+ thai
+ tibetan)))
+ ;; The string is covered by Latin and any one other Recommended
+ ;; script, except Cyrillic, Greek.
+ 'moderately-retrictive)
+ ;; Fixme `minimally-restrictive' -- needs well-formedness criteria
+ ;; and Identifier Profile.
+ (t
+ 'unrestricted))))
+
+(defun textsec-mixed-numbers-p (string)
+ "Return non-nil if STRING includes numbers from different decimal systems."
+ (>
+ (length
+ (seq-uniq
+ (mapcar
+ (lambda (char)
+ ;; Compare zeros in the respective decimal systems.
+ (- char (get-char-code-property char 'numeric-value)))
+ (seq-filter (lambda (char)
+ ;; We're selecting the characters that
+ ;; have a numeric property.
+ (eq (get-char-code-property char 'general-category)
+ 'Nd))
+ string))))
+ 1))
+
+(defun textsec-ascii-confusable-p (string)
+ "Return non-nil if non-ASCII STRING can be confused with ASCII on display."
+ (and (not (eq (textsec-restriction-level string) 'ascii-only))
+ (eq (textsec-restriction-level (textsec-unconfuse-string string))
+ 'ascii-only)))
+
+(defun textsec-unconfuse-string (string)
+ "Return a de-confused version of STRING.
+This algorithm is described in:
+
+ https://www.unicode.org/reports/tr39/#Confusable_Detection"
+ (ucs-normalize-NFD-string
+ (apply #'concat
+ (seq-map (lambda (char)
+ (or (gethash char uni-confusable-table)
+ (string char)))
+ (ucs-normalize-NFD-string string)))))
+
+(defun textsec-resolved-script-set (string)
+ "Return the resolved script set for STRING.
+This is the minimal covering script set for STRING, but is nil is
+STRING isn't a single script string.
+The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+ (and (textsec-single-script-p string)
+ (textsec-covering-scripts string)))
+
+(defun textsec-single-script-confusable-p (string1 string2)
+ "Say whether STRING1 and STRING2 are single-script confusables.
+The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+ (and (equal (textsec-unconfuse-string string1)
+ (textsec-unconfuse-string string2))
+ ;; And they have to have at least one resolved script in
+ ;; common.
+ (seq-intersection (textsec-resolved-script-set string1)
+ (textsec-resolved-script-set string2))))
+
+(defun textsec-mixed-script-confusable-p (string1 string2)
+ "Say whether STRING1 and STRING2 are mixed-script confusables.
+The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+ (and (equal (textsec-unconfuse-string string1)
+ (textsec-unconfuse-string string2))
+ ;; And they have no resolved scripts in common.
+ (null (seq-intersection (textsec-resolved-script-set string1)
+ (textsec-resolved-script-set string2)))))
+
+(defun textsec-whole-script-confusable-p (string1 string2)
+ "Say whether STRING1 and STRING2 are whole-script confusables.
+The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
+ (and (textsec-mixed-script-confusable-p string1 string2)
+ (textsec-single-script-p string1)
+ (textsec-single-script-p string2)))
+
+(defun textsec--ipvx-address-p (domain)
+ "Return non-nil if DOMAIN is an ipv4 or ipv6 address."
+ ;; This is a very relaxed pattern for IPv4 or IPv6 addresses. The
+ ;; assumption is that any malformed address accepted by this rule
+ ;; will be rejected by the actual address parser eventually.
+ (let ((case-fold-search t))
+ (rx-let ((ipv4 (** 1 4
+ (** 1 3 (in "0-9"))
+ (? ".")))
+ (ipv6 (: (** 1 7
+ (** 0 4 (in "0-9a-f"))
+ ":")
+ (** 0 4 (in "0-9a-f"))
+ (? ":" ipv4))))
+ (string-match-p (rx bos (or ipv4 ipv6 (: "[" ipv6 "]")) eos) domain))))
+
+(defun textsec-domain-suspicious-p (domain)
+ "Say whether DOMAIN's name looks suspicious.
+Return nil if it isn't suspicious. If it is, return a string explaining
+the potential problem.
+
+Domain names are considered suspicious if they use characters
+that can look similar to other characters when displayed, or
+use characters that are not allowed by Unicode's IDNA mapping,
+or use certain other unusual mixtures of characters."
+ (catch 'found
+ ;; Plain domains aren't suspicious.
+ (when (textsec--ipvx-address-p domain)
+ (throw 'found nil))
+ (seq-do
+ (lambda (char)
+ (when (eq (elt idna-mapping-table char) t)
+ (throw 'found
+ (format "Disallowed character%s (#x%x, %s)"
+ (if (eq (get-char-code-property char 'general-category)
+ 'Cf)
+ ""
+ (concat ": " (string char)))
+ char
+ (get-char-code-property char 'name)))))
+ domain)
+ ;; Does IDNA allow it?
+ (unless (puny-highly-restrictive-domain-p domain)
+ (throw
+ 'found
+ (format "`%s' mixes characters from different scripts in suspicious ways"
+ domain)))
+ ;; Check whether any segment of the domain name is confusable with
+ ;; an ASCII-only segment.
+ (dolist (elem (split-string domain "\\."))
+ (when (textsec-ascii-confusable-p elem)
+ (throw 'found (format "`%s' is confusable with ASCII" elem))))
+ nil))
+
+(defun textsec-local-address-suspicious-p (local)
+ "Say whether LOCAL part of an email address looks suspicious.
+LOCAL is the bit before \"@\" in an email address.
+
+If it isn't suspicious, return nil. If it is, return a string explaining
+the potential problem.
+
+Email addresses are considered suspicious if they use characters
+that can look similar to other characters when displayed, or use
+certain other unusual mixtures of characters."
+ (cond
+ ((not (equal local (ucs-normalize-NFKC-string local)))
+ (format "`%s' is not in normalized format `%s'"
+ local (ucs-normalize-NFKC-string local)))
+ ((textsec-mixed-numbers-p local)
+ (format "`%s' contains numbers from different number systems" local))
+ ((eq (textsec-restriction-level local) 'unrestricted)
+ (format "`%s' isn't restrictive enough" local))
+ ((string-match-p "\\`\\.\\|\\.\\'\\|\\.\\." local)
+ (format "`%s' contains invalid dots" local))))
+
+(defun textsec-bidi-controls-suspicious-p (string)
+ "Return non-nil of STRING uses bidi controls in suspicious ways.
+If STRING doesn't include any suspicious uses of bidirectional
+formatting control characters, return nil. Otherwise, return the
+index of the first character in STRING affected by such suspicious
+use of bidi controls. If the returned value is beyond the length
+of STRING, it means any text following STRING on display might be
+affected by bidi controls in STRING."
+ (with-temp-buffer
+ ;; We add a string that's representative of some text that could
+ ;; follow STRING, with the purpose of detecting residual bidi
+ ;; state at end of STRING which could then affect the following
+ ;; text.
+ (insert string "a1א:!")
+ (let ((pos (bidi-find-overridden-directionality 1 (point-max) nil)))
+ (and (fixnump pos)
+ (1- pos)))))
+
+(defun textsec-name-suspicious-p (name)
+ "Say whether NAME looks suspicious.
+NAME is (for instance) the free-text display name part of an
+email address.
+
+If it isn't suspicious, return nil. If it is, return a string
+explaining the potential problem.
+
+Names are considered suspicious if they use characters that can
+look similar to other characters when displayed, or use certain
+other unusual mixtures of characters."
+ (cond
+ ((not (equal name (ucs-normalize-NFC-string name)))
+ (format "`%s' is not in normalized format `%s'"
+ name (ucs-normalize-NFC-string name)))
+ ((and (seq-find (lambda (char)
+ (and (member char bidi-control-characters)
+ (not (member char
+ '( ?\N{left-to-right mark}
+ ?\N{right-to-left mark}
+ ?\N{arabic letter mark})))))
+ name)
+ ;; We have bidirectional formatting characters, but check
+ ;; whether they affect any other characters in suspicious
+ ;; ways. If not, NAME is not suspicious.
+ (fixnump (textsec-bidi-controls-suspicious-p name)))
+ (format "`%s' contains suspicious uses of bidirectional control characters"
+ name))
+ ((textsec-suspicious-nonspacing-p name))))
+
+(defun textsec-suspicious-nonspacing-p (string)
+ "Say whether STRING uses nonspacing characters in suspicious ways.
+If it doesn't, return nil. If it does, return a string explaining
+the potential problem.
+
+Use of nonspacing characters is considered suspicious if there are
+two or more consecutive identical nonspacing characters, or too many
+consecutive nonspacing characters."
+ (let ((prev nil)
+ (nonspace-count 0))
+ (catch 'found
+ (seq-do
+ (lambda (char)
+ (let ((nonspacing
+ (memq (get-char-code-property char 'general-category)
+ '(Mn Me))))
+ (when (and nonspacing
+ (equal char prev))
+ (throw 'found "Two identical consecutive nonspacing characters"))
+ (setq nonspace-count (if nonspacing
+ (1+ nonspace-count)
+ 0))
+ (when (> nonspace-count 4)
+ (throw 'found
+ "Too many consecutive nonspacing characters"))
+ (setq prev char)))
+ string)
+ nil)))
+
+(defun textsec-email-address-suspicious-p (address)
+ "Say whether EMAIL address looks suspicious.
+If it isn't, return nil. If it is, return a string explaining the
+potential problem.
+
+An email address is considered suspicious if either of its two
+parts -- the local address name or the domain -- are found to be
+suspicious by, respectively, `textsec-local-address-suspicious-p'
+and `textsec-domain-suspicious-p'."
+ (pcase-let ((`(,local ,domain) (split-string address "@")))
+ (or
+ (textsec-domain-suspicious-p domain)
+ (textsec-local-address-suspicious-p local))))
+
+(defun textsec-email-address-header-suspicious-p (email)
+ "Say whether EMAIL looks suspicious.
+If it isn't, return nil. If it is, return a string explaining the
+potential problem.
+
+Note that EMAIL has to be a valid email specification according
+to RFC2047bis -- strings that can't be parsed will be flagged as
+suspicious.
+
+An email specification is considered suspicious if either of its
+two parts -- the address or the name -- are found to be
+suspicious by, respectively, `textsec-email-address-suspicious-p'
+and `textsec-name-suspicious-p'."
+ (catch 'end
+ (pcase-let ((`(,address . ,name)
+ (condition-case nil
+ (mail-header-parse-address email t)
+ (error (throw 'end "Email address can't be parsed.")))))
+ (or
+ (textsec-email-address-suspicious-p address)
+ (and name (textsec-name-suspicious-p name))))))
+
+(defun textsec-url-suspicious-p (url)
+ "Say whether URL looks suspicious.
+If it isn't, return nil. If it is, return a string explaining the
+potential problem."
+ (let ((parsed (url-generic-parse-url url)))
+ ;; The URL may not have a domain.
+ (and (url-host parsed)
+ (textsec-domain-suspicious-p (url-host parsed)))))
+
+(defun textsec-link-suspicious-p (link)
+ "Say whether LINK is suspicious.
+LINK should be a cons cell where the first element is the URL,
+and the second element is the link text.
+
+This function will return non-nil if it seems like the link text
+is misleading about where the URL takes you. This is typical
+when the link text looks like an URL itself, but doesn't lead to
+the same domain as the URL."
+ (let* ((url (car link))
+ (text (string-trim (cdr link))))
+ (catch 'found
+ (let ((udomain (url-host (url-generic-parse-url url)))
+ (tdomain (url-host (url-generic-parse-url text))))
+ (cond
+ ((and udomain
+ tdomain
+ (not (equal udomain tdomain))
+ ;; One may be a sub-domain of the other, but don't allow too
+ ;; short domains.
+ (not (or (and (string-suffix-p udomain tdomain)
+ (url-domsuf-cookie-allowed-p udomain))
+ (and (string-suffix-p tdomain udomain)
+ (url-domsuf-cookie-allowed-p tdomain)))))
+ (throw 'found
+ (format "Text `%s' doesn't point to link URL `%s'"
+ text url)))
+ ((and tdomain
+ (textsec-domain-suspicious-p tdomain))
+ (throw 'found
+ (format "Domain `%s' in the link text is suspicious"
+ (bidi-string-strip-control-characters
+ tdomain)))))))))
+
+(provide 'textsec)
+
+;;; textsec.el ends here
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index a3b62667915..2a91e7cb5ec 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -62,6 +62,7 @@
;;; Code:
(require 'quail)
+(require 'generate-lisp-file)
;; List of values of key "ENCODE:" and the corresponding Emacs
;; coding-system and language environment name.
@@ -269,13 +270,10 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲,
(tit-moveleft ",<")
(tit-keyprompt nil))
- (princ (format ";;; %s -*- lexical-binding:t -*-\n"
- (file-name-nondirectory filename)))
+ (generate-lisp-file-heading filename 'titdic-convert :code nil)
(princ ";; Quail package `")
(princ package)
(princ "\n")
- (princ (substitute-command-keys
- ";; Generated by the command `titdic-convert'\n"))
(princ ";;\tOriginal TIT dictionary file: ")
(princ (file-name-nondirectory filename))
(princ "\n\n")
@@ -521,11 +519,8 @@ the generated Quail package is saved."
;; Process the body part
(tit-process-body)
-
- (princ ";; Local Variables:\n")
- (princ ";; version-control: never\n")
- (princ ";; no-update-autoloads: t\n")
- (princ ";; End:\n"))))))
+ (generate-lisp-file-trailer
+ filename :inhibit-provide t :compile t :coding nil))))))
;;;###autoload
(defun batch-titdic-convert (&optional force)
@@ -1135,11 +1130,8 @@ the generated Quail package is saved."
;; Explicitly set eol format to `unix'.
(setq coding-system-for-write 'utf-8-unix)
(with-temp-file (expand-file-name quailfile dirname)
- (insert (format ";;; %s -*- lexical-binding:t -*-\n"
- (file-name-nondirectory quailfile)))
+ (generate-lisp-file-heading quailfile 'miscdic-convert)
(insert (format-message ";; Quail package `%s'\n" name))
- (insert (format-message
- ";; Generated by the command `miscdic-convert'\n"))
(insert ";; Source dictionary file: " dicfile "\n")
(insert ";; Copyright notice of the source file\n")
(insert ";;------------------------------------------------------\n")
@@ -1161,11 +1153,8 @@ the generated Quail package is saved."
(let ((dicbuf (current-buffer)))
(with-current-buffer dstbuf
(funcall converter dicbuf)))))
- (insert ";; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-update-autoloads: t\n"
- ";; End:\n\n"
- ";;; " quailfile " ends here\n")))
+ (generate-lisp-file-trailer
+ quailfile :inhibit-provide t :compile t :coding nil)))
(setq tail (cdr tail)))))
(defun batch-miscdic-convert ()
@@ -1228,7 +1217,4 @@ The library is named pinyin.el, and contains the constant
(insert "(provide 'pinyin)\n"))
(kill-emacs 0)))
-;; Prevent "Local Variables" above confusing Emacs.
-
-
;;; titdic-cnv.el ends here
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index 8e79ff7fb7d..bc32b4f0737 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -536,74 +536,124 @@ COMPOSITION-PREDICATE will be used to compose region."
(,ucs-normalize-region (point-min) (point-max))
(buffer-string)))
-;;;###autoload
(defun ucs-normalize-NFD-region (from to)
- "Normalize the current region by the Unicode NFD."
+ "Decompose the region between FROM and TO according to the Unicode NFD.
+This replaces the text between FROM and TO with its canonical decomposition,
+a.k.a. the \"Unicode Normalization Form D\"."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfd-quick-check-regexp
'ucs-normalize-nfd-table nil))
-;;;###autoload
+
(defun ucs-normalize-NFD-string (str)
- "Normalize the string STR by the Unicode NFD."
+ "Decompose the string STR according to the Unicode NFD.
+This returns a new string that is the canonical decomposition of STR,
+a.k.a. the \"Unicode Normalization Form D\" of STR. For instance:
+
+ (ucs-normalize-NFD-string \"Å\") => \"Å\""
(ucs-normalize-string ucs-normalize-NFD-region))
-;;;###autoload
(defun ucs-normalize-NFC-region (from to)
- "Normalize the current region by the Unicode NFC."
+ "Compose the region between FROM and TO according to the Unicode NFC.
+This replaces the text between FROM and TO with the result of its
+canonical decomposition (see `ucs-normalize-NFD-region') followed by
+canonical composition, a.k.a. the \"Unicode Normalization Form C\"."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfc-quick-check-regexp
'ucs-normalize-nfd-table t))
+
;;;###autoload
+(defun string-glyph-compose (string)
+ "Compose STRING according to the Unicode NFC.
+This returns a new string obtained by canonical decomposition
+of STRING (see `ucs-normalize-NFC-string') followed by canonical
+composition, a.k.a. the \"Unicode Normalization Form C\" of STRING.
+For instance:
+
+ (string-glyph-compose \"Å\") => \"Å\""
+ (ucs-normalize-NFC-string string))
+
+;;;###autoload
+(defun string-glyph-decompose (string)
+ "Decompose STRING according to the Unicode NFD.
+This returns a new string that is the canonical decomposition of STRING,
+a.k.a. the \"Unicode Normalization Form D\" of STRING. For instance:
+
+ (ucs-normalize-NFD-string \"Å\") => \"Å\""
+ (ucs-normalize-NFD-string string))
+
(defun ucs-normalize-NFC-string (str)
- "Normalize the string STR by the Unicode NFC."
+ "Compose STR according to the Unicode NFC.
+This returns a new string obtained by canonical decomposition
+of STR (see `ucs-normalize-NFC-string') followed by canonical
+composition, a.k.a. the \"Unicode Normalization Form C\" of STR.
+For instance:
+
+ (string-glyph-compose \"Å\") => \"Å\""
(ucs-normalize-string ucs-normalize-NFC-region))
-;;;###autoload
(defun ucs-normalize-NFKD-region (from to)
- "Normalize the current region by the Unicode NFKD."
+ "Decompose the region between FROM and TO according to the Unicode NFKD.
+This replaces the text between FROM and TO with its compatibility
+decomposition, a.k.a. \"Unicode Normalization Form KD\"."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfkd-quick-check-regexp
'ucs-normalize-nfkd-table nil))
-;;;###autoload
+
(defun ucs-normalize-NFKD-string (str)
- "Normalize the string STR by the Unicode NFKD."
+ "Decompose the string STR according to the Unicode NFKD.
+This returns a new string obtained by compatibility decomposition
+of STR. This is much like the NFD (canonical decomposition) form,
+see `ucs-normalize-NFD-string', but mainly differs for precomposed
+characters. For instance:
+
+ (ucs-normalize-NFD-string \"fi\") => \"fi\"
+ (ucs-normalize-NFKD-string \"fi\") = \"fi\""
(ucs-normalize-string ucs-normalize-NFKD-region))
-;;;###autoload
(defun ucs-normalize-NFKC-region (from to)
- "Normalize the current region by the Unicode NFKC."
+ "Compose the region between FROM and TO according to the Unicode NFKC.
+This replaces the text between FROM and TO with the result of its
+compatibility decomposition (see `ucs-normalize-NFC-region') followed by
+canonical composition, a.k.a. the \"Unicode Normalization Form KC\"."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfkc-quick-check-regexp
'ucs-normalize-nfkd-table t))
-;;;###autoload
+
(defun ucs-normalize-NFKC-string (str)
- "Normalize the string STR by the Unicode NFKC."
+ "Compose STR according to the Unicode NFC.
+This returns a new string obtained by compatibility decomposition
+of STR (see `ucs-normalize-NFKD-string') followed by canonical
+composition, a.k.a. the \"Unicode Normalization Form KC\" of STR.
+This is much like the NFC (canonical composition) form, but mainly
+differs for precomposed characters. For instance:
+
+ (ucs-normalize-NFC-string \"fi\") => \"fi\"
+ (ucs-normalize-NFKC-string \"fi\") = \"fi\""
(ucs-normalize-string ucs-normalize-NFKC-region))
-;;;###autoload
(defun ucs-normalize-HFS-NFD-region (from to)
- "Normalize the current region by the Unicode NFD and Mac OS's HFS Plus."
+ "Normalize region between FROM and TO by Unicode NFD and Mac OS's HFS Plus."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-hfs-nfd-quick-check-regexp
'ucs-normalize-hfs-nfd-table
'ucs-normalize-hfs-nfd-comp-p))
-;;;###autoload
+
(defun ucs-normalize-HFS-NFD-string (str)
"Normalize the string STR by the Unicode NFD and Mac OS's HFS Plus."
(ucs-normalize-string ucs-normalize-HFS-NFD-region))
-;;;###autoload
+
(defun ucs-normalize-HFS-NFC-region (from to)
- "Normalize the current region by the Unicode NFC and Mac OS's HFS Plus."
+ "Normalize region between FROM and TO by Unicode NFC and Mac OS's HFS Plus."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-hfs-nfc-quick-check-regexp
'ucs-normalize-hfs-nfd-table t))
-;;;###autoload
+
(defun ucs-normalize-HFS-NFC-string (str)
"Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus."
(ucs-normalize-string ucs-normalize-HFS-NFC-region))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index a68c3a4748c..8f480a87d94 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -54,6 +54,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
;; Some additional options and constants.
@@ -430,13 +431,13 @@ and doesn't remove full-buffer highlighting after a search."
(defface lazy-highlight
'((((class color) (min-colors 88) (background light))
- (:background "paleturquoise"))
+ (:background "paleturquoise" :distant-foreground "black"))
(((class color) (min-colors 88) (background dark))
- (:background "paleturquoise4"))
+ (:background "paleturquoise4" :distant-foreground "white"))
(((class color) (min-colors 16))
- (:background "turquoise3"))
+ (:background "turquoise3" :distant-foreground "white"))
(((class color) (min-colors 8))
- (:background "turquoise3"))
+ (:background "turquoise3" :distant-foreground "white"))
(t (:underline t)))
"Face for lazy highlighting of matches other than the current one."
:group 'lazy-highlight
@@ -465,6 +466,12 @@ and doesn't remove full-buffer highlighting after a search."
:group 'lazy-count
:version "27.1")
+(defvar lazy-count-invisible-format " (invisible %s)"
+ "Format of the number of invisible matches for the prompt.
+When invisible matches exist, their number is appended
+after the total number of matches. Display nothing when
+this variable is nil.")
+
;; Define isearch help map.
@@ -488,9 +495,9 @@ and doesn't remove full-buffer highlighting after a search."
"You have typed %THIS-KEY%, the help character. Type a Help option:
\(Type \\<isearch-help-map>\\[help-quit] to exit the Help command.)
-\\[isearch-describe-bindings] Display all Isearch key bindings.
-\\[isearch-describe-key] KEYS Display full documentation of Isearch key sequence.
-\\[isearch-describe-mode] Display documentation of Isearch mode.
+ \\[isearch-describe-bindings] Display all Isearch key bindings.
+ \\[isearch-describe-key] Display full documentation of Isearch key sequence.
+ \\[isearch-describe-mode] Display documentation of Isearch mode.
You can't type here other help keys available in the global help map,
but outside of this help window when you type them in Isearch mode,
@@ -668,6 +675,7 @@ This is like `describe-bindings', but displays only Isearch keys."
;; The key translations defined in the C-x 8 prefix should add
;; characters to the search string. See iso-transl.el.
(define-key map "\C-x8\r" 'isearch-char-by-name)
+ (define-key map "\C-x8e\r" 'isearch-emoji-by-name)
map)
"Keymap for `isearch-mode'.")
@@ -758,6 +766,8 @@ This is like `describe-bindings', but displays only Isearch keys."
:help "Search for literal char"]
["Search for char by name" isearch-char-by-name
:help "Search for character by name"]
+ ["Search for Emoji by name" isearch-emoji-by-name
+ :help "Search for Emoji by its Unicode name"]
"---"
["Toggle input method" isearch-toggle-input-method
:help "Toggle input method for search"]
@@ -865,14 +875,16 @@ This variable is set and changed during isearch. To change the
default behavior used for searches, see `search-default-mode'
instead.")
-(defvar isearch-lax-whitespace t
+(defcustom isearch-lax-whitespace t
"If non-nil, a space will match a sequence of whitespace chars.
When you enter a space or spaces in ordinary incremental search, it
will match any sequence matched by the regexp defined by the variable
`search-whitespace-regexp'. If the value is nil, each space you type
matches literally, against one space. You can toggle the value of this
variable by the command `isearch-toggle-lax-whitespace', usually bound to
-`M-s SPC' during isearch.")
+`M-s SPC' during isearch."
+ :type 'boolean
+ :version "25.1")
(defvar isearch-regexp-lax-whitespace nil
"If non-nil, a space will match a sequence of whitespace chars.
@@ -1097,7 +1109,7 @@ In incremental searches, a space or spaces normally matches any
whitespace defined by the variable `search-whitespace-regexp'.
To search for a literal space and nothing else, enter C-q SPC.
To toggle whitespace matching, use `isearch-toggle-lax-whitespace',
-usually bound to `M-s SPC' during isearch.
+usually bound to \\`M-s SPC' during isearch.
This command does not support character folding."
(interactive "P\np")
(isearch-mode t (null not-regexp) nil (not no-recursive-edit)))
@@ -1271,6 +1283,7 @@ used to set the value of `isearch-regexp-function'."
isearch-lazy-count-current nil
isearch-lazy-count-total nil
+ isearch-lazy-count-invisible nil
;; Save the original value of `minibuffer-message-timeout', and
;; set it to nil so that isearch's messages don't get timed out.
@@ -1810,17 +1823,19 @@ The following additional command keys are active while editing.
;; Search string might have meta information on text properties.
(minibuffer-allow-text-properties t))
(setq isearch-new-string
- (read-from-minibuffer
- (isearch-message-prefix nil isearch-nonincremental)
- (cons isearch-string (1+ (or (isearch-fail-pos)
- (length isearch-string))))
- minibuffer-local-isearch-map nil
- (if isearch-regexp
- (cons 'regexp-search-ring
- (1+ (or regexp-search-ring-yank-pointer -1)))
- (cons 'search-ring
- (1+ (or search-ring-yank-pointer -1))))
- nil t)
+ (minibuffer-with-setup-hook
+ (minibuffer-lazy-highlight-setup)
+ (read-from-minibuffer
+ (isearch-message-prefix nil isearch-nonincremental)
+ (cons isearch-string (1+ (or (isearch-fail-pos)
+ (length isearch-string))))
+ minibuffer-local-isearch-map nil
+ (if isearch-regexp
+ (cons 'regexp-search-ring
+ (1+ (or regexp-search-ring-yank-pointer -1)))
+ (cons 'search-ring
+ (1+ (or search-ring-yank-pointer -1))))
+ nil t))
isearch-new-message
(mapconcat 'isearch-text-char-description
isearch-new-string "")))))
@@ -2063,7 +2078,7 @@ The command then executes BODY and updates the isearch prompt."
#',function))
(setq isearch-regexp nil)))
,@body
- (setq isearch-success t isearch-adjusted t)
+ (setq isearch-success t isearch-adjusted 'toggle)
(isearch-update))
(define-key isearch-mode-map ,key #',command-name)
,@(when (and function (symbolp function))
@@ -2488,8 +2503,8 @@ The arguments passed to `highlight-regexp' are the regexp from
the last search and the face from `hi-lock-read-face-name'."
(interactive)
(isearch--highlight-regexp-or-lines
- #'(lambda (regexp face lighter)
- (highlight-regexp regexp face nil lighter))))
+ (lambda (regexp face lighter)
+ (highlight-regexp regexp face nil lighter))))
(defun isearch-highlight-lines-matching-regexp ()
"Exit Isearch mode and call `highlight-lines-matching-regexp'.
@@ -2497,8 +2512,8 @@ The arguments passed to `highlight-lines-matching-regexp' are the
regexp from the last search and the face from `hi-lock-read-face-name'."
(interactive)
(isearch--highlight-regexp-or-lines
- #'(lambda (regexp face _lighter)
- (highlight-lines-matching-regexp regexp face))))
+ (lambda (regexp face _lighter)
+ (highlight-lines-matching-regexp regexp face))))
(defun isearch-delete-char ()
@@ -2514,6 +2529,12 @@ If no input items have been entered yet, just beep."
(if (null (cdr isearch-cmds))
(ding)
(isearch-pop-state))
+ ;; When going back to the hidden match, reopen it and close other overlays.
+ (when (and (eq search-invisible 'open) isearch-hide-immediately)
+ (if isearch-other-end
+ (isearch-range-invisible (min (point) isearch-other-end)
+ (max (point) isearch-other-end))
+ (isearch-close-unnecessary-overlays (point) (point))))
(isearch-update))
(defun isearch-del-char (&optional arg)
@@ -2629,9 +2650,10 @@ is bound to outside of Isearch."
;; Key search depends on mode (bug#47755)
(isearch-mode nil))
(key-binding (this-command-keys-vector) t))))
- (if (and (window-minibuffer-p w)
- (not (minibuffer-window-active-p w))) ; in echo area
- (isearch-yank-x-selection)
+ (if (or mouse-yank-at-point
+ (and (window-minibuffer-p w)
+ (not (minibuffer-window-active-p w)))) ; in echo area
+ (isearch-yank-x-selection)
(when (functionp binding)
(call-interactively binding)))))
@@ -2670,7 +2692,7 @@ or it might return the position of the end of the line."
(interactive "p")
(if (eobp)
(insert
- (with-current-buffer (cadr (buffer-list))
+ (with-minibuffer-selected-window
(buffer-substring-no-properties
(point) (progn (forward-char arg) (point)))))
(forward-char arg)))
@@ -2752,6 +2774,24 @@ With argument, add COUNT copies of the character."
(mapconcat 'isearch-text-char-description
string ""))))))))
+(defun isearch-emoji-by-name (&optional count)
+ "Read an Emoji name and add it to the search string COUNT times.
+COUNT (interactively, the prefix argument) defaults to 1.
+The command accepts Unicode names like \"smiling face\" or
+\"heart with arrow\", and completion is available."
+ (interactive "p")
+ (with-isearch-suspended
+ (let ((emoji (with-temp-buffer
+ (emoji-search)
+ (if (and (integerp count) (> count 1))
+ (apply 'concat (make-list count (buffer-string)))
+ (buffer-string)))))
+ (when emoji
+ (setq isearch-new-string (concat isearch-string emoji)
+ isearch-new-message (concat isearch-message
+ (mapconcat 'isearch-text-char-description
+ emoji "")))))))
+
(defun isearch-search-and-update ()
"Do the search and update the display."
(when (or isearch-success
@@ -2918,6 +2958,7 @@ to the barrier."
(put 'scroll-other-window-down 'isearch-scroll t)
(put 'beginning-of-buffer-other-window 'isearch-scroll t)
(put 'end-of-buffer-other-window 'isearch-scroll t)
+(put 'recenter-other-window 'isearch-scroll t)
;; Commands which change the window layout
(put 'delete-other-windows 'isearch-scroll t)
@@ -2932,6 +2973,9 @@ to the barrier."
(put 'mouse-drag-mode-line 'isearch-scroll t)
(put 'mouse-drag-vertical-line 'isearch-scroll t)
+;; For context menu with isearch submenu
+(put 'context-menu-open 'isearch-scroll t)
+
;; Aliases for split-window-*
(put 'split-window-vertically 'isearch-scroll t)
(put 'split-window-horizontally 'isearch-scroll t)
@@ -3422,7 +3466,7 @@ the word mode."
;; If currently failing, display no ellipsis.
(or isearch-success (setq ellipsis nil))
(let ((m (concat (if isearch-success "" "failing ")
- (if isearch-adjusted "pending " "")
+ (if (eq isearch-adjusted t) "pending " "")
(if (and isearch-wrapped
(not isearch-wrap-function)
(if isearch-forward
@@ -3435,11 +3479,13 @@ the word mode."
(if (and (not isearch-success) (not isearch-case-fold-search))
"case-sensitive ")
(let ((prefix ""))
- (advice-function-mapc
- (lambda (_ props)
- (let ((np (cdr (assq 'isearch-message-prefix props))))
- (if np (setq prefix (concat np prefix)))))
- isearch-filter-predicate)
+ (dolist (advice-function (list isearch-filter-predicate
+ isearch-search-fun-function))
+ (advice-function-mapc
+ (lambda (_ props)
+ (let ((np (cdr (assq 'isearch-message-prefix props))))
+ (if np (setq prefix (concat np prefix)))))
+ advice-function))
prefix)
(isearch--describe-regexp-mode isearch-regexp-function)
(cond
@@ -3490,7 +3536,12 @@ isearch-message-suffix prompt. Otherwise, for isearch-message-prefix."
(- isearch-lazy-count-total
isearch-lazy-count-current
-1)))
- (or isearch-lazy-count-total "?"))
+ (if (and isearch-lazy-count-invisible
+ lazy-count-invisible-format)
+ (concat (format "%s" (or isearch-lazy-count-total "?"))
+ (format lazy-count-invisible-format
+ isearch-lazy-count-invisible))
+ (or isearch-lazy-count-total "?")))
"")))
@@ -3526,10 +3577,10 @@ Can be changed via `isearch-search-fun-function' for special needs."
;; (Bug#35802).
(regexp
(cond (isearch-regexp-function
- (let ((lax (and (not bound)
+ (let ((lax (and (not bound) ; not lazy-highlight
(isearch--lax-regexp-function-p))))
(when lax
- (setq isearch-adjusted t))
+ (setq isearch-adjusted 'lax))
(if (functionp isearch-regexp-function)
(funcall isearch-regexp-function string lax)
(word-search-regexp string lax))))
@@ -3718,11 +3769,11 @@ Optional third argument, if t, means if fail just return nil (no error).
;; Verify if the current match is outside of each element of
;; `isearch-opened-overlays', if so close that overlay.
-(defun isearch-close-unnecessary-overlays (begin end)
+(defun isearch-close-unnecessary-overlays (beg end)
(let ((overlays isearch-opened-overlays))
(setq isearch-opened-overlays nil)
(dolist (ov overlays)
- (if (isearch-intersects-p begin end (overlay-start ov) (overlay-end ov))
+ (if (isearch-intersects-p beg end (overlay-start ov) (overlay-end ov))
(push ov isearch-opened-overlays)
(let ((fct-temp (overlay-get ov 'isearch-open-invisible-temporary)))
(if fct-temp
@@ -3741,10 +3792,11 @@ Optional third argument, if t, means if fail just return nil (no error).
(save-excursion
(goto-char beg)
(let (;; can-be-opened keeps track if we can open some overlays.
- (can-be-opened (eq search-invisible 'open))
+ (can-be-opened (memq search-invisible '(open can-be-opened)))
;; the list of overlays that could be opened
(crt-overlays nil))
- (when (and can-be-opened isearch-hide-immediately)
+ (when (and can-be-opened isearch-hide-immediately
+ (not (eq search-invisible 'can-be-opened)))
(isearch-close-unnecessary-overlays beg end))
;; If the following character is currently invisible,
;; skip all characters with that same `invisible' property value.
@@ -3783,9 +3835,10 @@ Optional third argument, if t, means if fail just return nil (no error).
(if (>= (point) end)
(if (and can-be-opened (consp crt-overlays))
(progn
- (setq isearch-opened-overlays
- (append isearch-opened-overlays crt-overlays))
- (mapc 'isearch-open-overlay-temporary crt-overlays)
+ (unless (eq search-invisible 'can-be-opened)
+ (setq isearch-opened-overlays
+ (append isearch-opened-overlays crt-overlays))
+ (mapc 'isearch-open-overlay-temporary crt-overlays))
nil)
(setq isearch-hidden t)))))))
@@ -3797,8 +3850,9 @@ Isearch, at least partially, as determined by `isearch-range-invisible'.
If `search-invisible' is t, which allows Isearch matches inside
invisible text, this function will always return non-nil, regardless
of what `isearch-range-invisible' says."
- (or (eq search-invisible t)
- (not (isearch-range-invisible beg end))))
+ (and (not (text-property-not-all beg end 'inhibit-isearch nil))
+ (or (eq search-invisible t)
+ (not (isearch-range-invisible beg end)))))
;; General utilities
@@ -3968,7 +4022,10 @@ since they have special meaning in a regexp."
(defvar isearch-lazy-highlight-error nil)
(defvar isearch-lazy-count-current nil)
(defvar isearch-lazy-count-total nil)
+(defvar isearch-lazy-count-invisible nil)
(defvar isearch-lazy-count-hash (make-hash-table))
+(defvar lazy-count-update-hook nil
+ "Hook run after new lazy count results are computed.")
(defun lazy-highlight-cleanup (&optional force procrastinate)
"Stop lazy highlighting and remove extra highlighting from current buffer.
@@ -4027,7 +4084,7 @@ by other Emacs features."
isearch-lazy-highlight-window-end))))))
;; something important did indeed change
(lazy-highlight-cleanup t (not (equal isearch-string ""))) ;stop old timer
- (when (and isearch-lazy-count isearch-mode (null isearch-message-function))
+ (when isearch-lazy-count
(when (or (equal isearch-string "")
;; Check if this place was reached by a condition above
;; other than changed window boundaries (that shouldn't
@@ -4044,9 +4101,13 @@ by other Emacs features."
;; Reset old counter before going to count new numbers
(clrhash isearch-lazy-count-hash)
(setq isearch-lazy-count-current nil
- isearch-lazy-count-total nil)
+ isearch-lazy-count-total nil
+ isearch-lazy-count-invisible nil)
;; Delay updating the message if possible, to avoid flicker
- (when (string-equal isearch-string "") (isearch-message))))
+ (when (string-equal isearch-string "")
+ (when (and isearch-mode (null isearch-message-function))
+ (isearch-message))
+ (run-hooks 'lazy-count-update-hook))))
(setq isearch-lazy-highlight-window-start-changed nil)
(setq isearch-lazy-highlight-window-end-changed nil)
(setq isearch-lazy-highlight-error isearch-error)
@@ -4099,13 +4160,15 @@ by other Emacs features."
'isearch-lazy-highlight-start))))
;; Update the current match number only in isearch-mode and
;; unless isearch-mode is used specially with isearch-message-function
- (when (and isearch-lazy-count isearch-mode (null isearch-message-function))
+ (when isearch-lazy-count
;; Update isearch-lazy-count-current only when it was already set
;; at the end of isearch-lazy-highlight-buffer-update
(when isearch-lazy-count-current
(setq isearch-lazy-count-current
(gethash (point) isearch-lazy-count-hash 0))
- (isearch-message))))
+ (when (and isearch-mode (null isearch-message-function))
+ (isearch-message))
+ (run-hooks 'lazy-count-update-hook))))
(defun isearch-lazy-highlight-search (string bound)
"Search ahead for the next or previous match, for lazy highlighting.
@@ -4119,10 +4182,10 @@ Attempt to do the search exactly the way the pending Isearch would."
(isearch-regexp-lax-whitespace
isearch-lazy-highlight-regexp-lax-whitespace)
(isearch-forward isearch-lazy-highlight-forward)
- ;; Don't match invisible text unless it can be opened
- ;; or when counting matches and user can visit hidden matches
- (search-invisible (or (eq search-invisible 'open)
- (and isearch-lazy-count search-invisible)))
+ ;; Count all invisible matches, but highlight only
+ ;; matches that can be opened by visiting them later
+ (search-invisible (or (not (null isearch-lazy-count))
+ 'can-be-opened))
(retry t)
(success nil))
;; Use a loop like in `isearch-search'.
@@ -4139,15 +4202,20 @@ Attempt to do the search exactly the way the pending Isearch would."
(error nil)))
(defun isearch-lazy-highlight-match (mb me)
- (let ((ov (make-overlay mb me)))
- (push ov isearch-lazy-highlight-overlays)
- ;; 1000 is higher than ediff's 100+,
- ;; but lower than isearch main overlay's 1001
- (overlay-put ov 'priority 1000)
- (overlay-put ov 'face 'lazy-highlight)
- (unless (or (eq isearch-lazy-highlight 'all-windows)
- isearch-lazy-highlight-buffer)
- (overlay-put ov 'window (selected-window)))))
+ (when (or (not isearch-lazy-count)
+ ;; Recheck the match that possibly was intended
+ ;; for counting only, but not for highlighting
+ (let ((search-invisible 'can-be-opened))
+ (funcall isearch-filter-predicate mb me)))
+ (let ((ov (make-overlay mb me)))
+ (push ov isearch-lazy-highlight-overlays)
+ ;; 1000 is higher than ediff's 100+,
+ ;; but lower than isearch main overlay's 1001
+ (overlay-put ov 'priority 1000)
+ (overlay-put ov 'face 'lazy-highlight)
+ (unless (or (eq isearch-lazy-highlight 'all-windows)
+ isearch-lazy-highlight-buffer)
+ (overlay-put ov 'window (selected-window))))))
(defun isearch-lazy-highlight-start ()
"Start a new lazy-highlight updating loop."
@@ -4281,11 +4349,22 @@ Attempt to do the search exactly the way the pending Isearch would."
(setq found nil)
(forward-char -1)))
(when isearch-lazy-count
- (setq isearch-lazy-count-total
- (1+ (or isearch-lazy-count-total 0)))
- (puthash (if isearch-lazy-highlight-forward me mb)
- isearch-lazy-count-total
- isearch-lazy-count-hash))
+ ;; Count as invisible when can't open overlay,
+ ;; but don't leave search-invisible with the
+ ;; value `open' since then lazy-highlight
+ ;; will open all overlays with matches.
+ (if (not (let ((search-invisible
+ (if (eq search-invisible 'open)
+ 'can-be-opened
+ search-invisible)))
+ (funcall isearch-filter-predicate mb me)))
+ (setq isearch-lazy-count-invisible
+ (1+ (or isearch-lazy-count-invisible 0)))
+ (setq isearch-lazy-count-total
+ (1+ (or isearch-lazy-count-total 0)))
+ (puthash (if isearch-lazy-highlight-forward me mb)
+ isearch-lazy-count-total
+ isearch-lazy-count-hash)))
;; Don't highlight the match when this loop is used
;; only to count matches or when matches were already
;; highlighted within the current window boundaries
@@ -4306,16 +4385,223 @@ Attempt to do the search exactly the way the pending Isearch would."
(setq looping nil
nomore t))))
(if nomore
- (when (and isearch-lazy-count isearch-mode (null isearch-message-function))
+ (when isearch-lazy-count
(unless isearch-lazy-count-total
(setq isearch-lazy-count-total 0))
(setq isearch-lazy-count-current
(gethash opoint isearch-lazy-count-hash 0))
- (isearch-message))
+ (when (and isearch-mode (null isearch-message-function))
+ (isearch-message)))
(setq isearch-lazy-highlight-timer
(run-at-time lazy-highlight-interval nil
- 'isearch-lazy-highlight-buffer-update)))))))))
+ 'isearch-lazy-highlight-buffer-update)))))
+ (when (and nomore isearch-lazy-count)
+ (run-hooks 'lazy-count-update-hook))))))
+
+;; Reading from minibuffer with lazy highlight and match count
+
+(defcustom minibuffer-lazy-count-format "%s "
+ "Format of the total number of matches for the prompt prefix."
+ :type '(choice (const :tag "Don't display a count" nil)
+ (string :tag "Display match count" "%s "))
+ :group 'lazy-count
+ :version "29.1")
+
+(cl-defun minibuffer-lazy-highlight-setup
+ (&key (highlight isearch-lazy-highlight)
+ (cleanup lazy-highlight-cleanup)
+ (transform #'identity)
+ (filter nil)
+ (regexp isearch-regexp)
+ (regexp-function isearch-regexp-function)
+ (case-fold isearch-case-fold-search)
+ (lax-whitespace (if regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)))
+ "Set up minibuffer for lazy highlight of matches in the original window.
+
+This function return a closure intended to be added to
+`minibuffer-setup-hook'. It accepts the following keyword
+arguments, all of which have a default based on the current
+isearch settings.
+
+HIGHLIGHT: Whether to perform lazy highlight.
+CLEANUP: Whether to clean up the lazy highlight when the minibuffer
+exits.
+TRANSFORM: A function taking one argument, the minibuffer contents,
+and returning the `isearch-string' to use for lazy highlighting.
+FILTER: A function to add to `isearch-filter-predicate'.
+REGEXP: The value of `isearch-regexp' to use for lazy highlighting.
+REGEXP-FUNCTION: The value of `isearch-regexp-function' to use for
+lazy highlighting.
+CASE-FOLD: The value of `isearch-case-fold' to use for lazy
+highlighting.
+LAX-WHITESPACE: The value of `isearch-lax-whitespace' and
+`isearch-regexp-lax-whitespace' to use for lazy highlighting."
+ (if (not highlight)
+ #'ignore
+ (let ((unwind (make-symbol "minibuffer-lazy-highlight--unwind"))
+ (after-change (make-symbol "minibuffer-lazy-highlight--after-change"))
+ (display-count (make-symbol "minibuffer-lazy-highlight--display-count"))
+ (buffer (current-buffer))
+ overlay)
+ (fset unwind
+ (lambda ()
+ (when filter
+ (with-current-buffer buffer
+ (remove-function (local 'isearch-filter-predicate) filter)))
+ (remove-hook 'lazy-count-update-hook display-count)
+ (when overlay (delete-overlay overlay))
+ (remove-hook 'after-change-functions after-change t)
+ (remove-hook 'minibuffer-exit-hook unwind t)
+ (let ((lazy-highlight-cleanup cleanup))
+ (lazy-highlight-cleanup))))
+ (fset after-change
+ (lambda (_beg _end _len)
+ (let ((inhibit-redisplay t) ;; Avoid cursor flickering
+ (string (minibuffer-contents)))
+ (with-minibuffer-selected-window
+ (let* ((isearch-forward t)
+ (isearch-regexp regexp)
+ (isearch-regexp-function regexp-function)
+ (isearch-case-fold-search case-fold)
+ (isearch-lax-whitespace lax-whitespace)
+ (isearch-regexp-lax-whitespace lax-whitespace)
+ (isearch-string (funcall transform string)))
+ (isearch-lazy-highlight-new-loop))))))
+ (fset display-count
+ (lambda ()
+ (overlay-put overlay 'before-string
+ (and isearch-lazy-count-total
+ (not isearch-error)
+ (format minibuffer-lazy-count-format
+ isearch-lazy-count-total)))))
+ (lambda ()
+ (add-hook 'minibuffer-exit-hook unwind nil t)
+ (add-hook 'after-change-functions after-change nil t)
+ (when minibuffer-lazy-count-format
+ (setq overlay (make-overlay (point-min) (point-min) (current-buffer) t))
+ (add-hook 'lazy-count-update-hook display-count))
+ (when filter
+ (with-current-buffer buffer
+ (add-function :after-while (local 'isearch-filter-predicate) filter)))
+ (funcall after-change nil nil nil)))))
+
+
+(defun isearch-search-fun-in-noncontiguous-region (search-fun bounds)
+ "Return the function that searches inside noncontiguous regions.
+A noncontiguous region is defined by the argument BOUNDS that
+is a list of cons cells of the form (START . END)."
+ (apply-partially
+ #'search-within-boundaries
+ search-fun
+ (lambda (pos)
+ (seq-some (lambda (b) (if isearch-forward
+ (and (>= pos (car b)) (< pos (cdr b)))
+ (and (> pos (car b)) (<= pos (cdr b)))))
+ bounds))
+ (lambda (pos)
+ (let ((bounds (flatten-list bounds))
+ found)
+ (unless isearch-forward
+ (setq bounds (nreverse bounds)))
+ (while (and bounds (not found))
+ (if (if isearch-forward (< pos (car bounds)) (> pos (car bounds)))
+ (setq found (car bounds))
+ (setq bounds (cdr bounds))))
+ found))))
+
+(defun isearch-search-fun-in-text-property (search-fun property)
+ "Return the function to search inside text that has the specified PROPERTY.
+The function will limit the search for matches only inside text which has
+this property in the current buffer.
+The argument SEARCH-FUN provides the function to search text, and
+defaults to the value of `isearch-search-fun-default' when nil."
+ (apply-partially
+ #'search-within-boundaries
+ search-fun
+ (lambda (pos) (get-text-property (if isearch-forward pos
+ (max (1- pos) (point-min)))
+ property))
+ (lambda (pos) (if isearch-forward
+ (next-single-property-change pos property)
+ (previous-single-property-change pos property)))))
+
+(defun search-within-boundaries ( search-fun get-fun next-fun
+ string &optional bound noerror count)
+ (let* ((old (point))
+ ;; Check if point is already on the property.
+ (beg (when (funcall get-fun old) old))
+ end found (i 0)
+ (subregexp
+ (and isearch-regexp
+ (save-match-data
+ (catch 'subregexp
+ (while (string-match "\\^\\|\\$" string i)
+ (setq i (match-end 0))
+ (when (subregexp-context-p string (match-beginning 0))
+ ;; The ^/$ is not inside a char-range or escaped.
+ (throw 'subregexp t))))))))
+ ;; Otherwise, try to search for the next property.
+ (unless beg
+ (setq beg (funcall next-fun old))
+ (when beg (goto-char beg)))
+ ;; Non-nil `beg' means there are more properties.
+ (while (and beg (not found))
+ ;; Search for the end of the current property.
+ (setq end (funcall next-fun beg))
+ ;; Handle ^/$ specially by matching in a temporary buffer.
+ (if subregexp
+ (let* ((prop-beg
+ (if (or (if isearch-forward (bobp) (eobp))
+ (null (funcall get-fun
+ (+ (point)
+ (if isearch-forward -1 1)))))
+ ;; Already at the beginning of the field.
+ beg
+ ;; Get the real beginning of the field when
+ ;; the search was started in the middle.
+ (let ((isearch-forward (not isearch-forward)))
+ ;; Search in the reverse direction.
+ (funcall next-fun beg))))
+ (substring (buffer-substring prop-beg end))
+ (offset (if isearch-forward prop-beg end))
+ match-data)
+ (with-temp-buffer
+ (insert substring)
+ (goto-char (- beg offset -1))
+ ;; Apply ^/$ regexp on the whole extracted substring.
+ (setq found (funcall
+ (or search-fun (isearch-search-fun-default))
+ string (and bound (max (point-min)
+ (min (point-max)
+ (- bound offset -1))))
+ noerror count))
+ ;; Adjust match data as if it's matched in original buffer.
+ (when found
+ (setq found (+ found offset -1)
+ match-data (mapcar (lambda (m) (+ m offset -1))
+ (match-data)))))
+ (when found (goto-char found))
+ (when match-data (set-match-data
+ (mapcar (lambda (m) (copy-marker m))
+ match-data))))
+ (setq found (funcall
+ (or search-fun (isearch-search-fun-default))
+ string (if bound (if isearch-forward
+ (min bound end)
+ (max bound end))
+ end)
+ noerror count)))
+ ;; Get the next text property.
+ (unless found
+ (setq beg (funcall next-fun end))
+ (when beg (goto-char beg))))
+ (unless found (goto-char old))
+ found))
+
+
(defun isearch-resume (string regexp word forward message case-fold)
"Resume an incremental search.
STRING is the string or regexp searched for.
@@ -4331,6 +4617,23 @@ CASE-FOLD non-nil means the search was case-insensitive."
(isearch-search)
(isearch-update))
+
+(defvar isearch-fold-quotes-mode--state)
+(define-minor-mode isearch-fold-quotes-mode
+ "Minor mode to aid searching for \\=` characters in help modes."
+ :lighter ""
+ (if isearch-fold-quotes-mode
+ (setq-local isearch-fold-quotes-mode--state
+ (buffer-local-set-state
+ search-default-mode
+ (lambda (string &optional _lax)
+ (thread-last
+ (regexp-quote string)
+ (replace-regexp-in-string "`" "[`‘]")
+ (replace-regexp-in-string "'" "['’]")
+ (replace-regexp-in-string "\"" "[\"“”]")))))
+ (buffer-local-restore-state isearch-fold-quotes-mode--state)))
+
(provide 'isearch)
;;; isearch.el ends here
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 20c12024745..be26ca55f0d 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -51,7 +51,7 @@ This variable controls both `display-time' and stealth fontification.
The optimum value is a little over the typical number of buffer
characters which fit in a typical window."
- :type 'integer)
+ :type 'natnum)
(defcustom jit-lock-stealth-time nil
@@ -217,6 +217,11 @@ If the system load rises above `jit-lock-stealth-load' percent, stealth
fontification is suspended. Stealth fontification intensity is controlled via
the variable `jit-lock-stealth-nice'.
+`jit-lock-mode' is not a regular minor mode, and it doesn't
+follow the regular conventions to switch the functionality on or
+off. Instead, an ARG of nil will switch it off, and non-nil will
+switch it on.
+
If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(setq jit-lock-mode arg)
(cond
@@ -237,20 +242,20 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
(setq jit-lock-stealth-timer
(run-with-idle-timer jit-lock-stealth-time t
- 'jit-lock-stealth-fontify)))
+ #'jit-lock-stealth-fontify)))
;; Create, but do not activate, the idle timer for repeated
;; stealth fontification.
(when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
(setq jit-lock-stealth-repeat-timer (timer-create))
(timer-set-function jit-lock-stealth-repeat-timer
- 'jit-lock-stealth-fontify '(t)))
+ #'jit-lock-stealth-fontify '(t)))
;; Init deferred fontification timer.
(when (and jit-lock-defer-time (null jit-lock-defer-timer))
(setq jit-lock-defer-timer
(run-with-idle-timer jit-lock-defer-time t
- 'jit-lock-deferred-fontify)))
+ #'jit-lock-deferred-fontify)))
;; Initialize contextual fontification if requested.
(when (eq jit-lock-contextually t)
@@ -260,13 +265,13 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(lambda ()
(unless jit-lock--antiblink-grace-timer
(jit-lock-context-fontify))))))
- (add-hook 'post-command-hook 'jit-lock--antiblink-post-command nil t)
+ (add-hook 'post-command-hook #'jit-lock--antiblink-post-command nil t)
(setq jit-lock-context-unfontify-pos
(or jit-lock-context-unfontify-pos (point-max))))
;; Setup our hooks.
- (add-hook 'after-change-functions 'jit-lock-after-change nil t)
- (add-hook 'fontification-functions 'jit-lock-function nil t))
+ (add-hook 'after-change-functions #'jit-lock-after-change nil t)
+ (add-hook 'fontification-functions #'jit-lock-function nil t))
;; Turn Just-in-time Lock mode off.
(t
@@ -289,8 +294,9 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(setq jit-lock-defer-timer nil)))
;; Remove hooks.
- (remove-hook 'after-change-functions 'jit-lock-after-change t)
- (remove-hook 'fontification-functions 'jit-lock-function))))
+ (remove-hook 'post-command-hook #'jit-lock--antiblink-post-command t)
+ (remove-hook 'after-change-functions #'jit-lock-after-change t)
+ (remove-hook 'fontification-functions #'jit-lock-function))))
(define-minor-mode jit-lock-debug-mode
"Minor mode to help debug code run from jit-lock.
@@ -702,8 +708,8 @@ will take place when text is fontified stealthily."
(min jit-lock-context-unfontify-pos jit-lock-start))))))
(defun jit-lock--antiblink-post-command ()
- (let* ((new-l-b-p (copy-marker (line-beginning-position)))
- (l-b-p-2 (line-beginning-position 2))
+ (let* ((new-l-b-p (copy-marker (syntax--lbp)))
+ (l-b-p-2 (syntax--lbp 2))
(same-line
(and jit-lock-antiblink-grace
(not (= new-l-b-p l-b-p-2))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 84d0ef9179b..b84e9b74b1f 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,7 +4,7 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
-;; Version: 1.0.14
+;; Version: 1.0.15
;; Package-Requires: ((emacs "25.2"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -698,7 +698,9 @@ TIMEOUT is nil)."
(defun jsonrpc--debug (server format &rest args)
"Debug message for SERVER with FORMAT and ARGS."
(jsonrpc--log-event
- server (if (stringp format)`(:message ,(format format args)) format)))
+ server (if (stringp format)
+ `(:message ,(apply #'format format args))
+ format)))
(defun jsonrpc--warn (format &rest args)
"Warning message with FORMAT and ARGS."
diff --git a/lisp/keymap.el b/lisp/keymap.el
new file mode 100644
index 00000000000..ad7d4fbbba1
--- /dev/null
+++ b/lisp/keymap.el
@@ -0,0 +1,585 @@
+;;; keymap.el --- Keymap functions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library deals with the "new" keymap binding interface: The
+;; only key syntax allowed by these functions is the `kbd' one.
+
+;;; Code:
+
+
+
+(defun keymap--check (key)
+ "Signal an error if KEY doesn't have a valid syntax."
+ (unless (key-valid-p key)
+ (error "%S is not a valid key definition; see `key-valid-p'" key)))
+
+(defun keymap--compile-check (&rest keys)
+ (dolist (key keys)
+ (when (or (vectorp key)
+ (and (stringp key) (not (key-valid-p key))))
+ (byte-compile-warn "Invalid `kbd' syntax: %S" key))))
+
+(defun keymap-set (keymap key definition)
+ "Set KEY to DEFINITION in KEYMAP.
+KEY is a string that satisfies `key-valid-p'.
+
+DEFINITION is anything that can be a key's definition:
+ nil (means key is undefined in this keymap),
+ a command (a Lisp function suitable for interactive calling),
+ a string (treated as a keyboard macro),
+ a keymap (to define a prefix key),
+ a symbol (when the key is looked up, the symbol will stand for its
+ function definition, which should at that time be one of the above,
+ or another symbol whose function definition is used, etc.),
+ a cons (STRING . DEFN), meaning that DEFN is the definition
+ (DEFN should be a valid definition in its own right) and
+ STRING is the menu item name (which is used only if the containing
+ keymap has been created with a menu name, see `make-keymap'),
+ or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
+ or an extended menu item definition.
+ (See info node `(elisp)Extended Menu Items'.)"
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (keymap--check key)
+ ;; If we're binding this key to another key, then parse that other
+ ;; key, too.
+ (when (stringp definition)
+ (keymap--check definition)
+ (setq definition (key-parse definition)))
+ (define-key keymap (key-parse key) definition))
+
+(defun keymap-global-set (key command)
+ "Give KEY a global binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+
+KEY is a string that satisfies `key-valid-p'.
+
+Note that if KEY has a local binding in the current buffer,
+that local binding will continue to shadow any global binding
+that you make with this function."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (interactive
+ (let* ((menu-prompting nil)
+ (key (read-key-sequence "Set key globally: " nil t)))
+ (list key
+ (read-command (format "Set key %s to command: "
+ (key-description key))))))
+ (keymap-set (current-global-map) key command))
+
+(defun keymap-local-set (key command)
+ "Give KEY a local binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+
+KEY is a string that satisfies `key-valid-p'.
+
+The binding goes in the current buffer's local map, which in most
+cases is shared with all other buffers in the same major mode."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (interactive "KSet key locally: \nCSet key %s locally to command: ")
+ (let ((map (current-local-map)))
+ (unless map
+ (use-local-map (setq map (make-sparse-keymap))))
+ (keymap-set map key command)))
+
+(defun keymap-global-unset (key &optional remove)
+ "Remove global binding of KEY (if any).
+KEY is a string that satisfies `key-valid-p'.
+
+If REMOVE (interactively, the prefix arg), remove the binding
+instead of unsetting it. See `keymap-unset' for details."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (interactive
+ (list (key-description (read-key-sequence "Set key locally: "))
+ current-prefix-arg))
+ (keymap-unset (current-global-map) key remove))
+
+(defun keymap-local-unset (key &optional remove)
+ "Remove local binding of KEY (if any).
+KEY is a string that satisfies `key-valid-p'.
+
+If REMOVE (interactively, the prefix arg), remove the binding
+instead of unsetting it. See `keymap-unset' for details."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (interactive
+ (list (key-description (read-key-sequence "Unset key locally: "))
+ current-prefix-arg))
+ (when (current-local-map)
+ (keymap-unset (current-local-map) key remove)))
+
+(defun keymap-unset (keymap key &optional remove)
+ "Remove key sequence KEY from KEYMAP.
+KEY is a string that satisfies `key-valid-p'.
+
+If REMOVE, remove the binding instead of unsetting it. This only
+makes a difference when there's a parent keymap. When unsetting
+a key in a child map, it will still shadow the same key in the
+parent keymap. Removing the binding will allow the key in the
+parent keymap to be used."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (keymap--check key)
+ (define-key keymap (key-parse key) nil remove))
+
+(defun keymap-substitute (keymap olddef newdef &optional oldmap prefix)
+ "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
+In other words, OLDDEF is replaced with NEWDEF wherever it appears.
+Alternatively, if optional fourth argument OLDMAP is specified, we redefine
+in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP.
+
+If you don't specify OLDMAP, you can usually get the same results
+in a cleaner way with command remapping, like this:
+ (define-key KEYMAP [remap OLDDEF] NEWDEF)
+\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
+ ;; Don't document PREFIX in the doc string because we don't want to
+ ;; advertise it. It's meant for recursive calls only. Here's its
+ ;; meaning
+
+ ;; If optional argument PREFIX is specified, it should be a key
+ ;; prefix, a string. Redefined bindings will then be bound to the
+ ;; original key, with PREFIX added at the front.
+ (unless prefix
+ (setq prefix ""))
+ (let* ((scan (or oldmap keymap))
+ (prefix1 (vconcat prefix [nil]))
+ (key-substitution-in-progress
+ (cons scan key-substitution-in-progress)))
+ ;; Scan OLDMAP, finding each char or event-symbol that
+ ;; has any definition, and act on it with hack-key.
+ (map-keymap
+ (lambda (char defn)
+ (aset prefix1 (length prefix) char)
+ (substitute-key-definition-key defn olddef newdef prefix1 keymap))
+ scan)))
+
+(defun keymap-set-after (keymap key definition &optional after)
+ "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
+This is like `keymap-set' except that the binding for KEY is placed
+just after the binding for the event AFTER, instead of at the beginning
+of the map. Note that AFTER must be an event type (like KEY), NOT a command
+\(like DEFINITION).
+
+If AFTER is t or omitted, the new binding goes at the end of the keymap.
+AFTER should be a single event type--a symbol or a character, not a sequence.
+
+Bindings are always added before any inherited map.
+
+The order of bindings in a keymap matters only when it is used as
+a menu, so this function is not useful for non-menu keymaps."
+ (declare (indent defun)
+ (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (keymap--check key)
+ (when after
+ (keymap--check after))
+ (define-key-after keymap (key-parse key) definition
+ (and after (key-parse after))))
+
+(defun key-parse (keys)
+ "Convert KEYS to the internal Emacs key representation.
+See `kbd' for a descripion of KEYS."
+ (declare (pure t) (side-effect-free t))
+ ;; A pure function is expected to preserve the match data.
+ (save-match-data
+ (let ((case-fold-search nil)
+ (len (length keys)) ; We won't alter keys in the loop below.
+ (pos 0)
+ (res []))
+ (while (and (< pos len)
+ (string-match "[^ \t\n\f]+" keys pos))
+ (let* ((word-beg (match-beginning 0))
+ (word-end (match-end 0))
+ (word (substring keys word-beg len))
+ (times 1)
+ key)
+ ;; Try to catch events of the form "<as df>".
+ (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
+ (setq word (match-string 0 word)
+ pos (+ word-beg (match-end 0)))
+ (setq word (substring keys word-beg word-end)
+ pos word-end))
+ (when (string-match "\\([0-9]+\\)\\*." word)
+ (setq times (string-to-number (substring word 0 (match-end 1))))
+ (setq word (substring word (1+ (match-end 1)))))
+ (cond ((string-match "^<<.+>>$" word)
+ (setq key (vconcat (if (eq (key-binding [?\M-x])
+ 'execute-extended-command)
+ [?\M-x]
+ (or (car (where-is-internal
+ 'execute-extended-command))
+ [?\M-x]))
+ (substring word 2 -2) "\r")))
+ ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
+ (progn
+ (setq word (concat (match-string 1 word)
+ (match-string 3 word)))
+ (not (string-match
+ "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
+ word))))
+ (setq key (list (intern word))))
+ ((or (equal word "REM") (string-match "^;;" word))
+ (setq pos (string-match "$" keys pos)))
+ (t
+ (let ((orig-word word) (prefix 0) (bits 0))
+ (while (string-match "^[ACHMsS]-." word)
+ (setq bits (+ bits
+ (cdr
+ (assq (aref word 0)
+ '((?A . ?\A-\0) (?C . ?\C-\0)
+ (?H . ?\H-\0) (?M . ?\M-\0)
+ (?s . ?\s-\0) (?S . ?\S-\0))))))
+ (setq prefix (+ prefix 2))
+ (setq word (substring word 2)))
+ (when (string-match "^\\^.$" word)
+ (setq bits (+ bits ?\C-\0))
+ (setq prefix (1+ prefix))
+ (setq word (substring word 1)))
+ (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
+ ("LFD" . "\n") ("TAB" . "\t")
+ ("ESC" . "\e") ("SPC" . " ")
+ ("DEL" . "\177")))))
+ (when found (setq word (cdr found))))
+ (when (string-match "^\\\\[0-7]+$" word)
+ (let ((n 0))
+ (dolist (ch (cdr (string-to-list word)))
+ (setq n (+ (* n 8) ch -48)))
+ (setq word (vector n))))
+ (cond ((= bits 0)
+ (setq key word))
+ ((and (= bits ?\M-\0) (stringp word)
+ (string-match "^-?[0-9]+$" word))
+ (setq key (mapcar (lambda (x) (+ x bits))
+ (append word nil))))
+ ((/= (length word) 1)
+ (error "%s must prefix a single character, not %s"
+ (substring orig-word 0 prefix) word))
+ ((and (/= (logand bits ?\C-\0) 0) (stringp word)
+ ;; We used to accept . and ? here,
+ ;; but . is simply wrong,
+ ;; and C-? is not used (we use DEL instead).
+ (string-match "[@-_a-z]" word))
+ (setq key (list (+ bits (- ?\C-\0)
+ (logand (aref word 0) 31)))))
+ (t
+ (setq key (list (+ bits (aref word 0)))))))))
+ (when key
+ (dolist (_ (number-sequence 1 times))
+ (setq res (vconcat res key))))))
+ res)))
+
+(defun key-valid-p (keys)
+ "Say whether KEYS is a valid key.
+A key is a string consisting of one or more key strokes.
+The key strokes are separated by single space characters.
+
+Each key stroke is either a single character, or the name of an
+event, surrounded by angle brackets. In addition, any key stroke
+may be preceded by one or more modifier keys. Finally, a limited
+number of characters have a special shorthand syntax.
+
+Here's some example key sequences.
+
+ \"f\" (the key `f')
+ \"S o m\" (a three key sequence of the keys `S', `o' and `m')
+ \"C-c o\" (a two key sequence of the keys `c' with the control modifier
+ and then the key `o')
+ \"H-<left>\" (the key named \"left\" with the hyper modifier)
+ \"M-RET\" (the \"return\" key with a meta modifier)
+ \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers)
+
+These are the characters that have shorthand syntax:
+NUL, RET, TAB, LFD, ESC, SPC, DEL.
+
+Modifiers have to be specified in this order:
+
+ A-C-H-M-S-s
+
+which is
+
+ Alt-Control-Hyper-Meta-Shift-super"
+ (declare (pure t) (side-effect-free t))
+ (let ((case-fold-search nil))
+ (and
+ (stringp keys)
+ (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys)
+ (save-match-data
+ (catch 'exit
+ (let ((prefixes
+ "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?"))
+ (dolist (key (split-string keys " "))
+ ;; Every key might have these modifiers, and they should be
+ ;; in this order.
+ (when (string-match (concat "\\`" prefixes) key)
+ (setq key (substring key (match-end 0))))
+ (unless (or (and (= (length key) 1)
+ ;; Don't accept control characters as keys.
+ (not (< (aref key 0) ?\s))
+ ;; Don't accept Meta'd characters as keys.
+ (or (multibyte-string-p key)
+ (not (<= 127 (aref key 0) 255))))
+ (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key)
+ ;; Don't allow <M-C-down>.
+ (= (progn
+ (string-match
+ (concat "\\`<" prefixes) key)
+ (match-end 0))
+ 1))
+ (string-match-p
+ "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'"
+ key))
+ ;; Invalid.
+ (throw 'exit nil)))
+ t))))))
+
+(defun key-translate (from to)
+ "Translate character FROM to TO on the current terminal.
+This function creates a `keyboard-translate-table' if necessary
+and then modifies one entry in it.
+
+Both KEY and TO are strings that satisfy `key-valid-p'."
+ (declare (compiler-macro
+ (lambda (form) (keymap--compile-check from to) form)))
+ (keymap--check from)
+ (keymap--check to)
+ (or (char-table-p keyboard-translate-table)
+ (setq keyboard-translate-table
+ (make-char-table 'keyboard-translate-table nil)))
+ (aset keyboard-translate-table (key-parse from) (key-parse to)))
+
+(defun keymap-lookup (keymap key &optional accept-default no-remap position)
+ "Return the binding for command KEY.
+KEY is a string that satisfies `key-valid-p'.
+
+If KEYMAP is nil, look up in the current keymaps. If non-nil, it
+should either be a keymap or a list of keymaps, and only these
+keymap(s) will be consulted.
+
+The binding is probably a symbol with a function definition.
+
+Normally, `keymap-lookup' ignores bindings for t, which act as
+default bindings, used when nothing else in the keymap applies;
+this makes it usable as a general function for probing keymaps.
+However, if the optional second argument ACCEPT-DEFAULT is
+non-nil, `keymap-lookup' does recognize the default bindings,
+just as `read-key-sequence' does.
+
+Like the normal command loop, `keymap-lookup' will remap the
+command resulting from looking up KEY by looking up the command
+in the current keymaps. However, if the optional third argument
+NO-REMAP is non-nil, `keymap-lookup' returns the unmapped
+command.
+
+If KEY is a key sequence initiated with the mouse, the used keymaps
+will depend on the clicked mouse position with regard to the buffer
+and possible local keymaps on strings.
+
+If the optional argument POSITION is non-nil, it specifies a mouse
+position as returned by `event-start' and `event-end', and the lookup
+occurs in the keymaps associated with it instead of KEY. It can also
+be a number or marker, in which case the keymap properties at the
+specified buffer position instead of point are used."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+ (keymap--check key)
+ (when (and keymap position)
+ (error "Can't pass in both keymap and position"))
+ (if keymap
+ (let ((value (lookup-key keymap (key-parse key) accept-default)))
+ (if (and (not no-remap)
+ (symbolp value))
+ (or (command-remapping value) value)
+ value))
+ (key-binding (kbd key) accept-default no-remap position)))
+
+(defun keymap-local-lookup (keys &optional accept-default)
+ "Return the binding for command KEYS in current local keymap only.
+KEY is a string that satisfies `key-valid-p'.
+
+The binding is probably a symbol with a function definition.
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `keymap-lookup' for more details
+about this."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check keys) form)))
+ (when-let ((map (current-local-map)))
+ (keymap-lookup map keys accept-default)))
+
+(defun keymap-global-lookup (keys &optional accept-default message)
+ "Return the binding for command KEYS in current global keymap only.
+KEY is a string that satisfies `key-valid-p'.
+
+The binding is probably a symbol with a function definition.
+This function's return values are the same as those of `keymap-lookup'
+\(which see).
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `keymap-lookup' for more details
+about this.
+
+If MESSAGE (and interactively), message the result."
+ (declare (compiler-macro (lambda (form) (keymap--compile-check keys) form)))
+ (interactive
+ (list (key-description (read-key-sequence "Look up key in global keymap: "))
+ nil t))
+ (let ((def (keymap-lookup (current-global-map) keys accept-default)))
+ (when message
+ (message "%s is bound to %s globally" keys def))
+ def))
+
+
+;;; define-keymap and defvar-keymap
+
+(defun define-keymap--compile (form &rest args)
+ ;; This compiler macro is only there for compile-time
+ ;; error-checking; it does not change the call in any way.
+ (while (and args
+ (keywordp (car args))
+ (not (eq (car args) :menu)))
+ (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix))
+ (byte-compile-warn-x (car args) "Invalid keyword: %s" (car args)))
+ (setq args (cdr args))
+ (when (null args)
+ (byte-compile-warn-x form "Uneven number of keywords in %S" form))
+ (setq args (cdr args)))
+ ;; Bindings.
+ (while args
+ (let* ((wargs args)
+ (key (pop args)))
+ (when (and (stringp key) (not (key-valid-p key)))
+ (byte-compile-warn-x wargs "Invalid `kbd' syntax: %S" key)))
+ (when (null args)
+ (byte-compile-warn-x form "Uneven number of key bindings in %S" form))
+ (setq args (cdr args)))
+ form)
+
+(defun define-keymap (&rest definitions)
+ "Create a new keymap and define KEY/DEFINITION pairs as key bindings.
+The new keymap is returned.
+
+Options can be given as keywords before the KEY/DEFINITION
+pairs. Available keywords are:
+
+:full If non-nil, create a chartable alist (see `make-keymap').
+ If nil (i.e., the default), create a sparse keymap (see
+ `make-sparse-keymap').
+
+:suppress If non-nil, the keymap will be suppressed (see `suppress-keymap').
+ If `nodigits', treat digits like other chars.
+
+:parent If non-nil, this should be a keymap to use as the parent
+ (see `set-keymap-parent').
+
+:keymap If non-nil, instead of creating a new keymap, the given keymap
+ will be destructively modified instead.
+
+:name If non-nil, this should be a string to use as the menu for
+ the keymap in case you use it as a menu with `x-popup-menu'.
+
+:prefix If non-nil, this should be a symbol to be used as a prefix
+ command (see `define-prefix-command'). If this is the case,
+ this symbol is returned instead of the map itself.
+
+KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can
+also be the special symbol `:menu', in which case DEFINITION
+should be a MENU form as accepted by `easy-menu-define'.
+
+\(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)"
+ (declare (indent defun)
+ (compiler-macro define-keymap--compile))
+ (let (full suppress parent name prefix keymap)
+ ;; Handle keywords.
+ (while (and definitions
+ (keywordp (car definitions))
+ (not (eq (car definitions) :menu)))
+ (let ((keyword (pop definitions)))
+ (unless definitions
+ (error "Missing keyword value for %s" keyword))
+ (let ((value (pop definitions)))
+ (pcase keyword
+ (:full (setq full value))
+ (:keymap (setq keymap value))
+ (:parent (setq parent value))
+ (:suppress (setq suppress value))
+ (:name (setq name value))
+ (:prefix (setq prefix value))
+ (_ (error "Invalid keyword: %s" keyword))))))
+
+ (when (and prefix
+ (or full parent suppress keymap))
+ (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords"))
+
+ (when (and keymap full)
+ (error "Invalid combination: :keymap with :full"))
+
+ (let ((keymap (cond
+ (keymap keymap)
+ (prefix (define-prefix-command prefix nil name))
+ (full (make-keymap name))
+ (t (make-sparse-keymap name)))))
+ (when suppress
+ (suppress-keymap keymap (eq suppress 'nodigits)))
+ (when parent
+ (set-keymap-parent keymap parent))
+
+ ;; Do the bindings.
+ (while definitions
+ (let ((key (pop definitions)))
+ (unless definitions
+ (error "Uneven number of key/definition pairs"))
+ (let ((def (pop definitions)))
+ (if (eq key :menu)
+ (easy-menu-define nil keymap "" def)
+ (keymap-set keymap key def)))))
+ keymap)))
+
+(defmacro defvar-keymap (variable-name &rest defs)
+ "Define VARIABLE-NAME as a variable with a keymap definition.
+See `define-keymap' for an explanation of the keywords and KEY/DEFINITION.
+
+In addition to the keywords accepted by `define-keymap', this
+macro also accepts a `:doc' keyword, which (if present) is used
+as the variable documentation string.
+
+\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)"
+ (declare (indent 1))
+ (let ((opts nil)
+ doc)
+ (while (and defs
+ (keywordp (car defs))
+ (not (eq (car defs) :menu)))
+ (let ((keyword (pop defs)))
+ (unless defs
+ (error "Uneven number of keywords"))
+ (if (eq keyword :doc)
+ (setq doc (pop defs))
+ (push keyword opts)
+ (push (pop defs) opts))))
+ (unless (zerop (% (length defs) 2))
+ (error "Uneven number of key/definition pairs: %s" defs))
+ `(defvar ,variable-name
+ (define-keymap ,@(nreverse opts) ,@defs)
+ ,@(and doc (list doc)))))
+
+(defun make-non-key-event (symbol)
+ "Mark SYMBOL as an event that shouldn't be returned from `where-is'."
+ (put symbol 'non-key-event t)
+ symbol)
+
+(provide 'keymap)
+
+;;; keymap.el ends here
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 7478e97134f..92118ad1433 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -129,7 +129,7 @@ Set to nil if no mouse binding is desired."
(defcustom kmacro-ring-max 8
"Maximum number of keyboard macros to save in macro ring."
- :type 'integer)
+ :type 'natnum)
(defcustom kmacro-execute-before-append t
@@ -164,43 +164,41 @@ macro to be executed before appending to it."
;; Keymap
-(defvar kmacro-keymap
- (let ((map (make-sparse-keymap)))
- ;; Start, end, execute macros
- (define-key map "s" #'kmacro-start-macro)
- (define-key map "\C-s" #'kmacro-start-macro)
- (define-key map "\C-k" #'kmacro-end-or-call-macro-repeat)
- (define-key map "r" #'apply-macro-to-region-lines)
- (define-key map "q" #'kbd-macro-query) ;; Like C-x q
- (define-key map "d" #'kmacro-redisplay)
-
- ;; macro ring
- (define-key map "\C-n" #'kmacro-cycle-ring-next)
- (define-key map "\C-p" #'kmacro-cycle-ring-previous)
- (define-key map "\C-v" #'kmacro-view-macro-repeat)
- (define-key map "\C-d" #'kmacro-delete-ring-head)
- (define-key map "\C-t" #'kmacro-swap-ring)
- (define-key map "\C-l" #'kmacro-call-ring-2nd-repeat)
-
- ;; macro counter
- (define-key map "\C-f" #'kmacro-set-format)
- (define-key map "\C-c" #'kmacro-set-counter)
- (define-key map "\C-i" #'kmacro-insert-counter)
- (define-key map "\C-a" #'kmacro-add-counter)
-
- ;; macro editing
- (define-key map "\C-e" #'kmacro-edit-macro-repeat)
- (define-key map "\r" #'kmacro-edit-macro)
- (define-key map "e" #'edit-kbd-macro)
- (define-key map "l" #'kmacro-edit-lossage)
- (define-key map " " #'kmacro-step-edit-macro)
-
- ;; naming and binding
- (define-key map "b" #'kmacro-bind-to-key)
- (define-key map "n" #'kmacro-name-last-macro)
- (define-key map "x" #'kmacro-to-register)
- map)
- "Keymap for keyboard macro commands.")
+(defvar-keymap kmacro-keymap
+ :doc "Keymap for keyboard macro commands."
+ ;; Start, end, execute macros
+ "s" #'kmacro-start-macro
+ "C-s" #'kmacro-start-macro
+ "C-k" #'kmacro-end-or-call-macro-repeat
+ "r" #'apply-macro-to-region-lines
+ "q" #'kbd-macro-query ;; Like C-x q
+ "d" #'kmacro-redisplay
+
+ ;; macro ring
+ "C-n" #'kmacro-cycle-ring-next
+ "C-p" #'kmacro-cycle-ring-previous
+ "C-v" #'kmacro-view-macro-repeat
+ "C-d" #'kmacro-delete-ring-head
+ "C-t" #'kmacro-swap-ring
+ "C-l" #'kmacro-call-ring-2nd-repeat
+
+ ;; macro counter
+ "C-f" #'kmacro-set-format
+ "C-c" #'kmacro-set-counter
+ "C-i" #'kmacro-insert-counter
+ "C-a" #'kmacro-add-counter
+
+ ;; macro editing
+ "C-e" #'kmacro-edit-macro-repeat
+ "RET" #'kmacro-edit-macro
+ "e" #'edit-kbd-macro
+ "l" #'kmacro-edit-lossage
+ "SPC" #'kmacro-step-edit-macro
+
+ ;; naming and binding
+ "b" #'kmacro-bind-to-key
+ "n" #'kmacro-name-last-macro
+ "x" #'kmacro-to-register)
(defalias 'kmacro-keymap kmacro-keymap)
;;; Provide some binding for startup:
@@ -362,9 +360,13 @@ information."
;;; Keyboard macro ring
+(oclosure-define kmacro
+ "Keyboard macro."
+ keys (counter :mutable t) format)
+
(defvar kmacro-ring nil
"The keyboard macro ring.
-Each element is a list (MACRO COUNTER FORMAT). Actually, the head of
+Each element is a `kmacro'. Actually, the head of
the macro ring (when defining or executing) is not stored in the ring;
instead it is available in the variables `last-kbd-macro', `kmacro-counter',
and `kmacro-counter-format'.")
@@ -378,20 +380,23 @@ and `kmacro-counter-format'.")
(defun kmacro-ring-head ()
"Return pseudo head element in macro ring."
(and last-kbd-macro
- (list last-kbd-macro kmacro-counter kmacro-counter-format-start)))
+ (kmacro last-kbd-macro kmacro-counter kmacro-counter-format-start)))
(defun kmacro-push-ring (&optional elt)
"Push ELT or current macro onto `kmacro-ring'."
(when (setq elt (or elt (kmacro-ring-head)))
+ (when (consp elt)
+ (message "Converting obsolete list form of kmacro: %S" elt)
+ (setq elt (apply #'kmacro elt)))
(let ((history-delete-duplicates nil))
(add-to-history 'kmacro-ring elt kmacro-ring-max))))
(defun kmacro-split-ring-element (elt)
- (setq last-kbd-macro (car elt)
- kmacro-counter (nth 1 elt)
- kmacro-counter-format-start (nth 2 elt)))
+ (setq last-kbd-macro (kmacro--keys elt)
+ kmacro-counter (kmacro--counter elt)
+ kmacro-counter-format-start (kmacro--format elt)))
(defun kmacro-pop-ring1 (&optional raw)
@@ -481,21 +486,16 @@ Optional arg EMPTY is message to print if no macros are defined."
;;;###autoload
-(defun kmacro-exec-ring-item (item arg)
+(define-obsolete-function-alias 'kmacro-exec-ring-item #'funcall "29.1"
"Execute item ITEM from the macro ring.
-ARG is the number of times to execute the item."
- ;; Use counter and format specific to the macro on the ring!
- (let ((kmacro-counter (nth 1 item))
- (kmacro-counter-format-start (nth 2 item)))
- (execute-kbd-macro (car item) arg #'kmacro-loop-setup-function)
- (setcar (cdr item) kmacro-counter)))
+ARG is the number of times to execute the item.")
(defun kmacro-call-ring-2nd (arg)
"Execute second keyboard macro in macro ring."
(interactive "P")
(unless (kmacro-ring-empty-p)
- (kmacro-exec-ring-item (car kmacro-ring) arg)))
+ (funcall (car kmacro-ring) arg)))
(defun kmacro-call-ring-2nd-repeat (arg)
@@ -515,7 +515,7 @@ without repeating the prefix."
"Display the second macro in the keyboard macro ring."
(interactive)
(unless (kmacro-ring-empty-p)
- (kmacro-display (car (car kmacro-ring)) nil "2nd macro")))
+ (kmacro-display (kmacro--keys (car kmacro-ring)) nil "2nd macro")))
(defun kmacro-cycle-ring-next (&optional _arg)
@@ -611,8 +611,7 @@ Use \\[kmacro-bind-to-key] to bind it to a key sequence."
(let ((append (and arg (listp arg))))
(unless append
(if last-kbd-macro
- (kmacro-push-ring
- (list last-kbd-macro kmacro-counter kmacro-counter-format-start)))
+ (kmacro-push-ring))
(setq kmacro-counter (or (if arg (prefix-numeric-value arg))
kmacro-initial-counter-value
0)
@@ -748,9 +747,9 @@ With \\[universal-argument], call second macro in macro ring."
(if kmacro-call-repeat-key
(kmacro-call-macro arg no-repeat t)
(kmacro-end-macro arg)))
- ((and (eq this-command 'kmacro-view-macro) ;; We are in repeat mode!
+ ((and (eq this-command #'kmacro-view-macro) ;; We are in repeat mode!
kmacro-view-last-item)
- (kmacro-exec-ring-item (car kmacro-view-last-item) arg))
+ (funcall (car kmacro-view-last-item) arg))
((and arg (listp arg))
(kmacro-call-ring-2nd 1))
(t
@@ -812,46 +811,72 @@ If kbd macro currently being defined end it before activating it."
;; executing the macro later on (but that's controversial...)
;;;###autoload
+(defun kmacro (keys &optional counter format)
+ "Create a `kmacro' for macro bound to symbol or key.
+KEYS should be a vector or a string that obeys `key-valid-p'."
+ (oclosure-lambda (kmacro (keys (if (stringp keys) (key-parse keys) keys))
+ (counter (or counter 0))
+ (format (or format "%d")))
+ (&optional arg)
+ ;; Use counter and format specific to the macro on the ring!
+ (let ((kmacro-counter counter)
+ (kmacro-counter-format-start format))
+ (execute-kbd-macro keys arg #'kmacro-loop-setup-function)
+ (setq counter kmacro-counter))))
+
+(cl-defmethod oclosure-interactive-form ((_ kmacro)) '(interactive "p"))
+
+;;;###autoload
(defun kmacro-lambda-form (mac &optional counter format)
- "Create lambda form for macro bound to symbol or key."
;; Apparently, there are two different ways this is called:
;; either `counter' and `format' are both provided and `mac' is a vector,
;; or only `mac' is provided, as a list (MAC COUNTER FORMAT).
;; The first is used from `insert-kbd-macro' and `edmacro-finish-edit',
;; while the second is used from within this file.
- (let ((mac (if counter (list mac counter format) mac)))
- ;; FIXME: This should be a "funcallable struct"!
- (lambda (&optional arg)
- "Keyboard macro."
- ;; We put an "unused prompt" as a special marker so
- ;; `kmacro-extract-lambda' can see it's "one of us".
- (interactive "pkmacro")
- (if (eq arg 'kmacro--extract-lambda)
- (cons 'kmacro--extract-lambda mac)
- (kmacro-exec-ring-item mac arg)))))
+ (declare (obsolete kmacro "29.1"))
+ (if (kmacro-p mac) mac
+ (when (and (null counter) (consp mac))
+ (setq format (nth 2 mac))
+ (setq counter (nth 1 mac))
+ (setq mac (nth 0 mac)))
+ (when (stringp mac)
+ ;; `kmacro' interprets a string according to `key-parse'.
+ (require 'macros)
+ (declare-function macro--string-to-vector "macros")
+ (setq mac (macro--string-to-vector mac)))
+ (kmacro mac counter format)))
(defun kmacro-extract-lambda (mac)
"Extract kmacro from a kmacro lambda form."
- (let ((mac (cond
- ((eq (car-safe mac) 'lambda)
- (let ((e (assoc 'kmacro-exec-ring-item mac)))
- (car-safe (cdr-safe (car-safe (cdr-safe e))))))
- ((and (functionp mac)
- (equal (interactive-form mac) '(interactive "pkmacro")))
- (let ((r (funcall mac 'kmacro--extract-lambda)))
- (and (eq (car-safe r) 'kmacro--extract-lambda) (cdr r)))))))
- (and (consp mac)
- (= (length mac) 3)
- (arrayp (car mac))
- mac)))
-
-(defalias 'kmacro-p #'kmacro-extract-lambda
- "Return non-nil if MAC is a kmacro keyboard macro.")
+ (declare (obsolete nil "29.1"))
+ (when (kmacro-p mac)
+ (list (kmacro--keys mac)
+ (kmacro--counter mac)
+ (kmacro--format mac))))
+
+(defun kmacro-p (x)
+ "Return non-nil if MAC is a kmacro keyboard macro."
+ (cl-typep x 'kmacro))
+
+(cl-defmethod cl-print-object ((object kmacro) stream)
+ (princ "#f(kmacro " stream)
+ (require 'macros)
+ (declare-function macros--insert-vector-macro "macros" (definition))
+ (let ((vecdef (kmacro--keys object))
+ (counter (kmacro--counter object))
+ (format (kmacro--format object)))
+ (prin1 (key-description vecdef) stream)
+ (unless (and (equal counter 0) (equal format "%d"))
+ (princ " " stream)
+ (prin1 counter stream)
+ (princ " " stream)
+ (prin1 format stream))
+ (princ ")" stream)))
(defun kmacro-bind-to-key (_arg)
"When not defining or executing a macro, offer to bind last macro to a key.
-The key sequences `C-x C-k 0' through `C-x C-k 9' and `C-x C-k A'
-through `C-x C-k Z' are reserved for user bindings, and to bind to
+The key sequences \\`C-x C-k 0' through \\`C-x C-k 9' and \\`C-x C-k A'
+through \\`C-x C-k Z' are reserved for user bindings, and to bind to
one of these sequences, just enter the digit or letter, rather than
the whole sequence.
@@ -884,16 +909,15 @@ The ARG parameter is unused."
(yes-or-no-p (format "%s runs command %S. Bind anyway? "
(format-kbd-macro key-seq)
cmd))))
- (define-key global-map key-seq
- (kmacro-lambda-form (kmacro-ring-head)))
+ (define-key global-map key-seq (kmacro-ring-head))
(message "Keyboard macro bound to %s" (format-kbd-macro key-seq))))))
(defun kmacro-keyboard-macro-p (symbol)
"Return non-nil if SYMBOL is the name of some sort of keyboard macro."
(let ((f (symbol-function symbol)))
(when f
- (or (stringp f)
- (vectorp f)
+ (or (stringp f) ;FIXME: Really deprecated.
+ (vectorp f) ;FIXME: Deprecated.
(kmacro-p f)))))
(defun kmacro-name-last-macro (symbol)
@@ -910,9 +934,7 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
symbol))
(if (string-equal symbol "")
(error "No command name given"))
- ;; FIXME: Use plain old `last-kbd-macro' for kmacros where it doesn't
- ;; make a difference?
- (fset symbol (kmacro-lambda-form (kmacro-ring-head)))
+ (fset symbol (kmacro-ring-head))
;; This used to be used to detect when a symbol corresponds to a kmacro.
;; Nowadays it's unused because we used `kmacro-p' instead to see if the
;; symbol's function definition matches that of a kmacro, which is more
@@ -930,7 +952,7 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
(cl-defmethod register-val-describe ((data kmacro-register) _verbose)
(princ (format "a keyboard macro:\n %s"
- (format-kbd-macro (kmacro-register-macro data)))))
+ (key-description (kmacro-register-macro data)))))
(cl-defmethod register-val-insert ((data kmacro-register))
(insert (format-kbd-macro (kmacro-register-macro data))))
@@ -953,7 +975,7 @@ The ARG parameter is unused."
(interactive)
(cond
((or (kmacro-ring-empty-p)
- (not (eq last-command 'kmacro-view-macro)))
+ (not (eq last-command #'kmacro-view-macro)))
(setq kmacro-view-last-item nil))
((null kmacro-view-last-item)
(setq kmacro-view-last-item kmacro-ring
@@ -963,10 +985,10 @@ The ARG parameter is unused."
kmacro-view-item-no (1+ kmacro-view-item-no)))
(t
(setq kmacro-view-last-item nil)))
- (setq this-command 'kmacro-view-macro
+ (setq this-command #'kmacro-view-macro
last-command this-command) ;; in case we repeat
(kmacro-display (if kmacro-view-last-item
- (car (car kmacro-view-last-item))
+ (kmacro--keys (car kmacro-view-last-item))
last-kbd-macro)
nil
(if kmacro-view-last-item
@@ -980,7 +1002,7 @@ The ARG parameter is unused."
"Display the last keyboard macro.
If repeated, it shows previous elements in the macro ring.
To execute the displayed macro ring item without changing the macro ring,
-just enter C-k.
+just enter \\`C-k'.
This is like `kmacro-view-macro', but allows repeating macro commands
without repeating the prefix."
(interactive)
@@ -1025,34 +1047,30 @@ without repeating the prefix."
(defvar kmacro-step-edit-help) ;; kmacro step edit help enabled
(defvar kmacro-step-edit-num-input-keys) ;; to ignore duplicate pre-command hook
-(defvar kmacro-step-edit-map
- (let ((map (make-sparse-keymap)))
- ;; query-replace-map answers include: `act', `skip', `act-and-show',
- ;; `exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
- ;; `automatic', `backup', `exit-prefix', and `help'.")
- ;; Also: `quit', `edit-replacement'
-
- (set-keymap-parent map query-replace-map)
-
- (define-key map "\t" 'act-repeat)
- (define-key map [tab] 'act-repeat)
- (define-key map "\C-k" 'skip-rest)
- (define-key map "c" 'automatic)
- (define-key map "f" 'skip-keep)
- (define-key map "q" 'quit)
- (define-key map "d" 'skip)
- (define-key map "\C-d" 'skip)
- (define-key map "i" 'insert)
- (define-key map "I" 'insert-1)
- (define-key map "r" 'replace)
- (define-key map "R" 'replace-1)
- (define-key map "a" 'append)
- (define-key map "A" 'append-end)
- map)
- "Keymap that defines the responses to questions in `kmacro-step-edit-macro'.
+(defvar-keymap kmacro-step-edit-map
+ :doc "Keymap that defines the responses to questions in `kmacro-step-edit-macro'.
This keymap is an extension to the `query-replace-map', allowing the
following additional answers: `insert', `insert-1', `replace', `replace-1',
-`append', `append-end', `act-repeat', `skip-end', `skip-keep'.")
+`append', `append-end', `act-repeat', `skip-end', `skip-keep'."
+ ;; query-replace-map answers include: `act', `skip', `act-and-show',
+ ;; `exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
+ ;; `automatic', `backup', `exit-prefix', and `help'.")
+ ;; Also: `quit', `edit-replacement'
+ :parent query-replace-map
+ "TAB" 'act-repeat
+ "<tab>" 'act-repeat
+ "C-k" 'skip-rest
+ "c" 'automatic
+ "f" 'skip-keep
+ "q" 'quit
+ "d" 'skip
+ "C-d" 'skip
+ "i" 'insert
+ "I" 'insert-1
+ "r" 'replace
+ "R" 'replace-1
+ "a" 'append
+ "A" 'append-end)
(defun kmacro-step-edit-prompt (macro index)
;; Show step-edit prompt
@@ -1068,21 +1086,27 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(concat
(format "Macro: %s%s%s%s%s\n"
(format-kbd-macro kmacro-step-edit-new-macro 1)
- (if (and kmacro-step-edit-new-macro (> (length kmacro-step-edit-new-macro) 0)) " " "")
+ (if (and kmacro-step-edit-new-macro
+ (> (length kmacro-step-edit-new-macro) 0))
+ " " "")
(propertize (if keys (format-kbd-macro keys)
- (if kmacro-step-edit-appending "<APPEND>" "<INSERT>")) 'face 'region)
+ (if kmacro-step-edit-appending
+ "<APPEND>" "<INSERT>"))
+ 'face 'region)
(if future " " "")
(if future (format-kbd-macro future) ""))
(cond
((minibufferp)
(format "%s\n%s\n"
(propertize "\
- minibuffer " 'face 'header-line)
+ minibuffer "
+ 'face 'header-line)
(buffer-substring (point-min) (point-max))))
(curmsg
(format "%s\n%s\n"
(propertize "\
- echo area " 'face 'header-line)
+ echo area "
+ 'face 'header-line)
curmsg))
(t ""))
(if keys
@@ -1113,7 +1137,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
;; Handle commands which reads additional input using read-char.
(cond
- ((and (eq this-command 'quoted-insert)
+ ((and (eq this-command #'quoted-insert)
(not (eq kmacro-step-edit-action t)))
;; Find the actual end of this key sequence.
;; Must be able to backtrack in case we actually execute it.
@@ -1133,7 +1157,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(cond
((eq kmacro-step-edit-action t) ;; Reentry for actual command @ end of prefix arg.
(cond
- ((eq this-command 'quoted-insert)
+ ((eq this-command #'quoted-insert)
(clear-this-command-keys) ;; recent-keys actually
(let (unread-command-events)
(quoted-insert (prefix-numeric-value current-prefix-arg))
@@ -1177,7 +1201,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
((eq act 'skip)
nil)
((eq act 'skip-keep)
- (setq this-command 'ignore)
+ (setq this-command #'ignore)
t)
((eq act 'skip-rest)
(setq kmacro-step-edit-active 'ignore)
@@ -1227,7 +1251,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(if restore-index
(setq executing-kbd-macro-index restore-index)))
(t
- (setq this-command 'ignore)))
+ (setq this-command #'ignore)))
(setq kmacro-step-edit-key-index next-index)))
(defun kmacro-step-edit-insert ()
@@ -1271,7 +1295,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq next-index kmacro-step-edit-key-index)
t)
(t nil))
- (setq this-command 'ignore)
+ (setq this-command #'ignore)
(setq this-command cmd)
(if (memq this-command '(self-insert-command digit-argument))
(setq last-command-event (aref keys (1- (length keys)))))
@@ -1284,7 +1308,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(when kmacro-step-edit-active
(cond
((eq kmacro-step-edit-active 'ignore)
- (setq this-command 'ignore))
+ (setq this-command #'ignore))
((eq kmacro-step-edit-active 'append-end)
(if (= executing-kbd-macro-index (length executing-kbd-macro))
(setq executing-kbd-macro (vconcat executing-kbd-macro [nil])
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index e06339cc625..5482b3ea306 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -60,7 +60,7 @@ If the argument is nil, we return the display table to its standard state."
(list
(let* ((completion-ignore-case t))
(completing-read
- "Cyrillic language (default nil): "
+ (format-prompt "Cyrillic language" "nil")
cyrillic-language-alist nil t nil nil nil))))
(or standard-display-table
diff --git a/lisp/language/greek.el b/lisp/language/greek.el
index 58f4fe6fc49..920cf67d871 100644
--- a/lisp/language/greek.el
+++ b/lisp/language/greek.el
@@ -79,7 +79,9 @@
(coding-priority greek-iso-8bit)
(nonascii-translation . iso-8859-7)
(input-method . "greek")
- (documentation . t)))
+ (documentation . "Support for Greek ISO-8859-7 using the greek input method.")
+ (sample-text . "Greek (ελληνικά) Γειά σας")
+ (tutorial . "TUTORIAL.el_GR")))
(provide 'greek)
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 7aa3f024a33..0c2419c91cd 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -6573,8 +6573,8 @@ The value is a hanja character that is selected interactively."
(hanja-filter (lambda (x) (car x))
(mapcar (lambda (c)
(if (listp c)
- (cons (decode-char 'ucs (car c)) (cdr c))
- (list (decode-char 'ucs c))))
+ (cons (car c) (cdr c))
+ (list c)))
(aref hanja-table char)))))
(unwind-protect
(when (aref hanja-conversions 2)
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 8b1c3d69ae5..27facaa858f 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -267,11 +267,34 @@
?த nil nil nil ?ந ?ன ;; DENTALS
?ப nil nil nil ?ம ;; LABIALS
?ய ?ர ?ற ?ல ?ள ?ழ ?வ ;; SEMIVOWELS
- nil ?ஷ ?ஸ ?ஹ ;; SIBILANTS
+ ?ஶ ?ஷ ?ஸ ?ஹ ;; SIBILANTS
nil nil nil nil nil nil nil nil ;; NUKTAS
- "ஜ்ஞ" "க்ஷ")
+ "ஜ்ஞ" "க்ஷ" "க்‌ஷ")
(;; Misc Symbols
- nil ?ஂ ?ஃ nil ?் nil nil)
+ nil ?ஂ ?ஃ nil ?் ?ௐ nil)
+ (;; Digits
+ nil nil nil nil nil nil nil nil nil nil)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "்ர" "ர்" "த்ர" nil nil)))
+
+(defvar indian-tml-base-digits-table
+ '(
+ (;; VOWELS
+ (?அ nil) (?ஆ ?ா) (?இ ?ி) (?ஈ ?ீ) (?உ ?ு) (?ஊ ?ூ)
+ nil nil nil (?ஏ ?ே) (?எ ?ெ) (?ஐ ?ை)
+ nil (?ஓ ?ோ) (?ஒ ?ொ) (?ஔ ?ௌ) nil nil)
+ (;; CONSONANTS
+ ?க nil nil nil ?ங ;; GUTTRULS
+ ?ச nil ?ஜ nil ?ஞ ;; PALATALS
+ ?ட nil nil nil ?ண ;; CEREBRALS
+ ?த nil nil nil ?ந ?ன ;; DENTALS
+ ?ப nil nil nil ?ம ;; LABIALS
+ ?ய ?ர ?ற ?ல ?ள ?ழ ?வ ;; SEMIVOWELS
+ ?ஶ ?ஷ ?ஸ ?ஹ ;; SIBILANTS
+ nil nil nil nil nil nil nil nil ;; NUKTAS
+ "ஜ்ஞ" "க்ஷ" "க்‌ஷ")
+ (;; Misc Symbols
+ nil ?ஂ ?ஃ nil ?் ?ௐ nil)
(;; Digits
?௦ ?௧ ?௨ ?௩ ?௪ ?௫ ?௬ ?௭ ?௮ ?௯)
(;; Inscript-extra (4) (#, $, ^, *, ])
@@ -292,8 +315,8 @@
'(;; for encode/decode
(;; vowels -- 18
"a" ("aa" "A") "i" ("ii" "I") "u" ("uu" "U")
- ("RRi" "R^i") ("LLi" "L^i") (".c" "e.c") "E" "e" "ai"
- "o.c" "O" "o" "au" ("RRI" "R^I") ("LLI" "L^I"))
+ ("RRi" "R^i" "RRu" "R^u") ("LLi" "L^i") (".c" "e.c") "E" "e" "ai"
+ "o.c" "O" "o" "au" ("RRI" "R^I" "RRU" "R^U") ("LLI" "L^I"))
(;; consonants -- 40
"k" "kh" "g" "gh" ("~N" "N^")
"ch" ("Ch" "chh") "j" "jh" ("~n" "JN")
@@ -557,6 +580,10 @@
(defvar indian-tml-itrans-v5-hash
(indian-make-hash indian-tml-base-table
indian-itrans-v5-table-for-tamil))
+
+(defvar indian-tml-itrans-digits-v5-hash
+ (indian-make-hash indian-tml-base-digits-table
+ indian-itrans-v5-table-for-tamil))
)
(defmacro indian-translate-region (from to hashtable encode-p)
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index e0adb0de6c3..2887d410adf 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -45,8 +45,9 @@
(coding-system utf-8)
(coding-priority utf-8)
(input-method . "devanagari-aiba")
+ (sample-text . "Devanagari (देवनागरी) नमस्ते / नमस्कार")
(documentation . "\
-Such languages using Devanagari script as Hindi and Marathi
+Such languages using Devanagari script as Hindi, Marathi and Nepali
are supported in this language environment."))
'("Indian"))
@@ -55,16 +56,18 @@ are supported in this language environment."))
(coding-system utf-8)
(coding-priority utf-8)
(input-method . "bengali-itrans")
+ (sample-text . "Bengali (বাংলা) নমস্কার")
(documentation . "\
Such languages using Bengali script as Bengali and Assamese
are supported in this language environment."))
'("Indian"))
(set-language-info-alist
- "Punjabi" '((charset unicode)
+ "Gurmukhi" '((charset unicode)
(coding-system utf-8)
(coding-priority utf-8)
(input-method . "punjabi-itrans")
+ (sample-text . "Gurmukhi (ਗੁਰਮੁਖੀ) ਸਤ ਸ੍ਰੀ ਅਕਾਲ")
(documentation . "\
North Indian language Punjabi is supported in this language environment."))
'("Indian"))
@@ -74,17 +77,31 @@ North Indian language Punjabi is supported in this language environment."))
(coding-system utf-8)
(coding-priority utf-8)
(input-method . "gujarati-itrans")
+ (sample-text . "Gujarati (ગુજરાતી) નમસ્તે")
(documentation . "\
North Indian language Gujarati is supported in this language environment."))
'("Indian"))
(set-language-info-alist
+ "Odia" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "odia")
+ (sample-text . "Odia (ଓଡ଼ିଆ) ନମସ୍କାର")
+ (documentation . "\
+Such languages using the Odia script as Odia, Khonti, and Santali
+are supported in this language environment. (This language
+environment was formerly known as \"Oriya\")."))
+ '("Indian"))
+
+(set-language-info-alist
"Oriya" '((charset unicode)
- (coding-system utf-8)
- (coding-priority utf-8)
- (input-method . "oriya-itrans")
- (documentation . "\
-Such languages using Oriya script as Oriya, Khonti, and Santali
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "odia")
+ (sample-text . "Odia (ଓଡ଼ିଆ) ନମସ୍କାର")
+ (documentation . "\
+Such languages using the Odia script as Odia, Khonti, and Santali
are supported in this language environment."))
'("Indian"))
@@ -93,6 +110,7 @@ are supported in this language environment."))
(coding-system utf-8)
(coding-priority utf-8)
(input-method . "tamil-itrans")
+ (sample-text . "Tamil (தமிழ்) வணக்கம்")
(documentation . "\
South Indian Language Tamil is supported in this language environment."))
'("Indian"))
@@ -102,6 +120,7 @@ South Indian Language Tamil is supported in this language environment."))
(coding-system utf-8)
(coding-priority utf-8)
(input-method . "telugu-itrans")
+ (sample-text . "Telugu (తెలుగు) నమస్కారం")
(documentation . "\
South Indian Language Telugu is supported in this language environment."))
'("Indian"))
@@ -113,7 +132,7 @@ South Indian Language Telugu is supported in this language environment."))
(input-method . "kannada-itrans")
(sample-text . "Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ")
(documentation . "\
-Kannada language and script is supported in this language
+Kannada language and script are supported in this language
environment."))
'("Indian"))
@@ -122,10 +141,131 @@ environment."))
(coding-system utf-8)
(coding-priority utf-8)
(input-method . "malayalam-itrans")
+ (sample-text . "Malayalam (മലയാളം) നമസ്കാരം")
(documentation . "\
South Indian language Malayalam is supported in this language environment."))
'("Indian"))
+(set-language-info-alist
+ "Brahmi" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "brahmi")
+ (sample-text . "Brahmi (𑀩𑁆𑀭𑀸𑀳𑁆𑀫𑀻) 𑀦𑀫𑀲𑁆𑀢𑁂")
+ (documentation . "\
+The ancient Brahmi script is supported in this language environment."))
+ '("Indian")) ; Should we have an "Old" category?
+
+(set-language-info-alist
+ "Kaithi" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "kaithi")
+ (sample-text . "Kaithi (𑂍𑂶𑂟𑂲) 𑂩𑂰𑂧𑂩𑂰𑂧")
+ (documentation . "\
+Languages such as Awadhi, Bhojpuri, Magahi and Maithili
+which used the Kaithi script are supported in this language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Tirhuta" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "tirhuta")
+ (sample-text . "Tirhuta (𑒞𑒱𑒩𑒯𑒳𑒞𑒰) 𑒣𑓂𑒩𑒢𑒰𑒧 / 𑒮𑒲𑒞𑒰𑒩𑒰𑒧")
+ (documentation . "\
+Maithili language and its script Tirhuta are supported in this
+language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Sharada" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "sharada")
+ (sample-text . "Sharada (𑆯𑆳𑆫𑆢𑆳) 𑆤𑆩𑆱𑇀𑆑𑆳𑆫")
+ (documentation . "\
+Kashmiri language and its script Sharada are supported in this
+language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Siddham" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "siddham")
+ (sample-text . "Siddham (𑖭𑖰𑖟𑖿𑖠𑖽) 𑖡𑖦𑖭𑖿𑖝𑖸")
+ (documentation . "\
+Sanskrit language and one of its script Siddham are supported
+in this language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Syloti Nagri" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "syloti-nagri")
+ (sample-text . "Syloti Nagri (ꠍꠤꠟꠐꠤ ꠘꠣꠉꠞꠤ) ꠀꠌ꠆ꠍꠣꠟꠣꠝꠥ ꠀꠟꠣꠁꠇꠥꠝ / ꠘꠝꠡ꠆ꠇꠣꠞ")
+ (documentation . "\
+Sylheti language and its script Syloti Nagri are supported
+in this language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Modi" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "modi")
+ (sample-text . "Modi (𑘦𑘻𑘚𑘲) 𑘡𑘦𑘭𑘿𑘎𑘰𑘨")
+ (documentation . "\
+Marathi language and one of its script Modi are supported
+in this language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Limbu" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "limbu")
+ (sample-text . "Limbu (ᤕᤠᤰᤌᤢᤱ ᤐᤠᤴ) ᤛᤣᤘᤠᤖᤥ")
+ (documentation . "\
+Limbu language and its script are supported in this
+language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Grantha" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "grantha")
+ (sample-text . "Grantha (𑌗𑍍𑌰𑌨𑍍𑌥) 𑌨𑌮𑌸𑍍𑌤𑍇 / 𑌨𑌮𑌸𑍍𑌕𑌾𑌰𑌃")
+ (documentation . "\
+Languages such as Sanskrit and Manipravalam, when they use the
+Grantha script, are supported in this language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Lepcha" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "lepcha")
+ (sample-text . "Lepcha (ᰛᰩᰵᰛᰧᰵᰶ) ᰂᰦᰕᰥᰬ")
+ (documentation . "\
+Lepcha language and its script are supported in this
+language environment."))
+ '("Indian"))
+
+(set-language-info-alist
+ "Meetei Mayek" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "meetei-mayek")
+ (sample-text . "Meetei Mayek (ꯃꯤꯇꯩ ꯃꯌꯦꯛ) ꯈꯨꯔꯨꯝꯖꯔꯤ")
+ (documentation . "\
+Meetei language and its script Meetei Mayek are supported in this
+language environment."))
+ '("Indian"))
+
;; Replace mnemonic characters in REGEXP according to TABLE. TABLE is
;; an alist of (MNEMONIC-STRING . REPLACEMENT-STRING).
@@ -147,6 +287,8 @@ South Indian language Malayalam is supported in this language environment."))
("H" . "\u094D") ; HALANT
("s" . "[\u0951\u0952]") ; stress sign
("t" . "[\u0953\u0954]") ; accent
+ ("1" . "\u0967") ; numeral 1
+ ("3" . "\u0969") ; numeral 3
("N" . "\u200C") ; ZWNJ
("J" . "\u200D") ; ZWJ
("X" . "[\u0900-\u097F]")))) ; all coverage
@@ -158,6 +300,8 @@ South Indian language Malayalam is supported in this language environment."))
"Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*n?a?s?t?A?\\)\\|"
;; special consonant form, or
"JHR\\|"
+ ;; vedic accents with numerals, or
+ "1ss?\\|3ss\\|s3ss\\|"
;; any other singleton characters
"X")
table))
@@ -168,14 +312,15 @@ South Indian language Malayalam is supported in this language environment."))
'(("a" . "\u0981") ; SIGN CANDRABINDU
("A" . "[\u0982\u0983]") ; SIGN ANUSVARA .. VISARGA
("V" . "[\u0985-\u0994\u09E0\u09E1]") ; independent vowel
- ("C" . "[\u0995-\u09B9\u09DC-\u09DF\u09F1]") ; consonant
+ ("C" . "[\u0995-\u09B9\u09DC-\u09DF\u09F0\u09F1]") ; consonant
("B" . "[\u09AC\u09AF\u09B0\u09F0]") ; BA, YA, RA
("R" . "[\u09B0\u09F0]") ; RA
("n" . "\u09BC") ; NUKTA
("v" . "[\u09BE-\u09CC\u09D7\u09E2\u09E3]") ; vowel sign
("H" . "\u09CD") ; HALANT
("T" . "\u09CE") ; KHANDA TA
- ("N" . "\u200C") ; ZWNJ
+ ("S" . "\u09FE") ; SANDHI MARK
+ ("N" . "\u200C") ; ZWNJ
("J" . "\u200D") ; ZWJ
("X" . "[\u0980-\u09FF]")))) ; all coverage
(indian-compose-regexp
@@ -183,7 +328,7 @@ South Indian language Malayalam is supported in this language environment."))
;; syllables with an independent vowel, or
"\\(?:RH\\)?Vn?\\(?:J?HB\\)?v*n?a?A?\\|"
;; consonant-based syllables, or
- "Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*[NJ]?v?a?A?\\)\\|"
+ "Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*[NJ]?v?a?A?S?\\)\\|"
;; another syllables with an independent vowel, or
"\\(?:RH\\)?T\\|"
;; special consonant form, or
@@ -250,7 +395,7 @@ South Indian language Malayalam is supported in this language environment."))
'(("a" . "\u0B01") ; SIGN CANDRABINDU
("A" . "[\u0B02\u0B03]") ; SIGN ANUSVARA .. VISARGA
("V" . "[\u0B05-\u0B14\u0B60\u0B61]") ; independent vowel
- ("C" . "[\u0B15-\u0B39\u0B5C\u0B5D\u0B71]") ; consonant
+ ("C" . "[\u0B15-\u0B39\u0B5C\u0B5D\u0B5F\u0B71]") ; consonant
("B" . "[\u0B15-\u0B17\u0B1B-\u0B1D\u0B1F-\u0B21\u0B23\u0B24\u0B27-\u0B30\u0B32-\u0B35\u0B38\u0B39]") ; consonant with below form
("R" . "\u0B30") ; RA
("n" . "\u0B3C") ; NUKTA
@@ -384,6 +529,263 @@ South Indian language Malayalam is supported in this language environment."))
(list (vector (cdr slot) 0 #'font-shape-gstring))))))
char-script-table))
-(provide 'indian)
+;; Brahmi composition rules
+(let ((consonant "[\U00011013-\U00011034]")
+ (non-consonant "[^\U00011013-\U00011034\U00011046\U0001107F]")
+ (vowel "[\U00011038-\U00011045]")
+ (numeral "[\U00011052-\U00011065]")
+ (multiplier "[\U00011064\U00011065]")
+ (virama "\U00011046")
+ (number-joiner "\U0001107F"))
+ (set-char-table-range composition-function-table
+ '(#x11046 . #x11046)
+ (list (vector
+ ;; Consonant conjuncts
+ (concat consonant "\\(?:" virama consonant "\\)+"
+ vowel "?")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowelless consonants
+ (concat consonant virama non-consonant)
+ 1 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#x1107F . #x1107F)
+ (list (vector
+ ;; Additive-multiplicative numerals
+ (concat multiplier number-joiner numeral)
+ 1 'font-shape-gstring))))
+
+;; Kaithi composition rules
+(let ((consonant "[\x1108D-\x110AF]")
+ (nukta "\x110BA")
+ (independent-vowel "[\x11083-\x1108C]")
+ (vowel "[\x1108D-\x110C2]")
+ (nasal "[\x11080\x11081]")
+ (virama "\x110B9")
+ (number-sign "\x110BD")
+ (number-sign-above "\x110CD")
+ (numerals "[\x966-\x96F]+")
+ (zwj "\x200D"))
+ (set-char-table-range composition-function-table
+ '(#x110B0 . #x110BA)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant nukta "?\\(?:" virama zwj "?" consonant
+ nukta "?\\)*\\(?:" virama zwj "?\\|" vowel "*" nukta
+ "?" nasal "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowel based syllables
+ (concat independent-vowel nukta "?" virama "?" vowel "?")
+ 1 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#x110BD . #x110BD)
+ (list (vector
+ ;; Number sign
+ (concat number-sign numerals)
+ 0 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#x110CD . #x110CD)
+ (list (vector
+ ;; Number sign above
+ (concat number-sign-above numerals)
+ 0 'font-shape-gstring))))
+
+;; Tirhuta composition rules
+(let ((consonant "[\x1148F-\x114AF]")
+ (nukta "\x114C3")
+ (independent-vowel "[\x11481-\x1148E]")
+ (vowel "[\x114B0-\x114BE]")
+ (nasal "[\x114BF\x114C0]")
+ (virama "\x114C2"))
+ (set-char-table-range composition-function-table
+ '(#x114B0 . #x114C3)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant nukta "?\\(?:" virama consonant nukta
+ "?\\)*\\(?:" virama "\\|" vowel "*" nukta "?"
+ nasal "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowel based syllables
+ (concat independent-vowel nukta "?" virama "?" vowel "?" nasal "?")
+ 1 'font-shape-gstring))))
+
+;; Sharada composition rules
+(let ((consonant "[\x11191-\x111B2]")
+ (nukta "\x111CA")
+ (independent-vowel "[\x11183-\x11190]")
+ (vowel "[\x111B3-\x111BF\x111CE]")
+ (vowel-modifier "\x111CB")
+ (extra-short-vowel-mark "\x111CC")
+ (nasal "[\x11181\x11180\x111CF]")
+ (virama "\x111C0")
+ (fricatives "[\x111C2\x111C3]")
+ (sandhi-mark "\x111C9")
+ (misc "[\x111C4-\x111C8\x111CD]"))
+ (set-char-table-range composition-function-table
+ '(#x111B3 . #x111CE)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant nukta "?" vowel-modifier "?\\(?:" virama
+ consonant nukta "?" vowel-modifier "?\\)*\\(?:" virama
+ "\\|" vowel "*" nukta "?" nasal "?" extra-short-vowel-mark
+ "?" vowel-modifier "?" sandhi-mark "?+" misc "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowel based syllables
+ (concat independent-vowel nukta "?" vowel-modifier "?" virama "?"
+ vowel "?" extra-short-vowel-mark "?" sandhi-mark "?"
+ fricatives "?" misc "?")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Fricatives with Consonants
+ (concat fricatives "?" consonant vowel "?")
+ 0 'font-shape-gstring))))
+
+;; Siddham composition rules
+(let ((consonant "[\x1158E-\x115AE]")
+ (nukta "\x115C0")
+ (independent-vowel "[\x11580-\x1158D\x115D8-\x115DB]")
+ (vowel "[\x115AF-\x115BB\x115DC\x115DD]")
+ (nasal "[\x115BC\x115BD]")
+ (visarga "\x115BE")
+ (virama "\x115BF"))
+ (set-char-table-range composition-function-table
+ '(#x115AF . #x115C0)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant nukta "?" "\\(?:" virama consonant nukta
+ "?\\)*\\(?:" virama "\\|" vowel "*" nukta "?" nasal
+ "?" visarga "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowels based syllables
+ (concat independent-vowel nukta "?" virama "?" vowel "?"
+ nasal "?" visarga "?")
+ 1 'font-shape-gstring))))
+
+;; Syloti Nagri composition rules
+(let ((consonant "[\xA807-\xA80A\xA80C-\xA822]")
+ (vowel "[\xA802\xA823-\xA827]")
+ (nasal "[\xA80B]")
+ (virama "\xA806")
+ (alternate-virama "\xA82C"))
+ (set-char-table-range composition-function-table
+ '(#xA806 . #xA806)
+ (list (vector
+ ;; Consonant conjunct based syllables
+ (concat consonant "\\(?:" virama consonant "\\)+"
+ vowel "?" nasal "?")
+ 1 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#xA823 . #xA827)
+ (list (vector
+ ;; Non Consonant conjunct based syllables
+ (concat consonant vowel nasal "?")
+ 1 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#xA82C . #xA82C)
+ (list (vector
+ ;; Consonant with the alternate virama
+ (concat consonant "\\(?:" alternate-virama consonant "\\)+"
+ vowel "?" nasal "?")
+ 1 'font-shape-gstring))))
+
+;; Modi composition rules
+(let ((consonant "[\x1160E-\x1162F]")
+ (independent-vowel "[\x11600-\x1160D]")
+ (vowel "[\x11630-\x1163C]")
+ (nasal "\x1163D")
+ (visarga "\x1163E")
+ (virama "\x1163F")
+ (ardhacandra "\x11640"))
+ (set-char-table-range composition-function-table
+ '(#x11630 . #x11640)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant "\\(?:" virama consonant "\\)*\\(?:"
+ virama "\\|" vowel "*" ardhacandra "?" nasal
+ "?" visarga "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowels based syllables
+ (concat independent-vowel virama "?" vowel "?" ardhacandra
+ nasal "?" visarga "?")
+ 1 'font-shape-gstring))))
+
+;; Limbu composition rules
+(let ((consonant "[\x1900-\x191E]")
+ (vowel "[\x1920-\x1928]")
+ (subjoined-letter "[\x1929-\x192B]")
+ (small-letter "[\x1930-\x1938]")
+ (other-signs "[\x1939\x193A]")
+ (sa-i "\x193B"))
+ (set-char-table-range composition-function-table
+ '(#x1920 . #x193B)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant sa-i "?" subjoined-letter "?" small-letter
+ "?" vowel "?" other-signs "?")
+ 1 'font-shape-gstring))))
+
+;; Grantha composition rules
+(let ((consonant "[\x11315-\x11339]")
+ (nukta "\x1133C")
+ (independent-vowel "[\x11305-\x11314\x11360\x11361]")
+ (vowel "[\x1133E-\x1134C\x11357\x11362\x11363]")
+ (nasal "[\x11300-\x11302]")
+ (bindu "\x1133B")
+ (visarga "\x11303")
+ (virama "\x1134D")
+ (avagraha "\x1133D")
+ (modifier-above "[\x11366-\x11374]"))
+ (set-char-table-range composition-function-table
+ '(#x1133B . #x1134D)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant nukta "?" "\\(?:" virama consonant nukta
+ "?\\)*\\(?:" virama "\\|" vowel "*" nukta "?" nasal
+ "?" bindu "?" visarga "?" modifier-above "?"
+ avagraha "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowels based syllables
+ (concat independent-vowel nukta "?" virama "?" vowel "?"
+ nasal "?" bindu "?" visarga "?" modifier-above
+ "?" avagraha "?")
+ 1 'font-shape-gstring))))
+
+;; Lepcha composition rules
+(let ((consonant "[\x1C00-\x1C23\x1C4D-\x1C4F]")
+ (vowel "[\x1C26-\x1C2C]")
+ (subjoined-letter "[\x1C24\x1C25]")
+ (consonant-sign "[\x1C2D-\x1C35]")
+ (other-signs "[\x1C36\x1C37]"))
+ (set-char-table-range composition-function-table
+ '(#x1C24 . #x1C37)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant other-signs "?" vowel "?"
+ consonant-sign "?" subjoined-letter "?"
+ other-signs "?")
+ 1 'font-shape-gstring))))
+
+;; Meetei Mayek composition rules
+(let ((akshara "[\xABC0-\xABE2\xAAE0-\xAAEA]")
+ (vowel "[\xABE3-\xABE9\xAAEB-\xAAEC]")
+ (nasal "\xABEA")
+ (visarga "\xAAF5")
+ (virama "[\xABED\xAAF6]")
+ (heavy-tone "\x11640"))
+ (set-char-table-range composition-function-table
+ '(#xABE3 . #xABED)
+ (list (vector
+ ;; Consonant based syllables
+ (concat akshara "\\(?:" virama akshara "\\)*\\(?:"
+ virama "\\|" vowel "*" nasal "?" visarga "?"
+ heavy-tone "?\\)")
+ 1 'font-shape-gstring))))
+(provide 'indian)
;;; indian.el ends here
diff --git a/lisp/language/indonesian.el b/lisp/language/indonesian.el
new file mode 100644
index 00000000000..699f8192543
--- /dev/null
+++ b/lisp/language/indonesian.el
@@ -0,0 +1,197 @@
+;;; indonesian.el --- Indonesian languages support -*- coding: utf-8; lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: समीर सिंह Sameer Singh <lumarzeli30@gmail.com>
+;; Keywords: multilingual, input method, i18n, Indonesia
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains definitions of Indonesia language environments, and
+;; setups for displaying the scripts used there.
+
+;;; Code:
+
+(set-language-info-alist
+ "Balinese" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "balinese")
+ (sample-text . "Balinese (ᬅᬓ᭄ᬱᬭᬩᬮᬶ) ᬒᬁᬲ᭄ᬯᬲ᭄ᬢ᭄ᬬᬲ᭄ᬢᬸ")
+ (documentation . "\
+Balinese language and its script are supported in this language environment.")))
+
+(set-language-info-alist
+ "Javanese" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "javanese")
+ (sample-text . "Javanese (ꦲꦏ꧀ꦱꦫꦗꦮ) ꦲꦭꦺꦴ")
+ (documentation . "\
+Javanese language and its script are supported in this language environment.")))
+
+(set-language-info-alist
+ "Sundanese" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "sundanese")
+ (sample-text . "Sundanese (ᮃᮊ᮪ᮞᮛᮞᮥᮔ᮪ᮓ) ᮞᮙ᮪ᮕᮥᮛᮞᮥᮔ᮪")
+ (documentation . "\
+Sundanese language and its script are supported in this language environment.")))
+
+(set-language-info-alist
+ "Batak" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "batak")
+ (sample-text . "Batak (ᯘᯮᯒᯗ᯲ᯅᯗᯂ᯲) ᯂᯬᯒᯘ᯲ / ᯔᯧᯐᯬᯀᯱᯐᯬᯀᯱ")
+ (documentation . "\
+Languages that use the Batak script, such as Karo, Toba, Pakpak, Mandailing
+and Simalungun, are supported in this language environment.")))
+
+(set-language-info-alist
+ "Rejang" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "rejang")
+ (sample-text . "Rejang (ꥆꤰ꥓ꤼꤽ ꤽꥍꤺꥏ) ꤸꥉꥐꤺꥉꥂꥎ")
+ (documentation . "\
+Rejang language and its script are supported in this language environment.")))
+
+(set-language-info-alist
+ "Makasar" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "makasar")
+ (sample-text . "Makasar (𑻪𑻢𑻪𑻢) 𑻦𑻤𑻵𑻱")
+ (documentation . "\
+Makassarese language and its script Makasar are supported in this language environment.")))
+
+(set-language-info-alist
+ "Buginese" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "lontara")
+ (sample-text . "Buginese (ᨒᨚᨈᨑ) ᨖᨒᨚ")
+ (documentation . "\
+Buginese language and its script Lontara are supported in this language environment.")))
+
+;; Balinese composition rules
+(let ((consonant "[\x1B13-\x1B33\x1B45-\x1B4B]")
+ (independent-vowel "[\x1B05-\x1B12]")
+ (rerekan "\x1B34")
+ (vowel "[\x1B35-\x1B43]")
+ (modifier-above "[\x1B00-\x1B04]")
+ (adeg-adeg "\x1B44")
+ (musical-symbol "[\x1B6B-\x1B73]"))
+ (set-char-table-range composition-function-table
+ '(#x1B34 . #x1B44)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant rerekan "?\\(?:" adeg-adeg consonant
+ rerekan "?\\)*\\(?:" adeg-adeg "\\|" vowel "*" rerekan
+ "?" modifier-above "?" musical-symbol "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowels based syllables
+ (concat independent-vowel rerekan "?" adeg-adeg "?"
+ vowel "?" modifier-above "?" musical-symbol "?")
+ 1 'font-shape-gstring))))
+
+;; Javanese composition rules
+(let ((consonant "[\xA98F-\xA9B2]")
+ (independent-vowel "[\xA984-\xA98E]")
+ (telu "\xA9B3")
+ (vowel "[\xA9B4-\xA9BC]")
+ (dependant-consonant "[\xA9BD-\xA9BF]")
+ (modifier-above "[\xA980-\xA983]")
+ (pangkon "\xA9C0"))
+ (set-char-table-range composition-function-table
+ '(#xA9B3 . #xA9C0)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant telu "?\\(?:" pangkon consonant
+ telu "?\\)*\\(?:" pangkon "\\|" vowel "*" telu
+ "?" modifier-above "?" dependant-consonant "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowels based syllables
+ (concat independent-vowel telu "?" pangkon "?"
+ vowel "?" modifier-above "?" dependant-consonant "?")
+ 1 'font-shape-gstring))))
+
+;; Sundanese composition rules
+(let ((consonant "[\x1B8A-\x1BA0\x1BAE\x1BAF\x1BBB-\x1BBF]")
+ (independent-vowel "[\x1B83-\x1B89]")
+ (vowel "[\x1BA4-\x1BA9]")
+ (dependant-consonant "[\x1BA1-\x1BA3\x1BAC-\x1BAD]")
+ (modifier-above "[\x1B80-\x1B82]")
+ (virama "[\x1BAA\x1BAB]"))
+ (set-char-table-range composition-function-table
+ '(#x1BA1 . #x1BAD)
+ (list (vector
+ ;; Consonant based syllables
+ (concat consonant "\\(?:" virama consonant
+ "\\)*\\(?:" virama "\\|" vowel "*"
+ modifier-above "?" dependant-consonant "?\\)")
+ 1 'font-shape-gstring)
+ (vector
+ ;; Vowels based syllables
+ (concat independent-vowel virama "?"
+ vowel "?" modifier-above "?" dependant-consonant "?")
+ 1 'font-shape-gstring))))
+
+;; Batak composition rules
+(let ((akshara "[\x1BC0-\x1BE5]")
+ (vowel "[\x1BE7-\x1BEF]")
+ (dependant-consonant "[\x1BF0\x1BF1]")
+ (modifier-above "\x1BE6")
+ (virama "[\x1BF2\x1BF3]"))
+ (set-char-table-range composition-function-table
+ '(#x1BE6 . #x1BF3)
+ (list (vector
+ ;; Akshara based syllables
+ (concat akshara virama "?" vowel "*" modifier-above
+ "?" dependant-consonant "?")
+ 1 'font-shape-gstring))))
+
+;; Rejang composition rules
+(let ((akshara "[\xA930-\xA946]")
+ (vowel "[\xA947-\xA94E]")
+ (dependant-consonant "[\xA94F\xA952]")
+ (virama "\xA953"))
+ (set-char-table-range composition-function-table
+ '(#xA947 . #xA953)
+ (list (vector
+ ;; Akshara based syllables
+ (concat akshara virama "?" vowel "*"
+ dependant-consonant "?")
+ 1 'font-shape-gstring))))
+
+;; Makasar composition rules
+(let ((akshara "[\x11EE0-\x11EF2]")
+ (vowel "[\x11EF3-\x11EF6]"))
+ (set-char-table-range composition-function-table
+ '(#x11EF3 . #x11EF6)
+ (list (vector
+ ;; Akshara based syllables
+ (concat akshara vowel "*")
+ 1 'font-shape-gstring))))
+
+(provide 'indonesian)
+;;; indonesian.el ends here
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 5c545df4840..1861eff15eb 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -59,11 +59,11 @@
(let* ((chars (car l))
(len (length chars))
;; Replace `c', `t', `v' to consonant, tone, and vowel.
- (regexp (mapconcat #'(lambda (c)
- (cond ((= c ?c) consonant)
- ((= c ?t) tone)
- ((= c ?v) vowel-upper-lower)
- (t (string c))))
+ (regexp (mapconcat (lambda (c)
+ (cond ((= c ?c) consonant)
+ ((= c ?t) tone)
+ ((= c ?v) vowel-upper-lower)
+ (t (string c))))
(cdr l) ""))
;; Element of composition-function-table.
(elt (list (vector regexp 1 #'lao-composition-function)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index c8a4821abf7..1e915c2f838 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -1,5 +1,6 @@
;;; misc-lang.el --- support for miscellaneous languages (characters) -*- lexical-binding: t; -*-
+;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -212,6 +213,59 @@ thin (i.e. 1-dot width) space."
(list (vector "[\U00013000-\U0001342E]+"
0 #'font-shape-gstring))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Hanifi Rohingya
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(set-language-info-alist
+ "Hanifi Rohingya" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "hanifi-rohingya")
+ (sample-text . "Hanifi Rohingya (𐴌𐴟𐴇𐴥𐴝𐴚𐴒𐴙𐴝 𐴇𐴝𐴕𐴞𐴉𐴞 𐴓𐴠𐴑𐴤𐴝) 𐴀𐴝𐴏𐴓𐴝𐴀𐴡𐴤𐴛𐴝𐴓𐴝𐴙𐴑𐴟𐴔")
+ (documentation . "\
+Rohingya language and its script Hanifi Rohingya are supported
+in this language environment.")))
+
+;; Hanifi Rohingya composition rules
+(set-char-table-range
+ composition-function-table
+ '(#x10D1D . #x10D27)
+ (list (vector
+ "[\x10D00-\x10D27]+"
+ 1 'font-shape-gstring)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Kharoṣṭhī
+;; Author: Stefan Baums <baums@gandhari.org>
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(set-language-info-alist
+ "Kharoshthi" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "kharoshthi")
+ (sample-text . "Kharoṣṭhī (𐨑𐨪𐨆𐨛𐨁) 𐨣𐨨𐨲𐨪𐨆 𐨐𐨪𐨅𐨨𐨁")
+ (documentation . "\
+Language environment for Gāndhārī, Sanskrit, and other languages
+using the Kharoṣṭhī script.")))
+
+(let ((consonant "[\U00010A00\U00010A10-\U00010A35]")
+ (vowel "[\U00010A01-\U00010A06]")
+ (virama "\U00010A3F")
+ (modifier "[\U00010A0C-\U00010A0F\U00010A38-\U00010A3A]"))
+ (set-char-table-range composition-function-table
+ '(#x10A3F . #x10A3F)
+ (list
+ (vector
+ (concat consonant
+ "\\(?:" virama consonant "\\)*"
+ modifier "*"
+ virama "?"
+ vowel "*"
+ modifier "*")
+ 1 'font-shape-gstring))))
+
(provide 'misc-lang)
;;; misc-lang.el ends here
diff --git a/lisp/language/philippine.el b/lisp/language/philippine.el
new file mode 100644
index 00000000000..e52ad6912cd
--- /dev/null
+++ b/lisp/language/philippine.el
@@ -0,0 +1,96 @@
+;;; philippine.el --- Philippine languages support -*- coding: utf-8; lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: समीर सिंह Sameer Singh <lumarzeli30@gmail.com>
+;; Keywords: multilingual, input method, i18n, Philippines
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains definitions of Philippine language environments, and
+;; setups for displaying the scripts used there.
+
+;;; Code:
+
+(set-language-info-alist
+ "Tagalog" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "tagalog")
+ (sample-text . "Tagalog (ᜊᜌ᜔ᜊᜌᜒᜈ᜔) ᜃᜓᜋᜓᜐ᜔ᜆ")
+ (documentation . "\
+Tagalog language using the Baybayin script is supported in
+this language environment.")))
+
+(set-language-info-alist
+ "Hanunoo" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "hanunoo")
+ (sample-text . "Hanunoo (ᜱᜨᜳᜨᜳᜢ) ᜫᜬᜧ᜴ ᜣᜭᜯᜥ᜴ ᜰᜲᜭᜥ᜴")
+ (documentation . "\
+Philippine Language Hanunoo is supported in this language environment.")))
+
+(set-language-info-alist
+ "Buhid" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "buhid")
+ (documentation . "\
+Philippine Language Buhid is supported in this language environment.")))
+
+(set-language-info-alist
+ "Tagbanwa" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "tagbanwa")
+ (sample-text . "Tagbanwa (ᝦᝪᝯ) ᝫᝩᝬᝥ ᝣᝮᝧᝯ")
+ (documentation . "\
+Philippine Languages Tagbanwa are supported in this language environment.")))
+
+;; Tagalog composition rules
+(let ((akshara "[\x1700-\x1711\x171F]")
+ (vowel "[\x1712\x1713]")
+ (virama "\x1714")
+ (pamudpod "\x1715"))
+ (set-char-table-range composition-function-table
+ '(#x1714 . #x1714)
+ (list (vector
+ ;; Akshara virama syllables
+ (concat akshara virama vowel "?")
+ 1 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#x1715 . #x1715)
+ (list (vector
+ ;; Akshara pamudpod syllables
+ (concat akshara pamudpod vowel "?")
+ 1 'font-shape-gstring))))
+
+;; Hanunoo composition rules
+(let ((akshara "[\x1720-\x1731]")
+ (vowel "[\x1732\x1733]")
+ (pamudpod "\x1734"))
+ (set-char-table-range composition-function-table
+ '(#x1734 . #x1734)
+ (list (vector
+ ;; Akshara pamudpod syllables
+ (concat akshara pamudpod vowel "?")
+ 1 'font-shape-gstring))))
+
+(provide 'philippine)
+;;; philippine.el ends here
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index d11daf0f839..6c004e9495c 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -244,15 +244,13 @@ positions (integers or markers) specifying the region."
;; Thai-word-mode requires functions in the feature `thai-word'.
(require 'thai-word)
-(defvar thai-word-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap forward-word] 'thai-forward-word)
- (define-key map [remap backward-word] 'thai-backward-word)
- (define-key map [remap kill-word] 'thai-kill-word)
- (define-key map [remap backward-kill-word] 'thai-backward-kill-word)
- (define-key map [remap transpose-words] 'thai-transpose-words)
- map)
- "Keymap for `thai-word-mode'.")
+(defvar-keymap thai-word-mode-map
+ :doc "Keymap for `thai-word-mode'."
+ "<remap> <forward-word>" #'thai-forward-word
+ "<remap> <backward-word>" #'thai-backward-word
+ "<remap> <kill-word>" #'thai-kill-word
+ "<remap> <backward-kill-word>" #'thai-backward-kill-word
+ "<remap> <transpose-words>" #'thai-transpose-words)
(define-minor-mode thai-word-mode
"Minor mode to make word-oriented commands aware of Thai words.
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index 6a6289a44c7..60f5f9d2a38 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -82,6 +82,43 @@ This is the same as `thai-tis620' with the addition of no-break-space."
(aset composition-function-table (aref chars i) elt)))
(aset composition-function-table ?ำ '(["[ก-ฯ]." 1 thai-composition-function]))
+;; Tai-Tham
+
+(set-language-info-alist
+ "Northern Thai" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (sample-text .
+ "Northern Thai (ᨣᩣᩴᨾᩮᩬᩥᨦ / ᨽᩣᩈᩣᩃ᩶ᩣ᩠ᨶᨶᩣ) ᩈ᩠ᩅᩢᩔ᩠ᨯᩦᨣᩕᩢ᩠ᨸ")
+ (documentation . t)))
+
+;; From Richard Wordingham <richard.wordingham@ntlworld.com>:
+(defvar tai-tham-composable-pattern
+ (let ((table
+ ;; C is letters, independent vowels, digits, punctuation and symbols.
+ '(("C" . "[\u1A20-\u1A54\u1A80-\u1A89\u1A90-\u1A99\u1AA0-\u1AAD]")
+ ("M" . ; Marks, CGJ, ZWNJ, ZWJ
+ "[\u0324\u034F\u0E49\u0E4A\u0E4B\u1A55-\u1A57\u1A59-\u1A5E\u1A61-\u1A7C\u1A7F\u200C\200D]")
+ ("H" . "\u1A60") ; Sakot
+ ("S" . ; Marks commuting with sakot
+ "[\u0E49-\u0E4B\u0EC9\u0ECB\u1A75-\u1A7C]")
+ ("N" . "\u1A58"))) ; mai kang lai
+ (basic-syllable "C\\(N*\\(M\\|HS*C\\)\\)*")
+ (regexp "X\\(N\\(X\\)?\\)*H?")) ; where X is basic syllable
+ (let ((case-fold-search nil))
+ (setq regexp (replace-regexp-in-string "X" basic-syllable regexp t t))
+ (dolist (elt table)
+ (setq regexp (replace-regexp-in-string (car elt) (cdr elt)
+ regexp t t))))
+ regexp))
+
+(let ((elt (list (vector tai-tham-composable-pattern 0 'font-shape-gstring)
+ )))
+ (set-char-table-range composition-function-table '(#x1A20 . #x1A54) elt)
+ (set-char-table-range composition-function-table '(#x1A80 . #x1A89) elt)
+ (set-char-table-range composition-function-table '(#x1A90 . #x1A99) elt)
+ (set-char-table-range composition-function-table '(#x1AA0 . #x1AAD) elt))
+
(provide 'thai)
;;; thai.el ends here
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 3aff6bddf95..98dad181f40 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1,9 +1,17 @@
-;;; loaddefs.el --- automatically extracted autoloads -*- lexical-binding: t -*-
-;;
+;;; loaddefs.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Commentary:
+
+;; This file will be copied to ldefs-boot.el and checked in
+;; periodically.
+
;;; Code:
+
-;;;### (autoloads nil "5x5" "play/5x5.el" (0 0 0 0))
;;; Generated autoloads from play/5x5.el
(autoload '5x5 "5x5" "\
@@ -30,21 +38,16 @@ Rotate left Calc Solutions \\[5x5-solve-rotate-left]
Rotate right Calc Solutions \\[5x5-solve-rotate-right]
Quit current game \\[5x5-quit-game]
-\(fn &optional SIZE)" t nil)
-
+(fn &optional SIZE)" t nil)
(autoload '5x5-crack-randomly "5x5" "\
Attempt to crack 5x5 using random solutions." t nil)
-
(autoload '5x5-crack-mutating-current "5x5" "\
Attempt to crack 5x5 by mutating the current solution." t nil)
-
(autoload '5x5-crack-mutating-best "5x5" "\
Attempt to crack 5x5 by mutating the best solution." t nil)
-
(autoload '5x5-crack-xor-mutate "5x5" "\
Attempt to crack 5x5 by xoring the current and best solution.
Mutate the result." t nil)
-
(autoload '5x5-crack "5x5" "\
Attempt to find a solution for 5x5.
@@ -53,50 +56,39 @@ two parameters, the first will be a grid vector array that is the current
solution and the second will be the best solution so far. The function
should return a grid vector array that is the new solution.
-\(fn BREEDER)" t nil)
-
+(fn BREEDER)" t nil)
(register-definition-prefixes "5x5" '("5x5-"))
-;;;***
-;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0))
;;; Generated autoloads from vc/add-log.el
(put 'change-log-default-name 'safe-local-variable #'string-or-null-p)
-
(defvar add-log-current-defun-function nil "\
If non-nil, function to guess name of surrounding function.
It is called by `add-log-current-defun' with no argument, and
should return the function's name as a string, or nil if point is
outside a function.")
-
(custom-autoload 'add-log-current-defun-function "add-log" t)
-
(defvar add-log-full-name nil "\
Full name of user, for inclusion in ChangeLog daily headers.
This defaults to the value returned by the function `user-full-name'.")
-
(custom-autoload 'add-log-full-name "add-log" t)
-
(defvar add-log-mailing-address nil "\
Email addresses of user, for inclusion in ChangeLog headers.
This defaults to the value of `user-mail-address'. In addition to
being a simple string, this value can also be a list. All elements
will be recognized as referring to the same user; when creating a new
ChangeLog entry, one element will be chosen at random.")
-
(custom-autoload 'add-log-mailing-address "add-log" t)
-
(autoload 'prompt-for-change-log-name "add-log" "\
Prompt for a change log name." nil nil)
-
(autoload 'find-change-log "add-log" "\
Find a change log file for \\[add-change-log-entry] and return the name.
Optional arg FILE-NAME specifies the file to use.
If FILE-NAME is nil, use the value of `change-log-default-name'.
If `change-log-default-name' is nil, behave as though it were \"ChangeLog\"
-\(or whatever we use on this operating system).
+(or whatever we use on this operating system).
If `change-log-default-name' contains a leading directory component, then
simply find it in the current directory. Otherwise, search in the current
@@ -110,8 +102,7 @@ Once a file is found, `change-log-default-name' is set locally in the
current buffer to the complete file name.
Optional arg BUFFER-FILE overrides `buffer-file-name'.
-\(fn &optional FILE-NAME BUFFER-FILE)" nil nil)
-
+(fn &optional FILE-NAME BUFFER-FILE)" nil nil)
(autoload 'add-change-log-entry "add-log" "\
Find ChangeLog buffer, add an entry for today and an item for this file.
Optional arg WHOAMI (interactive prefix) non-nil means prompt for
@@ -147,15 +138,13 @@ notices.
Today's date is calculated according to `add-log-time-zone-rule' if
non-nil, otherwise in local time.
-\(fn &optional WHOAMI CHANGELOG-FILE-NAME OTHER-WINDOW NEW-ENTRY PUT-NEW-ENTRY-ON-NEW-LINE)" t nil)
-
+(fn &optional WHOAMI CHANGELOG-FILE-NAME OTHER-WINDOW NEW-ENTRY PUT-NEW-ENTRY-ON-NEW-LINE)" t nil)
(autoload 'add-change-log-entry-other-window "add-log" "\
Find change log file in other window and add entry and item.
This is just like `add-change-log-entry' except that it displays
the change log file in another window.
-\(fn &optional WHOAMI FILE-NAME)" t nil)
-
+(fn &optional WHOAMI FILE-NAME)" t nil)
(autoload 'change-log-mode "add-log" "\
Major mode for editing change logs; like Indented Text mode.
Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
@@ -165,8 +154,7 @@ Runs `change-log-mode-hook'.
\\{change-log-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'add-log-current-defun "add-log" "\
Return name of function definition point is in, or nil.
@@ -180,7 +168,6 @@ identifiers followed by `:' or `='. See variables
`add-log-current-defun-function'.
Has a preference of looking backwards." nil nil)
-
(autoload 'change-log-merge "add-log" "\
Merge the contents of change log file OTHER-LOG with this buffer.
Both must be found in Change Log mode (since the merging depends on
@@ -190,13 +177,10 @@ or a buffer.
Entries are inserted in chronological order. Both the current and
old-style time formats for entries are supported.
-\(fn OTHER-LOG)" t nil)
-
+(fn OTHER-LOG)" t nil)
(register-definition-prefixes "add-log" '("add-log-" "change-log-"))
-;;;***
-;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/advice.el
(defvar ad-redefinition-action 'warn "\
@@ -209,9 +193,7 @@ old original, or keep it and raise an error. The values `accept', `discard',
`error' or `warn' govern what will be done. `warn' is just like `accept' but
it additionally prints a warning message. All other values will be
interpreted as `error'.")
-
(custom-autoload 'ad-redefinition-action "advice" t)
-
(defvar ad-default-compilation-action 'maybe "\
Defines whether to compile advised definitions during activation.
A value of `always' will result in unconditional compilation, `never' will
@@ -220,19 +202,15 @@ loaded, and `like-original' will compile if the original definition of the
advised function is compiled or a built-in function. Every other value will
be interpreted as `maybe'. This variable will only be considered if the
COMPILE argument of `ad-activate' was supplied as nil.")
-
(custom-autoload 'ad-default-compilation-action "advice" t)
-
(autoload 'ad-enable-advice "advice" "\
Enables the advice of FUNCTION with CLASS and NAME.
-\(fn FUNCTION CLASS NAME)" t nil)
-
+(fn FUNCTION CLASS NAME)" t nil)
(autoload 'ad-disable-advice "advice" "\
Disable the advice of FUNCTION with CLASS and NAME.
-\(fn FUNCTION CLASS NAME)" t nil)
-
+(fn FUNCTION CLASS NAME)" t nil)
(autoload 'ad-add-advice "advice" "\
Add a piece of ADVICE to FUNCTION's list of advices in CLASS.
@@ -256,8 +234,7 @@ If FUNCTION was not advised already, its advice info will be
initialized. Redefining a piece of advice whose name is part of
the cache-id will clear the cache.
-\(fn FUNCTION ADVICE CLASS POSITION)" nil nil)
-
+(fn FUNCTION ADVICE CLASS POSITION)" nil nil)
(autoload 'ad-activate "advice" "\
Activate all the advice information of an advised FUNCTION.
If FUNCTION has a proper original definition then an advised
@@ -275,8 +252,7 @@ an advised function that has actual pieces of advice but none of them are
enabled is equivalent to a call to `ad-deactivate'. The current advised
definition will always be cached for later usage.
-\(fn FUNCTION &optional COMPILE)" t nil)
-
+(fn FUNCTION &optional COMPILE)" t nil)
(autoload 'defadvice "advice" "\
Define a piece of advice for FUNCTION (a symbol).
The syntax of `defadvice' is as follows:
@@ -323,26 +299,32 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)
-\(fn FUNCTION ARGS &rest BODY)" nil t)
-
-(function-put 'defadvice 'doc-string-elt '3)
-
-(function-put 'defadvice 'lisp-indent-function '2)
-
+(fn FUNCTION ARGS &rest BODY)" nil t)
+(function-put 'defadvice 'doc-string-elt 3)
+(function-put 'defadvice 'lisp-indent-function 2)
(register-definition-prefixes "advice" '("ad-"))
-;;;***
-;;;### (autoloads nil "align" "align.el" (0 0 0 0))
;;; Generated autoloads from align.el
(autoload 'align "align" "\
Attempt to align a region based on a set of alignment rules.
-BEG and END mark the region. If BEG and END are specifically set to
-nil (this can only be done programmatically), the beginning and end of
-the current alignment section will be calculated based on the location
-of point, and the value of `align-region-separate' (or possibly each
-rule's `separate' attribute).
+Interactively, BEG and END are the mark/point of the current region.
+
+Many modes define specific alignment rules, and some of these
+rules in some modes react to the current prefix argument. For
+instance, in `text-mode', \\`M-x align' will align into columns
+based on space delimiters, while \\`C-u -' \\`M-x align' will align
+into columns based on the \"$\" character. See the
+`align-rules-list' variable definition for the specific rules.
+
+Also see `align-regexp', which will guide you through various
+parameters for aligning text.
+
+Non-interactively, if BEG and END are nil, the beginning and end
+of the current alignment section will be calculated based on the
+location of point, and the value of `align-region-separate' (or
+possibly each rule's `separate' attribute).
If SEPARATE is non-nil, it overrides the value of
`align-region-separate' for all rules, except those that have their
@@ -353,13 +335,21 @@ default rule lists defined in `align-rules-list' and
`align-exclude-rules-list'. See `align-rules-list' for more details
on the format of these lists.
-\(fn BEG END &optional SEPARATE RULES EXCLUDE-RULES)" t nil)
-
+(fn BEG END &optional SEPARATE RULES EXCLUDE-RULES)" t nil)
(autoload 'align-regexp "align" "\
Align the current region using an ad-hoc rule read from the minibuffer.
BEG and END mark the limits of the region. Interactively, this function
prompts for the regular expression REGEXP to align with.
+Interactively, if you specify a prefix argument, the function
+will guide you through entering the full regular expression, and
+then prompts for which subexpression parenthesis GROUP (default
+1) within REGEXP to modify, the amount of SPACING (default
+`align-default-spacing') to use, and whether or not to REPEAT the
+rule throughout the line.
+
+See `align-rules-list' for more information about these options.
+
For example, let's say you had a list of phone numbers, and wanted to
align them so that the opening parentheses would line up:
@@ -379,15 +369,8 @@ regular expression after you enter it. Interactively, you only
need to supply the characters to be lined up, and any preceding
whitespace is replaced.
-Non-interactively (or if you specify a prefix argument), you must
-enter the full regular expression, including the subexpression.
-Interactively, the function also then prompts for which
-subexpression parenthesis GROUP (default 1) within REGEXP to
-modify, the amount of SPACING (default `align-default-spacing')
-to use, and whether or not to REPEAT the rule throughout the
-line.
-
-See `align-rules-list' for more information about these options.
+Non-interactively, you must enter the full regular expression,
+including the subexpression.
The non-interactive form of the previous example would look something like:
(align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\")
@@ -395,8 +378,7 @@ The non-interactive form of the previous example would look something like:
This function is a nothing more than a small wrapper that helps you
construct a rule to pass to `align-region', which does the real work.
-\(fn BEG END REGEXP &optional GROUP SPACING REPEAT)" t nil)
-
+(fn BEG END REGEXP &optional GROUP SPACING REPEAT)" t nil)
(autoload 'align-entire "align" "\
Align the selected region as if it were one alignment section.
BEG and END mark the extent of the region. If RULES or EXCLUDE-RULES
@@ -404,8 +386,7 @@ is set to a list of rules (see `align-rules-list'), it can be used to
override the default alignment rules that would have been used to
align that section.
-\(fn BEG END &optional RULES EXCLUDE-RULES)" t nil)
-
+(fn BEG END &optional RULES EXCLUDE-RULES)" t nil)
(autoload 'align-current "align" "\
Call `align' on the current alignment section.
This function assumes you want to align only the current section, and
@@ -414,8 +395,7 @@ EXCLUDE-RULES is set to a list of rules (see `align-rules-list'), it
can be used to override the default alignment rules that would have
been used to align that section.
-\(fn &optional RULES EXCLUDE-RULES)" t nil)
-
+(fn &optional RULES EXCLUDE-RULES)" t nil)
(autoload 'align-highlight-rule "align" "\
Highlight the whitespace which a given rule would have modified.
BEG and END mark the extent of the region. TITLE identifies the rule
@@ -424,31 +404,25 @@ list of rules (see `align-rules-list'), it can be used to override the
default alignment rules that would have been used to identify the text
to be colored.
-\(fn BEG END TITLE &optional RULES EXCLUDE-RULES)" t nil)
-
+(fn BEG END TITLE &optional RULES EXCLUDE-RULES)" t nil)
(autoload 'align-unhighlight-rule "align" "\
Remove any highlighting that was added by `align-highlight-rule'." t nil)
-
(autoload 'align-newline-and-indent "align" "\
A replacement function for `newline-and-indent', aligning as it goes.
The alignment is done by calling `align' on the region that was
indented." t nil)
-
(register-definition-prefixes "align" '("align-"))
-;;;***
-;;;### (autoloads nil "allout" "allout.el" (0 0 0 0))
;;; Generated autoloads from allout.el
-(push (purecopy '(allout 2 3)) package--builtin-versions)
+(push (purecopy '(allout 2 3)) package--builtin-versions)
(autoload 'allout-auto-activation-helper "allout" "\
Institute `allout-auto-activation'.
Intended to be used as the `allout-auto-activation' :set function.
-\(fn VAR VALUE)" nil nil)
-
+(fn VAR VALUE)" nil nil)
(autoload 'allout-setup "allout" "\
Do fundamental Emacs session for allout auto-activation.
@@ -457,7 +431,6 @@ Establishes allout processing as part of visiting a file if
The proper way to use this is through customizing the setting of
`allout-auto-activation'." nil nil)
-
(defvar allout-auto-activation nil "\
Configure allout outline mode auto-activation.
@@ -476,57 +449,26 @@ With value \"activate\", only auto-mode-activation is enabled.
Auto-layout is not.
With value nil, inhibit any automatic allout-mode activation.")
-
(custom-autoload 'allout-auto-activation "allout" nil)
-
(put 'allout-use-hanging-indents 'safe-local-variable #'booleanp)
-
(put 'allout-reindent-bodies 'safe-local-variable (lambda (x) (memq x '(nil t text force))))
-
(put 'allout-show-bodies 'safe-local-variable #'booleanp)
-
(put 'allout-header-prefix 'safe-local-variable #'stringp)
-
(put 'allout-primary-bullet 'safe-local-variable #'stringp)
-
(put 'allout-plain-bullets-string 'safe-local-variable #'stringp)
-
(put 'allout-distinctive-bullets-string 'safe-local-variable #'stringp)
-
(put 'allout-use-mode-specific-leader 'safe-local-variable (lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start)) (stringp x))))
-
(put 'allout-old-style-prefixes 'safe-local-variable #'booleanp)
-
(put 'allout-stylish-prefixes 'safe-local-variable #'booleanp)
-
(put 'allout-numbered-bullet 'safe-local-variable #'string-or-null-p)
-
(put 'allout-file-xref-bullet 'safe-local-variable #'string-or-null-p)
-
(put 'allout-presentation-padding 'safe-local-variable #'integerp)
-
(put 'allout-layout 'safe-local-variable (lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
-
(autoload 'allout-mode-p "allout" "\
Return t if `allout-mode' is active in current buffer." nil t)
-
(autoload 'allout-mode "allout" "\
Toggle Allout outline mode.
-This is a minor mode. If called interactively, toggle the `Allout
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `allout-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
\\<allout-mode-map-value>
Allout outline mode is a minor mode that provides extensive
outline oriented formatting and manipulation. It enables
@@ -674,7 +616,7 @@ When the text cursor is positioned directly on the bullet character of
a topic, regular characters (a to z) invoke the commands of the
corresponding allout-mode keymap control chars. For example, \"f\"
would invoke the command typically bound to \"C-c<space>C-f\"
-\(\\[allout-forward-current-level] `allout-forward-current-level').
+(\\[allout-forward-current-level] `allout-forward-current-level').
Thus, by positioning the cursor on a topic bullet, you can
execute the outline navigation and manipulation commands with a
@@ -687,7 +629,7 @@ replaced with one that makes it easy to get to the hot-spot. If you
repeat it immediately it cycles (if `allout-beginning-of-line-cycles'
is set) to the beginning of the item and then, if you hit it again
immediately, to the hot-spot. Similarly, `allout-beginning-of-current-entry'
-\(\\[allout-beginning-of-current-entry]) moves to the hot-spot when the cursor is already located
+(\\[allout-beginning-of-current-entry]) moves to the hot-spot when the cursor is already located
at the beginning of the current entry.
Extending Allout
@@ -787,34 +729,41 @@ CONCEALED:
CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Allout mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-(defalias 'outlinify-sticky #'outlineify-sticky)
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `allout-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(defalias 'outlinify-sticky #'outlineify-sticky)
(autoload 'outlineify-sticky "allout" "\
Activate outline mode and establish file var so it is started subsequently.
See `allout-layout' and customization of `allout-auto-activation'
for details on preparing Emacs for automatic allout activation.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "allout" '("allout-"))
-;;;***
-;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from allout-widgets.el
-(push (purecopy '(allout-widgets 1 0)) package--builtin-versions)
+(push (purecopy '(allout-widgets 1 0)) package--builtin-versions)
(autoload 'allout-widgets-setup "allout-widgets" "\
Commission or decommission allout-widgets-mode along with allout-mode.
Meant to be used by customization of `allout-widgets-auto-activation'.
-\(fn VARNAME VALUE)" nil nil)
-
+(fn VARNAME VALUE)" nil nil)
(defvar allout-widgets-auto-activation nil "\
Activate to enable allout icon graphics wherever allout mode is active.
@@ -829,28 +778,11 @@ explicitly invoke `allout-widgets-mode' in allout buffers where
you want allout widgets operation.
See `allout-widgets-mode' for allout widgets mode features.")
-
(custom-autoload 'allout-widgets-auto-activation "allout-widgets" nil)
-
(put 'allout-widgets-mode-inhibit 'safe-local-variable #'booleanp)
-
(autoload 'allout-widgets-mode "allout-widgets" "\
Toggle Allout Widgets mode.
-This is a minor mode. If called interactively, toggle the
-`Allout-Widgets mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `allout-widgets-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Allout Widgets mode is an extension of Allout mode that provides
graphical decoration of outline structure. It is meant to
operate along with `allout-mode', via `allout-mode-hook'.
@@ -869,17 +801,32 @@ The bullet-icon and guide line graphics provide keybindings and mouse
bindings for easy outline navigation and exposure control, extending
outline hot-spot navigation (see `allout-mode').
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Allout-Widgets mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `allout-widgets-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "allout-widgets" '("allout-"))
-;;;***
-;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/analyze.el
+
+(register-definition-prefixes "semantic/analyze" '("semantic-a"))
+
+
;;; Generated autoloads from net/ange-ftp.el
(defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
-
(autoload 'ange-ftp-reread-dir "ange-ftp" "\
Reread remote directory DIR to update the directory cache.
The implementation of remote FTP file names caches directory contents
@@ -887,18 +834,14 @@ for speed. Therefore, when new remote files are created, Emacs
may not know they exist. You can use this command to reread a specific
directory, so that Emacs will know its current contents.
-\(fn &optional DIR)" t nil)
-
+(fn &optional DIR)" t nil)
(autoload 'ange-ftp-hook-function "ange-ftp" "\
-\(fn OPERATION &rest ARGS)" nil nil)
-
+(fn OPERATION &rest ARGS)" nil nil)
(register-definition-prefixes "ange-ftp" '("ange-ftp-" "ftp-error" "internal-ange-ftp-mode"))
-;;;***
-;;;### (autoloads nil "animate" "play/animate.el" (0 0 0 0))
;;; Generated autoloads from play/animate.el
(autoload 'animate-string "animate" "\
@@ -909,8 +852,7 @@ passing through `animate-n-steps' positions before the final ones.
If HPOS is nil (or omitted), center the string horizontally
in the current window.
-\(fn STRING VPOS &optional HPOS)" nil nil)
-
+(fn STRING VPOS &optional HPOS)" nil nil)
(autoload 'animate-sequence "animate" "\
Display animation strings from LIST-OF-STRING with buffer *Animation*.
Strings will be separated from each other by SPACE lines.
@@ -918,27 +860,22 @@ Strings will be separated from each other by SPACE lines.
animation in the buffer named by variable's value, creating the
buffer if one does not exist.
-\(fn LIST-OF-STRINGS SPACE)" nil nil)
-
+(fn LIST-OF-STRINGS SPACE)" nil nil)
(autoload 'animate-birthday-present "animate" "\
Return a birthday present in the buffer *Birthday-Present*.
When optional arg NAME is non-nil or called-interactively, prompt for
NAME of birthday present receiver and return a birthday present in
the buffer *Birthday-Present-for-Name*.
-\(fn &optional NAME)" t nil)
-
+(fn &optional NAME)" t nil)
(register-definition-prefixes "animate" '("animat"))
-;;;***
-;;;### (autoloads nil "ansi-color" "ansi-color.el" (0 0 0 0))
;;; Generated autoloads from ansi-color.el
-(push (purecopy '(ansi-color 3 4 2)) package--builtin-versions)
+(push (purecopy '(ansi-color 3 4 2)) package--builtin-versions)
(autoload 'ansi-color-for-comint-mode-on "ansi-color" "\
Set `ansi-color-for-comint-mode' to t." t nil)
-
(autoload 'ansi-color-process-output "ansi-color" "\
Maybe translate SGR control sequences of comint output into text properties.
@@ -952,22 +889,17 @@ The comint output is assumed to lie between the marker
This is a good function to put in `comint-output-filter-functions'.
-\(fn IGNORED)" nil nil)
-
+(fn IGNORED)" nil nil)
(autoload 'ansi-color-compilation-filter "ansi-color" "\
Maybe translate SGR control sequences into text properties.
This function depends on the `ansi-color-for-compilation-mode'
variable, and is meant to be used in `compilation-filter-hook'." nil nil)
-
(register-definition-prefixes "ansi-color" '("ansi-color-"))
-;;;***
-;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from progmodes/antlr-mode.el
-(push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions)
+(push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions)
(autoload 'antlr-show-makefile-rules "antlr-mode" "\
Show Makefile rules for all grammar files in the current directory.
If the `major-mode' of the current buffer has the value `makefile-mode',
@@ -984,21 +916,16 @@ If the file for a super-grammar cannot be determined, special file names
are used according to variable `antlr-unknown-file-formats' and a
commentary with value `antlr-help-unknown-file-text' is added. The
*Help* buffer always starts with the text in `antlr-help-rules-intro'." t nil)
-
(autoload 'antlr-mode "antlr-mode" "\
Major mode for editing ANTLR grammar files.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'antlr-set-tabs "antlr-mode" "\
Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'.
Used in `antlr-mode'. Also a useful function in `java-mode-hook'." nil nil)
-
(register-definition-prefixes "antlr-mode" '("antlr-"))
-;;;***
-;;;### (autoloads nil "appt" "calendar/appt.el" (0 0 0 0))
;;; Generated autoloads from calendar/appt.el
(autoload 'appt-add "appt" "\
@@ -1008,20 +935,16 @@ Optional argument WARNTIME is an integer (or string) giving the number
of minutes before the appointment at which to start warning.
The default is `appt-message-warning-time'.
-\(fn TIME MSG &optional WARNTIME)" t nil)
-
+(fn TIME MSG &optional WARNTIME)" t nil)
(autoload 'appt-activate "appt" "\
Toggle checking of appointments.
With optional numeric argument ARG, turn appointment checking on if
ARG is positive, otherwise off.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "appt" '("appt-"))
-;;;***
-;;;### (autoloads nil "apropos" "apropos.el" (0 0 0 0))
;;; Generated autoloads from apropos.el
(autoload 'apropos-read-pattern "apropos" "\
@@ -1032,8 +955,7 @@ literally, or a string which is used as a regexp to search for.
SUBJECT is a string that is included in the prompt to identify what
kind of objects to search.
-\(fn SUBJECT)" nil nil)
-
+(fn SUBJECT)" nil nil)
(autoload 'apropos-user-option "apropos" "\
Show user options that match PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@@ -1044,16 +966,14 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show
variables, not just user options.
-\(fn PATTERN &optional DO-ALL)" t nil)
-
+(fn PATTERN &optional DO-ALL)" t nil)
(autoload 'apropos-variable "apropos" "\
Show variables that match PATTERN.
With the optional argument DO-NOT-ALL non-nil (or when called
interactively with the prefix \\[universal-argument]), show user
options only, i.e. behave like `apropos-user-option'.
-\(fn PATTERN &optional DO-NOT-ALL)" t nil)
-
+(fn PATTERN &optional DO-NOT-ALL)" t nil)
(autoload 'apropos-local-variable "apropos" "\
Show buffer-local variables that match PATTERN.
Optional arg BUFFER (default: current buffer) is the buffer to check.
@@ -1061,8 +981,7 @@ Optional arg BUFFER (default: current buffer) is the buffer to check.
The output includes variables that are not yet set in BUFFER, but that
will be buffer-local when set.
-\(fn PATTERN &optional BUFFER)" t nil)
-
+(fn PATTERN &optional BUFFER)" t nil)
(autoload 'apropos-function "apropos" "\
Show functions that match PATTERN.
@@ -1074,10 +993,8 @@ search for matches for any two (or more) of those words.
This is the same as running `apropos-command' with a \\[universal-argument] prefix,
or a non-nil `apropos-do-all' argument.
-\(fn PATTERN)" t nil)
-
+(fn PATTERN)" t nil)
(defalias 'command-apropos #'apropos-command)
-
(autoload 'apropos-command "apropos" "\
Show commands (interactively callable functions) that match PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@@ -1094,13 +1011,11 @@ satisfy the predicate VAR-PREDICATE.
When called from a Lisp program, a string PATTERN is used as a regexp,
while a list of strings is used as a word list.
-\(fn PATTERN &optional DO-ALL VAR-PREDICATE)" t nil)
-
+(fn PATTERN &optional DO-ALL VAR-PREDICATE)" t nil)
(autoload 'apropos-documentation-property "apropos" "\
Like (documentation-property SYMBOL PROPERTY RAW) but handle errors.
-\(fn SYMBOL PROPERTY RAW)" nil nil)
-
+(fn SYMBOL PROPERTY RAW)" nil nil)
(autoload 'apropos "apropos" "\
Show all meaningful Lisp symbols whose names match PATTERN.
Symbols are shown if they are defined as functions, variables, or
@@ -1116,16 +1031,17 @@ consider all symbols (if they match PATTERN).
Return list of symbols and documentation found.
-\(fn PATTERN &optional DO-ALL)" t nil)
+The *Apropos* window will be selected if `help-window-select' is
+non-nil.
+(fn PATTERN &optional DO-ALL)" t nil)
(autoload 'apropos-library "apropos" "\
List the variables and functions defined by library FILE.
FILE should be one of the libraries currently loaded and should
thus be found in `load-history'. If `apropos-do-all' is non-nil,
the output includes key-bindings of commands.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'apropos-value "apropos" "\
Show all symbols whose value's printed representation matches PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@@ -1139,15 +1055,13 @@ names and values of properties.
Returns list of symbols and values found.
-\(fn PATTERN &optional DO-ALL)" t nil)
-
+(fn PATTERN &optional DO-ALL)" t nil)
(autoload 'apropos-local-value "apropos" "\
Show buffer-local variables whose values match PATTERN.
This is like `apropos-value', but only for buffer-local variables.
Optional arg BUFFER (default: current buffer) is the buffer to check.
-\(fn PATTERN &optional BUFFER)" t nil)
-
+(fn PATTERN &optional BUFFER)" t nil)
(autoload 'apropos-documentation "apropos" "\
Show symbols whose documentation contains matches for PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@@ -1162,13 +1076,10 @@ documentation strings.
Returns list of symbols and documentation found.
-\(fn PATTERN &optional DO-ALL)" t nil)
-
+(fn PATTERN &optional DO-ALL)" t nil)
(register-definition-prefixes "apropos" '("apropos-"))
-;;;***
-;;;### (autoloads nil "arc-mode" "arc-mode.el" (0 0 0 0))
;;; Generated autoloads from arc-mode.el
(autoload 'archive-mode "arc-mode" "\
@@ -1184,13 +1095,15 @@ archive.
\\{archive-mode-map}
-\(fn &optional FORCE)" nil nil)
-
+(fn &optional FORCE)" nil nil)
(register-definition-prefixes "arc-mode" '("arc"))
-;;;***
-;;;### (autoloads nil "array" "array.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/args.el
+
+(register-definition-prefixes "srecode/args" '("srecode-"))
+
+
;;; Generated autoloads from array.el
(autoload 'array-mode "array" "\
@@ -1260,32 +1173,15 @@ take a numeric prefix argument):
Entering array mode calls the function `array-mode-hook'.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward"))
-;;;***
-;;;### (autoloads nil "artist" "textmodes/artist.el" (0 0 0 0))
;;; Generated autoloads from textmodes/artist.el
(autoload 'artist-mode "artist" "\
Toggle Artist mode.
-This is a minor mode. If called interactively, toggle the `Artist
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `artist-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Artist lets you draw lines, squares, rectangles and poly-lines,
ellipses and circles with your mouse and/or keyboard.
@@ -1481,13 +1377,24 @@ Keymap summary
\\{artist-mode-map}
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Artist mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `artist-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "artist" '("artist-"))
-;;;***
-;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (0 0 0 0))
;;; Generated autoloads from progmodes/asm-mode.el
(autoload 'asm-mode "asm-mode" "\
@@ -1510,21 +1417,16 @@ Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization.
Special commands:
\\{asm-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "asm-mode" '("asm-"))
-;;;***
-;;;### (autoloads nil "auth-source" "auth-source.el" (0 0 0 0))
;;; Generated autoloads from auth-source.el
(defvar auth-source-cache-expiry 7200 "\
How many seconds passwords are cached, or nil to disable expiring.
Overrides `password-cache-expiry' through a let-binding.")
-
(custom-autoload 'auth-source-cache-expiry "auth-source" t)
-
(autoload 'authinfo-mode "auth-source" "\
Mode for editing .authinfo/.netrc files.
@@ -1534,20 +1436,15 @@ point is moved into the passwords (see `authinfo-hide-elements').
\\{authinfo-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "auth-source" '("auth"))
-;;;***
-;;;### (autoloads nil "auth-source-pass" "auth-source-pass.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from auth-source-pass.el
-(push (purecopy '(auth-source-pass 5 0 0)) package--builtin-versions)
+(push (purecopy '(auth-source-pass 5 0 0)) package--builtin-versions)
(autoload 'auth-source-pass-enable "auth-source-pass" "\
Enable auth-source-password-store." nil nil)
-
(autoload 'auth-source-pass-get "auth-source-pass" "\
Return the value associated to KEY in the password-store entry ENTRY.
@@ -1561,110 +1458,41 @@ secret
key1: value1
key2: value2
-\(fn KEY ENTRY)" nil nil)
-
+(fn KEY ENTRY)" nil nil)
(register-definition-prefixes "auth-source-pass" '("auth-source-pass-"))
-;;;***
-;;;### (autoloads nil "autoarg" "autoarg.el" (0 0 0 0))
-;;; Generated autoloads from autoarg.el
-
-(defvar autoarg-mode nil "\
-Non-nil if Autoarg mode is enabled.
-See the `autoarg-mode' command
-for a description of this minor mode.")
-
-(custom-autoload 'autoarg-mode "autoarg" nil)
-
-(autoload 'autoarg-mode "autoarg" "\
-Toggle Autoarg mode, a global minor mode.
-
-\\<autoarg-mode-map>
-In Autoarg mode, digits are bound to `digit-argument', i.e. they
-supply prefix arguments as C-DIGIT and M-DIGIT normally do.
-Furthermore, C-DIGIT inserts DIGIT.
-\\[autoarg-terminate] terminates the prefix sequence and inserts
-the digits of the autoarg sequence into the buffer.
-Without a numeric prefix arg, the normal binding of \\[autoarg-terminate]
-is invoked, i.e. what it would be with Autoarg mode off.
-
-For example:
-`6 9 \\[autoarg-terminate]' inserts `69' into the buffer, as does `C-6 C-9'.
-`6 9 a' inserts 69 `a's into the buffer.
-`6 9 \\[autoarg-terminate] \\[autoarg-terminate]' inserts `69' into the buffer and
-then invokes the normal binding of \\[autoarg-terminate].
-`\\[universal-argument] \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times.
-
-\\{autoarg-mode-map}
-
-\(fn &optional ARG)" t nil)
-
-(defvar autoarg-kp-mode nil "\
-Non-nil if Autoarg-Kp mode is enabled.
-See the `autoarg-kp-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `autoarg-kp-mode'.")
-
-(custom-autoload 'autoarg-kp-mode "autoarg" nil)
-
-(autoload 'autoarg-kp-mode "autoarg" "\
-Toggle Autoarg-KP mode, a global minor mode.
-
-This is a minor mode. If called interactively, toggle the `Autoarg-Kp
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='autoarg-kp-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\\<autoarg-kp-mode-map>
-This is similar to `autoarg-mode' but rebinds the keypad keys
-`kp-1' etc. to supply digit arguments.
-
-\\{autoarg-kp-mode-map}
-
-\(fn &optional ARG)" t nil)
+;;; Generated autoloads from cedet/ede/auto.el
-(register-definition-prefixes "autoarg" '("autoarg-"))
+(register-definition-prefixes "ede/auto" '("ede-"))
-;;;***
-;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (0 0 0 0))
;;; Generated autoloads from progmodes/autoconf.el
(autoload 'autoconf-mode "autoconf" "\
Major mode for editing Autoconf configure.ac files.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "autoconf" '("autoconf-"))
-;;;***
-;;;### (autoloads nil "autoinsert" "autoinsert.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/autoconf-edit.el
+
+(register-definition-prefixes "ede/autoconf-edit" '("autoconf-"))
+
+
;;; Generated autoloads from autoinsert.el
(autoload 'auto-insert "autoinsert" "\
Insert default contents into new files if variable `auto-insert' is non-nil.
Matches the visited file name against the elements of `auto-insert-alist'." t nil)
-
(autoload 'define-auto-insert "autoinsert" "\
Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
Optional AFTER means to insert action after all existing actions for CONDITION,
or if CONDITION had no actions, after all other CONDITIONs.
-\(fn CONDITION ACTION &optional AFTER)" nil nil)
-
+(fn CONDITION ACTION &optional AFTER)" nil nil)
+(function-put 'define-auto-insert 'lisp-indent-function 'defun)
(defvar auto-insert-mode nil "\
Non-nil if Auto-Insert mode is enabled.
See the `auto-insert-mode' command
@@ -1672,45 +1500,34 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `auto-insert-mode'.")
-
(custom-autoload 'auto-insert-mode "autoinsert" nil)
-
(autoload 'auto-insert-mode "autoinsert" "\
Toggle Auto-insert mode, a global minor mode.
-This is a minor mode. If called interactively, toggle the
-`Auto-Insert mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+When Auto-insert mode is enabled, when new files are created you can
+insert a template for the file depending on the mode of the buffer.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+This is a global minor mode. If called interactively, toggle the
+`Auto-Insert mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='auto-insert-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-When Auto-insert mode is enabled, when new files are created you can
-insert a template for the file depending on the mode of the buffer.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "autoinsert" '("auto-insert"))
-;;;***
-;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emacs-lisp/autoload.el
-(put 'generated-autoload-file 'safe-local-variable 'stringp)
-
-(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
-
(put 'autoload-ensure-writable 'risky-local-variable t)
-
(autoload 'update-file-autoloads "autoload" "\
Update the autoloads for FILE.
If prefix arg SAVE-AFTER is non-nil, save the buffer too.
@@ -1723,8 +1540,7 @@ existing value of `generated-autoload-file'.
Return FILE if there was no autoload cookie in it, else nil.
-\(fn FILE &optional SAVE-AFTER OUTFILE)" t nil)
-
+(fn FILE &optional SAVE-AFTER OUTFILE)" t nil)
(autoload 'update-directory-autoloads "autoload" "\
Update autoload definitions for Lisp files in the directories DIRS.
In an interactive call, you must give one argument, the name of a
@@ -1740,10 +1556,8 @@ value of `generated-autoload-file'. If any Lisp file binds
`generated-autoload-file' as a file-local variable, write its
autoloads into the specified file instead.
-\(fn &rest DIRS)" t nil)
-
-(make-obsolete 'update-directory-autoloads 'make-directory-autoloads '"28.1")
-
+(fn &rest DIRS)" t nil)
+(make-obsolete 'update-directory-autoloads 'make-directory-autoloads "28.1")
(autoload 'make-directory-autoloads "autoload" "\
Update autoload definitions for Lisp files in the directories DIRS.
DIR can be either a single directory or a list of
@@ -1756,38 +1570,20 @@ its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
directory or directories specified.
-\(fn DIR OUTPUT-FILE)" t nil)
-
+(fn DIR OUTPUT-FILE)" t nil)
(autoload 'batch-update-autoloads "autoload" "\
Update loaddefs.el autoloads in batch mode.
Calls `update-directory-autoloads' on the command line arguments.
Definitions are written to `generated-autoload-file' (which
should be non-nil)." nil nil)
+(register-definition-prefixes "autoload" '("autoload-" "batch-update-autoloads--summary" "generate-" "make-autoload" "no-update-autoloads"))
-(register-definition-prefixes "autoload" '("autoload-" "batch-update-autoloads--summary" "generate" "make-autoload" "no-update-autoloads"))
-
-;;;***
-;;;### (autoloads nil "autorevert" "autorevert.el" (0 0 0 0))
;;; Generated autoloads from autorevert.el
(autoload 'auto-revert-mode "autorevert" "\
Toggle reverting buffer when the file changes (Auto-Revert Mode).
-This is a minor mode. If called interactively, toggle the
-`Auto-Revert mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `auto-revert-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Auto-Revert Mode is a minor mode that affects only the current
buffer. When enabled, it reverts the buffer when the file on
disk changes.
@@ -1803,31 +1599,29 @@ Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Auto-Revert mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `auto-revert-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'turn-on-auto-revert-mode "autorevert" "\
Turn on Auto-Revert Mode.
This function is designed to be added to hooks, for example:
(add-hook \\='c-mode-hook #\\='turn-on-auto-revert-mode)" nil nil)
-
(autoload 'auto-revert-tail-mode "autorevert" "\
Toggle reverting tail of buffer when the file grows.
-This is a minor mode. If called interactively, toggle the
-`Auto-Revert-Tail mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `auto-revert-tail-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When Auto-Revert Tail Mode is enabled, the tail of the file is
constantly followed, as with the shell command `tail -f'. This
means that whenever the file grows on disk (presumably because
@@ -1843,14 +1637,27 @@ suppressed by setting `auto-revert-verbose' to nil.
Use `auto-revert-mode' for changes other than appends!
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Auto-Revert-Tail mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `auto-revert-tail-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'turn-on-auto-revert-tail-mode "autorevert" "\
Turn on Auto-Revert Tail Mode.
This function is designed to be added to hooks, for example:
(add-hook \\='my-logfile-mode-hook #\\='turn-on-auto-revert-tail-mode)" nil nil)
-
(defvar global-auto-revert-mode nil "\
Non-nil if Global Auto-Revert mode is enabled.
See the `global-auto-revert-mode' command
@@ -1858,26 +1665,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-auto-revert-mode'.")
-
(custom-autoload 'global-auto-revert-mode "autorevert" nil)
-
(autoload 'global-auto-revert-mode "autorevert" "\
Toggle Global Auto-Revert Mode.
-This is a minor mode. If called interactively, toggle the `Global
-Auto-Revert mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='global-auto-revert-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Global Auto-Revert Mode is a global minor mode that reverts any
buffer associated with a file when the file changes on disk. Use
`auto-revert-mode' to revert a particular buffer.
@@ -1895,21 +1686,30 @@ This function calls the hook `global-auto-revert-mode-hook'.
It displays the text that `global-auto-revert-mode-text'
specifies in the mode line.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Global Auto-Revert mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='global-auto-revert-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-"))
-;;;***
-;;;### (autoloads nil "avl-tree" "emacs-lisp/avl-tree.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emacs-lisp/avl-tree.el
(register-definition-prefixes "avl-tree" '("avl-tree-"))
-;;;***
-;;;### (autoloads nil "avoid" "avoid.el" (0 0 0 0))
;;; Generated autoloads from avoid.el
(defvar mouse-avoidance-mode nil "\
@@ -1917,9 +1717,7 @@ Activate Mouse Avoidance mode.
See function `mouse-avoidance-mode' for possible values.
Setting this variable directly does not take effect;
use either \\[customize] or \\[mouse-avoidance-mode].")
-
(custom-autoload 'mouse-avoidance-mode "avoid" nil)
-
(autoload 'mouse-avoidance-mode "avoid" "\
Set Mouse Avoidance mode to MODE.
MODE should be one of the symbols `banish', `exile', `jump', `animate',
@@ -1939,34 +1737,31 @@ Effects of the different modes:
* cat-and-mouse: Same as `animate'.
* proteus: As `animate', but changes the shape of the mouse pointer too.
-\(See `mouse-avoidance-threshold' for definition of \"too close\",
+(See `mouse-avoidance-threshold' for definition of \"too close\",
and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for
definition of \"random distance\".)
-\(fn &optional MODE)" t nil)
-
+(fn &optional MODE)" t nil)
(register-definition-prefixes "avoid" '("mouse-avoidance-"))
-;;;***
-;;;### (autoloads nil "backtrace" "emacs-lisp/backtrace.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/backtrace.el
-(push (purecopy '(backtrace 1 0)) package--builtin-versions)
+(push (purecopy '(backtrace 1 0)) package--builtin-versions)
(autoload 'backtrace "backtrace" "\
Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'." nil nil)
-
(register-definition-prefixes "backtrace" '("backtrace-"))
-;;;***
-;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/base.el
+
+(register-definition-prefixes "ede/base" '("ede-"))
+
+
;;; Generated autoloads from progmodes/bat-mode.el
(add-to-list 'auto-mode-alist '("\\.\\(bat\\|cmd\\)\\'" . bat-mode))
-
(autoload 'bat-mode "bat-mode" "\
Major mode for editing DOS/Windows batch files.
Start a new script from `bat-template'. Read help pages for DOS commands
@@ -1975,21 +1770,17 @@ Run script using `bat-run' and `bat-run-args'.
\\{bat-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "bat-mode" '("bat-"))
-;;;***
-;;;### (autoloads nil "battery" "battery.el" (0 0 0 0))
;;; Generated autoloads from battery.el
- (put 'battery-mode-line-string 'risky-local-variable t)
+ (put 'battery-mode-line-string 'risky-local-variable t)
(autoload 'battery "battery" "\
Display battery status information in the echo area.
The text being displayed in the echo area is controlled by the variables
`battery-echo-area-format' and `battery-status-function'." t nil)
-
(defvar display-battery-mode nil "\
Non-nil if Display-Battery mode is enabled.
See the `display-battery-mode' command
@@ -1997,39 +1788,37 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `display-battery-mode'.")
-
(custom-autoload 'display-battery-mode "battery" nil)
-
(autoload 'display-battery-mode "battery" "\
Toggle battery status display in mode line (Display Battery mode).
-This is a minor mode. If called interactively, toggle the
+The text displayed in the mode line is controlled by
+`battery-mode-line-format' and `battery-status-function'.
+The mode line is be updated every `battery-update-interval'
+seconds.
+
+The function which updates the mode-line display will call the
+functions in `battery-update-functions', which can be used to
+trigger actions based on battery-related events.
+
+This is a global minor mode. If called interactively, toggle the
`Display-Battery mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='display-battery-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-The text displayed in the mode line is controlled by
-`battery-mode-line-format' and `battery-status-function'.
-The mode line is be updated every `battery-update-interval'
-seconds.
-
-\(fn &optional ARG)" t nil)
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "battery" '("battery-" "my-"))
-(register-definition-prefixes "battery" '("battery-"))
-
-;;;***
-;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/benchmark.el
(autoload 'benchmark-call "benchmark" "\
@@ -2044,8 +1833,7 @@ specifies a minimum number of seconds that the benchmark execution
should take. In that case the return value is prepended with the
number of repetitions actually used.
-\(fn FUNC &optional REPETITIONS)" nil nil)
-
+(fn FUNC &optional REPETITIONS)" nil nil)
(autoload 'benchmark-run "benchmark" "\
Time execution of FORMS.
If REPETITIONS is supplied as a number, run FORMS that many times,
@@ -2055,20 +1843,16 @@ Return a list of the total elapsed time for execution, the number of
garbage collections that ran, and the time taken by garbage collection.
See also `benchmark-run-compiled'.
-\(fn &optional REPETITIONS &rest FORMS)" nil t)
-
-(function-put 'benchmark-run 'lisp-indent-function '1)
-
+(fn &optional REPETITIONS &rest FORMS)" nil t)
+(function-put 'benchmark-run 'lisp-indent-function 1)
(autoload 'benchmark-run-compiled "benchmark" "\
Time execution of compiled version of FORMS.
This is like `benchmark-run', but what is timed is a funcall of the
byte code obtained by wrapping FORMS in a `lambda' and compiling the
result. The overhead of the `lambda's is accounted for.
-\(fn &optional REPETITIONS &rest FORMS)" nil t)
-
-(function-put 'benchmark-run-compiled 'lisp-indent-function '1)
-
+(fn &optional REPETITIONS &rest FORMS)" nil t)
+(function-put 'benchmark-run-compiled 'lisp-indent-function 1)
(autoload 'benchmark "benchmark" "\
Print the time taken for REPETITIONS executions of FORM.
Interactively, REPETITIONS is taken from the prefix arg, and
@@ -2078,28 +1862,21 @@ For non-interactive use see also `benchmark-run' and
FORM can also be a function in which case we measure the time it takes
to call it without any argument.
-\(fn REPETITIONS FORM)" t nil)
-
+(fn REPETITIONS FORM)" t nil)
(autoload 'benchmark-progn "benchmark" "\
Evaluate BODY and message the time taken.
The return value is the value of the final form in BODY.
-\(fn &rest BODY)" nil t)
-
-(function-put 'benchmark-progn 'lisp-indent-function '0)
-
+(fn &rest BODY)" nil t)
+(function-put 'benchmark-progn 'lisp-indent-function 0)
(register-definition-prefixes "benchmark" '("benchmark-"))
-;;;***
-;;;### (autoloads nil "bib-mode" "textmodes/bib-mode.el" (0 0 0 0))
;;; Generated autoloads from textmodes/bib-mode.el
(register-definition-prefixes "bib-mode" '("addbib" "bib-" "mark-bib" "return-key-bib" "unread-bib"))
-;;;***
-;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (0 0 0 0))
;;; Generated autoloads from textmodes/bibtex.el
(autoload 'bibtex-initialize "bibtex" "\
@@ -2116,8 +1893,7 @@ When called interactively, FORCE is t, CURRENT is t if current buffer
visits a file using `bibtex-mode', and SELECT is t if current buffer
does not use `bibtex-mode'.
-\(fn &optional CURRENT FORCE SELECT)" t nil)
-
+(fn &optional CURRENT FORCE SELECT)" t nil)
(autoload 'bibtex-mode "bibtex" "\
Major mode for editing BibTeX files.
@@ -2171,8 +1947,7 @@ if that value is non-nil.
\\{bibtex-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'bibtex-search-entry "bibtex" "\
Move point to the beginning of BibTeX entry named KEY.
Return position of entry if KEY is found or nil if not found.
@@ -2186,59 +1961,44 @@ Also, GLOBAL is t if the current mode is not `bibtex-mode'
or `bibtex-search-entry-globally' is non-nil.
A prefix arg negates the value of `bibtex-search-entry-globally'.
-\(fn KEY &optional GLOBAL START DISPLAY)" t nil)
-
+(fn KEY &optional GLOBAL START DISPLAY)" t nil)
(register-definition-prefixes "bibtex" '("bibtex-"))
-;;;***
-;;;### (autoloads nil "bibtex-style" "textmodes/bibtex-style.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/bibtex-style.el
(autoload 'bibtex-style-mode "bibtex-style" "\
Major mode for editing BibTeX style files.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "bibtex-style" '("bibtex-style-"))
-;;;***
-;;;### (autoloads nil "bindat" "emacs-lisp/bindat.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/bindat.el
(register-definition-prefixes "bindat" '("bindat-"))
-;;;***
-;;;### (autoloads nil "binhex" "mail/binhex.el" (0 0 0 0))
;;; Generated autoloads from mail/binhex.el
(defconst binhex-begin-line "^:...............................................................$" "\
Regular expression matching the start of a BinHex encoded region.")
-
(autoload 'binhex-decode-region-internal "binhex" "\
Binhex decode region between START and END without using an external program.
If HEADER-ONLY is non-nil only decode header and return filename.
-\(fn START END &optional HEADER-ONLY)" t nil)
-
+(fn START END &optional HEADER-ONLY)" t nil)
(autoload 'binhex-decode-region-external "binhex" "\
Binhex decode region between START and END using external decoder.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'binhex-decode-region "binhex" "\
Binhex decode region between START and END.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(register-definition-prefixes "binhex" '("binhex-"))
-;;;***
-;;;### (autoloads nil "blackbox" "play/blackbox.el" (0 0 0 0))
;;; Generated autoloads from play/blackbox.el
(autoload 'blackbox "blackbox" "\
@@ -2353,27 +2113,23 @@ H * * * O - - - - - - - - - - - - - - - - - - - -
Be sure to compare the second example of a hit with the first example of
a reflection.
-\(fn NUM)" t nil)
-
+(fn NUM)" t nil)
(register-definition-prefixes "blackbox" '("bb-" "blackbox-"))
-;;;***
-;;;### (autoloads nil "bookmark" "bookmark.el" (0 0 0 0))
;;; Generated autoloads from bookmark.el
- (define-key ctl-x-r-map "b" 'bookmark-jump)
- (define-key ctl-x-r-map "m" 'bookmark-set)
- (define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite)
- (define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
-(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "D" 'bookmark-delete-all) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\
+ (keymap-set ctl-x-r-map "b" #'bookmark-jump)
+ (keymap-set ctl-x-r-map "m" #'bookmark-set)
+ (keymap-set ctl-x-r-map "M" #'bookmark-set-no-overwrite)
+ (keymap-set ctl-x-r-map "l" #'bookmark-bmenu-list)
+(defvar-keymap bookmark-map :doc "\
Keymap containing bindings to bookmark functions.
It is not bound to any key by default: to bind it
so that you have a bookmark prefix, just use `global-set-key' and bind a
key of your choice to variable `bookmark-map'. All interactive bookmark
-functions have a binding in this keymap.")
+functions have a binding in this keymap." "x" #'bookmark-set "m" #'bookmark-set "M" #'bookmark-set-no-overwrite "j" #'bookmark-jump "g" #'bookmark-jump "o" #'bookmark-jump-other-window "5" #'bookmark-jump-other-frame "i" #'bookmark-insert "e" #'edit-bookmarks "f" #'bookmark-insert-location "r" #'bookmark-rename "d" #'bookmark-delete "D" #'bookmark-delete-all "l" #'bookmark-load "w" #'bookmark-write "s" #'bookmark-save)
(fset 'bookmark-map bookmark-map)
-
(autoload 'bookmark-set "bookmark" "\
Set a bookmark named NAME at the current location.
If NAME is nil, then prompt the user.
@@ -2399,8 +2155,7 @@ Use \\[bookmark-delete] to remove bookmarks (you give it a name and
it removes only the first instance of a bookmark with that name from
the list of bookmarks.)
-\(fn &optional NAME NO-OVERWRITE)" t nil)
-
+(fn &optional NAME NO-OVERWRITE)" t nil)
(autoload 'bookmark-set-no-overwrite "bookmark" "\
Set a bookmark named NAME at the current location.
If NAME is nil, then prompt the user.
@@ -2429,8 +2184,7 @@ Use \\[bookmark-delete] to remove bookmarks (you give it a name and
it removes only the first instance of a bookmark with that name from
the list of bookmarks.)
-\(fn &optional NAME PUSH-BOOKMARK)" t nil)
-
+(fn &optional NAME PUSH-BOOKMARK)" t nil)
(autoload 'bookmark-jump "bookmark" "\
Jump to bookmark BOOKMARK (a point in some file).
You may have a problem using this function if the value of variable
@@ -2450,18 +2204,15 @@ If DISPLAY-FUNC is non-nil, it is a function to invoke to display the
bookmark. It defaults to `pop-to-buffer-same-window'. A typical value for
DISPLAY-FUNC would be `switch-to-buffer-other-window'.
-\(fn BOOKMARK &optional DISPLAY-FUNC)" t nil)
-
+(fn BOOKMARK &optional DISPLAY-FUNC)" t nil)
(autoload 'bookmark-jump-other-window "bookmark" "\
Jump to BOOKMARK in another window. See `bookmark-jump' for more.
-\(fn BOOKMARK)" t nil)
-
+(fn BOOKMARK)" t nil)
(autoload 'bookmark-jump-other-frame "bookmark" "\
Jump to BOOKMARK in another frame. See `bookmark-jump' for more.
-\(fn BOOKMARK)" t nil)
-
+(fn BOOKMARK)" t nil)
(autoload 'bookmark-relocate "bookmark" "\
Relocate BOOKMARK-NAME to another file, reading file name with minibuffer.
@@ -2469,18 +2220,15 @@ This makes an already existing bookmark point to that file, instead of
the one it used to point at. Useful when a file has been renamed
after a bookmark was set in it.
-\(fn BOOKMARK-NAME)" t nil)
-
+(fn BOOKMARK-NAME)" t nil)
(autoload 'bookmark-insert-location "bookmark" "\
Insert the name of the file associated with BOOKMARK-NAME.
Optional second arg NO-HISTORY means don't record this in the
minibuffer history list `bookmark-history'.
-\(fn BOOKMARK-NAME &optional NO-HISTORY)" t nil)
-
+(fn BOOKMARK-NAME &optional NO-HISTORY)" t nil)
(defalias 'bookmark-locate 'bookmark-insert-location)
-
(autoload 'bookmark-rename "bookmark" "\
Change the name of OLD-NAME bookmark to NEW-NAME name.
If called from keyboard, prompt for OLD-NAME and NEW-NAME.
@@ -2494,8 +2242,7 @@ While you are entering the new name, consecutive \\<bookmark-minibuffer-read-nam
consecutive words from the text of the buffer into the new bookmark
name.
-\(fn OLD-NAME &optional NEW-NAME)" t nil)
-
+(fn OLD-NAME &optional NEW-NAME)" t nil)
(autoload 'bookmark-insert "bookmark" "\
Insert the text of the file pointed to by bookmark BOOKMARK-NAME.
BOOKMARK-NAME is a bookmark name (a string), not a bookmark record.
@@ -2505,8 +2252,7 @@ You may have a problem using this function if the value of variable
bookmarks. See help on function `bookmark-load' for more about
this.
-\(fn BOOKMARK-NAME)" t nil)
-
+(fn BOOKMARK-NAME)" t nil)
(autoload 'bookmark-delete "bookmark" "\
Delete BOOKMARK-NAME from the bookmark list.
@@ -2517,20 +2263,16 @@ one most recently used in this file, if any).
Optional second arg BATCH means don't update the bookmark list buffer,
probably because we were called from there.
-\(fn BOOKMARK-NAME &optional BATCH)" t nil)
-
+(fn BOOKMARK-NAME &optional BATCH)" t nil)
(autoload 'bookmark-delete-all "bookmark" "\
Permanently delete all bookmarks.
If optional argument NO-CONFIRM is non-nil, don't ask for
confirmation.
-\(fn &optional NO-CONFIRM)" t nil)
-
+(fn &optional NO-CONFIRM)" t nil)
(autoload 'bookmark-write "bookmark" "\
Write bookmarks to a file (reading the file name with the minibuffer)." t nil)
-
(function-put 'bookmark-write 'interactive-only 'bookmark-save)
-
(autoload 'bookmark-save "bookmark" "\
Save currently defined bookmarks in FILE.
FILE defaults to `bookmark-default-file'.
@@ -2544,8 +2286,7 @@ When you want to load in the bookmarks from a file, use
for a file, defaulting to the file defined by variable
`bookmark-default-file'.
-\(fn &optional PARG FILE MAKE-DEFAULT)" t nil)
-
+(fn &optional PARG FILE MAKE-DEFAULT)" t nil)
(autoload 'bookmark-load "bookmark" "\
Load bookmarks from FILE (which must be in bookmark format).
Appends loaded bookmarks to the front of the list of bookmarks.
@@ -2565,34 +2306,29 @@ If you load a file containing bookmarks with the same names as
bookmarks already present in your Emacs, the new bookmarks will get
unique numeric suffixes \"<2>\", \"<3>\", etc.
-\(fn FILE &optional OVERWRITE NO-MSG DEFAULT)" t nil)
-
+(fn FILE &optional OVERWRITE NO-MSG DEFAULT)" t nil)
(autoload 'bookmark-bmenu-get-buffer "bookmark" "\
Return the Bookmark List, building it if it doesn't exists.
Don't affect the buffer ring order." nil nil)
-
(autoload 'bookmark-bmenu-list "bookmark" "\
Display a list of existing bookmarks.
The list is displayed in a buffer named `*Bookmark List*'.
The leftmost column displays a D if the bookmark is flagged for
deletion, or > if it is flagged for displaying." t nil)
-
(defalias 'list-bookmarks 'bookmark-bmenu-list)
-
(defalias 'edit-bookmarks 'bookmark-bmenu-list)
-
(autoload 'bookmark-bmenu-search "bookmark" "\
Incremental search of bookmarks, hiding the non-matches as we go." '(bookmark-bmenu-mode) nil)
-
(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map))
-
(defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
-
(register-definition-prefixes "bookmark" '("bookmark-" "with-buffer-modified-unmodified"))
-;;;***
-;;;### (autoloads nil "browse-url" "net/browse-url.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/bovine.el
+
+(register-definition-prefixes "semantic/bovine" '("semantic-"))
+
+
;;; Generated autoloads from net/browse-url.el
(defvar browse-url-browser-function 'browse-url-default-browser "\
@@ -2602,16 +2338,13 @@ This is used by the `browse-url-at-point', `browse-url-at-mouse', and
Also see `browse-url-secondary-browser-function' and
`browse-url-handlers'.")
-
(custom-autoload 'browse-url-browser-function "browse-url" t)
-
(defvar browse-url-default-handlers '(("\\`mailto:" . browse-url--mailto) ("\\`man:" . browse-url--man) (browse-url--non-html-file-url-p . browse-url-emacs)) "\
Like `browse-url-handlers' but populated by Emacs and packages.
Emacs and external packages capable of browsing certain URLs
should place their entries in this alist rather than
`browse-url-handlers' which is reserved for the user.")
-
(autoload 'browse-url-select-handler "browse-url" "\
Return a handler of suitable for browsing URL.
This searches `browse-url-handlers', and
@@ -2626,8 +2359,7 @@ Currently, it also consults `browse-url-browser-function' first
if it is set to an alist, although this usage is deprecated since
Emacs 28.1 and will be removed in a future release.
-\(fn URL &optional KIND)" nil nil)
-
+(fn URL &optional KIND)" nil nil)
(autoload 'browse-url-of-file "browse-url" "\
Use a web browser to display FILE.
Display the current buffer's file if FILE is nil or if called
@@ -2635,8 +2367,7 @@ interactively. Turn the filename into a URL with function
`browse-url-file-url'. Pass the URL to a browser using the
`browse-url' function then run `browse-url-of-file-hook'.
-\(fn &optional FILE)" t nil)
-
+(fn &optional FILE)" t nil)
(autoload 'browse-url-of-buffer "browse-url" "\
Use a web browser to display BUFFER.
See `browse-url' for details.
@@ -2645,17 +2376,14 @@ Display the current buffer if BUFFER is nil. Display only the
currently visible part of BUFFER (from a temporary file) if buffer is
narrowed.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'browse-url-of-dired-file "browse-url" "\
In Dired, ask a WWW browser to display the file named on this line." t nil)
-
(autoload 'browse-url-of-region "browse-url" "\
Use a web browser to display the current region.
See `browse-url' for details.
-\(fn MIN MAX)" t nil)
-
+(fn MIN MAX)" t nil)
(autoload 'browse-url "browse-url" "\
Open URL using a configurable method.
This will typically (by default) open URL with an external web
@@ -2677,16 +2405,14 @@ significance of ARGS (most of the functions ignore it).
If ARGS are omitted, the default is to pass
`browse-url-new-window-flag' as ARGS.
-\(fn URL &rest ARGS)" t nil)
-
+(fn URL &rest ARGS)" t nil)
(autoload 'browse-url-at-point "browse-url" "\
Open URL at point using a configurable method.
See `browse-url' for details.
Optional prefix argument ARG non-nil inverts the value of the option
`browse-url-new-window-flag'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'browse-url-with-browser-kind "browse-url" "\
Browse URL with a browser of the given browser KIND.
KIND is either `internal' or `external'.
@@ -2694,8 +2420,7 @@ KIND is either `internal' or `external'.
When called interactively, the default browser kind is the
opposite of the browser kind of `browse-url-browser-function'.
-\(fn KIND URL &optional ARG)" t nil)
-
+(fn KIND URL &optional ARG)" t nil)
(autoload 'browse-url-at-mouse "browse-url" "\
Use a web browser to load a URL clicked with the mouse.
See `browse-url' for details.
@@ -2703,36 +2428,13 @@ See `browse-url' for details.
The URL is the one around or before the position of the mouse
click but point is not changed.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'browse-url-xdg-open "browse-url" "\
Pass the specified URL to the \"xdg-open\" command.
xdg-open is a desktop utility that calls your preferred web browser.
The optional argument IGNORED is not used.
-\(fn URL &optional IGNORED)" t nil)
-
-(autoload 'browse-url-netscape "browse-url" "\
-Ask the Netscape WWW browser to load URL.
-Default to the URL around or before point. The strings in variable
-`browse-url-netscape-arguments' are also passed to Netscape.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Netscape window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-netscape-new-window-is-tab' is non-nil, then
-whenever a document would otherwise be loaded in a new window, it
-is loaded in a new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-netscape 'nil '"25.1")
-
+(fn URL &optional IGNORED)" t nil)
(autoload 'browse-url-mozilla "browse-url" "\
Ask the Mozilla WWW browser to load URL.
Default to the URL around or before point. The strings in variable
@@ -2750,8 +2452,7 @@ new tab in an existing window instead.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-firefox "browse-url" "\
Ask the Firefox WWW browser to load URL.
Defaults to the URL around or before point. Passes the strings
@@ -2768,8 +2469,7 @@ is loaded in a new tab in an existing window instead.
Non-interactively, this uses the optional second argument NEW-WINDOW
instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-chromium "browse-url" "\
Ask the Chromium WWW browser to load URL.
Default to the URL around or before point. The strings in
@@ -2777,38 +2477,26 @@ variable `browse-url-chromium-arguments' are also passed to
Chromium.
The optional argument NEW-WINDOW is not used.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(autoload 'browse-url-galeon "browse-url" "\
-Ask the Galeon WWW browser to load URL.
-Default to the URL around or before point. The strings in variable
-`browse-url-galeon-arguments' are also passed to Galeon.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Galeon window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-galeon-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-\(fn URL &optional NEW-WINDOW)" t nil)
+(fn URL &optional NEW-WINDOW)" t nil)
+(autoload 'browse-url-webpositive "browse-url" "\
+Ask the WebPositive WWW browser to load URL.
+Default to the URL around or before point.
+The optional argument NEW-WINDOW is not used.
-(make-obsolete 'browse-url-galeon 'nil '"25.1")
+(fn URL &optional NEW-WINDOW)" t nil)
+(autoload 'browse-url-default-haiku-browser "browse-url" "\
+Browse URL with the system default browser.
+Default to the URL around or before point.
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-emacs "browse-url" "\
Ask Emacs to load URL into a buffer and show it in another window.
Optional argument SAME-WINDOW non-nil means show the URL in the
currently selected window instead.
-\(fn URL &optional SAME-WINDOW)" t nil)
-
+(fn URL &optional SAME-WINDOW)" t nil)
(autoload 'browse-url-gnome-moz "browse-url" "\
-Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
+Ask Mozilla to load URL via the GNOME program `gnome-moz-remote'.
Default to the URL around or before point. The strings in variable
`browse-url-gnome-moz-arguments' are also passed.
@@ -2820,10 +2508,8 @@ effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-gnome-moz 'nil '"25.1")
-
+(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-gnome-moz 'nil "25.1")
(autoload 'browse-url-conkeror "browse-url" "\
Ask the Conkeror WWW browser to load URL.
Default to the URL around or before point. Also pass the strings
@@ -2842,10 +2528,8 @@ new window, load it in a new buffer in an existing window instead.
When called non-interactively, use optional second argument
NEW-WINDOW instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-conkeror 'nil '"28.1")
-
+(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-conkeror 'nil "28.1")
(autoload 'browse-url-w3 "browse-url" "\
Ask the w3 WWW browser to load URL.
Default to the URL around or before point.
@@ -2857,17 +2541,14 @@ prefix argument reverses the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-w3-gnudoit "browse-url" "\
Ask another Emacs running gnuserv to load the URL using the W3 browser.
The `browse-url-gnudoit-program' program is used with options given by
`browse-url-gnudoit-args'. Default to the URL around or before point.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-w3-gnudoit 'nil '"25.1")
-
+(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-w3-gnudoit 'nil "25.1")
(autoload 'browse-url-text-xterm "browse-url" "\
Ask a text browser to load URL.
URL defaults to the URL around or before point.
@@ -2876,8 +2557,7 @@ in an Xterm window using the Xterm program named by `browse-url-xterm-program'
with possible additional arguments `browse-url-xterm-args'.
The optional argument NEW-WINDOW is not used.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-text-emacs "browse-url" "\
Ask a text browser to load URL.
URL defaults to the URL around or before point.
@@ -2892,8 +2572,7 @@ reverses the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-BUFFER)" t nil)
-
+(fn URL &optional NEW-BUFFER)" t nil)
(autoload 'browse-url-mail "browse-url" "\
Open a new mail message buffer within Emacs for the RFC 2368 URL.
Default to using the mailto: URL around or before point as the
@@ -2909,8 +2588,7 @@ non-nil interactive prefix argument reverses the effect of
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-generic "browse-url" "\
Ask the WWW browser defined by `browse-url-generic-program' to load URL.
Default to the URL around or before point. A fresh copy of the
@@ -2918,15 +2596,13 @@ browser is started up in a new process with possible additional arguments
`browse-url-generic-args'. This is appropriate for browsers which
don't offer a form of remote control.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-kde "browse-url" "\
Ask the KDE WWW browser to load URL.
Default to the URL around or before point.
The optional argument NEW-WINDOW is not used.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-elinks "browse-url" "\
Ask the Elinks WWW browser to load URL.
Default to the URL around the point.
@@ -2937,42 +2613,34 @@ none yet running, a newly started instance.
The Elinks command will be prepended by the program+arguments
from `browse-url-elinks-wrapper'.
-\(fn URL &optional NEW-WINDOW)" t nil)
-
+(fn URL &optional NEW-WINDOW)" t nil)
(autoload 'browse-url-button-open "browse-url" "\
Follow the link under point using `browse-url'.
If EXTERNAL (the prefix if used interactively), open with the
external browser instead of the default one.
-\(fn &optional EXTERNAL MOUSE-EVENT)" t nil)
-
+(fn &optional EXTERNAL MOUSE-EVENT)" t nil)
(autoload 'browse-url-button-open-url "browse-url" "\
Open URL using `browse-url'.
If `current-prefix-arg' is non-nil, use
`browse-url-secondary-browser-function' instead.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "browse-url" '("browse-url-"))
-;;;***
-;;;### (autoloads nil "bs" "bs.el" (0 0 0 0))
;;; Generated autoloads from bs.el
(autoload 'bs-cycle-next "bs" "\
Select next buffer defined by buffer cycling.
The buffers taking part in buffer cycling are defined
by buffer configuration `bs-cycle-configuration-name'." t nil)
-
(autoload 'bs-cycle-previous "bs" "\
Select previous buffer defined by buffer cycling.
The buffers taking part in buffer cycling are defined
by buffer configuration `bs-cycle-configuration-name'." t nil)
-
(autoload 'bs-customize "bs" "\
Customization of group bs for Buffer Selection Menu." t nil)
-
(autoload 'bs-show "bs" "\
Make a menu of buffers so you can manipulate buffers or the buffer list.
\\<bs-mode-map>
@@ -2987,13 +2655,10 @@ With prefix argument ARG show a different buffer list. Function
`bs--configuration-name-for-prefix-arg' determine accordingly
name of buffer configuration.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "bs" '("bs-"))
-;;;***
-;;;### (autoloads nil "bubbles" "play/bubbles.el" (0 0 0 0))
;;; Generated autoloads from play/bubbles.el
(autoload 'bubbles "bubbles" "\
@@ -3009,79 +2674,69 @@ columns on its right towards the left.
\\[bubbles-set-game-medium] sets the difficulty to medium.
\\[bubbles-set-game-difficult] sets the difficulty to difficult.
\\[bubbles-set-game-hard] sets the difficulty to hard." t nil)
-
(register-definition-prefixes "bubbles" '("bubbles-"))
-;;;***
-;;;### (autoloads nil "bug-reference" "progmodes/bug-reference.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/bug-reference.el
(put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format)))))
-
(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
-
(autoload 'bug-reference-mode "bug-reference" "\
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
This is a minor mode. If called interactively, toggle the
-`Bug-Reference mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Bug-Reference mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `bug-reference-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'bug-reference-prog-mode "bug-reference" "\
Like `bug-reference-mode', but only buttonize in comments and strings.
This is a minor mode. If called interactively, toggle the
-`Bug-Reference-Prog mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Bug-Reference-Prog mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `bug-reference-prog-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "bug-reference" '("bug-reference-"))
-;;;***
-;;;### (autoloads nil "byte-opt" "emacs-lisp/byte-opt.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emacs-lisp/byte-opt.el
(register-definition-prefixes "byte-opt" '("byte-" "disassemble-offset"))
-;;;***
-;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emacs-lisp/bytecomp.el
+
(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
(put 'byte-compile-error-on-warn 'safe-local-variable 'booleanp)
-
(put 'byte-compile-warnings 'safe-local-variable (lambda (v) (or (symbolp v) (null (delq nil (mapcar (lambda (x) (not (symbolp x))) v))))))
+(autoload 'byte-compile-warning-enabled-p "bytecomp" "\
+Return non-nil if WARNING is enabled, according to `byte-compile-warnings'.
+(fn WARNING &optional SYMBOL)" nil nil)
(autoload 'byte-compile-disable-warning "bytecomp" "\
Change `byte-compile-warnings' to disable WARNING.
If `byte-compile-warnings' is t, set it to `(not WARNING)'.
@@ -3089,8 +2744,7 @@ Otherwise, if the first element is `not', add WARNING, else remove it.
Normally you should let-bind `byte-compile-warnings' before calling this,
else the global value will be modified.
-\(fn WARNING)" nil nil)
-
+(fn WARNING)" nil nil)
(autoload 'byte-compile-enable-warning "bytecomp" "\
Change `byte-compile-warnings' to enable WARNING.
If `byte-compile-warnings' is t, do nothing. Otherwise, if the
@@ -3098,14 +2752,12 @@ first element is `not', remove WARNING, else add it.
Normally you should let-bind `byte-compile-warnings' before calling this,
else the global value will be modified.
-\(fn WARNING)" nil nil)
-
+(fn WARNING)" nil nil)
(autoload 'byte-force-recompile "bytecomp" "\
Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
Files in subdirectories of DIRECTORY are processed also.
-\(fn DIRECTORY)" t nil)
-
+(fn DIRECTORY)" t nil)
(autoload 'byte-recompile-directory "bytecomp" "\
Recompile every `.el' file in DIRECTORY that needs recompilation.
This happens when a `.elc' file exists but is older than the `.el' file.
@@ -3125,34 +2777,32 @@ This command will normally not follow symlinks when compiling
files. If FOLLOW-SYMLINKS is non-nil, symlinked `.el' files will
also be compiled.
-\(fn DIRECTORY &optional ARG FORCE FOLLOW-SYMLINKS)" t nil)
+(fn DIRECTORY &optional ARG FORCE FOLLOW-SYMLINKS)" t nil)
(put 'no-byte-compile 'safe-local-variable 'booleanp)
-
(autoload 'byte-compile-file "bytecomp" "\
Compile a file of Lisp code named FILENAME into a file of byte code.
The output file's name is generated by passing FILENAME to the
function `byte-compile-dest-file' (which see).
The value is non-nil if there were no errors, nil if errors.
+If the file sets the file variable `no-byte-compile', it is not
+compiled, any existing output file is removed, and the return
+value is `no-byte-compile'.
See also `emacs-lisp-byte-compile-and-load'.
-\(fn FILENAME &optional LOAD)" t nil)
-
+(fn FILENAME &optional LOAD)" t nil)
(set-advertised-calling-convention 'byte-compile-file '(filename) '"28.1")
-
(autoload 'compile-defun "bytecomp" "\
Compile and evaluate the current top-level form.
Print the result in the echo area.
With argument ARG, insert value in current buffer after the form.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'byte-compile "bytecomp" "\
If FORM is a symbol, byte-compile its function definition.
If FORM is a lambda or a macro, byte-compile it as a function.
-\(fn FORM)" nil nil)
-
+(fn FORM)" nil nil)
(autoload 'display-call-tree "bytecomp" "\
Display a call graph of a specified file.
This lists which functions have been called, what functions called
@@ -3162,19 +2812,17 @@ all functions called by those functions.
The call graph does not include macros, inline functions, or
primitives that the byte-code interpreter knows about directly
-\(`eq', `cons', etc.).
+(`eq', `cons', etc.).
The call tree also lists those functions which are not known to be called
-\(that is, to which no calls have been compiled), and which cannot be
+(that is, to which no calls have been compiled), and which cannot be
invoked interactively.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'batch-byte-compile-if-not-done "bytecomp" "\
Like `byte-compile-file' but doesn't recompile if already up to date.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs." nil nil)
-
(autoload 'batch-byte-compile "bytecomp" "\
Run `byte-compile-file' on the files remaining on the command line.
Use this from the command line, with `-batch';
@@ -3191,8 +2839,7 @@ For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
If NOFORCE is non-nil, don't recompile a file that seems to be
already up-to-date.
-\(fn &optional NOFORCE)" nil nil)
-
+(fn &optional NOFORCE)" nil nil)
(autoload 'batch-byte-recompile-directory "bytecomp" "\
Run `byte-recompile-directory' on the dirs remaining on the command line.
Must be used only with `-batch', and kills Emacs on completion.
@@ -3202,61 +2849,44 @@ Optional argument ARG is passed as second argument ARG to
`byte-recompile-directory'; see there for its possible values
and corresponding effects.
-\(fn &optional ARG)" nil nil)
-
+(fn &optional ARG)" nil nil)
(register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile"))
-;;;***
-;;;### (autoloads nil "cal-bahai" "calendar/cal-bahai.el" (0 0 0
-;;;;;; 0))
+;;; Generated autoloads from cedet/semantic/bovine/c.el
+
+(register-definition-prefixes "semantic/bovine/c" '("c-mode" "semantic"))
+
+
;;; Generated autoloads from calendar/cal-bahai.el
(register-definition-prefixes "cal-bahai" '("calendar-bahai-" "diary-bahai-" "holiday-bahai"))
-;;;***
-;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/cal-china.el
(put 'calendar-chinese-time-zone 'risky-local-variable t)
-
(register-definition-prefixes "cal-china" '("calendar-chinese-" "diary-chinese-" "holiday-chinese"))
-;;;***
-;;;### (autoloads nil "cal-coptic" "calendar/cal-coptic.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-coptic.el
(register-definition-prefixes "cal-coptic" '("calendar-" "diary-"))
-;;;***
-;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-dst.el
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
-
(put 'calendar-daylight-savings-ends 'risky-local-variable t)
-
(put 'calendar-current-time-zone-cache 'risky-local-variable t)
-
(register-definition-prefixes "cal-dst" '("calendar-" "dst-"))
-;;;***
-;;;### (autoloads nil "cal-french" "calendar/cal-french.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-french.el
(register-definition-prefixes "cal-french" '("calendar-french-" "diary-french-date"))
-;;;***
-;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-hebrew.el
(autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\
@@ -3264,164 +2894,124 @@ List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
When called interactively from the calendar window, the date of death is taken
from the cursor position.
-\(fn DEATH-DATE START-YEAR END-YEAR)" t nil)
-
+(fn DEATH-DATE START-YEAR END-YEAR)" t nil)
(register-definition-prefixes "cal-hebrew" '("calendar-hebrew-" "diary-hebrew-" "holiday-hebrew"))
-;;;***
-;;;### (autoloads nil "cal-html" "calendar/cal-html.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-html.el
(register-definition-prefixes "cal-html" '("cal-html-"))
-;;;***
-;;;### (autoloads nil "cal-islam" "calendar/cal-islam.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/cal-islam.el
(register-definition-prefixes "cal-islam" '("calendar-islamic-" "diary-islamic-" "holiday-islamic"))
-;;;***
-;;;### (autoloads nil "cal-iso" "calendar/cal-iso.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-iso.el
(register-definition-prefixes "cal-iso" '("calendar-iso-" "diary-iso-date"))
-;;;***
-;;;### (autoloads nil "cal-julian" "calendar/cal-julian.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-julian.el
(register-definition-prefixes "cal-julian" '("calendar-" "diary-" "holiday-julian"))
-;;;***
-;;;### (autoloads nil "cal-mayan" "calendar/cal-mayan.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/cal-mayan.el
(register-definition-prefixes "cal-mayan" '("calendar-mayan-" "diary-mayan-date"))
-;;;***
-;;;### (autoloads nil "cal-menu" "calendar/cal-menu.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-menu.el
(register-definition-prefixes "cal-menu" '("cal"))
-;;;***
-;;;### (autoloads nil "cal-move" "calendar/cal-move.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-move.el
(register-definition-prefixes "cal-move" '("calendar-"))
-;;;***
-;;;### (autoloads nil "cal-persia" "calendar/cal-persia.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-persia.el
(register-definition-prefixes "cal-persia" '("calendar-persian-" "diary-persian-date"))
-;;;***
-;;;### (autoloads nil "cal-tex" "calendar/cal-tex.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-tex.el
(register-definition-prefixes "cal-tex" '("cal-tex-"))
-;;;***
-;;;### (autoloads nil "cal-x" "calendar/cal-x.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-x.el
(register-definition-prefixes "cal-x" '("calendar-" "diary-frame"))
-;;;***
-;;;### (autoloads nil "calc" "calc/calc.el" (0 0 0 0))
;;; Generated autoloads from calc/calc.el
- (define-key ctl-x-map "*" 'calc-dispatch)
+ (define-key ctl-x-map "*" 'calc-dispatch)
(autoload 'calc-dispatch "calc" "\
Invoke the GNU Emacs Calculator. See \\[calc-dispatch-help] for details.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'calc "calc" "\
The Emacs Calculator. Full documentation is listed under `calc-mode'.
-\(fn &optional ARG FULL-DISPLAY INTERACTIVE)" t nil)
-
+(fn &optional ARG FULL-DISPLAY INTERACTIVE)" t nil)
(autoload 'full-calc "calc" "\
Invoke the Calculator and give it a full-sized window.
-\(fn &optional INTERACTIVE)" t nil)
-
+(fn &optional INTERACTIVE)" t nil)
(autoload 'quick-calc "calc" "\
Do a quick calculation in the minibuffer without invoking full Calculator.
With prefix argument INSERT, insert the result in the current
buffer. Otherwise, the result is copied into the kill ring.
-\(fn &optional INSERT)" t nil)
-
+(fn &optional INSERT)" t nil)
(autoload 'calc-eval "calc" "\
Do a quick calculation and return the result as a string.
Return value will either be the formatted result in string form,
or a list containing a character position and an error message in string form.
-\(fn STR &optional SEPARATOR &rest ARGS)" nil nil)
-
+(fn STR &optional SEPARATOR &rest ARGS)" nil nil)
(autoload 'calc-keypad "calc" "\
Invoke the Calculator in \"visual keypad\" mode.
This is most useful in the X window system.
In this mode, click on the Calc \"buttons\" using the left mouse button.
Or, position the cursor manually and do \\[calc-keypad-press].
-\(fn &optional INTERACTIVE)" t nil)
-
+(fn &optional INTERACTIVE)" t nil)
(autoload 'full-calc-keypad "calc" "\
Invoke the Calculator in full-screen \"visual keypad\" mode.
See calc-keypad for details.
-\(fn &optional INTERACTIVE)" t nil)
-
+(fn &optional INTERACTIVE)" t nil)
(autoload 'calc-grab-region "calc" "\
Parse the region as a vector of numbers and push it on the Calculator stack.
-\(fn TOP BOT ARG)" t nil)
-
+(fn TOP BOT ARG)" t nil)
(autoload 'calc-grab-rectangle "calc" "\
Parse a rectangle as a matrix of numbers and push it on the Calculator stack.
-\(fn TOP BOT ARG)" t nil)
-
+(fn TOP BOT ARG)" t nil)
(autoload 'calc-grab-sum-down "calc" "\
Parse a rectangle as a matrix of numbers and sum its columns.
-\(fn TOP BOT ARG)" t nil)
-
+(fn TOP BOT ARG)" t nil)
(autoload 'calc-grab-sum-across "calc" "\
Parse a rectangle as a matrix of numbers and sum its rows.
-\(fn TOP BOT ARG)" t nil)
-
+(fn TOP BOT ARG)" t nil)
(autoload 'calc-embedded "calc" "\
Start Calc Embedded mode on the formula surrounding point.
-\(fn ARG &optional END OBEG OEND)" t nil)
-
+(fn ARG &optional END OBEG OEND)" t nil)
(autoload 'calc-embedded-activate "calc" "\
Scan the current editing buffer for all embedded := and => formulas.
Also looks for the equivalent TeX words, \\gets and \\evalto.
-\(fn &optional ARG CBUF)" t nil)
-
+(fn &optional ARG CBUF)" t nil)
(autoload 'defmath "calc" "\
Define Calc function.
@@ -3434,297 +3024,234 @@ actual Lisp function name.
See Info node `(calc)Defining Functions'.
-\(fn FUNC ARGS &rest BODY)" nil t)
+(fn FUNC ARGS &rest BODY)" nil t)
+(function-put 'defmath 'doc-string-elt 3)
+(function-put 'defmath 'lisp-indent-function 'defun)
+(register-definition-prefixes "calc" '("calc" "defcalcmodevar" "inexact-result" "math-" "var-"))
-(function-put 'defmath 'doc-string-elt '3)
+
+;;; Generated autoloads from calc/calc-aent.el
-(register-definition-prefixes "calc" '("calc" "defcalcmodevar" "inexact-result" "math-" "var-"))
+(register-definition-prefixes "calc-aent" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-alg" "calc/calc-alg.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-alg.el
(register-definition-prefixes "calc-alg" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-arith" "calc/calc-arith.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-arith.el
(register-definition-prefixes "calc-arith" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-bin" "calc/calc-bin.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-bin.el
(register-definition-prefixes "calc-bin" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-comb" "calc/calc-comb.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-comb.el
(register-definition-prefixes "calc-comb" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-cplx" "calc/calc-cplx.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-cplx.el
(register-definition-prefixes "calc-cplx" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-ext" "calc/calc-ext.el" (0 0 0 0))
+;;; Generated autoloads from calc/calc-embed.el
+
+(register-definition-prefixes "calc-embed" '("calc-"))
+
+
;;; Generated autoloads from calc/calc-ext.el
(register-definition-prefixes "calc-ext" '("calc" "math-" "var-"))
-;;;***
-;;;### (autoloads nil "calc-fin" "calc/calc-fin.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-fin.el
(register-definition-prefixes "calc-fin" '("calc" "math-c"))
-;;;***
-;;;### (autoloads nil "calc-forms" "calc/calc-forms.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-forms.el
(register-definition-prefixes "calc-forms" '("calc" "math-" "var-TimeZone"))
-;;;***
-;;;### (autoloads nil "calc-frac" "calc/calc-frac.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-frac.el
(register-definition-prefixes "calc-frac" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-funcs" "calc/calc-funcs.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-funcs.el
(register-definition-prefixes "calc-funcs" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-graph" "calc/calc-graph.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-graph.el
(register-definition-prefixes "calc-graph" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-help" "calc/calc-help.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-help.el
(register-definition-prefixes "calc-help" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-incom" "calc/calc-incom.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-incom.el
(register-definition-prefixes "calc-incom" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-keypd" "calc/calc-keypd.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-keypd.el
(register-definition-prefixes "calc-keypd" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-lang" "calc/calc-lang.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-lang.el
(register-definition-prefixes "calc-lang" '("calc-" "math-"))
-;;;***
-;;;### (autoloads nil "calc-macs" "calc/calc-macs.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-macs.el
(register-definition-prefixes "calc-macs" '("Math-" "calc-" "math-"))
-;;;***
-;;;### (autoloads nil "calc-map" "calc/calc-map.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-map.el
(register-definition-prefixes "calc-map" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-math" "calc/calc-math.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-math.el
(register-definition-prefixes "calc-math" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-menu" "calc/calc-menu.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-menu.el
(register-definition-prefixes "calc-menu" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-mode" "calc/calc-mode.el" (0 0 0 0))
+;;; Generated autoloads from calc/calc-misc.el
+
+(register-definition-prefixes "calc-misc" '("math-iipow"))
+
+
;;; Generated autoloads from calc/calc-mode.el
(register-definition-prefixes "calc-mode" '("calc-" "math-get-modes-vec"))
-;;;***
-;;;### (autoloads nil "calc-mtx" "calc/calc-mtx.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-mtx.el
(register-definition-prefixes "calc-mtx" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-nlfit" "calc/calc-nlfit.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-nlfit.el
(register-definition-prefixes "calc-nlfit" '("calc-fit-" "math-nlfit-"))
-;;;***
-;;;### (autoloads nil "calc-poly" "calc/calc-poly.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-poly.el
(register-definition-prefixes "calc-poly" '("calcFunc-" "math-"))
-;;;***
-;;;### (autoloads nil "calc-prog" "calc/calc-prog.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-prog.el
(register-definition-prefixes "calc-prog" '("calc" "math-" "var-q"))
-;;;***
-;;;### (autoloads nil "calc-rewr" "calc/calc-rewr.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-rewr.el
(register-definition-prefixes "calc-rewr" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-rules" "calc/calc-rules.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-rules.el
(register-definition-prefixes "calc-rules" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-sel" "calc/calc-sel.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-sel.el
(register-definition-prefixes "calc-sel" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-stat" "calc/calc-stat.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-stat.el
(register-definition-prefixes "calc-stat" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-store" "calc/calc-store.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-store.el
(register-definition-prefixes "calc-store" '("calc"))
-;;;***
-;;;### (autoloads nil "calc-stuff" "calc/calc-stuff.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-stuff.el
(register-definition-prefixes "calc-stuff" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-trail" "calc/calc-trail.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-trail.el
(register-definition-prefixes "calc-trail" '("calc-trail-"))
-;;;***
-;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-undo.el
(autoload 'calc-undo "calc-undo" "\
-\(fn N)" t nil)
-
+(fn N)" t nil)
(register-definition-prefixes "calc-undo" '("calc-"))
-;;;***
-;;;### (autoloads nil "calc-units" "calc/calc-units.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-units.el
(register-definition-prefixes "calc-units" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calc-vec" "calc/calc-vec.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-vec.el
(register-definition-prefixes "calc-vec" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calcalg2" "calc/calcalg2.el" (0 0 0 0))
+;;; Generated autoloads from calc/calc-yank.el
+
+(register-definition-prefixes "calc-yank" '("calc-" "math-number-regexp"))
+
+
;;; Generated autoloads from calc/calcalg2.el
(register-definition-prefixes "calcalg2" '("calc" "math-" "var-IntegLimit"))
-;;;***
-;;;### (autoloads nil "calcalg3" "calc/calcalg3.el" (0 0 0 0))
;;; Generated autoloads from calc/calcalg3.el
(register-definition-prefixes "calcalg3" '("calc" "math-"))
-;;;***
-;;;### (autoloads nil "calccomp" "calc/calccomp.el" (0 0 0 0))
;;; Generated autoloads from calc/calccomp.el
(register-definition-prefixes "calccomp" '("calcFunc-c" "math-"))
-;;;***
-;;;### (autoloads nil "calcsel2" "calc/calcsel2.el" (0 0 0 0))
;;; Generated autoloads from calc/calcsel2.el
(register-definition-prefixes "calcsel2" '("calc-"))
-;;;***
-;;;### (autoloads nil "calculator" "calculator.el" (0 0 0 0))
;;; Generated autoloads from calculator.el
(autoload 'calculator "calculator" "\
Run the Emacs calculator.
See the documentation for `calculator-mode' for more information." t nil)
-
(register-definition-prefixes "calculator" '("calculator-"))
-;;;***
-;;;### (autoloads nil "calendar" "calendar/calendar.el" (0 0 0 0))
;;; Generated autoloads from calendar/calendar.el
(autoload 'calendar "calendar" "\
@@ -3762,94 +3289,68 @@ Runs the following hooks:
This function is suitable for execution in an init file.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "calendar" '("calendar-" "diary-" "holiday-buffer" "lunar-phases-buffer" "solar-sunrises-buffer"))
-;;;***
-;;;### (autoloads nil "canlock" "gnus/canlock.el" (0 0 0 0))
;;; Generated autoloads from gnus/canlock.el
(autoload 'canlock-insert-header "canlock" "\
Insert a Cancel-Key and/or a Cancel-Lock header if possible.
-\(fn &optional ID-FOR-KEY ID-FOR-LOCK PASSWORD)" nil nil)
-
+(fn &optional ID-FOR-KEY ID-FOR-LOCK PASSWORD)" nil nil)
(autoload 'canlock-verify "canlock" "\
Verify Cancel-Lock or Cancel-Key in BUFFER.
If BUFFER is nil, the current buffer is assumed. Signal an error if
it fails.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(register-definition-prefixes "canlock" '("canlock-"))
-;;;***
-;;;### (autoloads nil "cc-align" "progmodes/cc-align.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-align.el
(register-definition-prefixes "cc-align" '("c-"))
-;;;***
-;;;### (autoloads nil "cc-awk" "progmodes/cc-awk.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-awk.el
(register-definition-prefixes "cc-awk" '("awk-" "c-awk-"))
-;;;***
-;;;### (autoloads nil "cc-bytecomp" "progmodes/cc-bytecomp.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from progmodes/cc-bytecomp.el
(register-definition-prefixes "cc-bytecomp" '("cc-"))
-;;;***
-;;;### (autoloads nil "cc-cmds" "progmodes/cc-cmds.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-cmds.el
(register-definition-prefixes "cc-cmds" '("c-"))
-;;;***
-;;;### (autoloads nil "cc-defs" "progmodes/cc-defs.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-defs.el
(register-definition-prefixes "cc-defs" '("c-" "cc-bytecomp-compiling-or-loading"))
-;;;***
-;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/cc-engine.el
(autoload 'c-guess-basic-syntax "cc-engine" "\
Return the syntactic context of the current line." nil nil)
-
(register-definition-prefixes "cc-engine" '("c-"))
-;;;***
-;;;### (autoloads nil "cc-fonts" "progmodes/cc-fonts.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-fonts.el
(register-definition-prefixes "cc-fonts" '("autodoc-" "c++-font-lock-keywords" "c-" "doxygen-font-lock-" "gtkdoc-font-lock-" "idl-font-lock-keywords" "java" "objc-font-lock-keywords" "pike-font-lock-keywords"))
-;;;***
-;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-guess.el
(defvar c-guess-guessed-offsets-alist nil "\
Currently guessed offsets-alist.")
-
(defvar c-guess-guessed-basic-offset nil "\
Currently guessed basic-offset.")
-
(autoload 'c-guess "cc-guess" "\
Guess the style in the region up to `c-guess-region-max', and install it.
@@ -3859,8 +3360,7 @@ If given a prefix argument (or if the optional argument ACCUMULATE is
non-nil) then the previous guess is extended, otherwise a new guess is
made from scratch.
-\(fn &optional ACCUMULATE)" t nil)
-
+(fn &optional ACCUMULATE)" t nil)
(autoload 'c-guess-no-install "cc-guess" "\
Guess the style in the region up to `c-guess-region-max'; don't install it.
@@ -3868,8 +3368,7 @@ If given a prefix argument (or if the optional argument ACCUMULATE is
non-nil) then the previous guess is extended, otherwise a new guess is
made from scratch.
-\(fn &optional ACCUMULATE)" t nil)
-
+(fn &optional ACCUMULATE)" t nil)
(autoload 'c-guess-buffer "cc-guess" "\
Guess the style on the whole current buffer, and install it.
@@ -3879,8 +3378,7 @@ If given a prefix argument (or if the optional argument ACCUMULATE is
non-nil) then the previous guess is extended, otherwise a new guess is
made from scratch.
-\(fn &optional ACCUMULATE)" t nil)
-
+(fn &optional ACCUMULATE)" t nil)
(autoload 'c-guess-buffer-no-install "cc-guess" "\
Guess the style on the whole current buffer; don't install it.
@@ -3888,8 +3386,7 @@ If given a prefix argument (or if the optional argument ACCUMULATE is
non-nil) then the previous guess is extended, otherwise a new guess is
made from scratch.
-\(fn &optional ACCUMULATE)" t nil)
-
+(fn &optional ACCUMULATE)" t nil)
(autoload 'c-guess-region "cc-guess" "\
Guess the style on the region and install it.
@@ -3899,8 +3396,7 @@ If given a prefix argument (or if the optional argument ACCUMULATE is
non-nil) then the previous guess is extended, otherwise a new guess is
made from scratch.
-\(fn START END &optional ACCUMULATE)" t nil)
-
+(fn START END &optional ACCUMULATE)" t nil)
(autoload 'c-guess-region-no-install "cc-guess" "\
Guess the style on the region; don't install it.
@@ -3924,41 +3420,33 @@ guess is made from scratch.
Note that the larger the region to guess in, the slower the guessing.
So you can limit the region with `c-guess-region-max'.
-\(fn START END &optional ACCUMULATE)" t nil)
-
+(fn START END &optional ACCUMULATE)" t nil)
(autoload 'c-guess-install "cc-guess" "\
Install the latest guessed style into the current buffer.
-\(This guessed style is a combination of `c-guess-guessed-basic-offset',
+(This guessed style is a combination of `c-guess-guessed-basic-offset',
`c-guess-guessed-offsets-alist' and `c-offsets-alist'.)
The style is entered into CC Mode's style system by
`c-add-style'. Its name is either STYLE-NAME, or a name based on
the absolute file name of the file if STYLE-NAME is nil.
-\(fn &optional STYLE-NAME)" t nil)
-
+(fn &optional STYLE-NAME)" t nil)
(register-definition-prefixes "cc-guess" '("c-guess-"))
-;;;***
-;;;### (autoloads nil "cc-langs" "progmodes/cc-langs.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-langs.el
(register-definition-prefixes "cc-langs" '("c-"))
-;;;***
-;;;### (autoloads nil "cc-menus" "progmodes/cc-menus.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-menus.el
(register-definition-prefixes "cc-menus" '("cc-imenu-"))
-;;;***
-;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-mode.el
-(push (purecopy '(cc-mode 5 33 1)) package--builtin-versions)
+(push (purecopy '(cc-mode 5 33 1)) package--builtin-versions)
(autoload 'c-initialize-cc-mode "cc-mode" "\
Initialize CC Mode for use in the current buffer.
If the optional NEW-STYLE-INIT is nil or left out then all necessary
@@ -3967,7 +3455,7 @@ only some basic setup is done, and a call to `c-init-language-vars' or
`c-init-language-vars-for' is necessary too (which gives more
control). See \"cc-mode.el\" for more info.
-\(fn &optional NEW-STYLE-INIT)" nil nil)
+(fn &optional NEW-STYLE-INIT)" nil nil)
(add-to-list 'auto-mode-alist '("\\.\\(cc\\|hh\\)\\'" . c++-mode))
(add-to-list 'auto-mode-alist '("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode))
(add-to-list 'auto-mode-alist '("\\.\\(CC?\\|HH?\\)\\'" . c++-mode))
@@ -3977,7 +3465,6 @@ control). See \"cc-mode.el\" for more info.
(add-to-list 'auto-mode-alist '("\\.lex\\'" . c-mode))
(add-to-list 'auto-mode-alist '("\\.i\\'" . c-mode))
(add-to-list 'auto-mode-alist '("\\.ii\\'" . c++-mode))
-
(autoload 'c-mode "cc-mode" "\
Major mode for editing C code.
@@ -3994,8 +3481,7 @@ initialization, then `c-mode-hook'.
Key bindings:
\\{c-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'c-or-c++-mode "cc-mode" "\
Analyze buffer and enable either C or C++ mode.
@@ -4007,7 +3493,6 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-mode' or `c++-mode'." t nil)
-
(autoload 'c++-mode "cc-mode" "\
Major mode for editing C++ code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
@@ -4024,9 +3509,8 @@ initialization, then `c++-mode-hook'.
Key bindings:
\\{c++-mode-map}
-\(fn)" t nil)
+(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.m\\'" . objc-mode))
-
(autoload 'objc-mode "cc-mode" "\
Major mode for editing Objective C code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
@@ -4043,9 +3527,8 @@ initialization, then `objc-mode-hook'.
Key bindings:
\\{objc-mode-map}
-\(fn)" t nil)
+(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.java\\'" . java-mode))
-
(autoload 'java-mode "cc-mode" "\
Major mode for editing Java code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
@@ -4062,9 +3545,8 @@ initialization, then `java-mode-hook'.
Key bindings:
\\{java-mode-map}
-\(fn)" t nil)
+(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.idl\\'" . idl-mode))
-
(autoload 'idl-mode "cc-mode" "\
Major mode for editing CORBA's IDL, PSDL and CIDL code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
@@ -4081,10 +3563,9 @@ initialization, then `idl-mode-hook'.
Key bindings:
\\{idl-mode-map}
-\(fn)" t nil)
+(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(\\.in\\)?\\)\\'" . pike-mode))
(add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
-
(autoload 'pike-mode "cc-mode" "\
Major mode for editing Pike code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
@@ -4101,13 +3582,12 @@ initialization, then `pike-mode-hook'.
Key bindings:
\\{pike-mode-map}
-\(fn)" t nil)
+(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.awk\\'" . awk-mode))
(add-to-list 'interpreter-mode-alist '("awk" . awk-mode))
(add-to-list 'interpreter-mode-alist '("mawk" . awk-mode))
(add-to-list 'interpreter-mode-alist '("nawk" . awk-mode))
(add-to-list 'interpreter-mode-alist '("gawk" . awk-mode))
-
(autoload 'awk-mode "cc-mode" "\
Major mode for editing AWK code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
@@ -4123,14 +3603,10 @@ initialization, then `awk-mode-hook'.
Key bindings:
\\{awk-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "cc-mode" '("awk-mode-map" "c++-mode-" "c-" "idl-mode-" "java-mode-" "objc-mode-" "pike-mode-"))
-;;;***
-;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/cc-styles.el
(autoload 'c-set-style "cc-styles" "\
@@ -4156,8 +3632,7 @@ calls c-set-style internally in this way whilst initializing a buffer; if
c-set-style is called like this from anywhere else, it will usually behave as
a null operation.
-\(fn STYLENAME &optional DONT-OVERRIDE)" t nil)
-
+(fn STYLENAME &optional DONT-OVERRIDE)" t nil)
(autoload 'c-add-style "cc-styles" "\
Add a style to `c-style-alist', or update an existing one.
STYLE is a string identifying the style to add or update. DESCRIPTION
@@ -4169,43 +3644,35 @@ See the variable `c-style-alist' for the semantics of BASESTYLE,
VARIABLE and VALUE. This function also sets the current style to
STYLE using `c-set-style' if the optional SET-P flag is non-nil.
-\(fn STYLE DESCRIPTION &optional SET-P)" t nil)
-
+(fn STYLE DESCRIPTION &optional SET-P)" t nil)
(autoload 'c-set-offset "cc-styles" "\
Change the value of a syntactic element symbol in `c-offsets-alist'.
SYMBOL is the syntactic element symbol to change and OFFSET is the new
offset for that syntactic element. The optional argument is not used
and exists only for compatibility reasons.
-\(fn SYMBOL OFFSET &optional IGNORED)" t nil)
-
+(fn SYMBOL OFFSET &optional IGNORED)" t nil)
(register-definition-prefixes "cc-styles" '("c-" "cc-choose-style-for-mode"))
-;;;***
-;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-vars.el
+
(put 'c-basic-offset 'safe-local-variable 'integerp)
(put 'c-backslash-column 'safe-local-variable 'integerp)
(put 'c-file-style 'safe-local-variable 'string-or-null-p)
-
(register-definition-prefixes "cc-vars" '("awk-mode-hook" "c++-" "c-" "defcustom-c-stylevar" "idl-" "java-" "objc-" "pike-"))
-;;;***
-;;;### (autoloads nil "ccl" "international/ccl.el" (0 0 0 0))
;;; Generated autoloads from international/ccl.el
(autoload 'ccl-compile "ccl" "\
Return the compiled code of CCL-PROGRAM as a vector of integers.
-\(fn CCL-PROGRAM)" nil nil)
-
+(fn CCL-PROGRAM)" nil nil)
(autoload 'ccl-dump "ccl" "\
Disassemble compiled CCL-code CODE.
-\(fn CODE)" nil nil)
-
+(fn CODE)" nil nil)
(autoload 'declare-ccl-program "ccl" "\
Declare NAME as a name of CCL program.
@@ -4217,8 +3684,7 @@ execution.
Optional arg VECTOR is a compiled CCL code of the CCL program.
-\(fn NAME &optional VECTOR)" nil t)
-
+(fn NAME &optional VECTOR)" nil t)
(autoload 'define-ccl-program "ccl" "\
Set NAME the compiled code of CCL-PROGRAM.
@@ -4463,10 +3929,9 @@ MAP-IDs := MAP-ID ...
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer
-\(fn NAME CCL-PROGRAM &optional DOC)" nil t)
-
-(function-put 'define-ccl-program 'doc-string-elt '3)
-
+(fn NAME CCL-PROGRAM &optional DOC)" nil t)
+(function-put 'define-ccl-program 'doc-string-elt 3)
+(function-put 'define-ccl-program 'lisp-indent-function 'defun)
(autoload 'check-ccl-program "ccl" "\
Check validity of CCL-PROGRAM.
If CCL-PROGRAM is a symbol denoting a CCL program, return
@@ -4474,87 +3939,63 @@ CCL-PROGRAM, else return nil.
If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied,
register CCL-PROGRAM by name NAME, and return NAME.
-\(fn CCL-PROGRAM &optional NAME)" nil t)
-
+(fn CCL-PROGRAM &optional NAME)" nil t)
(autoload 'ccl-execute-with-args "ccl" "\
Execute CCL-PROGRAM with registers initialized by the remaining args.
The return value is a vector of resulting CCL registers.
See the documentation of `define-ccl-program' for the detail of CCL program.
-\(fn CCL-PROG &rest ARGS)" nil nil)
-
+(fn CCL-PROG &rest ARGS)" nil nil)
(register-definition-prefixes "ccl" '("ccl-"))
-;;;***
-;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cconv.el
(autoload 'cconv-closure-convert "cconv" "\
Main entry point for closure conversion.
--- FORM is a piece of Elisp code after macroexpansion.
--- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST
+FORM is a piece of Elisp code after macroexpansion.
Returns a form where all lambdas don't have any free variables.
-\(fn FORM)" nil nil)
-
+(fn FORM)" nil nil)
(register-definition-prefixes "cconv" '("cconv-"))
-;;;***
-;;;### (autoloads nil "cdl" "cdl.el" (0 0 0 0))
;;; Generated autoloads from cdl.el
(register-definition-prefixes "cdl" '("cdl-"))
-;;;***
-;;;### (autoloads nil "cedet" "cedet/cedet.el" (0 0 0 0))
;;; Generated autoloads from cedet/cedet.el
-(push (purecopy '(cedet 2 0)) package--builtin-versions)
+(push (purecopy '(cedet 2 0)) package--builtin-versions)
(register-definition-prefixes "cedet" '("cedet-"))
-;;;***
-;;;### (autoloads nil "cedet-cscope" "cedet/cedet-cscope.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from cedet/cedet-cscope.el
(register-definition-prefixes "cedet-cscope" '("cedet-cscope-"))
-;;;***
-;;;### (autoloads nil "cedet-files" "cedet/cedet-files.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from cedet/cedet-files.el
(register-definition-prefixes "cedet-files" '("cedet-"))
-;;;***
-;;;### (autoloads nil "cedet-global" "cedet/cedet-global.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from cedet/cedet-global.el
(register-definition-prefixes "cedet-global" '("cedet-g"))
-;;;***
-;;;### (autoloads nil "cedet-idutils" "cedet/cedet-idutils.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from cedet/cedet-idutils.el
(register-definition-prefixes "cedet-idutils" '("cedet-idutils-"))
-;;;***
-;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cfengine.el
-(push (purecopy '(cfengine 1 4)) package--builtin-versions)
+(push (purecopy '(cfengine 1 4)) package--builtin-versions)
(autoload 'cfengine3-mode "cfengine" "\
Major mode for editing CFEngine3 input.
There are no special keybindings by default.
@@ -4562,8 +4003,7 @@ There are no special keybindings by default.
Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
to the action header.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'cfengine2-mode "cfengine" "\
Major mode for editing CFEngine2 input.
There are no special keybindings by default.
@@ -4571,16 +4011,12 @@ There are no special keybindings by default.
Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
to the action header.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'cfengine-auto-mode "cfengine" "\
Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents." t nil)
-
(register-definition-prefixes "cfengine" '("cfengine"))
-;;;***
-;;;### (autoloads nil "char-fold" "char-fold.el" (0 0 0 0))
;;; Generated autoloads from char-fold.el
(autoload 'char-fold-to-regexp "char-fold" "\
@@ -4601,42 +4037,37 @@ just return the result of calling `regexp-quote' on STRING.
FROM is for internal use. It specifies an index in the STRING
from which to start.
-\(fn STRING &optional LAX FROM)" nil nil)
-
+(fn STRING &optional LAX FROM)" nil nil)
(register-definition-prefixes "char-fold" '("char-fold-"))
-;;;***
-;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/chart.el
(register-definition-prefixes "chart" '("chart"))
-;;;***
-;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/chart.el
+
+(register-definition-prefixes "semantic/chart" '("semantic-chart-"))
+
+
;;; Generated autoloads from emacs-lisp/check-declare.el
(autoload 'check-declare-file "check-declare" "\
Check veracity of all `declare-function' statements in FILE.
See `check-declare-directory' for more information.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'check-declare-directory "check-declare" "\
Check veracity of all `declare-function' statements under directory ROOT.
Returns non-nil if any false statements are found.
-\(fn ROOT)" t nil)
-
+(fn ROOT)" t nil)
(register-definition-prefixes "check-declare" '("check-declare-"))
-;;;***
-;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emacs-lisp/checkdoc.el
+
(put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-force-history-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable #'booleanp)
@@ -4645,19 +4076,16 @@ Returns non-nil if any false statements are found.
(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-verb-check-experimental-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-symbol-words 'safe-local-variable #'checkdoc-list-of-strings-p)
-
(autoload 'checkdoc-list-of-strings-p "checkdoc" "\
Return t when OBJ is a list of strings.
-\(fn OBJ)" nil nil)
+(fn OBJ)" nil nil)
(put 'checkdoc-proper-noun-regexp 'safe-local-variable 'stringp)
(put 'checkdoc-common-verbs-regexp 'safe-local-variable 'stringp)
-
(autoload 'checkdoc "checkdoc" "\
Interactively check the entire buffer for style errors.
The current status of the check will be displayed in a buffer which
the users will view as each check is completed." '(emacs-lisp-mode) nil)
-
(autoload 'checkdoc-interactive "checkdoc" "\
Interactively check the current buffer for doc string errors.
Prefix argument START-HERE will start the checking from the current
@@ -4667,8 +4095,7 @@ errors. Does not check for comment or space warnings.
Optional argument SHOWSTATUS indicates that we should update the
checkdoc status window instead of the usual behavior.
-\(fn &optional START-HERE SHOWSTATUS)" '(emacs-lisp-mode) nil)
-
+(fn &optional START-HERE SHOWSTATUS)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-message-interactive "checkdoc" "\
Interactively check the current buffer for message string errors.
Prefix argument START-HERE will start the checking from the current
@@ -4678,27 +4105,23 @@ errors. Does not check for comment or space warnings.
Optional argument SHOWSTATUS indicates that we should update the
checkdoc status window instead of the usual behavior.
-\(fn &optional START-HERE SHOWSTATUS)" '(emacs-lisp-mode) nil)
-
+(fn &optional START-HERE SHOWSTATUS)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-eval-current-buffer "checkdoc" "\
Evaluate and check documentation for the current buffer.
Evaluation is done first because good documentation for something that
doesn't work is just not useful. Comments, doc strings, and rogue
spacing are all verified." t nil)
-
(autoload 'checkdoc-current-buffer "checkdoc" "\
Check current buffer for document, comment, error style, and rogue spaces.
With a prefix argument (in Lisp, the argument TAKE-NOTES),
store all errors found in a warnings buffer,
otherwise stop after the first error.
-\(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
-
+(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-file "checkdoc" "\
Check FILE for document, comment, error style, and rogue spaces.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'checkdoc-start "checkdoc" "\
Start scanning the current buffer for documentation string style errors.
Only documentation strings are checked.
@@ -4706,23 +4129,20 @@ Use `checkdoc-continue' to continue checking if an error cannot be fixed.
Prefix argument TAKE-NOTES means to collect all the warning messages into
a separate buffer.
-\(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
-
+(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-continue "checkdoc" "\
Find the next doc string in the current buffer which has a style error.
Prefix argument TAKE-NOTES means to continue through the whole
buffer and save warnings in a separate buffer.
-\(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
-
+(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-comments "checkdoc" "\
Find missing comment sections in the current Emacs Lisp file.
Prefix argument TAKE-NOTES non-nil means to save warnings in a
separate buffer. Otherwise print a message. This returns the error
if there is one.
-\(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
-
+(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-rogue-spaces "checkdoc" "\
Find extra spaces at the end of lines in the current file.
Prefix argument TAKE-NOTES non-nil means to save warnings in a
@@ -4730,20 +4150,17 @@ separate buffer. Otherwise print a message. This returns the error
if there is one.
Optional argument INTERACT permits more interactive fixing.
-\(fn &optional TAKE-NOTES INTERACT)" '(emacs-lisp-mode) nil)
-
+(fn &optional TAKE-NOTES INTERACT)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-message-text "checkdoc" "\
Scan the buffer for occurrences of the error function, and verify text.
Optional argument TAKE-NOTES causes all errors to be logged.
-\(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
-
+(fn &optional TAKE-NOTES)" '(emacs-lisp-mode) nil)
(autoload 'checkdoc-eval-defun "checkdoc" "\
Evaluate the current form with `eval-defun' and check its documentation.
Evaluation is done first so the form will be read before the
documentation is checked. If there is a documentation error, then the display
of what was evaluated will be overwritten by the diagnostic message." t nil)
-
(autoload 'checkdoc-defun "checkdoc" "\
Examine the doc string of the function or variable under point.
Call `error' if the doc string has problems. If NO-ERROR is
@@ -4751,122 +4168,106 @@ non-nil, then do not call error, but call `message' instead.
If the doc string passes the test, then check the function for rogue white
space at the end of each line.
-\(fn &optional NO-ERROR)" t nil)
+(fn &optional NO-ERROR)" t nil)
+(autoload 'checkdoc-dired "checkdoc" "\
+In Dired, run `checkdoc' on marked files.
+Skip anything that doesn't have the Emacs Lisp library file
+extension (\".el\").
+When called from Lisp, FILES is a list of filenames.
+(fn FILES)" '(dired-mode) nil)
(autoload 'checkdoc-ispell "checkdoc" "\
Check the style and spelling of everything interactively.
Calls `checkdoc' with spell-checking turned on.
Prefix argument is the same as for `checkdoc'." t nil)
-
(autoload 'checkdoc-ispell-current-buffer "checkdoc" "\
Check the style and spelling of the current buffer.
Calls `checkdoc-current-buffer' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-current-buffer'." t nil)
-
(autoload 'checkdoc-ispell-interactive "checkdoc" "\
Check the style and spelling of the current buffer interactively.
Calls `checkdoc-interactive' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-interactive'." t nil)
-
(autoload 'checkdoc-ispell-message-interactive "checkdoc" "\
Check the style and spelling of message text interactively.
Calls `checkdoc-message-interactive' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-message-interactive'." t nil)
-
(autoload 'checkdoc-ispell-message-text "checkdoc" "\
Check the style and spelling of message text interactively.
Calls `checkdoc-message-text' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-message-text'." t nil)
-
(autoload 'checkdoc-ispell-start "checkdoc" "\
Check the style and spelling of the current buffer.
Calls `checkdoc-start' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-start'." t nil)
-
(autoload 'checkdoc-ispell-continue "checkdoc" "\
Check the style and spelling of the current buffer after point.
Calls `checkdoc-continue' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-continue'." t nil)
-
(autoload 'checkdoc-ispell-comments "checkdoc" "\
Check the style and spelling of the current buffer's comments.
Calls `checkdoc-comments' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-comments'." t nil)
-
(autoload 'checkdoc-ispell-defun "checkdoc" "\
Check the style and spelling of the current defun with Ispell.
Calls `checkdoc-defun' with spell-checking turned on.
Prefix argument is the same as for `checkdoc-defun'." t nil)
-
(autoload 'checkdoc-minor-mode "checkdoc" "\
Toggle automatic docstring checking (Checkdoc minor mode).
-This is a minor mode. If called interactively, toggle the `Checkdoc
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `checkdoc-minor-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
In Checkdoc minor mode, the usual bindings for `eval-defun' which is
bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
checking of documentation strings.
\\{checkdoc-minor-mode-map}
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Checkdoc minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `checkdoc-minor-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'checkdoc-package-keywords "checkdoc" "\
Find package keywords that aren't in `finder-known-keywords'." t nil)
-
(register-definition-prefixes "checkdoc" '("checkdoc-"))
-;;;***
-;;;### (autoloads nil "china-util" "language/china-util.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from language/china-util.el
(autoload 'decode-hz-region "china-util" "\
Decode HZ/ZW encoded text in the current region.
Return the length of resulting text.
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'decode-hz-buffer "china-util" "\
Decode HZ/ZW encoded text in the current buffer." t nil)
-
(autoload 'encode-hz-region "china-util" "\
Encode the text in the current region to HZ.
Return the length of resulting text.
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'encode-hz-buffer "china-util" "\
Encode the text in the current buffer to HZ." t nil)
-
(autoload 'post-read-decode-hz "china-util" "\
-\(fn LEN)" nil nil)
-
+(fn LEN)" nil nil)
(autoload 'pre-write-encode-hz "china-util" "\
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(register-definition-prefixes "china-util" '("decode-hz-line-continuation" "hz-" "hz/zw-start-gb" "iso2022-" "zw-start-gb"))
-;;;***
-;;;### (autoloads nil "chistory" "chistory.el" (0 0 0 0))
;;; Generated autoloads from chistory.el
(autoload 'repeat-matching-complex-command "chistory" "\
@@ -4876,8 +4277,7 @@ a form for evaluation. If PATTERN is empty (or nil), every form in the
command history is offered. The form is placed in the minibuffer for
editing and the result is evaluated.
-\(fn &optional PATTERN)" t nil)
-
+(fn &optional PATTERN)" t nil)
(autoload 'list-command-history "chistory" "\
List history of commands that used the minibuffer.
The number of commands listed is controlled by `list-command-history-max'.
@@ -4885,26 +4285,26 @@ Calls value of `list-command-history-filter' (if non-nil) on each history
element to judge if that element should be excluded from the list.
The buffer is left in Command History mode." t nil)
-
(autoload 'command-history "chistory" "\
Examine commands from variable `command-history' in a buffer.
The number of commands listed is controlled by `list-command-history-max'.
The command history is filtered by `list-command-history-filter' if non-nil.
-Use \\<command-history-map>\\[command-history-repeat] to repeat the command on the current line.
+Use \\<command-history-mode-map>\\[command-history-repeat] to repeat the command on the current line.
Otherwise much like Emacs-Lisp Mode except that there is no self-insertion
and digits provide prefix arguments. Tab does not indent.
-\\{command-history-map}
+\\{command-history-mode-map}
This command always recompiles the Command History listing
and runs the normal hook `command-history-hook'." t nil)
-
(register-definition-prefixes "chistory" '("command-history-" "default-command-history-filter" "list-command-history-"))
-;;;***
-;;;### (autoloads nil "cl-font-lock" "progmodes/cl-font-lock.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/cl-extra.el
+
+(register-definition-prefixes "cl-extra" '("cl-"))
+
+
;;; Generated autoloads from progmodes/cl-font-lock.el
(defvar cl-font-lock-built-in-mode nil "\
@@ -4914,38 +4314,32 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `cl-font-lock-built-in-mode'.")
-
(custom-autoload 'cl-font-lock-built-in-mode "cl-font-lock" nil)
-
(autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\
Highlight built-in functions, variables, and types in `lisp-mode'.
-This is a minor mode. If called interactively, toggle the
+This is a global minor mode. If called interactively, toggle the
`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='cl-font-lock-built-in-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "cl-font-lock" '("cl-font-lock-"))
-;;;***
-;;;### (autoloads nil "cl-generic" "emacs-lisp/cl-generic.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-generic.el
-(push (purecopy '(cl-generic 1 0)) package--builtin-versions)
+(push (purecopy '(cl-generic 1 0)) package--builtin-versions)
(autoload 'cl-defgeneric "cl-generic" "\
Create a generic function NAME.
DOC-STRING is the base documentation for this class. A generic
@@ -4959,17 +4353,13 @@ OPTIONS-AND-METHODS currently understands:
- (:method [QUALIFIERS...] ARGS &rest BODY)
DEFAULT-BODY, if present, is used as the body of a default method.
-\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" nil t)
-
-(function-put 'cl-defgeneric 'lisp-indent-function '2)
-
-(function-put 'cl-defgeneric 'doc-string-elt '3)
-
+(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" nil t)
+(function-put 'cl-defgeneric 'lisp-indent-function 2)
+(function-put 'cl-defgeneric 'doc-string-elt 3)
(autoload 'cl-generic-define "cl-generic" "\
-\(fn NAME ARGS OPTIONS)" nil nil)
-
+(fn NAME ARGS OPTIONS)" nil nil)
(autoload 'cl-defmethod "cl-generic" "\
Define a new method for generic function NAME.
This defines an implementation of NAME to use for invocations
@@ -5000,7 +4390,7 @@ the method is combined with other methods, including:
:around - Method will be called around everything else
The absence of QUALIFIER means this is a \"primary\" method.
The set of acceptable qualifiers and their meaning is defined
-\(and can be extended) by the methods of `cl-generic-combine-methods'.
+(and can be extended) by the methods of `cl-generic-combine-methods'.
ARGS can also include so-called context specializers, introduced by
`&context' (which should appear right after the mandatory arguments,
@@ -5009,30 +4399,22 @@ EXPR is an Elisp expression whose value should match TYPE for the
method to be applicable.
The set of acceptable TYPEs (also called \"specializers\") is defined
-\(and can be extended) by the various methods of `cl-generic-generalizers'.
-
-\(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" nil t)
+(and can be extended) by the various methods of `cl-generic-generalizers'.
+(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" nil t)
(function-put 'cl-defmethod 'doc-string-elt 'cl--defmethod-doc-pos)
-
(function-put 'cl-defmethod 'lisp-indent-function 'defun)
-
(autoload 'cl-generic-define-method "cl-generic" "\
-\(fn NAME QUALIFIERS ARGS USES-CNM FUNCTION)" nil nil)
-
+(fn NAME QUALIFIERS ARGS CALL-CON FUNCTION)" nil nil)
(autoload 'cl-find-method "cl-generic" "\
-\(fn GENERIC QUALIFIERS SPECIALIZERS)" nil nil)
-
+(fn GENERIC QUALIFIERS SPECIALIZERS)" nil nil)
(register-definition-prefixes "cl-generic" '("cl-"))
-;;;***
-;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/cl-indent.el
(autoload 'common-lisp-indent-function "cl-indent" "\
@@ -5100,7 +4482,7 @@ property are:
specifies how to indent the associated argument.
For example, the function `case' has an indent property
-\(4 &rest (&whole 2 &rest 1)), meaning:
+(4 &rest (&whole 2 &rest 1)), meaning:
* indent the first argument by 4.
* arguments after the first should be lists, and there may be any number
of them. The first list element has an offset of 2, all the rest
@@ -5111,18 +4493,15 @@ If the current mode is actually `emacs-lisp-mode', look for a
at `common-lisp-indent-function' and, if set, use its value
instead.
-\(fn INDENT-POINT STATE)" nil nil)
-
+(fn INDENT-POINT STATE)" nil nil)
(register-definition-prefixes "cl-indent" '("common-lisp-" "lisp-"))
-;;;***
-;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-lib.el
-(push (purecopy '(cl-lib 1 0)) package--builtin-versions)
-
-(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.3")
+(push (purecopy '(cl-lib 1 0)) package--builtin-versions)
+(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "\
+24.3")
(defvar cl-custom-print-functions nil "\
This is a list of functions that format user objects for printing.
Each function is called in turn with three arguments: the object, the
@@ -5132,14 +4511,15 @@ printer proceeds to the next function on the list.
This variable is not used at present, but it is defined in hopes that
a future Emacs interpreter will be able to use it.")
-
(autoload 'cl-incf "cl-lib" "\
Increment PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The return value is the incremented value of PLACE.
-\(fn PLACE &optional X)" nil t)
+If X is specified, it should be an expression that should
+evaluate to a number.
+(fn PLACE &optional X)" nil t)
(defvar cl-old-struct-compat-mode nil "\
Non-nil if Cl-Old-Struct-Compat mode is enabled.
See the `cl-old-struct-compat-mode' command
@@ -5147,55 +4527,54 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `cl-old-struct-compat-mode'.")
-
(custom-autoload 'cl-old-struct-compat-mode "cl-lib" nil)
-
(autoload 'cl-old-struct-compat-mode "cl-lib" "\
Enable backward compatibility with old-style structs.
+
This can be needed when using code byte-compiled using the old
macro-expansion of `cl-defstruct' that used vectors objects instead
of record objects.
-This is a minor mode. If called interactively, toggle the
-`Cl-Old-Struct-Compat mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Cl-Old-Struct-Compat mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='cl-old-struct-compat-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "cl-lib" '("cl-"))
-;;;***
-;;;### (autoloads nil "cl-print" "emacs-lisp/cl-print.el" (0 0 0
-;;;;;; 0))
+;;; Generated autoloads from emacs-lisp/cl-macs.el
+
+(register-definition-prefixes "cl-macs" '("cl-" "foo" "function-form"))
+
+
;;; Generated autoloads from emacs-lisp/cl-print.el
-(push (purecopy '(cl-print 1 0)) package--builtin-versions)
+(push (purecopy '(cl-print 1 0)) package--builtin-versions)
(autoload 'cl-print-object "cl-print" "\
Dispatcher to print OBJECT on STREAM according to its type.
You can add methods to it to customize the output.
But if you just want to print something, don't call this directly:
call other entry points instead, such as `cl-prin1'.
-\(fn OBJECT STREAM)" nil nil)
-
+(fn OBJECT STREAM)" nil nil)
(autoload 'cl-print-expand-ellipsis "cl-print" "\
Print the expansion of an ellipsis to STREAM.
VALUE should be the value of the `cl-print-ellipsis' text property
which was attached to the ellipsis by `cl-prin1'.
-\(fn VALUE STREAM)" nil nil)
-
+(fn VALUE STREAM)" nil nil)
(autoload 'cl-prin1 "cl-print" "\
Print OBJECT on STREAM according to its type.
Output is further controlled by the variables
@@ -5203,13 +4582,11 @@ Output is further controlled by the variables
variables for the standard printing functions. See Info
node `(elisp)Output Variables'.
-\(fn OBJECT &optional STREAM)" nil nil)
-
+(fn OBJECT &optional STREAM)" nil nil)
(autoload 'cl-prin1-to-string "cl-print" "\
Return a string containing the `cl-prin1'-printed representation of OBJECT.
-\(fn OBJECT)" nil nil)
-
+(fn OBJECT)" nil nil)
(autoload 'cl-print-to-string-with-limit "cl-print" "\
Return a string containing a printed representation of VALUE.
Attempt to get the length of the returned string under LIMIT
@@ -5226,13 +4603,15 @@ this function with `cl-prin1-expand-ellipsis' to expand an
ellipsis, abbreviating the expansion to stay within a size
limit.
-\(fn PRINT-FUNCTION VALUE LIMIT)" nil nil)
-
+(fn PRINT-FUNCTION VALUE LIMIT)" nil nil)
(register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code"))
-;;;***
-;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/cl-seq.el
+
+(register-definition-prefixes "cl-seq" '("cl--"))
+
+
;;; Generated autoloads from progmodes/cmacexp.el
(autoload 'c-macro-expand "cmacexp" "\
@@ -5248,13 +4627,10 @@ otherwise use `c-macro-cppflags'.
Noninteractive args are START, END, SUBST.
For use inside Lisp programs, see also `c-macro-expansion'.
-\(fn START END SUBST)" t nil)
-
+(fn START END SUBST)" t nil)
(register-definition-prefixes "cmacexp" '("c-macro-"))
-;;;***
-;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (0 0 0 0))
;;; Generated autoloads from cmuscheme.el
(autoload 'run-scheme "cmuscheme" "\
@@ -5268,15 +4644,12 @@ Note that this may lose due to a timing error if the Scheme processor
discards input when it starts up.
Runs the hook `inferior-scheme-mode-hook' (after the `comint-mode-hook'
is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)
-
-\(fn CMD)" t nil)
+(Type \\[describe-mode] in the process buffer for a list of commands.)
+(fn CMD)" t nil)
(register-definition-prefixes "cmuscheme" '("cmuscheme-load-hook" "inferior-scheme-" "scheme-" "switch-to-scheme"))
-;;;***
-;;;### (autoloads nil "color" "color.el" (0 0 0 0))
;;; Generated autoloads from color.el
(autoload 'color-name-to-rgb "color" "\
@@ -5295,13 +4668,10 @@ Optional argument FRAME specifies the frame where the color is to be
displayed. If FRAME is omitted or nil, use the selected frame.
If FRAME cannot display COLOR, return nil.
-\(fn COLOR &optional FRAME)" nil nil)
-
+(fn COLOR &optional FRAME)" nil nil)
(register-definition-prefixes "color" '("color-"))
-;;;***
-;;;### (autoloads nil "comint" "comint.el" (0 0 0 0))
;;; Generated autoloads from comint.el
(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
@@ -5316,7 +4686,6 @@ See also `comint-preoutput-filter-functions'.
You can use `add-hook' to add functions to this list
either globally or locally.")
-
(autoload 'make-comint-in-buffer "comint" "\
Make a Comint process NAME in BUFFER, running PROGRAM.
If BUFFER is nil, it defaults to NAME surrounded by `*'s.
@@ -5336,8 +4705,7 @@ If PROGRAM is a string, any more args are arguments to PROGRAM.
Return the (possibly newly created) process buffer.
-\(fn NAME BUFFER PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
-
+(fn NAME BUFFER PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
(autoload 'make-comint "comint" "\
Make a Comint process NAME in a buffer, running PROGRAM.
The name of the buffer is made by surrounding NAME with `*'s.
@@ -5352,8 +4720,7 @@ If PROGRAM is a string, any more args are arguments to PROGRAM.
Returns the (possibly newly created) process buffer.
-\(fn NAME PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
-
+(fn NAME PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
(autoload 'comint-run "comint" "\
Run PROGRAM in a Comint buffer and switch to that buffer.
@@ -5366,79 +4733,66 @@ hooks on this symbol are run in the buffer.
See `make-comint' and `comint-exec'.
-\(fn PROGRAM &optional SWITCHES)" t nil)
-
+(fn PROGRAM &optional SWITCHES)" t nil)
(function-put 'comint-run 'interactive-only 'make-comint)
-
(defvar comint-file-name-prefix (purecopy "") "\
Prefix prepended to absolute file names taken from process input.
This is used by Comint's and shell's completion functions, and by shell's
directory tracking functions.")
-
(autoload 'comint-redirect-send-command "comint" "\
Send COMMAND to process in current buffer, with output to OUTPUT-BUFFER.
With prefix arg ECHO, echo output in process buffer.
If NO-DISPLAY is non-nil, do not show the output buffer.
-\(fn COMMAND OUTPUT-BUFFER ECHO &optional NO-DISPLAY)" t nil)
-
+(fn COMMAND OUTPUT-BUFFER ECHO &optional NO-DISPLAY)" t nil)
(autoload 'comint-redirect-send-command-to-process "comint" "\
Send COMMAND to PROCESS, with output to OUTPUT-BUFFER.
With prefix arg, echo output in process buffer.
If NO-DISPLAY is non-nil, do not show the output buffer.
-\(fn COMMAND OUTPUT-BUFFER PROCESS ECHO &optional NO-DISPLAY)" t nil)
-
+(fn COMMAND OUTPUT-BUFFER PROCESS ECHO &optional NO-DISPLAY)" t nil)
(autoload 'comint-redirect-results-list "comint" "\
Send COMMAND to current process.
Return a list of expressions in the output which match REGEXP.
REGEXP-GROUP is the regular expression group in REGEXP to use.
-\(fn COMMAND REGEXP REGEXP-GROUP)" nil nil)
-
+(fn COMMAND REGEXP REGEXP-GROUP)" nil nil)
(autoload 'comint-redirect-results-list-from-process "comint" "\
Send COMMAND to PROCESS.
Return a list of expressions in the output which match REGEXP.
REGEXP-GROUP is the regular expression group in REGEXP to use.
-\(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil)
-
+(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil)
(register-definition-prefixes "comint" '("comint-"))
-;;;***
-;;;### (autoloads nil "comp" "emacs-lisp/comp.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/comp.el
-(put 'no-native-compile 'safe-local-variable 'booleanp)
+(put 'no-native-compile 'safe-local-variable 'booleanp)
(autoload 'comp-subr-trampoline-install "comp" "\
Make SUBR-NAME effectively advice-able when called from native code.
-\(fn SUBR-NAME)" nil nil)
-
+(fn SUBR-NAME)" nil nil)
(autoload 'comp-c-func-name "comp" "\
Given NAME, return a name suitable for the native code.
Add PREFIX in front of it. If FIRST is not nil, pick the first
available name ignoring compilation context and potential name
clashes.
-\(fn NAME PREFIX &optional FIRST)" nil nil)
-
+(fn NAME PREFIX &optional FIRST)" nil nil)
(autoload 'comp-clean-up-stale-eln "comp" "\
Remove all FILE*.eln* files found in `native-comp-eln-load-path'.
The files to be removed are those produced from the original source
filename (including FILE).
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'comp-lookup-eln "comp" "\
Given a Lisp source FILENAME return the corresponding .eln file if found.
Search happens in `native-comp-eln-load-path'.
-\(fn FILENAME)" nil nil)
-
+(fn FILENAME)" nil nil)
(autoload 'native-compile "comp" "\
Compile FUNCTION-OR-FILE into native code.
This is the synchronous entry-point for the Emacs Lisp native
@@ -5451,8 +4805,7 @@ If FUNCTION-OR-FILE is a filename, return the filename of the
compiled object. If FUNCTION-OR-FILE is a function symbol or a
form, return the compiled function.
-\(fn FUNCTION-OR-FILE &optional OUTPUT)" nil nil)
-
+(fn FUNCTION-OR-FILE &optional OUTPUT)" nil nil)
(autoload 'batch-native-compile "comp" "\
Perform batch native compilation of remaining command-line arguments.
@@ -5464,16 +4817,14 @@ as part of building the source tarball, in which case the .eln file
will be placed under the native-lisp/ directory (actually, in the
last directory in `native-comp-eln-load-path').
-\(fn &optional FOR-TARBALL)" nil nil)
-
+(fn &optional FOR-TARBALL)" nil nil)
(autoload 'batch-byte+native-compile "comp" "\
Like `batch-native-compile', but used for bootstrap.
Generate .elc files in addition to the .eln files.
Force the produced .eln to be outputted in the eln system
directory (the last entry in `native-comp-eln-load-path') unless
`native-compile-target-directory' is non-nil. If the environment
-variable 'NATIVE_DISABLED' is set, only byte compile." nil nil)
-
+variable \"NATIVE_DISABLED\" is set, only byte compile." nil nil)
(autoload 'native-compile-async "comp" "\
Compile FILES asynchronously.
FILES is one file or a list of filenames or directories.
@@ -5493,21 +4844,20 @@ a function -- A function selecting files with matching names.
The variable `native-comp-async-jobs-number' specifies the number
of (commands) to run simultaneously.
-\(fn FILES &optional RECURSIVELY LOAD SELECTOR)" nil nil)
-
+(fn FILES &optional RECURSIVELY LOAD SELECTOR)" nil nil)
(register-definition-prefixes "comp" '("comp-" "make-comp-edge" "native-" "no-native-compile"))
-;;;***
-;;;### (autoloads nil "comp-cstr" "emacs-lisp/comp-cstr.el" (0 0
-;;;;;; 0 0))
+;;; Generated autoloads from cedet/semantic/wisent/comp.el
+
+(register-definition-prefixes "semantic/wisent/comp" '("wisent-"))
+
+
;;; Generated autoloads from emacs-lisp/comp-cstr.el
(register-definition-prefixes "comp-cstr" '("comp-" "with-comp-cstr-accessors"))
-;;;***
-;;;### (autoloads nil "compare-w" "vc/compare-w.el" (0 0 0 0))
;;; Generated autoloads from vc/compare-w.el
(autoload 'compare-windows "compare-w" "\
@@ -5539,70 +4889,52 @@ on first call it advances points to the next difference,
on second call it synchronizes points by skipping the difference,
on third call it again advances points to the next difference and so on.
-\(fn IGNORE-WHITESPACE)" t nil)
-
+(fn IGNORE-WHITESPACE)" t nil)
(register-definition-prefixes "compare-w" '("compare-"))
-;;;***
-;;;### (autoloads nil "compface" "image/compface.el" (0 0 0 0))
;;; Generated autoloads from image/compface.el
(register-definition-prefixes "compface" '("uncompface"))
-;;;***
-;;;### (autoloads nil "compile" "progmodes/compile.el" (0 0 0 0))
;;; Generated autoloads from progmodes/compile.el
(defvar compilation-mode-hook nil "\
List of hook functions run by `compilation-mode'.")
-
(custom-autoload 'compilation-mode-hook "compile" t)
-
(defvar compilation-start-hook nil "\
Hook run after starting a new compilation process.
The hook is run with one argument, the new process.")
-
(custom-autoload 'compilation-start-hook "compile" t)
-
(defvar compilation-window-height nil "\
Number of lines in a compilation window.
If nil, use Emacs default.")
-
(custom-autoload 'compilation-window-height "compile" t)
-
(defvar compilation-process-setup-function #'ignore "\
Function to call to customize the compilation process.
This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process.")
-
(defvar compilation-buffer-name-function #'compilation--default-buffer-name "\
Function to compute the name of a compilation buffer.
The function receives one argument, the name of the major mode of the
compilation buffer. It should return a string.
By default, it returns `(concat \"*\" (downcase name-of-mode) \"*\")'.")
-
(defvar compilation-finish-functions nil "\
Functions to call when a compilation process finishes.
Each function is called with two arguments: the compilation buffer,
and a string describing how the process finished.")
(put 'compilation-directory 'safe-local-variable 'stringp)
-
(defvar compilation-ask-about-save t "\
Non-nil means \\[compile] asks which buffers to save before compiling.
Otherwise, it saves all modified buffers without asking.")
-
(custom-autoload 'compilation-ask-about-save "compile" t)
-
(defvar compilation-search-path '(nil) "\
List of directories to search for source files named in error messages.
Elements should be directory names, not file names of directories.
The value nil as an element means to try the default directory.")
-
(custom-autoload 'compilation-search-path "compile" t)
-
(defvar compile-command (purecopy "make -k ") "\
Last shell command used to do a compilation; default for next compilation.
@@ -5620,17 +4952,13 @@ You might also use mode hooks to specify it in certain modes, like this:
(file-name-sans-extension buffer-file-name))))))))
It's often useful to leave a space at the end of the value.")
-
(custom-autoload 'compile-command "compile" t)
(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
-
(defvar compilation-disable-input nil "\
If non-nil, send end-of-file as compilation process input.
This only affects platforms that support asynchronous processes (see
`start-process'); synchronous compilation processes never accept input.")
-
(custom-autoload 'compilation-disable-input "compile" t)
-
(autoload 'compile "compile" "\
Compile the program including the current buffer. Default: run `make'.
Runs COMMAND, a shell command, in a separate process asynchronously
@@ -5660,8 +4988,7 @@ The name used for the buffer is actually whatever is returned by
the function in `compilation-buffer-name-function', so you can set that
to a function that generates a unique name.
-\(fn COMMAND &optional COMINT)" t nil)
-
+(fn COMMAND &optional COMINT)" t nil)
(autoload 'compilation-start "compile" "\
Run compilation command COMMAND (low level interface).
If COMMAND starts with a cd command, that becomes the `default-directory'.
@@ -5679,10 +5006,15 @@ If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
the matching section of the visited source line; the default is to use the
global value of `compilation-highlight-regexp'.
-Returns the compilation buffer created.
+If CONTINUE is non-nil, the buffer won't be emptied before
+compilation is started. This can be useful if you wish to
+combine the output from several compilation commands in the same
+buffer. The new output will be at the end of the buffer, and
+point is not changed.
-\(fn COMMAND &optional MODE NAME-FUNCTION HIGHLIGHT-REGEXP)" nil nil)
+Returns the compilation buffer created.
+(fn COMMAND &optional MODE NAME-FUNCTION HIGHLIGHT-REGEXP CONTINUE)" nil nil)
(autoload 'compilation-mode "compile" "\
Major mode for compilation log buffers.
\\<compilation-mode-map>To visit the source for a line-numbered error,
@@ -5693,69 +5025,78 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
\\{compilation-mode-map}
-\(fn &optional NAME-OF-MODE)" t nil)
-
+(fn &optional NAME-OF-MODE)" t nil)
(put 'define-compilation-mode 'doc-string-elt 3)
-
(autoload 'compilation-shell-minor-mode "compile" "\
Toggle Compilation Shell minor mode.
+When Compilation Shell minor mode is enabled, all the
+error-parsing commands of the Compilation major mode are
+available but bound to keys that don't collide with Shell mode.
+See `compilation-mode'.
+
This is a minor mode. If called interactively, toggle the
`Compilation-Shell minor mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `compilation-shell-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-When Compilation Shell minor mode is enabled, all the
-error-parsing commands of the Compilation major mode are
-available but bound to keys that don't collide with Shell mode.
-See `compilation-mode'.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'compilation-minor-mode "compile" "\
Toggle Compilation minor mode.
+When Compilation minor mode is enabled, all the error-parsing
+commands of Compilation major mode are available. See
+`compilation-mode'.
+
This is a minor mode. If called interactively, toggle the
-`Compilation minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Compilation minor mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `compilation-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-When Compilation minor mode is enabled, all the error-parsing
-commands of Compilation major mode are available. See
-`compilation-mode'.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'compilation-next-error-function "compile" "\
Advance to the next error message and visit the file where the error was.
This is the value of `next-error-function' in Compilation buffers.
-\(fn N &optional RESET)" t nil)
-
+(fn N &optional RESET)" t nil)
(register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile"))
-;;;***
-;;;### (autoloads nil "completion" "completion.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/compile.el
+
+(register-definition-prefixes "srecode/compile" '("srecode-"))
+
+
+;;; Generated autoloads from cedet/semantic/analyze/complete.el
+
+(register-definition-prefixes "semantic/analyze/complete" '("semantic-analyze-"))
+
+
+;;; Generated autoloads from cedet/semantic/complete.el
+
+(register-definition-prefixes "semantic/complete" '("semantic-"))
+
+
;;; Generated autoloads from completion.el
(defvar dynamic-completion-mode nil "\
@@ -5765,34 +5106,29 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `dynamic-completion-mode'.")
-
(custom-autoload 'dynamic-completion-mode "completion" nil)
-
(autoload 'dynamic-completion-mode "completion" "\
Toggle dynamic word-completion on or off.
-This is a minor mode. If called interactively, toggle the
-`Dynamic-Completion mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Dynamic-Completion mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='dynamic-completion-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-(register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "initialize-completions" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-"))
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-"))
-;;;***
-;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from textmodes/conf-mode.el
(autoload 'conf-mode "conf-mode" "\
@@ -5826,14 +5162,12 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
\\{conf-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-unix-mode "conf-mode" "\
Conf Mode starter for Unix style Conf files.
Comments start with `#'. For details see `conf-mode'.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-windows-mode "conf-mode" "\
Conf Mode starter for Windows style Conf files.
Comments start with `;'.
@@ -5841,15 +5175,14 @@ For details see `conf-mode'. Example:
; Conf mode font-locks this right on Windows and with \\[conf-windows-mode]
-\[ExtShellFolderViews]
+[ExtShellFolderViews]
Default={5984FFE0-28D4-11CF-AE66-08002B2E1262}
{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}
-\[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]
+[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]
PersistMoniker=file://Folder.htt
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-javaprop-mode "conf-mode" "\
Conf Mode starter for Java properties files.
Comments start with `#' but are also recognized with `//' or
@@ -5867,8 +5200,7 @@ x.1 =
x.2.y.1.z.1 =
x.2.y.1.z.2.zz =
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-space-mode "conf-mode" "\
Conf Mode starter for space separated conf files.
\"Assignments\" are with ` '. Keywords before the parameters are
@@ -5892,14 +5224,12 @@ class desktop
add /dev/audio desktop
add /dev/mixer desktop
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-space-keywords "conf-mode" "\
Enter Conf Space mode using regexp KEYWORDS to match the keywords.
See `conf-space-mode'.
-\(fn KEYWORDS)" t nil)
-
+(fn KEYWORDS)" t nil)
(autoload 'conf-colon-mode "conf-mode" "\
Conf Mode starter for Colon files.
\"Assignments\" are with `:'.
@@ -5910,8 +5240,7 @@ For details see `conf-mode'. Example:
<Multi_key> <exclam> <exclam> : \"\\241\" exclamdown
<Multi_key> <c> <slash> : \"\\242\" cent
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-ppd-mode "conf-mode" "\
Conf Mode starter for Adobe/CUPS PPD files.
Comments start with `*%' and \"assignments\" are with `:'.
@@ -5922,8 +5251,7 @@ For details see `conf-mode'. Example:
*DefaultTransfer: Null
*Transfer Null.Inverse: \"{ 1 exch sub }\"
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-xdefaults-mode "conf-mode" "\
Conf Mode starter for Xdefaults files.
Comments start with `!' and \"assignments\" are with `:'.
@@ -5934,8 +5262,7 @@ For details see `conf-mode'. Example:
*background: gray99
*foreground: black
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-toml-mode "conf-mode" "\
Conf Mode starter for TOML files.
Comments start with `#' and \"assignments\" are with `='.
@@ -5943,11 +5270,10 @@ For details see `conf-mode'. Example:
# Conf mode font-locks this right with \\[conf-toml-mode]
-\[entry]
+[entry]
value = \"some string\"
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'conf-desktop-mode "conf-mode" "\
Conf Mode started for freedesktop.org Desktop files.
Comments start with `#' and \"assignments\" are with `='.
@@ -5960,13 +5286,15 @@ For details see `conf-mode'.
Exec=gimp-2.8 %U
Terminal=false
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "conf-mode" '("conf-"))
-;;;***
-;;;### (autoloads nil "cookie1" "play/cookie1.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/config.el
+
+(register-definition-prefixes "ede/config" '("ede-"))
+
+
;;; Generated autoloads from play/cookie1.el
(autoload 'cookie "cookie1" "\
@@ -5976,33 +5304,27 @@ of load, ENDMSG at the end.
Interactively, PHRASE-FILE defaults to `cookie-file', unless that
is nil or a prefix argument is used.
-\(fn PHRASE-FILE &optional STARTMSG ENDMSG)" t nil)
-
+(fn PHRASE-FILE &optional STARTMSG ENDMSG)" t nil)
(autoload 'cookie-insert "cookie1" "\
Insert random phrases from PHRASE-FILE; COUNT of them.
When the phrase file is read in, display STARTMSG at the beginning
of load, ENDMSG at the end.
-\(fn PHRASE-FILE &optional COUNT STARTMSG ENDMSG)" nil nil)
-
+(fn PHRASE-FILE &optional COUNT STARTMSG ENDMSG)" nil nil)
(autoload 'cookie-snarf "cookie1" "\
Read the PHRASE-FILE, return it as a vector of strings.
Emit STARTMSG and ENDMSG before and after. Cache the result; second
and subsequent calls on the same file won't go to disk.
-\(fn PHRASE-FILE &optional STARTMSG ENDMSG)" nil nil)
-
+(fn PHRASE-FILE &optional STARTMSG ENDMSG)" nil nil)
(register-definition-prefixes "cookie1" '("cookie"))
-;;;***
-;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/copyright.el
+
(put 'copyright-at-end-flag 'safe-local-variable 'booleanp)
(put 'copyright-names-regexp 'safe-local-variable 'stringp)
(put 'copyright-year-ranges 'safe-local-variable 'booleanp)
-
(autoload 'copyright-update "copyright" "\
Update copyright notice to indicate the current year.
With prefix ARG, replace the years in the notice rather than adding
@@ -6012,32 +5334,26 @@ following the copyright are updated as well.
If non-nil, INTERACTIVEP tells the function to behave as when it's called
interactively.
-\(fn &optional ARG INTERACTIVEP)" t nil)
-
+(fn &optional ARG INTERACTIVEP)" t nil)
(autoload 'copyright-fix-years "copyright" "\
Convert 2 digit years to 4 digit years.
Uses heuristic: year >= 50 means 19xx, < 50 means 20xx.
If `copyright-year-ranges' (which see) is non-nil, also
independently replaces consecutive years with a range." t nil)
-
(autoload 'copyright "copyright" "\
Insert a copyright by $ORGANIZATION notice at cursor.
-\(fn &optional STR ARG)" t nil)
-
+(fn &optional STR ARG)" t nil)
(autoload 'copyright-update-directory "copyright" "\
Update copyright notice for all files in DIRECTORY matching MATCH.
If FIX is non-nil, run `copyright-fix-years' instead.
-\(fn DIRECTORY MATCH &optional FIX)" t nil)
-
+(fn DIRECTORY MATCH &optional FIX)" t nil)
(register-definition-prefixes "copyright" '("copyright-"))
-;;;***
-;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from progmodes/cperl-mode.el
+
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
(put 'cperl-continued-brace-offset 'safe-local-variable 'integerp)
@@ -6045,7 +5361,7 @@ If FIX is non-nil, run `copyright-fix-years' instead.
(put 'cperl-continued-statement-offset 'safe-local-variable 'integerp)
(put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp)
(put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp)
-
+(put 'cperl-file-style 'safe-local-variable 'stringp)
(autoload 'cperl-mode "cperl-mode" "\
Major mode for editing Perl code.
Expression and list commands understand all C brackets.
@@ -6115,10 +5431,10 @@ into
\\{cperl-mode-map}
Setting the variable `cperl-font-lock' to t switches on `font-lock-mode'
-\(even with older Emacsen), `cperl-electric-lbrace-space' to t switches
+(even with older Emacsen), `cperl-electric-lbrace-space' to t switches
on electric space between $ and {, `cperl-electric-parens-string' is
the string that contains parentheses that should be electric in CPerl
-\(see also `cperl-electric-parens-mark' and `cperl-electric-parens'),
+(see also `cperl-electric-parens-mark' and `cperl-electric-parens'),
setting `cperl-electric-keywords' enables electric expansion of
control structures in CPerl. `cperl-electric-linefeed' governs which
one of two linefeed behavior is preferable. You can enable all these
@@ -6133,7 +5449,7 @@ If your site has perl5 documentation in info format, you can use commands
These keys run commands `cperl-info-on-current-command' and
`cperl-info-on-command', which one is which is controlled by variable
`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings'
-\(in turn affected by `cperl-hairy').
+(in turn affected by `cperl-hairy').
Even if you have no info-format documentation, short one-liner-style
help is available on \\[cperl-get-help], and one can run perldoc or
@@ -6196,9 +5512,11 @@ Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith
`cperl-continued-statement-offset' 5 4 2 4 4
CPerl knows several indentation styles, and may bulk set the
-corresponding variables. Use \\[cperl-set-style] to do this. Use
-\\[cperl-set-style-back] to restore the memorized preexisting values
-\(both available from menu). See examples in `cperl-style-examples'.
+corresponding variables. Use \\[cperl-set-style] to do this or
+set the `cperl-file-style' user option. Use
+\\[cperl-set-style-back] to restore the memorized preexisting
+values (both available from menu). See examples in
+`cperl-style-examples'.
Part of the indentation style is how different parts of if/elsif/else
statements are broken into lines; in CPerl, this is reflected on how
@@ -6219,21 +5537,16 @@ DO NOT FORGET to read micro-docs (available from `Perl' menu)
or as help on variables `cperl-tips', `cperl-problems',
`cperl-praise', `cperl-speed'.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'cperl-perldoc "cperl-mode" "\
Run `perldoc' on WORD.
-\(fn WORD)" t nil)
-
+(fn WORD)" t nil)
(autoload 'cperl-perldoc-at-point "cperl-mode" "\
Run a `perldoc' on the word around point." t nil)
-
(register-definition-prefixes "cperl-mode" '("cperl-" "pod2man-program"))
-;;;***
-;;;### (autoloads nil "cpp" "progmodes/cpp.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cpp.el
(autoload 'cpp-highlight-buffer "cpp" "\
@@ -6242,16 +5555,22 @@ This command pops up a buffer which you should edit to specify
what kind of highlighting to use, and the criteria for highlighting.
A prefix arg suppresses display of that buffer.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'cpp-parse-edit "cpp" "\
Edit display information for cpp conditionals." t nil)
-
(register-definition-prefixes "cpp" '("cpp-"))
-;;;***
-;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/cpp.el
+
+(register-definition-prefixes "srecode/cpp" '("srecode-"))
+
+
+;;; Generated autoloads from cedet/ede/cpp-root.el
+
+(register-definition-prefixes "ede/cpp-root" '("ede-cpp-root-"))
+
+
;;; Generated autoloads from emacs-lisp/crm.el
(autoload 'completing-read-multiple "crm" "\
@@ -6273,13 +5592,15 @@ contents of the minibuffer are \"alice,bob,eve\" and point is between
This function returns a list of the strings that were read,
with empty strings removed.
-\(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
-
+(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
(register-definition-prefixes "crm" '("crm-"))
-;;;***
-;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/symref/cscope.el
+
+(register-definition-prefixes "semantic/symref/cscope" '("semantic-symref-cscope--line-re"))
+
+
;;; Generated autoloads from textmodes/css-mode.el
(autoload 'css-mode "css-mode" "\
@@ -6303,14 +5624,12 @@ be used to fill comments.
\\{css-mode-map}
-\(fn)" t nil)
+(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode))
-
(autoload 'scss-mode "css-mode" "\
Major mode to edit \"Sassy CSS\" files.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'css-lookup-symbol "css-mode" "\
Display the CSS documentation for SYMBOL, as found on MDN.
When this command is used interactively, it picks a default
@@ -6318,13 +5637,20 @@ symbol based on the CSS text before point -- either an @-keyword,
a property name, a pseudo-class, or a pseudo-element, depending
on what is seen near point.
-\(fn SYMBOL)" t nil)
-
+(fn SYMBOL)" t nil)
(register-definition-prefixes "css-mode" '("css-" "scss-"))
-;;;***
-;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/ctxt.el
+
+(register-definition-prefixes "srecode/ctxt" '("srecode-"))
+
+
+;;; Generated autoloads from cedet/semantic/ctxt.el
+
+(register-definition-prefixes "semantic/ctxt" '("semantic-"))
+
+
;;; Generated autoloads from emulation/cua-base.el
(defvar cua-mode nil "\
@@ -6334,26 +5660,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `cua-mode'.")
-
(custom-autoload 'cua-mode "cua-base" nil)
-
(autoload 'cua-mode "cua-base" "\
Toggle Common User Access style editing (CUA mode).
-This is a minor mode. If called interactively, toggle the `Cua mode'
-mode. If the prefix argument is positive, enable the mode, and if it
-is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='cua-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
CUA mode is a global minor mode. When enabled, typed text
replaces the active selection, and you can use C-z, C-x, C-c, and
C-v to undo, cut, copy, and paste in addition to the normal Emacs
@@ -6372,81 +5682,87 @@ You can customize `cua-enable-cua-keys' to completely disable the
CUA bindings, or `cua-prefix-override-inhibit-delay' to change
the prefix fallback behavior.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Cua mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='cua-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'cua-selection-mode "cua-base" "\
Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "cua-base" '("cua-"))
-;;;***
-;;;### (autoloads nil "cua-gmrk" "emulation/cua-gmrk.el" (0 0 0 0))
;;; Generated autoloads from emulation/cua-gmrk.el
(register-definition-prefixes "cua-gmrk" '("cua-"))
-;;;***
-;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (0 0 0 0))
;;; Generated autoloads from emulation/cua-rect.el
(autoload 'cua-rectangle-mark-mode "cua-rect" "\
Toggle the region as rectangular.
+
Activates the region if needed. Only lasts until the region is deactivated.
This is a minor mode. If called interactively, toggle the
-`Cua-Rectangle-Mark mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Cua-Rectangle-Mark mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `cua-rectangle-mark-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "cua-rect" '("cua-"))
-;;;***
-;;;### (autoloads nil "cursor-sensor" "emacs-lisp/cursor-sensor.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cursor-sensor.el
(defvar cursor-sensor-inhibit nil "\
When non-nil, suspend `cursor-sensor-mode' and `cursor-intangible-mode'.
By convention, this is a list of symbols where each symbol stands for the
\"cause\" of the suspension.")
-
(autoload 'cursor-intangible-mode "cursor-sensor" "\
Keep cursor outside of any `cursor-intangible' text property.
This is a minor mode. If called interactively, toggle the
-`Cursor-Intangible mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Cursor-Intangible mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `cursor-intangible-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'cursor-sensor-mode "cursor-sensor" "\
Handle the `cursor-sensor-functions' text property.
+
This property should hold a list of functions which react to the motion
of the cursor. They're called with three arguments (WINDOW OLDPOS DIR)
where WINDOW is the affected window, OLDPOS is the last known position of
@@ -6454,50 +5770,39 @@ the cursor and DIR can be `entered' or `left' depending on whether the cursor
is entering the area covered by the text-property property or leaving it.
This is a minor mode. If called interactively, toggle the
-`Cursor-Sensor mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Cursor-Sensor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `cursor-sensor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))
-;;;***
-;;;### (autoloads nil "cus-dep" "cus-dep.el" (0 0 0 0))
;;; Generated autoloads from cus-dep.el
(register-definition-prefixes "cus-dep" '("custom-" "generated-custom-dependencies-file"))
-;;;***
-;;;### (autoloads nil "cus-edit" "cus-edit.el" (0 0 0 0))
;;; Generated autoloads from cus-edit.el
(defvar custom-browse-sort-alphabetically nil "\
If non-nil, sort customization group alphabetically in `custom-browse'.")
-
(custom-autoload 'custom-browse-sort-alphabetically "cus-edit" t)
-
(defvar custom-buffer-sort-alphabetically t "\
Whether to sort customization groups alphabetically in Custom buffer.")
-
(custom-autoload 'custom-buffer-sort-alphabetically "cus-edit" t)
-
(defvar custom-menu-sort-alphabetically nil "\
If non-nil, sort each customization group alphabetically in menus.")
-
(custom-autoload 'custom-menu-sort-alphabetically "cus-edit" t)
-
(autoload 'customize-set-value "cus-edit" "\
Set VARIABLE to VALUE, and return VALUE. VALUE is a Lisp object.
@@ -6509,8 +5814,7 @@ If VARIABLE has a `custom-type' property, it must be a widget and the
If given a prefix (or a COMMENT argument), also prompt for a comment.
-\(fn VARIABLE VALUE &optional COMMENT)" t nil)
-
+(fn VARIABLE VALUE &optional COMMENT)" t nil)
(autoload 'customize-set-variable "cus-edit" "\
Set the default for VARIABLE to VALUE, and return VALUE.
VALUE is a Lisp object.
@@ -6526,8 +5830,18 @@ If VARIABLE has a `custom-type' property, it must be a widget and the
If given a prefix (or a COMMENT argument), also prompt for a comment.
-\(fn VARIABLE VALUE &optional COMMENT)" t nil)
+(fn VARIABLE VALUE &optional COMMENT)" t nil)
+(autoload 'setopt "cus-edit" "\
+Set VARIABLE/VALUE pairs, and return the final VALUE.
+This is like `setq', but is meant for user options instead of
+plain variables. This means that `setopt' will execute any
+`custom-set' form associated with VARIABLE.
+(fn [VARIABLE VALUE]...)" nil t)
+(autoload 'setopt--set "cus-edit" "\
+
+
+(fn VARIABLE VALUE)" nil nil)
(autoload 'customize-save-variable "cus-edit" "\
Set the default for VARIABLE to VALUE, and save it for future sessions.
Return VALUE.
@@ -6543,8 +5857,7 @@ If VARIABLE has a `custom-type' property, it must be a widget and the
If given a prefix (or a COMMENT argument), also prompt for a comment.
-\(fn VARIABLE VALUE &optional COMMENT)" t nil)
-
+(fn VARIABLE VALUE &optional COMMENT)" t nil)
(autoload 'customize-push-and-save "cus-edit" "\
Add ELTS to LIST-VAR and save for future sessions, safely.
ELTS should be a list. This function adds each entry to the
@@ -6554,48 +5867,39 @@ If Emacs is initialized, call `customize-save-variable' to save
the resulting list value now. Otherwise, add an entry to
`after-init-hook' to save it after initialization.
-\(fn LIST-VAR ELTS)" nil nil)
-
+(fn LIST-VAR ELTS)" nil nil)
(autoload 'customize "cus-edit" "\
Select a customization buffer which you can use to set user options.
User options are structured into \"groups\".
Initially the top-level group `Emacs' and its immediate subgroups
are shown; the contents of those subgroups are initially hidden." t nil)
-
(autoload 'customize-mode "cus-edit" "\
Customize options related to a major or minor mode.
By default the current major mode is used. With a prefix
argument or if the current major mode has no known group, prompt
for the MODE to customize.
-\(fn MODE)" t nil)
-
+(fn MODE)" t nil)
(autoload 'customize-group "cus-edit" "\
Customize GROUP, which must be a customization group.
If OTHER-WINDOW is non-nil, display in another window.
-\(fn &optional GROUP OTHER-WINDOW)" t nil)
-
+(fn &optional GROUP OTHER-WINDOW)" t nil)
(autoload 'customize-group-other-window "cus-edit" "\
Customize GROUP, which must be a customization group, in another window.
-\(fn &optional GROUP)" t nil)
-
+(fn &optional GROUP)" t nil)
(defalias 'customize-variable 'customize-option)
-
(autoload 'customize-option "cus-edit" "\
Customize SYMBOL, which must be a user option.
-\(fn SYMBOL)" t nil)
-
+(fn SYMBOL)" t nil)
(defalias 'customize-variable-other-window 'customize-option-other-window)
-
(autoload 'customize-option-other-window "cus-edit" "\
Customize SYMBOL, which must be a user option.
Show the buffer in another window, but don't select it.
-\(fn SYMBOL)" t nil)
-
+(fn SYMBOL)" t nil)
(defvar customize-package-emacs-version-alist nil "\
Alist mapping versions of a package to Emacs versions.
We use this for packages that have their own names, but are released
@@ -6626,9 +5930,7 @@ The value of PACKAGE needs to be unique and it needs to match the
PACKAGE value appearing in the :package-version keyword. Since
the user might see the value in an error message, a good choice is
the official name of the package, such as MH-E or Gnus.")
-
(define-obsolete-function-alias 'customize-changed-options #'customize-changed "28.1")
-
(autoload 'customize-changed "cus-edit" "\
Customize all settings whose meanings have changed in Emacs itself.
This includes new user options and faces, and new customization
@@ -6639,8 +5941,7 @@ release.
With argument SINCE-VERSION (a string), customize all settings
that were added or redefined since that version.
-\(fn &optional SINCE-VERSION)" t nil)
-
+(fn &optional SINCE-VERSION)" t nil)
(autoload 'customize-face "cus-edit" "\
Customize FACE, which should be a face name or nil.
If FACE is nil, customize all faces. If FACE is actually a
@@ -6651,8 +5952,7 @@ If OTHER-WINDOW is non-nil, display in another window.
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable.
-\(fn &optional FACE OTHER-WINDOW)" t nil)
-
+(fn &optional FACE OTHER-WINDOW)" t nil)
(autoload 'customize-face-other-window "cus-edit" "\
Show customization buffer for face FACE in other window.
If FACE is actually a face-alias, customize the face it is aliased to.
@@ -6660,17 +5960,13 @@ If FACE is actually a face-alias, customize the face it is aliased to.
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable.
-\(fn &optional FACE)" t nil)
-
+(fn &optional FACE)" t nil)
(autoload 'customize-unsaved "cus-edit" "\
Customize all options and faces set in this session but not saved." t nil)
-
(autoload 'customize-rogue "cus-edit" "\
Customize all user variables modified outside customize." t nil)
-
(autoload 'customize-saved "cus-edit" "\
Customize all saved options and faces." t nil)
-
(autoload 'customize-apropos "cus-edit" "\
Customize loaded options, faces and groups matching PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@@ -6682,28 +5978,23 @@ If TYPE is `options', include only options.
If TYPE is `faces', include only faces.
If TYPE is `groups', include only groups.
-\(fn PATTERN &optional TYPE)" t nil)
-
+(fn PATTERN &optional TYPE)" t nil)
(autoload 'customize-apropos-options "cus-edit" "\
Customize all loaded customizable options matching REGEXP.
-\(fn REGEXP &optional IGNORED)" t nil)
-
+(fn REGEXP &optional IGNORED)" t nil)
(autoload 'customize-apropos-faces "cus-edit" "\
Customize all loaded faces matching REGEXP.
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(autoload 'customize-apropos-groups "cus-edit" "\
Customize all loaded groups matching REGEXP.
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(autoload 'custom-prompt-customize-unsaved-options "cus-edit" "\
Prompt user to customize any unsaved customization options.
Return nil if user chooses to customize, for use in
`kill-emacs-query-functions'." nil nil)
-
(autoload 'custom-buffer-create "cus-edit" "\
Create a buffer containing OPTIONS.
Optional NAME is the name of the buffer.
@@ -6712,8 +6003,7 @@ SYMBOL is a customization option, and WIDGET is a widget for editing
that option.
DESCRIPTION is unused.
-\(fn OPTIONS &optional NAME DESCRIPTION)" nil nil)
-
+(fn OPTIONS &optional NAME DESCRIPTION)" nil nil)
(autoload 'custom-buffer-create-other-window "cus-edit" "\
Create a buffer containing OPTIONS, and display it in another window.
The result includes selecting that window.
@@ -6723,13 +6013,11 @@ SYMBOL is a customization option, and WIDGET is a widget for editing
that option.
DESCRIPTION is unused.
-\(fn OPTIONS &optional NAME DESCRIPTION)" nil nil)
-
+(fn OPTIONS &optional NAME DESCRIPTION)" nil nil)
(autoload 'customize-browse "cus-edit" "\
Create a tree browser for the customize hierarchy.
-\(fn &optional GROUP)" t nil)
-
+(fn &optional GROUP)" t nil)
(defvar custom-file nil "\
File used for storing customization information.
The default is nil, which means to use your init file
@@ -6740,8 +6028,8 @@ You can set this option through Custom, if you carefully read the
last paragraph below. However, usually it is simpler to write
something like the following in your init file:
-\(setq custom-file \"~/.config/emacs-custom.el\")
-\(load custom-file)
+(setq custom-file \"~/.config/emacs-custom.el\")
+(load custom-file)
Note that both lines are necessary: the first line tells Custom to
save all customizations in this file, but does not load it.
@@ -6762,34 +6050,26 @@ want. You also have to put something like (load \"CUSTOM-FILE\")
in your init file, where CUSTOM-FILE is the actual name of the
file. Otherwise, Emacs will not load the file when it starts up,
and hence will not set `custom-file' to that file either.")
-
(custom-autoload 'custom-file "cus-edit" t)
-
(autoload 'custom-save-all "cus-edit" "\
Save all customizations in `custom-file'." nil nil)
-
(autoload 'customize-save-customized "cus-edit" "\
Save all user options which have been set in this session." t nil)
-
(autoload 'custom-menu-create "cus-edit" "\
Create menu for customization group SYMBOL.
The menu is in a format applicable to `easy-menu-define'.
-\(fn SYMBOL)" nil nil)
-
+(fn SYMBOL)" nil nil)
(autoload 'customize-menu-create "cus-edit" "\
Return a customize menu for customization group SYMBOL.
If optional NAME is given, use that as the name of the menu.
Otherwise the menu will be named `Customize'.
The format is suitable for use with `easy-menu-define'.
-\(fn SYMBOL &optional NAME)" nil nil)
-
+(fn SYMBOL &optional NAME)" nil nil)
(register-definition-prefixes "cus-edit" '("Custom-" "cus" "widget-"))
-;;;***
-;;;### (autoloads nil "cus-theme" "cus-theme.el" (0 0 0 0))
;;; Generated autoloads from cus-theme.el
(autoload 'customize-create-theme "cus-theme" "\
@@ -6801,73 +6081,66 @@ from the Custom save file.
BUFFER, if non-nil, should be a buffer to use; the default is
named *Custom Theme*.
-\(fn &optional THEME BUFFER)" t nil)
-
+(fn &optional THEME BUFFER)" t nil)
(autoload 'custom-theme-visit-theme "cus-theme" "\
Set up a Custom buffer to edit custom theme THEME.
-\(fn THEME)" t nil)
-
+(fn THEME)" t nil)
(autoload 'describe-theme "cus-theme" "\
Display a description of the Custom theme THEME (a symbol).
-\(fn THEME)" t nil)
-
+(fn THEME)" t nil)
(autoload 'customize-themes "cus-theme" "\
Display a selectable list of Custom themes.
When called from Lisp, BUFFER should be the buffer to use; if
omitted, a buffer named *Custom Themes* is used.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(register-definition-prefixes "cus-theme" '("custom-" "describe-theme-1"))
-;;;***
-;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/custom.el
+
+(register-definition-prefixes "ede/custom" '("ede-" "eieio-ede-old-variables"))
+
+
;;; Generated autoloads from vc/cvs-status.el
(autoload 'cvs-status-mode "cvs-status" "\
Mode used for cvs status output.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "cvs-status" '("cvs-"))
-;;;***
-;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cwarn.el
(autoload 'cwarn-mode "cwarn" "\
Minor mode that highlights suspicious C and C++ constructions.
-This is a minor mode. If called interactively, toggle the `Cwarn
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `cwarn-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Suspicious constructs are highlighted using `font-lock-warning-face'.
Note, in addition to enabling this minor mode, the major mode must
be included in the variable `cwarn-configuration'. By default C and
C++ modes are included.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the `Cwarn
+mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
-(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
+To check whether the minor mode is enabled in the current buffer,
+evaluate `cwarn-mode'.
-(put 'global-cwarn-mode 'globalized-minor-mode t)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
+(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
+(put 'global-cwarn-mode 'globalized-minor-mode t)
(defvar global-cwarn-mode nil "\
Non-nil if Global Cwarn mode is enabled.
See the `global-cwarn-mode' command
@@ -6875,9 +6148,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-cwarn-mode'.")
-
(custom-autoload 'global-cwarn-mode "cwarn" nil)
-
(autoload 'global-cwarn-mode "cwarn" "\
Toggle Cwarn mode in all buffers.
With prefix ARG, enable Global Cwarn mode if ARG is positive;
@@ -6892,26 +6163,20 @@ Cwarn mode is enabled in all buffers where
See `cwarn-mode' for more information on Cwarn mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "cwarn" '("cwarn-" "turn-on-cwarn-mode-if-enabled"))
-;;;***
-;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from language/cyril-util.el
(autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\
Return KOI8-R external character code of CHAR if appropriate.
-\(fn CHAR)" nil nil)
-
+(fn CHAR)" nil nil)
(autoload 'cyrillic-encode-alternativnyj-char "cyril-util" "\
Return ALTERNATIVNYJ external character code of CHAR if appropriate.
-\(fn CHAR)" nil nil)
-
+(fn CHAR)" nil nil)
(autoload 'standard-display-cyrillic-translit "cyril-util" "\
Display a Cyrillic buffer using a transliteration.
For readability, the table is slightly
@@ -6923,19 +6188,16 @@ Possible values are listed in `cyrillic-language-alist'.
If the argument is t, we use the default cyrillic transliteration.
If the argument is nil, we return the display table to its standard state.
-\(fn &optional CYRILLIC-LANGUAGE)" t nil)
-
+(fn &optional CYRILLIC-LANGUAGE)" t nil)
(register-definition-prefixes "cyril-util" '("cyrillic-language-alist"))
-;;;***
-;;;### (autoloads nil "dabbrev" "dabbrev.el" (0 0 0 0))
;;; Generated autoloads from dabbrev.el
+
(put 'dabbrev-case-fold-search 'risky-local-variable t)
(put 'dabbrev-case-replace 'risky-local-variable t)
(define-key esc-map "/" 'dabbrev-expand)
(define-key esc-map [?\C-/] 'dabbrev-completion)
-
(autoload 'dabbrev-completion "dabbrev" "\
Completion on current word.
Like \\[dabbrev-expand] but finds all expansions in the current buffer
@@ -6948,8 +6210,7 @@ completions.
If the prefix argument is 16 (which comes from \\[universal-argument] \\[universal-argument]),
then it searches *all* buffers.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'dabbrev-expand "dabbrev" "\
Expand previous word \"dynamically\".
@@ -6974,25 +6235,74 @@ direction of search to backward if set non-nil.
See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion].
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "dabbrev" '("dabbrev-"))
-;;;***
-;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (0 0 0 0))
;;; Generated autoloads from cedet/data-debug.el
(autoload 'data-debug-new-buffer "data-debug" "\
Create a new data-debug buffer with NAME.
-\(fn NAME)" nil nil)
-
+(fn NAME)" nil nil)
(register-definition-prefixes "data-debug" '("data-debug-"))
-;;;***
-;;;### (autoloads nil "dbus" "net/dbus.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/db.el
+
+(register-definition-prefixes "semantic/db" '("semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-debug.el
+
+(register-definition-prefixes "semantic/db-debug" '("semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-ebrowse.el
+
+(register-definition-prefixes "semantic/db-ebrowse" '("c++-mode" "semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-el.el
+
+(register-definition-prefixes "semantic/db-el" '("emacs-lisp-mode" "semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-file.el
+
+(register-definition-prefixes "semantic/db-file" '("semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-find.el
+
+(register-definition-prefixes "semantic/db-find" '("semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-global.el
+
+(register-definition-prefixes "semantic/db-global" '("semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-javascript.el
+
+(register-definition-prefixes "semantic/db-javascript" '("javascript-mode" "semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-mode.el
+
+(register-definition-prefixes "semantic/db-mode" '("semanticdb-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-ref.el
+
+(register-definition-prefixes "semantic/db-ref" '("semanticdb-ref-"))
+
+
+;;; Generated autoloads from cedet/semantic/db-typecache.el
+
+(register-definition-prefixes "semantic/db-typecache" '("semanticdb-"))
+
+
;;; Generated autoloads from net/dbus.el
(autoload 'dbus-handle-event "dbus" "\
@@ -7001,22 +6311,17 @@ EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
part of the event, is called with arguments ARGS (without type information).
If the HANDLER returns a `dbus-error', it is propagated as return message.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(function-put 'dbus-handle-event 'completion-predicate #'ignore)
-
(autoload 'dbus-monitor "dbus" "\
Invoke `dbus-register-monitor' interactively, and switch to the buffer.
BUS is either a Lisp keyword, `:system' or `:session', or a
string denoting the bus address. The value nil defaults to `:session'.
-\(fn &optional BUS)" t nil)
-
+(fn &optional BUS)" t nil)
(register-definition-prefixes "dbus" '("dbus-"))
-;;;***
-;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (0 0 0 0))
;;; Generated autoloads from progmodes/dcl-mode.el
(autoload 'dcl-mode "dcl-mode" "\
@@ -7137,17 +6442,13 @@ $
There is some minimal font-lock support (see vars
`dcl-font-lock-defaults' and `dcl-font-lock-keywords').
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "dcl-mode" '("dcl-"))
-;;;***
-;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
-
(autoload 'debug "debug" "\
Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger.
Arguments are mainly for use when this is called from the internals
@@ -7160,8 +6461,7 @@ first will be printed into the backtrace buffer.
If `inhibit-redisplay' is non-nil when this function is called,
the debugger will not be entered.
-\(fn &rest ARGS)" t nil)
-
+(fn &rest ARGS)" t nil)
(autoload 'debug-on-entry "debug" "\
Request FUNCTION to invoke debugger each time it is called.
@@ -7177,16 +6477,14 @@ primitive functions only works when that function is called from Lisp.
Use \\[cancel-debug-on-entry] to cancel the effect of this command.
Redefining FUNCTION also cancels it.
-\(fn FUNCTION)" t nil)
-
+(fn FUNCTION)" t nil)
(autoload 'cancel-debug-on-entry "debug" "\
Undo effect of \\[debug-on-entry] on FUNCTION.
If FUNCTION is nil, cancel `debug-on-entry' for all functions.
When called interactively, prompt for FUNCTION in the minibuffer.
To specify a nil argument interactively, exit with an empty minibuffer.
-\(fn &optional FUNCTION)" t nil)
-
+(fn &optional FUNCTION)" t nil)
(autoload 'debug-on-variable-change "debug" "\
Trigger a debugger invocation when VARIABLE is changed.
@@ -7205,30 +6503,38 @@ Use \\[cancel-debug-on-variable-change] to cancel the effect of
this command. Uninterning VARIABLE or making it an alias of
another symbol also cancels it.
-\(fn VARIABLE)" t nil)
-
+(fn VARIABLE)" t nil)
(defalias 'debug-watch #'debug-on-variable-change)
-
(autoload 'cancel-debug-on-variable-change "debug" "\
Undo effect of \\[debug-on-variable-change] on VARIABLE.
If VARIABLE is nil, cancel `debug-on-variable-change' for all variables.
When called interactively, prompt for VARIABLE in the minibuffer.
To specify a nil argument interactively, exit with an empty minibuffer.
-\(fn &optional VARIABLE)" t nil)
-
+(fn &optional VARIABLE)" t nil)
(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
-
(register-definition-prefixes "debug" '("debug" "inhibit-debug-on-entry"))
-;;;***
-;;;### (autoloads nil "decipher" "play/decipher.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/bovine/debug.el
+
+(register-definition-prefixes "semantic/bovine/debug" '("semantic-"))
+
+
+;;; Generated autoloads from cedet/semantic/analyze/debug.el
+
+(register-definition-prefixes "semantic/analyze/debug" '("semantic-analyze"))
+
+
+;;; Generated autoloads from cedet/semantic/debug.el
+
+(register-definition-prefixes "semantic/debug" '("semantic-debug-"))
+
+
;;; Generated autoloads from play/decipher.el
(autoload 'decipher "decipher" "\
Format a buffer of ciphertext for cryptanalysis and enter Decipher mode." t nil)
-
(autoload 'decipher-mode "decipher" "\
Major mode for decrypting monoalphabetic substitution ciphers.
Lower-case letters enter plaintext.
@@ -7245,18 +6551,19 @@ The most useful commands are:
\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "decipher" '("decipher-"))
-;;;***
-;;;### (autoloads nil "delim-col" "delim-col.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/decorate.el
+
+(register-definition-prefixes "semantic/decorate" '("semantic-"))
+
+
;;; Generated autoloads from delim-col.el
(autoload 'delimit-columns-customize "delim-col" "\
Customize the `columns' group." t nil)
-
(autoload 'delimit-columns-region "delim-col" "\
Prettify all columns in a text region.
@@ -7280,8 +6587,7 @@ See the `delimit-columns-str-before',
`delimit-columns-extra' variables for customization of the
look.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'delimit-columns-rectangle "delim-col" "\
Prettify all columns in a text rectangle.
@@ -7289,17 +6595,13 @@ See `delimit-columns-region' for what this entails.
START and END delimit the corners of the text rectangle.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(register-definition-prefixes "delim-col" '("delimit-columns-"))
-;;;***
-;;;### (autoloads nil "delsel" "delsel.el" (0 0 0 0))
;;; Generated autoloads from delsel.el
(defalias 'pending-delete-mode 'delete-selection-mode)
-
(defvar delete-selection-mode nil "\
Non-nil if Delete-Selection mode is enabled.
See the `delete-selection-mode' command
@@ -7307,26 +6609,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `delete-selection-mode'.")
-
(custom-autoload 'delete-selection-mode "delsel" nil)
-
(autoload 'delete-selection-mode "delsel" "\
Toggle Delete Selection mode.
-This is a minor mode. If called interactively, toggle the
-`Delete-Selection mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='delete-selection-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When Delete Selection mode is enabled, typed text replaces the selection
if the selection is active. Otherwise, typed text is just inserted at
point regardless of any selection.
@@ -7334,20 +6620,36 @@ point regardless of any selection.
See `delete-selection-helper' and `delete-selection-pre-hook' for
information on adapting behavior of commands in Delete Selection mode.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Delete-Selection mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='delete-selection-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'delete-active-region "delsel" "\
Delete the active region.
If KILLP is non-nil, or if called interactively with a prefix argument,
the active region is killed instead of deleted.
-\(fn &optional KILLP)" t nil)
-
+(fn &optional KILLP)" t nil)
(register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit"))
-;;;***
-;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/dep.el
+
+(register-definition-prefixes "semantic/dep" '("defcustom-mode-local-semantic-dependency-system-include-path" "semantic-"))
+
+
;;; Generated autoloads from emacs-lisp/derived.el
(autoload 'define-derived-mode "derived" "\
@@ -7409,23 +6711,19 @@ the hook will be named `foo-mode-hook'.
See Info node `(elisp)Derived Modes' for more details.
-\(fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t)
-
-(function-put 'define-derived-mode 'doc-string-elt '4)
-
+(fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)" nil t)
+(function-put 'define-derived-mode 'doc-string-elt 4)
+(function-put 'define-derived-mode 'lisp-indent-function 'defun)
(autoload 'derived-mode-init-mode-variables "derived" "\
Initialize variables for a new MODE.
Right now, if they don't already exist, set up a blank keymap, an
empty syntax table, and an empty abbrev table -- these will be merged
the first time the mode is used.
-\(fn MODE)" nil nil)
-
+(fn MODE)" nil nil)
(register-definition-prefixes "derived" '("derived-mode-"))
-;;;***
-;;;### (autoloads nil "descr-text" "descr-text.el" (0 0 0 0))
;;; Generated autoloads from descr-text.el
(autoload 'describe-text-properties "descr-text" "\
@@ -7436,8 +6734,7 @@ If optional second argument OUTPUT-BUFFER is non-nil,
insert the output into that buffer, and don't initialize or clear it
otherwise.
-\(fn POS &optional OUTPUT-BUFFER BUFFER)" t nil)
-
+(fn POS &optional OUTPUT-BUFFER BUFFER)" t nil)
(autoload 'describe-char "descr-text" "\
Describe position POS (interactively, point) and the char after POS.
POS is taken to be in BUFFER, or the current buffer if BUFFER is nil.
@@ -7464,8 +6761,7 @@ The character information includes:
Unicode Data Base;
and widgets, buttons, overlays, and text properties relevant to POS.
-\(fn POS &optional BUFFER)" t nil)
-
+(fn POS &optional BUFFER)" t nil)
(autoload 'describe-char-eldoc "descr-text" "\
Return a description of character at point for use by ElDoc mode.
@@ -7479,13 +6775,10 @@ minibuffer window for width limit.
This function can be used as a value of
`eldoc-documentation-functions' variable.
-\(fn CALLBACK &rest _)" nil nil)
-
+(fn CALLBACK &rest _)" nil nil)
(register-definition-prefixes "descr-text" '("describe-"))
-;;;***
-;;;### (autoloads nil "desktop" "desktop.el" (0 0 0 0))
;;; Generated autoloads from desktop.el
(defvar desktop-save-mode nil "\
@@ -7495,26 +6788,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `desktop-save-mode'.")
-
(custom-autoload 'desktop-save-mode "desktop" nil)
-
(autoload 'desktop-save-mode "desktop" "\
Toggle desktop saving (Desktop Save mode).
-This is a minor mode. If called interactively, toggle the
-`Desktop-Save mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='desktop-save-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When Desktop Save mode is enabled, the state of Emacs is saved from
one session to another. In particular, Emacs will save the desktop when
it exits (this may prompt you; see the option `desktop-save'). The next
@@ -7530,15 +6807,26 @@ To see all the options you can set, browse the `desktop' customization group.
For further details, see info node `(emacs)Saving Emacs Sessions'.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Desktop-Save mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='desktop-save-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines case-fold-search case-replace fill-column overwrite-mode change-log-default-name line-number-mode column-number-mode size-indication-mode buffer-file-coding-system buffer-display-time indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) "\
List of local variables to save for each buffer.
The variables are saved only when they really are local. Conventional minor
modes are restored automatically; they should not be listed here.")
-
(custom-autoload 'desktop-locals-to-save "desktop" t)
-
(defvar-local desktop-save-buffer nil "\
When non-nil, save buffer status in desktop file.
@@ -7552,7 +6840,6 @@ When file names are returned, they should be formatted using the call
Later, when `desktop-read' evaluates the desktop file, auxiliary information
is passed as the argument DESKTOP-BUFFER-MISC to functions in
`desktop-buffer-mode-handlers'.")
-
(defvar desktop-buffer-mode-handlers nil "\
Alist of major mode specific functions to restore a desktop buffer.
Functions listed are called by `desktop-create-buffer' when `desktop-read'
@@ -7591,9 +6878,7 @@ code like
The major mode function must either be autoloaded, or of the form
\"foobar-mode\" and defined in library \"foobar\", so that desktop
can guess how to load the mode's definition.")
-
(put 'desktop-buffer-mode-handlers 'risky-local-variable t)
-
(defvar desktop-minor-mode-handlers nil "\
Alist of functions to restore non-standard minor modes.
Functions are called by `desktop-create-buffer' to restore minor modes.
@@ -7637,9 +6922,7 @@ The minor mode function must either be autoloaded, or of the form
can guess how to load the mode's definition.
See also `desktop-minor-mode-table'.")
-
(put 'desktop-minor-mode-handlers 'risky-local-variable t)
-
(autoload 'desktop-clear "desktop" "\
Empty the Desktop.
This kills all buffers except for internal ones and those with names matched by
@@ -7648,7 +6931,6 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'.
When called interactively and `desktop-restore-frames' is non-nil, it also
deletes all frames except the selected one (and its minibuffer frame,
if different)." t nil)
-
(autoload 'desktop-save "desktop" "\
Save the state of Emacs in a desktop file in directory DIRNAME.
Optional argument RELEASE non-nil says we're done with this
@@ -7684,12 +6966,10 @@ In a non-interactive call, VERSION can be given as an integer, either
206 or 208, to specify the format version in which to save the file,
no questions asked.
-\(fn DIRNAME &optional RELEASE ONLY-IF-CHANGED VERSION)" t nil)
-
+(fn DIRNAME &optional RELEASE ONLY-IF-CHANGED VERSION)" t nil)
(autoload 'desktop-remove "desktop" "\
Delete desktop file in `desktop-dirname'.
This function also sets `desktop-dirname' to nil." t nil)
-
(autoload 'desktop-read "desktop" "\
Read and process the desktop file in directory DIRNAME.
Look for a desktop file in DIRNAME, or if DIRNAME is omitted, look in
@@ -7700,27 +6980,26 @@ Interactively, with prefix arg \\[universal-argument], ask for DIRNAME.
This function is a no-op when Emacs is running in batch mode.
It returns t if a desktop file was loaded, nil otherwise.
-\(fn DIRNAME)" t nil)
-
+(fn DIRNAME)" t nil)
(autoload 'desktop-change-dir "desktop" "\
Change to desktop saved in DIRNAME.
Kill the desktop as specified by variables `desktop-save-mode' and
`desktop-save', then clear the desktop and load the desktop file in
directory DIRNAME.
-\(fn DIRNAME)" t nil)
-
+(fn DIRNAME)" t nil)
(autoload 'desktop-save-in-desktop-dir "desktop" "\
Save the desktop in directory `desktop-dirname'." t nil)
-
(autoload 'desktop-revert "desktop" "\
Revert to the last loaded desktop." t nil)
-
(register-definition-prefixes "desktop" '("desktop-"))
-;;;***
-;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/detect.el
+
+(register-definition-prefixes "ede/detect" '("ede-"))
+
+
;;; Generated autoloads from gnus/deuglify.el
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\
@@ -7730,38 +7009,34 @@ You can control what lines will be unwrapped by frobbing
indicating the minimum and maximum length of an unwrapped citation line. If
NODISPLAY is non-nil, don't redisplay the article buffer.
-\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
-
+(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-article-outlook-repair-attribution "deuglify" "\
Repair a broken attribution line.
If NODISPLAY is non-nil, don't redisplay the article buffer.
-\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
+(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
+(autoload 'gnus-article-outlook-rearrange-citation "deuglify" "\
+Repair broken citations.
+If NODISPLAY is non-nil, don't redisplay the article buffer.
+(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-outlook-deuglify-article "deuglify" "\
Full deuglify of broken Outlook (Express) articles.
Treat \"smartquotes\", unwrap lines, repair attribution and
rearrange citation. If NODISPLAY is non-nil, don't redisplay the
article buffer.
-\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
-
+(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-article-outlook-deuglify-article "deuglify" "\
Deuglify broken Outlook (Express) articles and redisplay." '(gnus-article-mode gnus-summary-mode) nil)
+(register-definition-prefixes "deuglify" '("gnus-outlook-"))
-(register-definition-prefixes "deuglify" '("gnus-"))
-
-;;;***
-;;;### (autoloads nil "dframe" "dframe.el" (0 0 0 0))
;;; Generated autoloads from dframe.el
(register-definition-prefixes "dframe" '("dframe-"))
-;;;***
-;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/diary-lib.el
(autoload 'diary "diary-lib" "\
@@ -7770,8 +7045,7 @@ If no argument is provided, the number of days of diary entries is governed
by the variable `diary-number-of-entries'. A value of ARG less than 1
does nothing. This function is suitable for execution in an init file.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'diary-mail-entries "diary-lib" "\
Send a mail message showing diary entries for next NDAYS days.
If no prefix argument is given, NDAYS is set to `diary-mail-days'.
@@ -7785,27 +7059,23 @@ ensure that all relevant variables are set.
#!/usr/bin/emacs -script
;; diary-rem.el - run the Emacs diary-reminder
-\(setq diary-mail-days 3
+(setq diary-mail-days 3
diary-file \"/path/to/diary.file\"
calendar-date-style \\='european
diary-mail-addr \"user@host.name\")
-\(diary-mail-entries)
+(diary-mail-entries)
# diary-rem.el ends here
-\(fn &optional NDAYS)" t nil)
-
+(fn &optional NDAYS)" t nil)
(autoload 'diary-mode "diary-lib" "\
Major mode for editing the diary file.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "diary-lib" '("calendar-mark-" "diary-"))
-;;;***
-;;;### (autoloads nil "dictionary" "net/dictionary.el" (0 0 0 0))
;;; Generated autoloads from net/dictionary.el
(autoload 'dictionary-mode "dictionary" "\
@@ -7827,35 +7097,28 @@ This is a quick reference to this mode describing the default key bindings:
* \\[dictionary-select-strategy] select the default search strategy
* RET or <mouse-2> visit that link" nil nil)
-
(autoload 'dictionary "dictionary" "\
Create a new dictionary buffer and install `dictionary-mode'." t nil)
-
(autoload 'dictionary-search "dictionary" "\
Search the WORD in DICTIONARY if given or in all if nil.
It presents the selection or word at point as default input and
allows editing it.
-\(fn WORD &optional DICTIONARY)" t nil)
-
+(fn WORD &optional DICTIONARY)" t nil)
(autoload 'dictionary-lookup-definition "dictionary" "\
Unconditionally lookup the word at point." t nil)
-
(autoload 'dictionary-match-words "dictionary" "\
Search PATTERN in current default dictionary using default strategy.
-\(fn &optional PATTERN &rest IGNORED)" t nil)
-
+(fn &optional PATTERN &rest IGNORED)" t nil)
(autoload 'dictionary-mouse-popup-matching-words "dictionary" "\
Display entries matching the word at the cursor retrieved using EVENT.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'dictionary-popup-matching-words "dictionary" "\
Display entries matching WORD or the current word if not given.
-\(fn &optional WORD)" t nil)
-
+(fn &optional WORD)" t nil)
(autoload 'dictionary-tooltip-mode "dictionary" "\
Display tooltips for the current word.
@@ -7863,8 +7126,7 @@ This function can be used to enable or disable the tooltip mode
for the current buffer (based on ARG). If global-tooltip-mode is
active it will overwrite that mode for the current buffer.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'global-dictionary-tooltip-mode "dictionary" "\
Enable/disable `dictionary-tooltip-mode' for all buffers.
@@ -7874,29 +7136,27 @@ It can be overwritten for each buffer using `dictionary-tooltip-mode'.
Note: (global-dictionary-tooltip-mode 0) will not disable the mode
any buffer where (dictionary-tooltip-mode 1) has been called.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'dictionary-context-menu "dictionary" "\
Populate MENU with dictionary commands at CLICK.
When you add this function to `context-menu-functions',
the context menu will contain an item that searches
the word at mouse click.
-\(fn MENU CLICK)" nil nil)
-
+(fn MENU CLICK)" nil nil)
(register-definition-prefixes "dictionary" '("dictionary-" "global-dictionary-tooltip-mode"))
-;;;***
-;;;### (autoloads nil "dictionary-connection" "net/dictionary-connection.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/dictionary.el
+
+(register-definition-prefixes "srecode/dictionary" '("srecode-"))
+
+
;;; Generated autoloads from net/dictionary-connection.el
(register-definition-prefixes "dictionary-connection" '("dictionary-connection-"))
-;;;***
-;;;### (autoloads nil "diff" "vc/diff.el" (0 0 0 0))
;;; Generated autoloads from vc/diff.el
(defvar diff-switches (purecopy "-u") "\
@@ -7906,14 +7166,10 @@ This variable is also used in the `vc-diff' command (and related
commands) if the backend-specific diff switch variable isn't
set (`vc-git-diff-switches' for git, for instance), and
`vc-diff-switches' isn't set.")
-
(custom-autoload 'diff-switches "diff" t)
-
(defvar diff-command (purecopy "diff") "\
The command to use to run diff.")
-
(custom-autoload 'diff-command "diff" t)
-
(autoload 'diff "diff" "\
Find and display the differences between OLD and NEW files.
When called interactively, read NEW, then OLD, using the
@@ -7928,8 +7184,7 @@ command.
Non-interactively, OLD and NEW may each be a file or a buffer.
-\(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil)
-
+(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil)
(autoload 'diff-backup "diff" "\
Diff this file with its backup file or vice versa.
Uses the latest backup, if there are several numerical backups.
@@ -7937,19 +7192,16 @@ If this file is a backup, diff it with its original.
The backup file is the first file given to `diff'.
With prefix arg SWITCHES, prompt for diff switches.
-\(fn FILE &optional SWITCHES)" t nil)
-
+(fn FILE &optional SWITCHES)" t nil)
(autoload 'diff-latest-backup-file "diff" "\
Return the latest existing backup of file FN, or nil.
-\(fn FN)" nil nil)
-
+(fn FN)" nil nil)
(autoload 'diff-buffer-with-file "diff" "\
View the differences between BUFFER and its associated file.
This requires the external program `diff' to be in your `exec-path'.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'diff-buffers "diff" "\
Find and display the differences between OLD and NEW buffers.
@@ -7965,13 +7217,12 @@ diff command.
OLD and NEW may each be a buffer or a buffer name.
-\(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil)
+Also see the `diff-entire-buffers' variable.
+(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil)
(register-definition-prefixes "diff" '("diff-"))
-;;;***
-;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (0 0 0 0))
;;; Generated autoloads from vc/diff-mode.el
(autoload 'diff-mode "diff-mode" "\
@@ -7989,34 +7240,30 @@ a diff with \\[diff-reverse-direction].
\\{diff-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'diff-minor-mode "diff-mode" "\
Toggle Diff minor mode.
-This is a minor mode. If called interactively, toggle the `Diff minor
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+\\{diff-minor-mode-map}
+
+This is a minor mode. If called interactively, toggle the `Diff
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `diff-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\\{diff-minor-mode-map}
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "diff-mode" '("diff-"))
-;;;***
-;;;### (autoloads nil "dig" "net/dig.el" (0 0 0 0))
;;; Generated autoloads from net/dig.el
(autoload 'dig "dig" "\
@@ -8025,13 +7272,15 @@ See `dig-invoke' for an explanation for the parameters.
When called interactively, DOMAIN is prompted for. If given a prefix,
also prompt for the QUERY-TYPE parameter.
-\(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t nil)
-
+(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t nil)
(register-definition-prefixes "dig" '("dig-" "query-dig"))
-;;;***
-;;;### (autoloads nil "dired" "dired.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/dired.el
+
+(register-definition-prefixes "ede/dired" '("ede-dired-"))
+
+
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
@@ -8051,16 +7300,13 @@ each option.
On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
some of the `ls' switches are not supported; see the doc string of
`insert-directory' in `ls-lisp.el' for more details.")
-
(custom-autoload 'dired-listing-switches "dired" t)
-
-(defvar dired-directory nil "\
+(defvar-local dired-directory nil "\
The directory name or wildcard spec that this Dired directory lists.
Local to each Dired buffer. May be a list, in which case the car is the
directory name and the cdr is the list of files to mention.
The directory name must be absolute, but need not be fully expanded.")
(define-key ctl-x-map "d" 'dired)
-
(autoload 'dired "dired" "\
\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
Optional second argument SWITCHES specifies the options to be used
@@ -8084,31 +7330,26 @@ Type \\[describe-mode] after entering Dired for more info.
If DIRNAME is already in a Dired buffer, that buffer is used without refresh.
-\(fn DIRNAME &optional SWITCHES)" t nil)
+(fn DIRNAME &optional SWITCHES)" t nil)
(define-key ctl-x-4-map "d" 'dired-other-window)
-
(autoload 'dired-other-window "dired" "\
\"Edit\" directory DIRNAME. Like `dired' but select in another window.
-\(fn DIRNAME &optional SWITCHES)" t nil)
+(fn DIRNAME &optional SWITCHES)" t nil)
(define-key ctl-x-5-map "d" 'dired-other-frame)
-
(autoload 'dired-other-frame "dired" "\
\"Edit\" directory DIRNAME. Like `dired' but make a new frame.
-\(fn DIRNAME &optional SWITCHES)" t nil)
+(fn DIRNAME &optional SWITCHES)" t nil)
(define-key tab-prefix-map "d" 'dired-other-tab)
-
(autoload 'dired-other-tab "dired" "\
\"Edit\" directory DIRNAME. Like `dired' but make a new tab.
-\(fn DIRNAME &optional SWITCHES)" t nil)
-
+(fn DIRNAME &optional SWITCHES)" t nil)
(autoload 'dired-noselect "dired" "\
Like `dired' but return the Dired buffer as value, do not select it.
-\(fn DIR-OR-LIST &optional SWITCHES)" nil nil)
-
+(fn DIR-OR-LIST &optional SWITCHES)" nil nil)
(autoload 'dired-mode "dired" "\
Mode for \"editing\" directory listings.
In Dired, you are \"editing\" a list of the files in a directory and
@@ -8141,7 +7382,7 @@ Type \\[dired-do-copy] to Copy files.
Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches.
Type \\[revert-buffer] to read all currently expanded directories aGain.
This retains all marks and hides subdirs again that were hidden before.
-Use `SPC' and `DEL' to move down and up by lines.
+Use \\`SPC' and \\`DEL' to move down and up by lines.
If Dired ever gets confused, you can either type \\[revert-buffer] to read the
directories again, type \\[dired-do-redisplay] to relist the file at point or the marked files or a
@@ -8159,9 +7400,8 @@ This mode runs the following hooks:
Keybindings:
\\{dired-mode-map}
-\(fn &optional DIRNAME SWITCHES)" nil nil)
+(fn &optional DIRNAME SWITCHES)" nil nil)
(put 'dired-find-alternate-file 'disabled t)
-
(autoload 'dired-jump "dired" "\
Jump to Dired buffer corresponding to current buffer.
If in a buffer visiting a file, Dired that file's directory and
@@ -8178,36 +7418,28 @@ When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
When FILE-NAME is non-nil, jump to its line in Dired.
Interactively with prefix argument, read FILE-NAME.
-\(fn &optional OTHER-WINDOW FILE-NAME)" t nil)
-
+(fn &optional OTHER-WINDOW FILE-NAME)" t nil)
(autoload 'dired-jump-other-window "dired" "\
Like \\[dired-jump] (`dired-jump') but in other window.
-\(fn &optional FILE-NAME)" t nil)
-
+(fn &optional FILE-NAME)" t nil)
(register-definition-prefixes "dired" '("dired-"))
-;;;***
-;;;### (autoloads nil "dirtrack" "dirtrack.el" (0 0 0 0))
-;;; Generated autoloads from dirtrack.el
+;;; Generated autoloads from dired-aux.el
-(autoload 'dirtrack-mode "dirtrack" "\
-Toggle directory tracking in shell buffers (Dirtrack mode).
+(register-definition-prefixes "dired-aux" '("dired-" "minibuffer-default-add-dired-shell-commands"))
-This is a minor mode. If called interactively, toggle the `Dirtrack
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+
+;;; Generated autoloads from dired-x.el
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+(register-definition-prefixes "dired-x" '("dired-" "virtual-dired"))
-To check whether the minor mode is enabled in the current buffer,
-evaluate `dirtrack-mode'.
+
+;;; Generated autoloads from dirtrack.el
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+(autoload 'dirtrack-mode "dirtrack" "\
+Toggle directory tracking in shell buffers (Dirtrack mode).
This method requires that your shell prompt contain the current
working directory at all times, and that you set the variable
@@ -8217,8 +7449,21 @@ This is an alternative to `shell-dirtrack-mode', which works by
tracking `cd' and similar commands which change the shell working
directory.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Dirtrack mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `dirtrack-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'dirtrack "dirtrack" "\
Determine the current directory from the process output for a prompt.
This filter function is used by `dirtrack-mode'. It looks for
@@ -8226,58 +7471,47 @@ the prompt specified by `dirtrack-list', and calls
`shell-process-cd' if the directory seems to have changed away
from `default-directory'.
-\(fn INPUT)" nil nil)
-
+(fn INPUT)" nil nil)
(register-definition-prefixes "dirtrack" '("dirtrack-"))
-;;;***
-;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/disass.el
(autoload 'disassemble "disass" "\
Print disassembled code for OBJECT in (optional) BUFFER.
OBJECT can be a symbol defined as a function, or a function itself
-\(a lambda expression or a compiled-function object).
+(a lambda expression or a compiled-function object).
If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol.
-\(fn OBJECT &optional BUFFER INDENT INTERACTIVE-P)" t nil)
-
+(fn OBJECT &optional BUFFER INDENT INTERACTIVE-P)" t nil)
(register-definition-prefixes "disass" '("disassemble-"))
-;;;***
-;;;### (autoloads nil "disp-table" "disp-table.el" (0 0 0 0))
;;; Generated autoloads from disp-table.el
(autoload 'make-display-table "disp-table" "\
Return a new, empty display table." nil nil)
-
(autoload 'display-table-slot "disp-table" "\
Return the value of the extra slot in DISPLAY-TABLE named SLOT.
SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol).
Valid symbols are `truncation', `wrap', `escape', `control',
`selective-display', and `vertical-border'.
-\(fn DISPLAY-TABLE SLOT)" nil nil)
-
+(fn DISPLAY-TABLE SLOT)" nil nil)
(autoload 'set-display-table-slot "disp-table" "\
Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE.
SLOT may be a number from 0 to 5 inclusive, or a name (symbol).
Valid symbols are `truncation', `wrap', `escape', `control',
`selective-display', and `vertical-border'.
-\(fn DISPLAY-TABLE SLOT VALUE)" nil nil)
-
+(fn DISPLAY-TABLE SLOT VALUE)" nil nil)
(autoload 'describe-display-table "disp-table" "\
Describe the display table DT in a help buffer.
-\(fn DT)" nil nil)
-
+(fn DT)" nil nil)
(autoload 'describe-current-display-table "disp-table" "\
Describe the display table in use in the selected window and buffer." t nil)
-
(autoload 'standard-display-8bit "disp-table" "\
Display characters representing raw bytes in the range L to H literally.
@@ -8291,57 +7525,47 @@ byte.
Note that ASCII printable characters (SPC to TILDA) are displayed
in the default way after this call.
-\(fn L H)" nil nil)
-
+(fn L H)" nil nil)
(autoload 'standard-display-default "disp-table" "\
Display characters in the range L to H using the default notation.
-\(fn L H)" nil nil)
-
+(fn L H)" nil nil)
(autoload 'standard-display-ascii "disp-table" "\
Display character C using printable string S.
-\(fn C S)" nil nil)
-
+(fn C S)" nil nil)
(autoload 'standard-display-g1 "disp-table" "\
Display character C as character SC in the g1 character set.
This function assumes that your terminal uses the SO/SI characters;
it is meaningless for a graphical frame.
-\(fn C SC)" nil nil)
-
+(fn C SC)" nil nil)
(autoload 'standard-display-graphic "disp-table" "\
Display character C as character GC in graphics character set.
This function assumes VT100-compatible escapes; it is meaningless
for a graphical frame.
-\(fn C GC)" nil nil)
-
+(fn C GC)" nil nil)
(autoload 'standard-display-underline "disp-table" "\
Display character C as character UC plus underlining.
-\(fn C UC)" nil nil)
-
+(fn C UC)" nil nil)
(autoload 'create-glyph "disp-table" "\
Allocate a glyph code to display by sending STRING to the terminal.
-\(fn STRING)" nil nil)
-
+(fn STRING)" nil nil)
(autoload 'make-glyph-code "disp-table" "\
Return a glyph code representing char CHAR with face FACE.
-\(fn CHAR &optional FACE)" nil nil)
-
+(fn CHAR &optional FACE)" nil nil)
(autoload 'glyph-char "disp-table" "\
Return the character of glyph code GLYPH.
-\(fn GLYPH)" nil nil)
-
+(fn GLYPH)" nil nil)
(autoload 'glyph-face "disp-table" "\
Return the face of glyph code GLYPH, or nil if glyph has default face.
-\(fn GLYPH)" nil nil)
-
+(fn GLYPH)" nil nil)
(autoload 'standard-display-european "disp-table" "\
Semi-obsolete way to toggle display of ISO 8859 European characters.
@@ -8361,34 +7585,16 @@ from Lisp code also selects Latin-1 as the language environment.
This provides increased compatibility for users who call this function
in `.emacs'.
-\(fn ARG)" nil nil)
-
+(fn ARG)" nil nil)
(register-definition-prefixes "disp-table" '("display-table-print-array"))
-;;;***
-;;;### (autoloads nil "display-fill-column-indicator" "display-fill-column-indicator.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from display-fill-column-indicator.el
(autoload 'display-fill-column-indicator-mode "display-fill-column-indicator" "\
Toggle display of `fill-column' indicator.
-This uses `display-fill-column-indicator' internally.
-This is a minor mode. If called interactively, toggle the
-`Display-Fill-Column-Indicator mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `display-fill-column-indicator-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+This uses `display-fill-column-indicator' internally.
To change the position of the column displayed by default
customize `display-fill-column-indicator-column'. You can change the
@@ -8397,10 +7603,23 @@ The globalized version is `global-display-fill-column-indicator-mode',
which see.
See Info node `Displaying Boundaries' for details.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Display-Fill-Column-Indicator mode' mode. If the prefix
+argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
-(put 'global-display-fill-column-indicator-mode 'globalized-minor-mode t)
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `display-fill-column-indicator-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(put 'global-display-fill-column-indicator-mode 'globalized-minor-mode t)
(defvar global-display-fill-column-indicator-mode nil "\
Non-nil if Global Display-Fill-Column-Indicator mode is enabled.
See the `global-display-fill-column-indicator-mode' command
@@ -8408,9 +7627,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-display-fill-column-indicator-mode'.")
-
(custom-autoload 'global-display-fill-column-indicator-mode "display-fill-column-indicator" nil)
-
(autoload 'global-display-fill-column-indicator-mode "display-fill-column-indicator" "\
Toggle Display-Fill-Column-Indicator mode in all buffers.
With prefix ARG, enable Global Display-Fill-Column-Indicator mode if
@@ -8429,8 +7646,7 @@ Display-Fill-Column-Indicator mode.
`global-display-fill-column-indicator-modes' is used to control which
modes this minor mode is used in.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(defvar global-display-fill-column-indicator-modes '((not special-mode) t) "\
Which major modes `display-fill-column-indicator-mode' is switched on in.
This variable can be either t (all major modes), nil (no major modes),
@@ -8444,43 +7660,38 @@ modes derived from `message-mode' or `mail-mode', but do use in other
modes derived from `text-mode'\". An element with value t means \"use\"
and nil means \"don't use\". There's an implicit nil at the end of the
list.")
-
(custom-autoload 'global-display-fill-column-indicator-modes "display-fill-column-indicator" t)
-
(register-definition-prefixes "display-fill-column-indicator" '("display-fill-column-indicator--turn-on"))
-;;;***
-;;;### (autoloads nil "display-line-numbers" "display-line-numbers.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from display-line-numbers.el
(autoload 'display-line-numbers-mode "display-line-numbers" "\
Toggle display of line numbers in the buffer.
+
This uses `display-line-numbers' internally.
+To change the type of line numbers displayed by default,
+customize `display-line-numbers-type'. To change the type while
+the mode is on, set `display-line-numbers' directly.
+
This is a minor mode. If called interactively, toggle the
-`Display-Line-Numbers mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Display-Line-Numbers mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `display-line-numbers-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-To change the type of line numbers displayed by default,
-customize `display-line-numbers-type'. To change the type while
-the mode is on, set `display-line-numbers' directly.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(put 'global-display-line-numbers-mode 'globalized-minor-mode t)
-
(defvar global-display-line-numbers-mode nil "\
Non-nil if Global Display-Line-Numbers mode is enabled.
See the `global-display-line-numbers-mode' command
@@ -8488,9 +7699,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-display-line-numbers-mode'.")
-
(custom-autoload 'global-display-line-numbers-mode "display-line-numbers" nil)
-
(autoload 'global-display-line-numbers-mode "display-line-numbers" "\
Toggle Display-Line-Numbers mode in all buffers.
With prefix ARG, enable Global Display-Line-Numbers mode if ARG is
@@ -8506,13 +7715,57 @@ Display-Line-Numbers mode is enabled in all buffers where
See `display-line-numbers-mode' for more information on
Display-Line-Numbers mode.
-\(fn &optional ARG)" t nil)
+(fn &optional ARG)" t nil)
+(defvar header-line-indent "" "\
+String to indent at the start if the header line.
+This is used in `header-line-indent-mode', and buffers that have
+this switched on should have a `header-line-format' that look like:
+
+ (\"\" header-line-indent THE-REST...)
+
+Also see `header-line-indent-width'.")
+(defvar header-line-indent-width 0 "\
+The width of the current line numbers displayed.
+This is updated when `header-line-indent-mode' is switched on.
+
+Also see `header-line-indent'.")
+(autoload 'header-line-indent-mode "display-line-numbers" "\
+Mode to indent the header line in `display-line-numbers-mode' buffers.
+
+This means that the header line will be kept indented so that it
+has blank space that's as wide as the displayed line numbers in
+the buffer.
+
+Buffers that have this switched on should have a
+`header-line-format' that look like:
-(register-definition-prefixes "display-line-numbers" '("display-line-numbers-"))
+ (\"\" header-line-indent THE-REST...)
+
+The `header-line-indent-width' variable is also kept updated, and
+has the width of `header-line-format'. This can be used, for
+instance, in `:align-to' specs, like:
+
+ (space :align-to (+ header-line-indent-width 10))
+
+This is a minor mode. If called interactively, toggle the
+`Header-Line-Indent mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `header-line-indent-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "display-line-numbers" '("display-line-numbers-" "header-line-indent--"))
-;;;***
-;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0))
;;; Generated autoloads from play/dissociate.el
(autoload 'dissociated-press "dissociate" "\
@@ -8524,11 +7777,9 @@ If ARG is positive, require ARG chars of continuity.
If ARG is negative, require -ARG words of continuity.
Default is 2.
-\(fn &optional ARG)" t nil)
+(fn &optional ARG)" t nil)
-;;;***
-;;;### (autoloads nil "dnd" "dnd.el" (0 0 0 0))
;;; Generated autoloads from dnd.el
(defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\
@@ -8543,14 +7794,10 @@ is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
The function shall return the action done (move, copy, link or private)
if some action was made, or nil if the URL is ignored.")
-
(custom-autoload 'dnd-protocol-alist "dnd" t)
-
(register-definition-prefixes "dnd" '("dnd-"))
-;;;***
-;;;### (autoloads nil "dns" "net/dns.el" (0 0 0 0))
;;; Generated autoloads from net/dns.el
(autoload 'dns-query "dns" "\
@@ -8558,13 +7805,10 @@ Query a DNS server for NAME of TYPE.
If FULL, return the entire record returned.
If REVERSE, look up an IP address.
-\(fn NAME &optional TYPE FULL REVERSE)" nil nil)
-
+(fn NAME &optional TYPE FULL REVERSE)" nil nil)
(register-definition-prefixes "dns" '("dns-"))
-;;;***
-;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (0 0 0 0))
;;; Generated autoloads from textmodes/dns-mode.el
(autoload 'dns-mode "dns-mode" "\
@@ -8577,26 +7821,26 @@ table and its own syntax table.
Turning on DNS mode runs `dns-mode-hook'.
-\(fn)" t nil)
+(fn)" t nil)
(defalias 'zone-mode 'dns-mode)
-
(autoload 'dns-mode-soa-increment-serial "dns-mode" "\
Locate SOA record and increment the serial field." t nil)
-
(register-definition-prefixes "dns-mode" '("dns-mode-"))
-;;;***
-;;;### (autoloads nil "doc-view" "doc-view.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/doc.el
+
+(register-definition-prefixes "semantic/doc" '("semantic-doc"))
+
+
;;; Generated autoloads from doc-view.el
(autoload 'doc-view-mode-p "doc-view" "\
Return non-nil if document type TYPE is available for `doc-view'.
-Document types are symbols like `dvi', `ps', `pdf', or `odf' (any
-OpenDocument format).
-
-\(fn TYPE)" nil nil)
+Document types are symbols like `dvi', `ps', `pdf', `epub',
+`cbz', `fb2', `xps', `oxps', or`odf' (any OpenDocument format).
+(fn TYPE)" nil nil)
(autoload 'doc-view-mode "doc-view" "\
Major mode in DocView buffers.
@@ -8606,133 +7850,110 @@ and DVI files (as PNG images) in Emacs buffers.
You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to
toggle between displaying the document or editing it as text.
\\{doc-view-mode-map}" t nil)
-
(autoload 'doc-view-mode-maybe "doc-view" "\
Switch to `doc-view-mode' if possible.
If the required external tools are not available, then fallback
to the next best mode." nil nil)
-
(autoload 'doc-view-minor-mode "doc-view" "\
Toggle displaying buffer via Doc View (Doc View minor mode).
-This is a minor mode. If called interactively, toggle the `Doc-View
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+See the command `doc-view-mode' for more information on this mode.
+
+This is a minor mode. If called interactively, toggle the
+`Doc-View minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `doc-view-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-See the command `doc-view-mode' for more information on this mode.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'doc-view-bookmark-jump "doc-view" "\
-\(fn BMK)" nil nil)
-
+(fn BMK)" nil nil)
(register-definition-prefixes "doc-view" '("doc-view-"))
-;;;***
-;;;### (autoloads nil "doctor" "play/doctor.el" (0 0 0 0))
;;; Generated autoloads from play/doctor.el
(autoload 'doctor "doctor" "\
Switch to *doctor* buffer and start giving psychotherapy." t nil)
-
(register-definition-prefixes "doctor" '("doc" "make-doctor-variables"))
-;;;***
-;;;### (autoloads nil "dom" "dom.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/document.el
+
+(register-definition-prefixes "srecode/document" '("srecode-document-"))
+
+
;;; Generated autoloads from dom.el
(register-definition-prefixes "dom" '("dom-"))
-;;;***
-;;;### (autoloads nil "dos-fns" "dos-fns.el" (0 0 0 0))
;;; Generated autoloads from dos-fns.el
(register-definition-prefixes "dos-fns" '("dos"))
-;;;***
-;;;### (autoloads nil "dos-vars" "dos-vars.el" (0 0 0 0))
;;; Generated autoloads from dos-vars.el
(register-definition-prefixes "dos-vars" '("dos-codepage-setup-hook" "msdos-shells"))
-;;;***
-;;;### (autoloads nil "dos-w32" "dos-w32.el" (0 0 0 0))
;;; Generated autoloads from dos-w32.el
(register-definition-prefixes "dos-w32" '("file-name-buffer-file-type-alist" "find-" "w32-"))
-;;;***
-;;;### (autoloads nil "double" "double.el" (0 0 0 0))
;;; Generated autoloads from double.el
(autoload 'double-mode "double" "\
Toggle special insertion on double keypresses (Double mode).
-This is a minor mode. If called interactively, toggle the `Double
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+When Double mode is enabled, some keys will insert different
+strings when pressed twice. See `double-map' for details.
+
+This is a minor mode. If called interactively, toggle the
+`Double mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `double-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-When Double mode is enabled, some keys will insert different
-strings when pressed twice. See `double-map' for details.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "double" '("double-"))
-;;;***
-;;;### (autoloads nil "dunnet" "play/dunnet.el" (0 0 0 0))
;;; Generated autoloads from play/dunnet.el
(autoload 'dunnet "dunnet" "\
Switch to *dungeon* buffer and start game." t nil)
-
(register-definition-prefixes "dunnet" '("dun" "obj-special"))
-;;;***
-;;;### (autoloads nil "dynamic-setting" "dynamic-setting.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from dynamic-setting.el
(register-definition-prefixes "dynamic-setting" '("dynamic-setting-handle-config-changed-event" "font-setting-change-default-font"))
-;;;***
-;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/easy-mmode.el
(defalias 'easy-mmode-define-minor-mode #'define-minor-mode)
-
(autoload 'define-minor-mode "easy-mmode" "\
Define a new minor mode MODE.
This defines the toggle command MODE and (by default) a control variable
@@ -8804,14 +8025,11 @@ For backward compatibility with the Emacs<21 calling convention,
the keywords can also be preceded by the obsolete triplet
INIT-VALUE LIGHTER KEYMAP.
-\(fn MODE DOC [KEYWORD VAL ... &rest BODY])" nil t)
-
-(function-put 'define-minor-mode 'doc-string-elt '2)
-
+(fn MODE DOC [KEYWORD VAL ... &rest BODY])" nil t)
+(function-put 'define-minor-mode 'doc-string-elt 2)
+(function-put 'define-minor-mode 'lisp-indent-function 'defun)
(defalias 'easy-mmode-define-global-mode #'define-globalized-minor-mode)
-
(defalias 'define-global-minor-mode #'define-globalized-minor-mode)
-
(autoload 'define-globalized-minor-mode "easy-mmode" "\
Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
@@ -8841,10 +8059,9 @@ When a major mode is initialized, MODE is actually turned on just
after running the major mode's hook. However, MODE is not turned
on if the hook has explicitly disabled it.
-\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" nil t)
-
-(function-put 'define-globalized-minor-mode 'doc-string-elt '2)
-
+(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" nil t)
+(function-put 'define-globalized-minor-mode 'doc-string-elt 2)
+(function-put 'define-globalized-minor-mode 'lisp-indent-function 'defun)
(autoload 'easy-mmode-define-keymap "easy-mmode" "\
Return a keymap built from bindings BS.
BS must be a list of (KEY . BINDING) where
@@ -8862,85 +8079,67 @@ Valid keywords and arguments are:
:suppress Non-nil to call `suppress-keymap' on keymap,
`nodigits' to suppress digits as prefix arguments.
-\(fn BS &optional NAME M ARGS)" nil nil)
-
+(fn BS &optional NAME M ARGS)" nil nil)
(autoload 'easy-mmode-defmap "easy-mmode" "\
Define a constant M whose value is the result of `easy-mmode-define-keymap'.
The M, BS, and ARGS arguments are as per that function. DOC is
the constant's documentation.
-\(fn M BS DOC &rest ARGS)" nil t)
-
-(function-put 'easy-mmode-defmap 'lisp-indent-function '1)
+This macro is deprecated; use `defvar-keymap' instead.
+(fn M BS DOC &rest ARGS)" nil t)
+(function-put 'easy-mmode-defmap 'doc-string-elt 3)
+(function-put 'easy-mmode-defmap 'lisp-indent-function 1)
(autoload 'easy-mmode-defsyntax "easy-mmode" "\
Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
-\(fn ST CSS DOC &rest ARGS)" nil t)
-
-(function-put 'easy-mmode-defsyntax 'lisp-indent-function '1)
-
+(fn ST CSS DOC &rest ARGS)" nil t)
+(function-put 'easy-mmode-defsyntax 'doc-string-elt 3)
+(function-put 'easy-mmode-defsyntax 'lisp-indent-function 1)
(register-definition-prefixes "easy-mmode" '("easy-mmode-"))
-;;;***
-;;;### (autoloads nil "ebnf-abn" "progmodes/ebnf-abn.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-abn.el
(register-definition-prefixes "ebnf-abn" '("ebnf-abn-"))
-;;;***
-;;;### (autoloads nil "ebnf-bnf" "progmodes/ebnf-bnf.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-bnf.el
(register-definition-prefixes "ebnf-bnf" '("ebnf-"))
-;;;***
-;;;### (autoloads nil "ebnf-dtd" "progmodes/ebnf-dtd.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-dtd.el
(register-definition-prefixes "ebnf-dtd" '("ebnf-dtd-"))
-;;;***
-;;;### (autoloads nil "ebnf-ebx" "progmodes/ebnf-ebx.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-ebx.el
(register-definition-prefixes "ebnf-ebx" '("ebnf-ebx-"))
-;;;***
-;;;### (autoloads nil "ebnf-iso" "progmodes/ebnf-iso.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-iso.el
(register-definition-prefixes "ebnf-iso" '("ebnf-"))
-;;;***
-;;;### (autoloads nil "ebnf-otz" "progmodes/ebnf-otz.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-otz.el
(register-definition-prefixes "ebnf-otz" '("ebnf-"))
-;;;***
-;;;### (autoloads nil "ebnf-yac" "progmodes/ebnf-yac.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-yac.el
(register-definition-prefixes "ebnf-yac" '("ebnf-yac-"))
-;;;***
-;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf2ps.el
-(push (purecopy '(ebnf2ps 4 4)) package--builtin-versions)
+(push (purecopy '(ebnf2ps 4 4)) package--builtin-versions)
(autoload 'ebnf-customize "ebnf2ps" "\
Customization for ebnf group." t nil)
-
(autoload 'ebnf-print-directory "ebnf2ps" "\
Generate and print a PostScript syntactic chart image of DIRECTORY.
@@ -8951,8 +8150,7 @@ processed.
See also `ebnf-print-buffer'.
-\(fn &optional DIRECTORY)" t nil)
-
+(fn &optional DIRECTORY)" t nil)
(autoload 'ebnf-print-file "ebnf2ps" "\
Generate and print a PostScript syntactic chart image of the file FILE.
@@ -8961,8 +8159,7 @@ killed after process termination.
See also `ebnf-print-buffer'.
-\(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
-
+(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
(autoload 'ebnf-print-buffer "ebnf2ps" "\
Generate and print a PostScript syntactic chart image of the buffer.
@@ -8975,14 +8172,12 @@ is nil, send the image to the printer. If FILENAME is a string, save
the PostScript image in a file with that name. If FILENAME is a
number, prompt the user for the name of the file to save in.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'ebnf-print-region "ebnf2ps" "\
Generate and print a PostScript syntactic chart image of the region.
Like `ebnf-print-buffer', but prints just the current region.
-\(fn FROM TO &optional FILENAME)" t nil)
-
+(fn FROM TO &optional FILENAME)" t nil)
(autoload 'ebnf-spool-directory "ebnf2ps" "\
Generate and spool a PostScript syntactic chart image of DIRECTORY.
@@ -8993,8 +8188,7 @@ processed.
See also `ebnf-spool-buffer'.
-\(fn &optional DIRECTORY)" t nil)
-
+(fn &optional DIRECTORY)" t nil)
(autoload 'ebnf-spool-file "ebnf2ps" "\
Generate and spool a PostScript syntactic chart image of the file FILE.
@@ -9003,23 +8197,20 @@ killed after process termination.
See also `ebnf-spool-buffer'.
-\(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
-
+(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
(autoload 'ebnf-spool-buffer "ebnf2ps" "\
Generate and spool a PostScript syntactic chart image of the buffer.
Like `ebnf-print-buffer' except that the PostScript image is saved in a
local buffer to be sent to the printer later.
Use the command `ebnf-despool' to send the spooled images to the printer." t nil)
-
(autoload 'ebnf-spool-region "ebnf2ps" "\
Generate a PostScript syntactic chart image of the region and spool locally.
Like `ebnf-spool-buffer', but spools just the current region.
Use the command `ebnf-despool' to send the spooled images to the printer.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'ebnf-eps-directory "ebnf2ps" "\
Generate EPS files from EBNF files in DIRECTORY.
@@ -9030,8 +8221,7 @@ processed.
See also `ebnf-eps-buffer'.
-\(fn &optional DIRECTORY)" t nil)
-
+(fn &optional DIRECTORY)" t nil)
(autoload 'ebnf-eps-file "ebnf2ps" "\
Generate an EPS file from EBNF file FILE.
@@ -9040,8 +8230,7 @@ killed after EPS generation.
See also `ebnf-eps-buffer'.
-\(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
-
+(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
(autoload 'ebnf-eps-buffer "ebnf2ps" "\
Generate a PostScript syntactic chart image of the buffer in an EPS file.
@@ -9061,7 +8250,6 @@ The EPS file name has the following form:
WARNING: This function does *NOT* ask any confirmation to override existing
files." t nil)
-
(autoload 'ebnf-eps-region "ebnf2ps" "\
Generate a PostScript syntactic chart image of the region in an EPS file.
@@ -9082,10 +8270,8 @@ The EPS file name has the following form:
WARNING: This function does *NOT* ask any confirmation to override existing
files.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(defalias 'ebnf-despool #'ps-despool)
-
(autoload 'ebnf-syntax-directory "ebnf2ps" "\
Do a syntactic analysis of the files in DIRECTORY.
@@ -9096,8 +8282,7 @@ are processed.
See also `ebnf-syntax-buffer'.
-\(fn &optional DIRECTORY)" t nil)
-
+(fn &optional DIRECTORY)" t nil)
(autoload 'ebnf-syntax-file "ebnf2ps" "\
Do a syntactic analysis of the named FILE.
@@ -9106,47 +8291,39 @@ killed after syntax checking.
See also `ebnf-syntax-buffer'.
-\(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
-
+(fn FILE &optional DO-NOT-KILL-BUFFER-WHEN-DONE)" t nil)
(autoload 'ebnf-syntax-buffer "ebnf2ps" "\
Do a syntactic analysis of the current buffer." t nil)
-
(autoload 'ebnf-syntax-region "ebnf2ps" "\
Do a syntactic analysis of a region.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'ebnf-setup "ebnf2ps" "\
Return the current ebnf2ps setup." nil nil)
-
(autoload 'ebnf-find-style "ebnf2ps" "\
Return style definition if NAME is already defined; otherwise, return nil.
See `ebnf-style-database' documentation.
-\(fn NAME)" t nil)
-
+(fn NAME)" t nil)
(autoload 'ebnf-insert-style "ebnf2ps" "\
Insert a new style NAME with inheritance INHERITS and values VALUES.
See `ebnf-style-database' documentation.
-\(fn NAME INHERITS &rest VALUES)" t nil)
-
+(fn NAME INHERITS &rest VALUES)" t nil)
(autoload 'ebnf-delete-style "ebnf2ps" "\
Delete style NAME.
See `ebnf-style-database' documentation.
-\(fn NAME)" t nil)
-
+(fn NAME)" t nil)
(autoload 'ebnf-merge-style "ebnf2ps" "\
Merge values of style NAME with style VALUES.
See `ebnf-style-database' documentation.
-\(fn NAME &rest VALUES)" t nil)
-
+(fn NAME &rest VALUES)" t nil)
(autoload 'ebnf-apply-style "ebnf2ps" "\
Set STYLE as the current style.
@@ -9154,8 +8331,7 @@ Returns the old style symbol.
See `ebnf-style-database' documentation.
-\(fn STYLE)" t nil)
-
+(fn STYLE)" t nil)
(autoload 'ebnf-reset-style "ebnf2ps" "\
Reset current style.
@@ -9163,8 +8339,7 @@ Returns the old style symbol.
See `ebnf-style-database' documentation.
-\(fn &optional STYLE)" t nil)
-
+(fn &optional STYLE)" t nil)
(autoload 'ebnf-push-style "ebnf2ps" "\
Push the current style onto a stack and set STYLE as the current style.
@@ -9174,8 +8349,7 @@ See also `ebnf-pop-style'.
See `ebnf-style-database' documentation.
-\(fn &optional STYLE)" t nil)
-
+(fn &optional STYLE)" t nil)
(autoload 'ebnf-pop-style "ebnf2ps" "\
Pop a style from the stack of pushed styles and set it as the current style.
@@ -9184,12 +8358,9 @@ Returns the old style symbol.
See also `ebnf-push-style'.
See `ebnf-style-database' documentation." t nil)
-
(register-definition-prefixes "ebnf2ps" '("ebnf-"))
-;;;***
-;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebrowse.el
(autoload 'ebrowse-tree-mode "ebrowse" "\
@@ -9197,73 +8368,57 @@ Major mode for Ebrowse class tree buffers.
Each line corresponds to a class in a class tree.
Letters do not insert themselves, they are commands.
File operations in the tree buffer work on class tree data structures.
-E.g.\\[save-buffer] writes the tree to the file it was loaded from.
+E.g. \\[save-buffer] writes the tree to the file it was loaded from.
Tree mode key bindings:
\\{ebrowse-tree-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'ebrowse-electric-choose-tree "ebrowse" "\
Return a buffer containing a tree or nil if no tree found or canceled." t nil)
-
(autoload 'ebrowse-member-mode "ebrowse" "\
Major mode for Ebrowse member buffers.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'ebrowse-tags-view-declaration "ebrowse" "\
View declaration of member at point." t nil)
-
(autoload 'ebrowse-tags-find-declaration "ebrowse" "\
Find declaration of member at point." t nil)
-
(autoload 'ebrowse-tags-view-definition "ebrowse" "\
View definition of member at point." t nil)
-
(autoload 'ebrowse-tags-find-definition "ebrowse" "\
Find definition of member at point." t nil)
-
(autoload 'ebrowse-tags-find-declaration-other-window "ebrowse" "\
Find declaration of member at point in other window." t nil)
-
(autoload 'ebrowse-tags-view-definition-other-window "ebrowse" "\
View definition of member at point in other window." t nil)
-
(autoload 'ebrowse-tags-find-definition-other-window "ebrowse" "\
Find definition of member at point in other window." t nil)
-
(autoload 'ebrowse-tags-find-declaration-other-frame "ebrowse" "\
Find definition of member at point in other frame." t nil)
-
(autoload 'ebrowse-tags-view-definition-other-frame "ebrowse" "\
View definition of member at point in other frame." t nil)
-
(autoload 'ebrowse-tags-find-definition-other-frame "ebrowse" "\
Find definition of member at point in other frame." t nil)
-
(autoload 'ebrowse-tags-complete-symbol "ebrowse" "\
Perform completion on the C++ symbol preceding point.
A second call of this function without changing point inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
completion.
-\(fn PREFIX)" t nil)
-
+(fn PREFIX)" '("P") nil)
(autoload 'ebrowse-tags-loop-continue "ebrowse" "\
Repeat last operation on files in tree.
FIRST-TIME non-nil means this is not a repetition, but the first time.
TREE-BUFFER if indirectly specifies which files to loop over.
-\(fn &optional FIRST-TIME TREE-BUFFER)" t nil)
-
+(fn &optional FIRST-TIME TREE-BUFFER)" t nil)
(autoload 'ebrowse-tags-search "ebrowse" "\
Search for REGEXP in all files in a tree.
If marked classes exist, process marked classes, only.
If regular expression is nil, repeat last search.
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(autoload 'ebrowse-tags-query-replace "ebrowse" "\
Query replace FROM with TO in all files of a class tree.
With prefix arg, process files of marked classes only.
@@ -9273,8 +8428,7 @@ what to do with it. Type SPC or `y' to replace the match,
DEL or `n' to skip and go to the next match. For more directions,
type \\[help-command] at that time.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'ebrowse-tags-search-member-use "ebrowse" "\
Search for call sites of a member.
If FIX-NAME is specified, search uses of that member.
@@ -9282,41 +8436,32 @@ Otherwise, read a member name from the minibuffer.
Searches in all files mentioned in a class tree for something that
looks like a function call to the member.
-\(fn &optional FIX-NAME)" t nil)
-
+(fn &optional FIX-NAME)" t nil)
(autoload 'ebrowse-back-in-position-stack "ebrowse" "\
Move backward in the position stack.
Prefix arg ARG says how much.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'ebrowse-forward-in-position-stack "ebrowse" "\
Move forward in the position stack.
Prefix arg ARG says how much.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'ebrowse-electric-position-menu "ebrowse" "\
List positions in the position stack in an electric buffer." t nil)
-
(autoload 'ebrowse-save-tree "ebrowse" "\
Save current tree in same file it was loaded from." t nil)
-
(autoload 'ebrowse-save-tree-as "ebrowse" "\
Write the current tree data structure to a file.
Read the file name from the minibuffer if interactive.
Otherwise, FILE-NAME specifies the file to save the tree in.
-\(fn &optional FILE-NAME)" t nil)
-
+(fn &optional FILE-NAME)" t nil)
(autoload 'ebrowse-statistics "ebrowse" "\
Display statistics for a class tree." t nil)
-
(register-definition-prefixes "ebrowse" '("ebrowse-" "electric-buffer-menu-mode-hook"))
-;;;***
-;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (0 0 0 0))
;;; Generated autoloads from ebuff-menu.el
(autoload 'electric-buffer-list "ebuff-menu" "\
@@ -9345,39 +8490,30 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "ebuff-menu" '("Electric-buffer-menu-" "electric-buffer-"))
-;;;***
-;;;### (autoloads nil "echistory" "echistory.el" (0 0 0 0))
;;; Generated autoloads from echistory.el
(autoload 'Electric-command-history-redo-expression "echistory" "\
Edit current history line in minibuffer and execute result.
With prefix arg NOCONFIRM, execute current line as-is without editing.
-\(fn &optional NOCONFIRM)" t nil)
-
+(fn &optional NOCONFIRM)" t nil)
(register-definition-prefixes "echistory" '("Electric-history-" "electric-"))
-;;;***
-;;;### (autoloads nil "ecomplete" "ecomplete.el" (0 0 0 0))
;;; Generated autoloads from ecomplete.el
(autoload 'ecomplete-setup "ecomplete" "\
Read the .ecompleterc file." nil nil)
-
(register-definition-prefixes "ecomplete" '("ecomplete-"))
-;;;***
-;;;### (autoloads nil "ede" "cedet/ede.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede.el
-(push (purecopy '(ede 1 2)) package--builtin-versions)
+(push (purecopy '(ede 1 2)) package--builtin-versions)
(defvar global-ede-mode nil "\
Non-nil if Global Ede mode is enabled.
See the `global-ede-mode' command
@@ -9385,197 +8521,36 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-ede-mode'.")
-
(custom-autoload 'global-ede-mode "ede" nil)
-
(autoload 'global-ede-mode "ede" "\
Toggle global EDE (Emacs Development Environment) mode.
-This is a minor mode. If called interactively, toggle the `Global Ede
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='global-ede-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
This global minor mode enables `ede-minor-mode' in all buffers in
an EDE controlled project.
-\(fn &optional ARG)" t nil)
-
-(register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede"))
-
-;;;***
-
-;;;### (autoloads nil "ede/auto" "cedet/ede/auto.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/auto.el
-
-(register-definition-prefixes "ede/auto" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/autoconf-edit" "cedet/ede/autoconf-edit.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/autoconf-edit.el
-
-(register-definition-prefixes "ede/autoconf-edit" '("autoconf-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/detect" "cedet/ede/detect.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/detect.el
-
-(register-definition-prefixes "ede/detect" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/makefile-edit" "cedet/ede/makefile-edit.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/makefile-edit.el
-
-(register-definition-prefixes "ede/makefile-edit" '("makefile-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/pconf" "cedet/ede/pconf.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/pconf.el
-
-(register-definition-prefixes "ede/pconf" '("ede-pconf-create-file-query"))
-
-;;;***
-
-;;;### (autoloads nil "ede/pmake" "cedet/ede/pmake.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/pmake.el
-
-(register-definition-prefixes "ede/pmake" '("ede-pmake-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj" "cedet/ede/proj.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/proj.el
-
-(register-definition-prefixes "ede/proj" '("ede-proj-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-archive" "cedet/ede/proj-archive.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-archive.el
-
-(register-definition-prefixes "ede/proj-archive" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-aux" "cedet/ede/proj-aux.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from cedet/ede/proj-aux.el
-
-(register-definition-prefixes "ede/proj-aux" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-comp" "cedet/ede/proj-comp.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-comp.el
-
-(register-definition-prefixes "ede/proj-comp" '("ede-" "proj-comp-insert-variable-once"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-elisp" "cedet/ede/proj-elisp.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-elisp.el
-
-(register-definition-prefixes "ede/proj-elisp" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-info" "cedet/ede/proj-info.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-info.el
-
-(register-definition-prefixes "ede/proj-info" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-misc" "cedet/ede/proj-misc.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-misc.el
-
-(register-definition-prefixes "ede/proj-misc" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-obj" "cedet/ede/proj-obj.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from cedet/ede/proj-obj.el
-
-(register-definition-prefixes "ede/proj-obj" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-prog" "cedet/ede/proj-prog.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-prog.el
-
-(register-definition-prefixes "ede/proj-prog" '("ede-proj-target-makefile-program"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-scheme" "cedet/ede/proj-scheme.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-scheme.el
-
-(register-definition-prefixes "ede/proj-scheme" '("ede-proj-target-scheme"))
-
-;;;***
-
-;;;### (autoloads nil "ede/proj-shared" "cedet/ede/proj-shared.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/proj-shared.el
-
-(register-definition-prefixes "ede/proj-shared" '("ede-"))
-
-;;;***
-
-;;;### (autoloads nil "ede/project-am" "cedet/ede/project-am.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/project-am.el
-
-(register-definition-prefixes "ede/project-am" '("project-am-"))
+This is a global minor mode. If called interactively, toggle the
+`Global Ede mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-;;;***
-
-;;;### (autoloads nil "ede/simple" "cedet/ede/simple.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/simple.el
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
-(register-definition-prefixes "ede/simple" '("ede-simple-"))
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='global-ede-mode)'.
-;;;***
-
-;;;### (autoloads nil "ede/source" "cedet/ede/source.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/source.el
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-(register-definition-prefixes "ede/source" '("ede-source"))
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede"))
-;;;***
-;;;### (autoloads nil "ede/srecode" "cedet/ede/srecode.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from cedet/ede/srecode.el
+;;; Generated autoloads from cedet/semantic/ede-grammar.el
-(register-definition-prefixes "ede/srecode" '("ede-srecode-"))
+(register-definition-prefixes "semantic/ede-grammar" '("semantic-ede-"))
-;;;***
-;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
@@ -9586,27 +8561,24 @@ This applies to `eval-defun', `eval-region', `eval-buffer', and
You can use the command `edebug-all-defs' to toggle the value of this
variable. You may wish to make it local to each buffer with
-\(make-local-variable \\='edebug-all-defs) in your
-`emacs-lisp-mode-hook'.")
+(make-local-variable \\='edebug-all-defs) in your
+`emacs-lisp-mode-hook'.
+Note that this user option has no effect unless the edebug
+package has been loaded.")
(custom-autoload 'edebug-all-defs "edebug" t)
-
(defvar edebug-all-forms nil "\
Non-nil means evaluation of all forms will instrument for Edebug.
This doesn't apply to loading or evaluations in the minibuffer.
Use the command `edebug-all-forms' to toggle the value of this option.")
-
(custom-autoload 'edebug-all-forms "edebug" t)
-
(autoload 'edebug-basic-spec "edebug" "\
Return t if SPEC uses only extant spec symbols.
An extant spec symbol is a symbol that is not a function and has a
`edebug-form-spec' property.
-\(fn SPEC)" nil nil)
-
+(fn SPEC)" nil nil)
(defalias 'edebug-defun 'edebug-eval-top-level-form)
-
(autoload 'edebug-eval-top-level-form "edebug" "\
Evaluate the top level form point is in, stepping through with Edebug.
This is like `eval-defun' except that it steps the code for Edebug
@@ -9622,53 +8594,42 @@ instrumented for Edebug.
If the current defun is actually a call to `defvar' or `defcustom',
evaluating it this way resets the variable using its initial value
expression even if the variable already has some other value.
-\(Normally `defvar' and `defcustom' do not alter the value if there
+(Normally `defvar' and `defcustom' do not alter the value if there
already is one.)" t nil)
-
(autoload 'edebug-all-defs "edebug" "\
Toggle edebugging of all definitions." t nil)
-
(autoload 'edebug-all-forms "edebug" "\
Toggle edebugging of all forms." t nil)
-
(register-definition-prefixes "edebug" '("arglist" "backquote-form" "def-declarations" "edebug" "function-form" "interactive" "lambda-" "name" "nested-backquote-form"))
-;;;***
-;;;### (autoloads nil "ediff" "vc/ediff.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff.el
-(push (purecopy '(ediff 2 81 6)) package--builtin-versions)
+(push (purecopy '(ediff 2 81 6)) package--builtin-versions)
(autoload 'ediff-files "ediff" "\
Run Ediff on a pair of files, FILE-A and FILE-B.
STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers.
-\(fn FILE-A FILE-B &optional STARTUP-HOOKS)" t nil)
-
+(fn FILE-A FILE-B &optional STARTUP-HOOKS)" t nil)
(autoload 'ediff-files3 "ediff" "\
Run Ediff on three files, FILE-A, FILE-B, and FILE-C.
STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers.
-\(fn FILE-A FILE-B FILE-C &optional STARTUP-HOOKS)" t nil)
-
+(fn FILE-A FILE-B FILE-C &optional STARTUP-HOOKS)" t nil)
(defalias 'ediff3 #'ediff-files3)
-
(defalias 'ediff #'ediff-files)
-
(autoload 'ediff-current-file "ediff" "\
Start ediff between current buffer and its file on disk.
This command can be used instead of `revert-buffer'. If there is
nothing to revert then this command fails." t nil)
-
(autoload 'ediff-backup "ediff" "\
Run Ediff on FILE and its backup file.
Uses the latest backup, if there are several numerical backups.
If this file is a backup, `ediff' it with its original.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'ediff-buffers "ediff" "\
Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B.
STARTUP-HOOKS is a list of functions that Emacs calls without
@@ -9679,10 +8640,8 @@ symbol describing the Ediff job type; it defaults to
`ediff-last-dir-C', `ediff-buffers3', `ediff-merge-buffers', or
`ediff-merge-buffers-with-ancestor'.
-\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME)" t nil)
-
+(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME)" t nil)
(defalias 'ebuffers #'ediff-buffers)
-
(autoload 'ediff-buffers3 "ediff" "\
Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C.
STARTUP-HOOKS is a list of functions that Emacs calls without
@@ -9693,10 +8652,8 @@ symbol describing the Ediff job type; it defaults to
`ediff-last-dir-C', `ediff-buffers', `ediff-merge-buffers', or
`ediff-merge-buffers-with-ancestor'.
-\(fn BUFFER-A BUFFER-B BUFFER-C &optional STARTUP-HOOKS JOB-NAME)" t nil)
-
+(fn BUFFER-A BUFFER-B BUFFER-C &optional STARTUP-HOOKS JOB-NAME)" t nil)
(defalias 'ebuffers3 #'ediff-buffers3)
-
(autoload 'ediff-directories "ediff" "\
Run Ediff on directories DIR1 and DIR2, comparing files.
Consider only files that have the same name in both directories.
@@ -9704,19 +8661,15 @@ Consider only files that have the same name in both directories.
REGEXP is nil or a regular expression; only file names that match
the regexp are considered.
-\(fn DIR1 DIR2 REGEXP)" t nil)
-
+(fn DIR1 DIR2 REGEXP)" t nil)
(defalias 'edirs #'ediff-directories)
-
(autoload 'ediff-directory-revisions "ediff" "\
Run Ediff on a directory, DIR1, comparing its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account.
-\(fn DIR1 REGEXP)" t nil)
-
+(fn DIR1 REGEXP)" t nil)
(defalias 'edir-revisions #'ediff-directory-revisions)
-
(autoload 'ediff-directories3 "ediff" "\
Run Ediff on directories DIR1, DIR2, and DIR3, comparing files.
Consider only files that have the same name in all three directories.
@@ -9724,20 +8677,16 @@ Consider only files that have the same name in all three directories.
REGEXP is nil or a regular expression; only file names that match
the regexp are considered.
-\(fn DIR1 DIR2 DIR3 REGEXP)" t nil)
-
+(fn DIR1 DIR2 DIR3 REGEXP)" t nil)
(defalias 'edirs3 #'ediff-directories3)
-
(autoload 'ediff-merge-directories "ediff" "\
Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
the same name in both. The third argument, REGEXP, is nil or a regular
expression; only file names that match the regexp are considered.
MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
-\(fn DIR1 DIR2 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
-
+(fn DIR1 DIR2 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(defalias 'edirs-merge #'ediff-merge-directories)
-
(autoload 'ediff-merge-directories-with-ancestor "ediff" "\
Merge files in DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors.
Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
@@ -9746,30 +8695,24 @@ without ancestor. The fourth argument, REGEXP, is nil or a regular expression;
only file names that match the regexp are considered.
MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
-\(fn DIR1 DIR2 ANCESTOR-DIR REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
-
+(fn DIR1 DIR2 ANCESTOR-DIR REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(autoload 'ediff-merge-directory-revisions "ediff" "\
Run Ediff on a directory, DIR1, merging its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account.
MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
-\(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
-
+(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(defalias 'edir-merge-revisions #'ediff-merge-directory-revisions)
-
(autoload 'ediff-merge-directory-revisions-with-ancestor "ediff" "\
Run Ediff on DIR1 and merge its files with their revisions and ancestors.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account.
MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
-\(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
-
+(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(defalias 'edir-merge-revisions-with-ancestor 'ediff-merge-directory-revisions-with-ancestor)
-
(defalias 'edirs-merge-with-ancestor 'ediff-merge-directories-with-ancestor)
-
(autoload 'ediff-windows-wordwise "ediff" "\
Compare WIND-A and WIND-B, which are selected by clicking, wordwise.
This compares the portions of text visible in each of the two windows.
@@ -9780,8 +8723,7 @@ If WIND-B is nil, use window next to WIND-A.
STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers.
-\(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
-
+(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
(autoload 'ediff-windows-linewise "ediff" "\
Compare WIND-A and WIND-B, which are selected by clicking, linewise.
This compares the portions of text visible in each of the two windows.
@@ -9792,8 +8734,7 @@ If WIND-B is nil, use window next to WIND-A.
STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers.
-\(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
-
+(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
(autoload 'ediff-regions-wordwise "ediff" "\
Run Ediff on a pair of regions in specified buffers.
BUFFER-A and BUFFER-B are the buffers to be compared.
@@ -9803,8 +8744,7 @@ use `ediff-regions-linewise' instead.
STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers.
-\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
-
+(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
(autoload 'ediff-regions-linewise "ediff" "\
Run Ediff on a pair of regions in specified buffers.
BUFFER-A and BUFFER-B are the buffers to be compared.
@@ -9815,10 +8755,8 @@ lines. For small regions, use `ediff-regions-wordwise'.
STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers.
-\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
-
+(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
(defalias 'ediff-merge 'ediff-merge-files)
-
(autoload 'ediff-merge-files "ediff" "\
Merge two files without ancestor.
FILE-A and FILE-B are the names of the files to be merged.
@@ -9826,8 +8764,7 @@ STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers. MERGE-BUFFER-FILE
is the name of the file to be associated with the merge buffer..
-\(fn FILE-A FILE-B &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
-
+(fn FILE-A FILE-B &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-files-with-ancestor "ediff" "\
Merge two files with ancestor.
FILE-A and FILE-B are the names of the files to be merged, and
@@ -9836,10 +8773,8 @@ a list of functions that Emacs calls without arguments after
setting up the Ediff buffers. MERGE-BUFFER-FILE is the name of
the file to be associated with the merge buffer.
-\(fn FILE-A FILE-B FILE-ANCESTOR &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
-
+(fn FILE-A FILE-B FILE-ANCESTOR &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(defalias 'ediff-merge-with-ancestor 'ediff-merge-files-with-ancestor)
-
(autoload 'ediff-merge-buffers "ediff" "\
Merge buffers without ancestor.
BUFFER-A and BUFFER-B are the buffers to be merged.
@@ -9852,8 +8787,7 @@ symbol describing the Ediff job type; it defaults to
`ediff-merge-buffers-with-ancestor'. MERGE-BUFFER-FILE is the
name of the file to be associated with the merge buffer.
-\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
-
+(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-buffers-with-ancestor "ediff" "\
Merge buffers with ancestor.
BUFFER-A and BUFFER-B are the buffers to be merged, and
@@ -9866,8 +8800,7 @@ also be one of `ediff-merge-files-with-ancestor',
`ediff-buffers3', or `ediff-merge-buffers'. MERGE-BUFFER-FILE is
the name of the file to be associated with the merge buffer.
-\(fn BUFFER-A BUFFER-B BUFFER-ANCESTOR &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
-
+(fn BUFFER-A BUFFER-B BUFFER-ANCESTOR &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-revisions "ediff" "\
Run Ediff by merging two revisions of a file.
The file is the optional FILE argument or the file visited by the
@@ -9876,8 +8809,7 @@ calls without arguments after setting up the Ediff buffers.
MERGE-BUFFER-FILE is the name of the file to be associated with
the merge buffer.
-\(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
-
+(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-revisions-with-ancestor "ediff" "\
Run Ediff by merging two revisions of a file with a common ancestor.
The file is the optional FILE argument or the file visited by the
@@ -9886,8 +8818,7 @@ calls without arguments after setting up the Ediff buffers.
MERGE-BUFFER-FILE is the name of the file to be associated with
the merge buffer.
-\(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
-
+(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-patch-file "ediff" "\
Query for a file name, and then run Ediff by patching that file.
If optional PATCH-BUF is given, use the patch in that buffer
@@ -9895,8 +8826,7 @@ and don't ask the user.
If prefix argument ARG, then: if even argument, assume that the
patch is in a buffer. If odd -- assume it is in a file.
-\(fn &optional ARG PATCH-BUF)" t nil)
-
+(fn &optional ARG PATCH-BUF)" t nil)
(autoload 'ediff-patch-buffer "ediff" "\
Run Ediff by patching the buffer specified at prompt.
Without the optional prefix ARG, asks if the patch is in some buffer and
@@ -9906,12 +8836,9 @@ With ARG=2, assumes the patch is in a buffer and prompts for the buffer.
PATCH-BUF is an optional argument, which specifies the buffer that contains the
patch. If not given, the user is prompted according to the prefix argument.
-\(fn &optional ARG PATCH-BUF)" t nil)
-
+(fn &optional ARG PATCH-BUF)" t nil)
(defalias 'epatch 'ediff-patch-file)
-
(defalias 'epatch-buffer 'ediff-patch-buffer)
-
(autoload 'ediff-revision "ediff" "\
Run Ediff by comparing versions of a file.
The file is an optional FILE argument or the file entered at the prompt.
@@ -9920,153 +8847,118 @@ Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'.
STARTUP-HOOKS is a list of functions that Emacs calls without
arguments after setting up the Ediff buffers.
-\(fn &optional FILE STARTUP-HOOKS)" t nil)
-
+(fn &optional FILE STARTUP-HOOKS)" t nil)
(defalias 'erevision 'ediff-revision)
-
(autoload 'ediff-version "ediff" "\
Return string describing the version of Ediff.
When called interactively, displays the version." t nil)
-
(autoload 'ediff-documentation "ediff" "\
Display Ediff's manual.
With optional NODE, goes to that node.
-\(fn &optional NODE)" t nil)
-
+(fn &optional NODE)" t nil)
(autoload 'ediff-files-command "ediff" "\
Call `ediff-files' with the next two command line arguments." nil nil)
-
(autoload 'ediff3-files-command "ediff" "\
Call `ediff3-files' with the next three command line arguments." nil nil)
-
(autoload 'ediff-merge-command "ediff" "\
Call `ediff-merge-files' with the next two command line arguments." nil nil)
-
(autoload 'ediff-merge-with-ancestor-command "ediff" "\
Call `ediff-merge-files-with-ancestor' with next three command line arguments." nil nil)
-
(autoload 'ediff-directories-command "ediff" "\
Call `ediff-directories' with the next three command line arguments." nil nil)
-
(autoload 'ediff-directories3-command "ediff" "\
Call `ediff-directories3' with the next four command line arguments." nil nil)
-
(autoload 'ediff-merge-directories-command "ediff" "\
Call `ediff-merge-directories' with the next three command line arguments." nil nil)
-
(autoload 'ediff-merge-directories-with-ancestor-command "ediff" "\
Call `ediff-merge-directories-with-ancestor' with the next four command line
arguments." nil nil)
-
(register-definition-prefixes "ediff" '("ediff-"))
-;;;***
-;;;### (autoloads nil "ediff-diff" "vc/ediff-diff.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-diff.el
(register-definition-prefixes "ediff-diff" '("ediff-"))
-;;;***
-;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-help.el
(autoload 'ediff-customize "ediff-help" nil t nil)
-
(register-definition-prefixes "ediff-help" '("ediff-"))
-;;;***
-;;;### (autoloads nil "ediff-init" "vc/ediff-init.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-init.el
(register-definition-prefixes "ediff-init" '("ediff-" "stipple-pixmap"))
-;;;***
-;;;### (autoloads nil "ediff-merg" "vc/ediff-merg.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-merg.el
(register-definition-prefixes "ediff-merg" '("ediff-"))
-;;;***
-;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-mult.el
(autoload 'ediff-show-registry "ediff-mult" "\
Display Ediff's registry." t nil)
-
(defalias 'eregistry #'ediff-show-registry)
-
(register-definition-prefixes "ediff-mult" '("ediff-"))
-;;;***
-;;;### (autoloads nil "ediff-ptch" "vc/ediff-ptch.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-ptch.el
(register-definition-prefixes "ediff-ptch" '("ediff-"))
-;;;***
-;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-util.el
(autoload 'ediff-toggle-multiframe "ediff-util" "\
Switch from multiframe display to single-frame display and back.
To change the default, set the variable `ediff-window-setup-function',
which see." t nil)
-
(autoload 'ediff-toggle-use-toolbar "ediff-util" "\
Enable or disable Ediff toolbar.
Works only in versions of Emacs that support toolbars.
To change the default, set the variable `ediff-use-toolbar-p', which see." t nil)
-
(register-definition-prefixes "ediff-util" '("ediff-"))
-;;;***
-;;;### (autoloads nil "ediff-vers" "vc/ediff-vers.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-vers.el
(register-definition-prefixes "ediff-vers" '("ediff-" "rcs-ediff-view-revision"))
-;;;***
-;;;### (autoloads nil "ediff-wind" "vc/ediff-wind.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-wind.el
(register-definition-prefixes "ediff-wind" '("ediff-"))
-;;;***
-;;;### (autoloads nil "edmacro" "edmacro.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/edit.el
+
+(register-definition-prefixes "semantic/edit" '("semantic-"))
+
+
;;; Generated autoloads from edmacro.el
(autoload 'edit-kbd-macro "edmacro" "\
Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `\\[kmacro-end-and-call-macro]' or RET to edit the last
+Or, type `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last
keyboard macro, `\\[view-lossage]' to edit the last 300
keystrokes as a keyboard macro, or `\\[execute-extended-command]'
to edit a macro by its command name.
With a prefix argument, format the macro in a more concise way.
-\(fn KEYS &optional PREFIX FINISH-HOOK STORE-HOOK)" t nil)
-
+(fn KEYS &optional PREFIX FINISH-HOOK STORE-HOOK)" t nil)
(autoload 'edit-last-kbd-macro "edmacro" "\
Edit the most recently defined keyboard macro.
-\(fn &optional PREFIX)" t nil)
-
+(fn &optional PREFIX)" t nil)
(autoload 'edit-named-kbd-macro "edmacro" "\
Edit a keyboard macro which has been given a name by `name-last-kbd-macro'.
-\(fn &optional PREFIX)" t nil)
-
+(fn &optional PREFIX)" t nil)
(autoload 'read-kbd-macro "edmacro" "\
Read the region as a keyboard macro definition.
The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
@@ -10079,8 +8971,7 @@ the result is returned rather than being installed as the current macro.
The result will be a string if possible, otherwise an event vector.
Second argument NEED-VECTOR means to return an event vector always.
-\(fn START &optional END)" t nil)
-
+(fn START &optional END)" t nil)
(autoload 'format-kbd-macro "edmacro" "\
Return the keyboard macro MACRO as a human-readable string.
This string is suitable for passing to `read-kbd-macro'.
@@ -10088,13 +8979,10 @@ Second argument VERBOSE means to put one command per line with comments.
If VERBOSE is `1', put everything on one line. If VERBOSE is omitted
or nil, use a compact 80-column format.
-\(fn &optional MACRO VERBOSE)" nil nil)
-
+(fn &optional MACRO VERBOSE)" nil nil)
(register-definition-prefixes "edmacro" '("edmacro-"))
-;;;***
-;;;### (autoloads nil "edt" "emulation/edt.el" (0 0 0 0))
;;; Generated autoloads from emulation/edt.el
(autoload 'edt-set-scroll-margins "edt" "\
@@ -10102,47 +8990,32 @@ Set scroll margins.
Argument TOP is the top margin in number of lines or percent of window.
Argument BOTTOM is the bottom margin in number of lines or percent of window.
-\(fn TOP BOTTOM)" t nil)
-
+(fn TOP BOTTOM)" t nil)
(autoload 'edt-emulation-on "edt" "\
Turn on EDT Emulation." t nil)
-
(register-definition-prefixes "edt" '("edt-"))
-;;;***
-;;;### (autoloads nil "edt-lk201" "emulation/edt-lk201.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emulation/edt-lk201.el
(register-definition-prefixes "edt-lk201" '("*EDT-keys*"))
-;;;***
-;;;### (autoloads nil "edt-mapper" "emulation/edt-mapper.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emulation/edt-mapper.el
(register-definition-prefixes "edt-mapper" '("edt-"))
-;;;***
-;;;### (autoloads nil "edt-pc" "emulation/edt-pc.el" (0 0 0 0))
;;; Generated autoloads from emulation/edt-pc.el
(register-definition-prefixes "edt-pc" '("*EDT-keys*"))
-;;;***
-;;;### (autoloads nil "edt-vt100" "emulation/edt-vt100.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emulation/edt-vt100.el
(register-definition-prefixes "edt-vt100" '("edt-set-term-width-"))
-;;;***
-;;;### (autoloads nil "ehelp" "ehelp.el" (0 0 0 0))
;;; Generated autoloads from ehelp.el
(autoload 'with-electric-help "ehelp" "\
@@ -10169,38 +9042,28 @@ When the user exits (with `electric-help-exit', or otherwise), the help
buffer's window disappears (i.e., we use `save-window-excursion'), and
BUFFER is put back into its original major mode.
-\(fn THUNK &optional BUFFER NOERASE MINHEIGHT)" nil nil)
-
+(fn THUNK &optional BUFFER NOERASE MINHEIGHT)" nil nil)
(autoload 'electric-helpify "ehelp" "\
-\(fn FUN &optional NAME)" nil nil)
-
+(fn FUN &optional NAME)" nil nil)
(register-definition-prefixes "ehelp" '("ehelp-" "electric-"))
-;;;***
-;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio.el
-(push (purecopy '(eieio 1 4)) package--builtin-versions)
+(push (purecopy '(eieio 1 4)) package--builtin-versions)
(register-definition-prefixes "eieio" '("child-of-class-p" "defclass" "eieio-" "find-class" "obj" "oref" "oset" "same-class-p" "set-slot-value" "slot-" "with-slots"))
-;;;***
-;;;### (autoloads nil "eieio-base" "emacs-lisp/eieio-base.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-base.el
(register-definition-prefixes "eieio-base" '("eieio-"))
-;;;***
-;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-core.el
-(push (purecopy '(eieio-core 1 4)) package--builtin-versions)
+(push (purecopy '(eieio-core 1 4)) package--builtin-versions)
(autoload 'eieio-defclass-autoload "eieio-core" "\
Create autoload symbols for the EIEIO class CNAME.
SUPERCLASSES are the superclasses that CNAME inherits from.
@@ -10209,35 +9072,45 @@ This function creates a mock-class for CNAME and adds it into
SUPERCLASSES as children.
It creates an autoload function for CNAME's constructor.
-\(fn CNAME SUPERCLASSES FILENAME DOC)" nil nil)
-
+(fn CNAME SUPERCLASSES FILENAME DOC)" nil nil)
(register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot"))
-;;;***
-;;;### (autoloads nil "eieio-datadebug" "emacs-lisp/eieio-datadebug.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/eieio-custom.el
+
+(register-definition-prefixes "eieio-custom" '("eieio-"))
+
+
;;; Generated autoloads from emacs-lisp/eieio-datadebug.el
(register-definition-prefixes "eieio-datadebug" '("data-debug-insert-object-"))
-;;;***
-;;;### (autoloads nil "eieio-speedbar" "emacs-lisp/eieio-speedbar.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/eieio-opt.el
+
+(register-definition-prefixes "eieio-opt" '("eieio-"))
+
+
;;; Generated autoloads from emacs-lisp/eieio-speedbar.el
(register-definition-prefixes "eieio-speedbar" '("eieio-speedbar"))
-;;;***
-;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/el.el
+
+(register-definition-prefixes "srecode/el" '("srecode-semantic-apply-tag-to-dict"))
+
+
+;;; Generated autoloads from cedet/semantic/bovine/el.el
+
+(register-definition-prefixes "semantic/bovine/el" '("emacs-lisp-mode" "semantic-"))
+
+
;;; Generated autoloads from emacs-lisp/eldoc.el
-(push (purecopy '(eldoc 1 11 0)) package--builtin-versions)
-;;;***
+(push (purecopy '(eldoc 1 12 0)) package--builtin-versions)
+
-;;;### (autoloads nil "elec-pair" "elec-pair.el" (0 0 0 0))
;;; Generated autoloads from elec-pair.el
(defvar electric-pair-mode nil "\
@@ -10247,26 +9120,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `electric-pair-mode'.")
-
(custom-autoload 'electric-pair-mode "elec-pair" nil)
-
(autoload 'electric-pair-mode "elec-pair" "\
Toggle automatic parens pairing (Electric Pair mode).
-This is a minor mode. If called interactively, toggle the
-`Electric-Pair mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='electric-pair-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
closing parenthesis, and vice versa. (Likewise for brackets, etc.).
@@ -10275,35 +9132,70 @@ inserted around the region instead.
To toggle the mode in a single buffer, use `electric-pair-local-mode'.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Electric-Pair mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='electric-pair-mode)'.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'electric-pair-local-mode "elec-pair" "\
Toggle `electric-pair-mode' only in this buffer.
This is a minor mode. If called interactively, toggle the
-`Electric-Pair-Local mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Electric-Pair-Local mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(buffer-local-value \\='electric-pair-mode
-\(current-buffer))'.
+(current-buffer))'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "elec-pair" '("electric-pair-"))
-;;;***
-;;;### (autoloads nil "elide-head" "elide-head.el" (0 0 0 0))
;;; Generated autoloads from elide-head.el
+(autoload 'elide-head-mode "elide-head" "\
+Toggle eliding (hiding) header material in the current buffer.
+
+When Elide Header mode is enabled, headers are hidden according
+to `elide-head-headers-to-hide'.
+
+This is suitable as an entry on `find-file-hook' or appropriate
+mode hooks.
+
+This is a minor mode. If called interactively, toggle the
+`Elide-Head mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `elide-head-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'elide-head "elide-head" "\
Hide header material in buffer according to `elide-head-headers-to-hide'.
@@ -10312,81 +9204,171 @@ an elided material again.
This is suitable as an entry on `find-file-hook' or appropriate mode hooks.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
+(make-obsolete 'elide-head 'elide-head-mode "29.1")
(register-definition-prefixes "elide-head" '("elide-head-"))
-;;;***
-;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/elint.el
(autoload 'elint-file "elint" "\
Lint the file FILE.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'elint-directory "elint" "\
Lint all the .el files in DIRECTORY.
A complicated directory may require a lot of memory.
-\(fn DIRECTORY)" t nil)
-
+(fn DIRECTORY)" t nil)
(autoload 'elint-current-buffer "elint" "\
Lint the current buffer.
If necessary, this first calls `elint-initialize'." t nil)
-
(autoload 'elint-defun "elint" "\
Lint the function at point.
If necessary, this first calls `elint-initialize'." t nil)
-
(autoload 'elint-initialize "elint" "\
Initialize elint.
If elint is already initialized, this does nothing, unless
optional prefix argument REINIT is non-nil.
-\(fn &optional REINIT)" t nil)
-
+(fn &optional REINIT)" t nil)
(register-definition-prefixes "elint" '("elint-"))
-;;;***
-;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/elp.el
(autoload 'elp-instrument-function "elp" "\
Instrument FUNSYM for profiling.
FUNSYM must be a symbol of a defined function.
-\(fn FUNSYM)" t nil)
-
+(fn FUNSYM)" t nil)
(autoload 'elp-instrument-list "elp" "\
Instrument, for profiling, all functions in `elp-function-list'.
Use optional LIST if provided instead.
If called interactively, prompt for LIST in the minibuffer;
type \"nil\" to use `elp-function-list'.
-\(fn &optional LIST)" t nil)
-
+(fn &optional LIST)" t nil)
(autoload 'elp-instrument-package "elp" "\
Instrument for profiling, all functions which start with PREFIX.
For example, to instrument all ELP functions, do the following:
\\[elp-instrument-package] RET elp- RET
-\(fn PREFIX)" t nil)
+Note that only functions that are currently loaded will be
+instrumented. If you run this function, and then later load
+further functions that start with PREFIX, they will not be
+instrumented automatically.
+(fn PREFIX)" t nil)
(autoload 'elp-results "elp" "\
Display current profiling results.
If `elp-reset-after-results' is non-nil, then current profiling
information for all instrumented functions is reset after results are
displayed." t nil)
-
(register-definition-prefixes "elp" '("elp-"))
-;;;***
-;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (0 0 0 0))
+;;; Generated autoloads from eshell/em-alias.el
+
+(register-definition-prefixes "em-alias" '("eshell" "pcomplete/eshell-mode/alias"))
+
+
+;;; Generated autoloads from eshell/em-banner.el
+
+(register-definition-prefixes "em-banner" '("eshell-banner-"))
+
+
+;;; Generated autoloads from eshell/em-basic.el
+
+(register-definition-prefixes "em-basic" '("eshell"))
+
+
+;;; Generated autoloads from eshell/em-cmpl.el
+
+(register-definition-prefixes "em-cmpl" '("eshell-"))
+
+
+;;; Generated autoloads from eshell/em-dirs.el
+
+(register-definition-prefixes "em-dirs" '("eshell"))
+
+
+;;; Generated autoloads from eshell/em-elecslash.el
+
+(register-definition-prefixes "em-elecslash" '("eshell-elec"))
+
+
+;;; Generated autoloads from eshell/em-extpipe.el
+
+(register-definition-prefixes "em-extpipe" '("em-extpipe--or-with-catch" "eshell-"))
+
+
+;;; Generated autoloads from eshell/em-glob.el
+
+(register-definition-prefixes "em-glob" '("eshell-"))
+
+
+;;; Generated autoloads from eshell/em-hist.el
+
+(register-definition-prefixes "em-hist" '("eshell"))
+
+
+;;; Generated autoloads from eshell/em-ls.el
+
+(register-definition-prefixes "em-ls" '("eshell"))
+
+
+;;; Generated autoloads from eshell/em-pred.el
+
+(register-definition-prefixes "em-pred" '("eshell-"))
+
+
+;;; Generated autoloads from eshell/em-prompt.el
+
+(register-definition-prefixes "em-prompt" '("eshell-"))
+
+
+;;; Generated autoloads from eshell/em-rebind.el
+
+(register-definition-prefixes "em-rebind" '("eshell-"))
+
+
+;;; Generated autoloads from eshell/em-script.el
+
+(register-definition-prefixes "em-script" '("eshell"))
+
+
+;;; Generated autoloads from eshell/em-smart.el
+
+(register-definition-prefixes "em-smart" '("eshell-"))
+
+
+;;; Generated autoloads from eshell/em-term.el
+
+(register-definition-prefixes "em-term" '("eshell-"))
+
+
+;;; Generated autoloads from eshell/em-tramp.el
+
+(register-definition-prefixes "em-tramp" '("eshell"))
+
+
+;;; Generated autoloads from eshell/em-unix.el
+
+(register-definition-prefixes "em-unix" '("eshell" "nil-blank-string"))
+
+
+;;; Generated autoloads from eshell/em-xtra.el
+
+(register-definition-prefixes "em-xtra" '("eshell/"))
+
+
+;;; Generated autoloads from cedet/ede/emacs.el
+
+(register-definition-prefixes "ede/emacs" '("ede-emacs-"))
+
+
;;; Generated autoloads from emacs-lock.el
(autoload 'emacs-lock-mode "emacs-lock" "\
@@ -10410,13 +9392,23 @@ Other values are interpreted as usual.
See also `emacs-lock-unlockable-modes', which exempts buffers under
some major modes from being locked under some circumstances.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock"))
-;;;***
-;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (0 0 0 0))
+;;; Generated autoloads from textmodes/emacs-news-mode.el
+
+(autoload 'emacs-news-mode "emacs-news-mode" "\
+Major mode for editing the Emacs NEWS file.
+
+(fn)" t nil)
+(autoload 'emacs-news-view-mode "emacs-news-mode" "\
+Major mode for viewing the Emacs NEWS file.
+
+(fn)" t nil)
+(register-definition-prefixes "emacs-news-mode" '("emacs-news-"))
+
+
;;; Generated autoloads from mail/emacsbug.el
(autoload 'report-emacs-bug "emacsbug" "\
@@ -10427,100 +9419,105 @@ Already submitted bugs can be found in the Emacs bug tracker:
https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1
-\(fn TOPIC &optional UNUSED)" t nil)
-
+(fn TOPIC &optional UNUSED)" t nil)
(set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5")
-
(autoload 'submit-emacs-patch "emacsbug" "\
Send an Emacs patch to the Emacs maintainers.
Interactively, you will be prompted for SUBJECT and a patch FILE
name (which will be attached to the mail). You will end up in a
Message buffer where you can explain more about the patch.
-\(fn SUBJECT FILE)" t nil)
-
+(fn SUBJECT FILE)" t nil)
(register-definition-prefixes "emacsbug" '("emacs-bug--system-description" "report-emacs-bug-"))
-;;;***
-;;;### (autoloads nil "emerge" "vc/emerge.el" (0 0 0 0))
;;; Generated autoloads from vc/emerge.el
(autoload 'emerge-files "emerge" "\
Run Emerge on two files FILE-A and FILE-B.
-\(fn ARG FILE-A FILE-B FILE-OUT &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-
+(fn ARG FILE-A FILE-B FILE-OUT &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
(autoload 'emerge-files-with-ancestor "emerge" "\
Run Emerge on two files, giving another file as the ancestor.
-\(fn ARG FILE-A FILE-B FILE-ANCESTOR FILE-OUT &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-
+(fn ARG FILE-A FILE-B FILE-ANCESTOR FILE-OUT &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
(autoload 'emerge-buffers "emerge" "\
Run Emerge on two buffers BUFFER-A and BUFFER-B.
-\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-
+(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
(autoload 'emerge-buffers-with-ancestor "emerge" "\
Run Emerge on two buffers, giving another buffer as the ancestor.
-\(fn BUFFER-A BUFFER-B BUFFER-ANCESTOR &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-
+(fn BUFFER-A BUFFER-B BUFFER-ANCESTOR &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
(autoload 'emerge-files-command "emerge" nil nil nil)
-
(autoload 'emerge-files-with-ancestor-command "emerge" nil nil nil)
-
(autoload 'emerge-files-remote "emerge" "\
-\(fn FILE-A FILE-B FILE-OUT)" nil nil)
-
+(fn FILE-A FILE-B FILE-OUT)" nil nil)
(autoload 'emerge-files-with-ancestor-remote "emerge" "\
-\(fn FILE-A FILE-B FILE-ANC FILE-OUT)" nil nil)
-
+(fn FILE-A FILE-B FILE-ANC FILE-OUT)" nil nil)
(autoload 'emerge-revisions "emerge" "\
Emerge two RCS revisions of a file.
-\(fn ARG FILE REVISION-A REVISION-B &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-
+(fn ARG FILE REVISION-A REVISION-B &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
(autoload 'emerge-revisions-with-ancestor "emerge" "\
Emerge two RCS revisions of a file, with another revision as ancestor.
-\(fn ARG FILE REVISION-A REVISION-B ANCESTOR &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-
+(fn ARG FILE REVISION-A REVISION-B ANCESTOR &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
(autoload 'emerge-merge-directories "emerge" "\
-\(fn A-DIR B-DIR ANCESTOR-DIR OUTPUT-DIR)" t nil)
-
+(fn A-DIR B-DIR ANCESTOR-DIR OUTPUT-DIR)" t nil)
(register-definition-prefixes "emerge" '("emerge-"))
-;;;***
-;;;### (autoloads nil "enriched" "textmodes/enriched.el" (0 0 0 0))
+;;; Generated autoloads from international/emoji.el
+
+(autoload 'emoji-insert "emoji" "\
+Choose and insert an emoji glyph." t nil)
+(autoload 'emoji-recent "emoji" "\
+Choose and insert one of the recently-used emoji glyphs." t nil)
+(autoload 'emoji-search "emoji" "\
+Choose and insert an emoji glyph by typing its Unicode name.
+This command prompts for an emoji name, with completion, and
+inserts it. It recognizes the Unicode Standard names of emoji,
+and also consults the `emoji-alternate-names' alist." t nil)
+(autoload 'emoji-list "emoji" "\
+List emojis and insert the one that's selected.
+Select the emoji by typing \\<emoji-list-mode-map>\\[emoji-list-select] on its picture.
+The glyph will be inserted into the buffer that was current
+when the command was invoked." t nil)
+(autoload 'emoji-describe "emoji" "\
+Display the name of the grapheme cluster composed from GLYPH.
+GLYPH should be a string of one or more characters which together
+produce an emoji. Interactively, GLYPH is the emoji at point (it
+could also be any character, not just emoji).
+
+If called from Lisp, return the name as a string; return nil if
+the name is not known.
+
+(fn GLYPH &optional INTERACTIVE)" t nil)
+(autoload 'emoji-zoom-increase "emoji" "\
+Increase the size of the character under point.
+FACTOR is the multiplication factor for the size.
+
+(fn &optional FACTOR)" t nil)
+(autoload 'emoji-zoom-decrease "emoji" "\
+Decrease the size of the character under point." t nil)
+(register-definition-prefixes "emoji" '("emoji-"))
+
+
;;; Generated autoloads from textmodes/enriched.el
(autoload 'enriched-mode "enriched" "\
Minor mode for editing text/enriched files.
+
These are files with embedded formatting information in the MIME standard
text/enriched format.
-This is a minor mode. If called interactively, toggle the `Enriched
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `enriched-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Turning the mode on or off runs `enriched-mode-hook'.
More information about Enriched mode is available in the file
@@ -10530,35 +9527,42 @@ Commands:
\\{enriched-mode-map}
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Enriched mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-(autoload 'enriched-encode "enriched" "\
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `enriched-mode'.
-\(fn FROM TO ORIG-BUF)" nil nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(autoload 'enriched-encode "enriched" "\
-(autoload 'enriched-decode "enriched" "\
+(fn FROM TO ORIG-BUF)" nil nil)
+(autoload 'enriched-decode "enriched" "\
-\(fn FROM TO)" nil nil)
+(fn FROM TO)" nil nil)
(register-definition-prefixes "enriched" '("enriched-"))
-;;;***
-;;;### (autoloads nil "epa" "epa.el" (0 0 0 0))
;;; Generated autoloads from epa.el
(autoload 'epa-list-keys "epa" "\
List all keys matched with NAME from the public keyring.
-\(fn &optional NAME)" t nil)
-
+(fn &optional NAME)" t nil)
(autoload 'epa-list-secret-keys "epa" "\
List all keys matched with NAME from the private keyring.
-\(fn &optional NAME)" t nil)
-
+(fn &optional NAME)" t nil)
(autoload 'epa-select-keys "epa" "\
Display a user's keyring and ask him to select keys.
CONTEXT is an `epg-context'.
@@ -10567,29 +9571,24 @@ NAMES is a list of strings to be matched with keys. If it is nil, all
the keys are listed.
If SECRET is non-nil, list secret keys instead of public keys.
-\(fn CONTEXT PROMPT &optional NAMES SECRET)" nil nil)
-
+(fn CONTEXT PROMPT &optional NAMES SECRET)" nil nil)
(autoload 'epa-decrypt-file "epa" "\
Decrypt DECRYPT-FILE into PLAIN-FILE.
If you do not specify PLAIN-FILE, this functions prompts for the value to use.
-\(fn DECRYPT-FILE &optional PLAIN-FILE)" t nil)
-
+(fn DECRYPT-FILE &optional PLAIN-FILE)" t nil)
(autoload 'epa-verify-file "epa" "\
Verify FILE.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'epa-sign-file "epa" "\
Sign FILE by SIGNERS keys selected.
-\(fn FILE SIGNERS MODE)" t nil)
-
+(fn FILE SIGNERS MODE)" t nil)
(autoload 'epa-encrypt-file "epa" "\
Encrypt FILE for RECIPIENTS.
-\(fn FILE RECIPIENTS)" t nil)
-
+(fn FILE RECIPIENTS)" t nil)
(autoload 'epa-decrypt-region "epa" "\
Decrypt the current region between START and END.
@@ -10608,23 +9607,20 @@ should consider using the string based counterpart
For example:
-\(let ((context (epg-make-context \\='OpenPGP)))
+(let ((context (epg-make-context \\='OpenPGP)))
(decode-coding-string
(epg-decrypt-string context (buffer-substring start end))
\\='utf-8))
-\(fn START END &optional MAKE-BUFFER-FUNCTION)" t nil)
-
+(fn START END &optional MAKE-BUFFER-FUNCTION)" t nil)
(autoload 'epa-decrypt-armor-in-region "epa" "\
Decrypt OpenPGP armors in the current region between START and END.
Don't use this command in Lisp programs!
See the reason described in the `epa-decrypt-region' documentation.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(function-put 'epa-decrypt-armor-in-region 'interactive-only 't)
-
(autoload 'epa-verify-region "epa" "\
Verify the current region between START and END.
@@ -10638,25 +9634,21 @@ should consider using the string based counterpart
For example:
-\(let ((context (epg-make-context \\='OpenPGP)))
+(let ((context (epg-make-context \\='OpenPGP)))
(decode-coding-string
(epg-verify-string context (buffer-substring start end))
\\='utf-8))
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(function-put 'epa-verify-region 'interactive-only 't)
-
(autoload 'epa-verify-cleartext-in-region "epa" "\
Verify OpenPGP cleartext signed messages in current region from START to END.
Don't use this command in Lisp programs!
See the reason described in the `epa-verify-region' documentation.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(function-put 'epa-verify-cleartext-in-region 'interactive-only 't)
-
(autoload 'epa-sign-region "epa" "\
Sign the current region between START and END by SIGNERS keys selected.
@@ -10669,15 +9661,13 @@ based counterpart `epg-sign-file' instead.
For example:
-\(let ((context (epg-make-context \\='OpenPGP)))
+(let ((context (epg-make-context \\='OpenPGP)))
(epg-sign-string
context
(encode-coding-string (buffer-substring start end) \\='utf-8)))
-\(fn START END SIGNERS MODE)" t nil)
-
+(fn START END SIGNERS MODE)" t nil)
(function-put 'epa-sign-region 'interactive-only 't)
-
(autoload 'epa-encrypt-region "epa" "\
Encrypt the current region between START and END for RECIPIENTS.
@@ -10690,84 +9680,64 @@ file based counterpart `epg-encrypt-file' instead.
For example:
-\(let ((context (epg-make-context \\='OpenPGP)))
+(let ((context (epg-make-context \\='OpenPGP)))
(epg-encrypt-string
context
(encode-coding-string (buffer-substring start end) \\='utf-8)
nil))
-\(fn START END RECIPIENTS SIGN SIGNERS)" t nil)
-
+(fn START END RECIPIENTS SIGN SIGNERS)" t nil)
(function-put 'epa-encrypt-region 'interactive-only 't)
-
(autoload 'epa-delete-keys "epa" "\
Delete selected KEYS.
-\(fn KEYS &optional ALLOW-SECRET)" t nil)
-
+(fn KEYS &optional ALLOW-SECRET)" t nil)
(autoload 'epa-import-keys "epa" "\
Import keys from FILE.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'epa-import-keys-region "epa" "\
Import keys from the region.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'epa-import-armor-in-region "epa" "\
Import keys in the OpenPGP armor format in the current region from START to END.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'epa-export-keys "epa" "\
Export selected KEYS to FILE.
-\(fn KEYS FILE)" t nil)
-
+(fn KEYS FILE)" t nil)
(autoload 'epa-insert-keys "epa" "\
Insert selected KEYS after the point.
-\(fn KEYS)" t nil)
-
+(fn KEYS)" t nil)
(register-definition-prefixes "epa" '("epa-"))
-;;;***
-;;;### (autoloads nil "epa-dired" "epa-dired.el" (0 0 0 0))
;;; Generated autoloads from epa-dired.el
(autoload 'epa-dired-do-decrypt "epa-dired" "\
Decrypt marked files." t nil)
-
(autoload 'epa-dired-do-verify "epa-dired" "\
Verify marked files." t nil)
-
(autoload 'epa-dired-do-sign "epa-dired" "\
Sign marked files." t nil)
-
(autoload 'epa-dired-do-encrypt "epa-dired" "\
Encrypt marked files." t nil)
-;;;***
-;;;### (autoloads nil "epa-file" "epa-file.el" (0 0 0 0))
;;; Generated autoloads from epa-file.el
(autoload 'epa-file-handler "epa-file" "\
-\(fn OPERATION &rest ARGS)" nil nil)
-
+(fn OPERATION &rest ARGS)" nil nil)
(autoload 'epa-file-enable "epa-file" nil t nil)
-
(autoload 'epa-file-disable "epa-file" nil t nil)
-
(register-definition-prefixes "epa-file" '("epa-"))
-;;;***
-;;;### (autoloads nil "epa-ks" "epa-ks.el" (0 0 0 0))
;;; Generated autoloads from epa-ks.el
(autoload 'epa-search-keys "epa-ks" "\
@@ -10781,46 +9751,38 @@ exact matches.
Note that the request may fail if the query is not specific
enough, since keyservers have strict timeout settings.
-\(fn QUERY EXACT)" t nil)
-
+(fn QUERY EXACT)" t nil)
(register-definition-prefixes "epa-ks" '("epa-k"))
-;;;***
-;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0))
;;; Generated autoloads from epa-mail.el
(autoload 'epa-mail-mode "epa-mail" "\
A minor-mode for composing encrypted/clearsigned mails.
-This is a minor mode. If called interactively, toggle the `epa-mail
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`epa-mail mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `epa-mail-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'epa-mail-decrypt "epa-mail" "\
Decrypt OpenPGP armors in the current buffer.
The buffer is expected to contain a mail message." t nil)
-
(function-put 'epa-mail-decrypt 'interactive-only 't)
-
(autoload 'epa-mail-verify "epa-mail" "\
Verify OpenPGP cleartext signed messages in the current buffer.
The buffer is expected to contain a mail message." t nil)
-
(function-put 'epa-mail-verify 'interactive-only 't)
-
(autoload 'epa-mail-sign "epa-mail" "\
Sign the current buffer.
The buffer is expected to contain a mail message, and signing is
@@ -10828,10 +9790,8 @@ performed with your default key.
With prefix argument, asks you to select interactively the key to
use from your key ring.
-\(fn START END SIGNERS MODE)" t nil)
-
+(fn START END SIGNERS MODE)" t nil)
(function-put 'epa-mail-sign 'interactive-only 't)
-
(autoload 'epa-mail-encrypt "epa-mail" "\
Encrypt the outgoing mail message in the current buffer.
Takes the recipients from the text in the header in the buffer
@@ -10845,14 +9805,11 @@ or nil meaning use the defaults.
SIGNERS is a list of keys to sign the message with.
-\(fn &optional RECIPIENTS SIGNERS)" t nil)
-
+(fn &optional RECIPIENTS SIGNERS)" t nil)
(autoload 'epa-mail-import-keys "epa-mail" "\
Import keys in the OpenPGP armor format in the current buffer.
The buffer is expected to contain a mail message." t nil)
-
(function-put 'epa-mail-import-keys 'interactive-only 't)
-
(defvar epa-global-mail-mode nil "\
Non-nil if Epa-Global-Mail mode is enabled.
See the `epa-global-mail-mode' command
@@ -10860,46 +9817,38 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `epa-global-mail-mode'.")
-
(custom-autoload 'epa-global-mail-mode "epa-mail" nil)
-
(autoload 'epa-global-mail-mode "epa-mail" "\
Minor mode to hook EasyPG into Mail mode.
-This is a minor mode. If called interactively, toggle the
+This is a global minor mode. If called interactively, toggle the
`Epa-Global-Mail mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='epa-global-mail-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "epa-mail" '("epa-mail-"))
-;;;***
-;;;### (autoloads nil "epg" "epg.el" (0 0 0 0))
;;; Generated autoloads from epg.el
-(push (purecopy '(epg 1 0 0)) package--builtin-versions)
+(push (purecopy '(epg 1 0 0)) package--builtin-versions)
(autoload 'epg-make-context "epg" "\
Return a context object.
-\(fn &optional PROTOCOL ARMOR TEXTMODE INCLUDE-CERTS CIPHER-ALGORITHM DIGEST-ALGORITHM COMPRESS-ALGORITHM)" nil nil)
-
+(fn &optional PROTOCOL ARMOR TEXTMODE INCLUDE-CERTS CIPHER-ALGORITHM DIGEST-ALGORITHM COMPRESS-ALGORITHM)" nil nil)
(register-definition-prefixes "epg" '("epg-"))
-;;;***
-;;;### (autoloads nil "epg-config" "epg-config.el" (0 0 0 0))
;;; Generated autoloads from epg-config.el
(autoload 'epg-find-configuration "epg-config" "\
@@ -10913,13 +9862,10 @@ Then it walks through PROGRAM-ALIST or
Otherwise, it tries the programs listed in the entry until the
version requirement is met.
-\(fn PROTOCOL &optional NO-CACHE PROGRAM-ALIST)" nil nil)
-
+(fn PROTOCOL &optional NO-CACHE PROGRAM-ALIST)" nil nil)
(autoload 'epg-configuration "epg-config" "\
Return a list of internal configuration parameters of `epg-gpg-program'." nil nil)
-
-(make-obsolete 'epg-configuration 'epg-find-configuration '"25.1")
-
+(make-obsolete 'epg-configuration 'epg-find-configuration "25.1")
(autoload 'epg-check-configuration "epg-config" "\
Verify that a sufficient version of GnuPG is installed.
CONFIG should be a `epg-configuration' object (a plist).
@@ -10928,24 +9874,19 @@ REQ-VERSIONS should be a list with elements of the form (MIN
semi-open range of acceptable versions. REQ-VERSIONS may also be
a single minimum version string.
-\(fn CONFIG &optional REQ-VERSIONS)" nil nil)
-
+(fn CONFIG &optional REQ-VERSIONS)" nil nil)
(autoload 'epg-expand-group "epg-config" "\
Look at CONFIG and try to expand GROUP.
-\(fn CONFIG GROUP)" nil nil)
-
+(fn CONFIG GROUP)" nil nil)
(register-definition-prefixes "epg-config" '("epg-"))
-;;;***
-;;;### (autoloads nil "erc" "erc/erc.el" (0 0 0 0))
;;; Generated autoloads from erc/erc.el
-(push (purecopy '(erc 5 4)) package--builtin-versions)
+(push (purecopy '(erc 5 4 1)) package--builtin-versions)
(autoload 'erc-select-read-args "erc" "\
Prompt the user for values of nick, server, port, and password." nil nil)
-
(autoload 'erc "erc" "\
ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
@@ -10956,8 +9897,10 @@ Non-interactively, it takes the keyword arguments
(server (erc-compute-server))
(port (erc-compute-port))
(nick (erc-compute-nick))
+ (user (erc-compute-user))
password
(full-name (erc-compute-full-name))
+ id
That is, if called with
@@ -10967,10 +9910,12 @@ then the server and full-name will be set to those values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
for the values of the other parameters.
-\(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)))" t nil)
+When present, ID should be an opaque object used to identify the
+connection unequivocally. This is rarely needed and not available
+interactively.
+(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME (erc-compute-full-name)) ID)" '((erc-select-read-args)) nil)
(defalias 'erc-select #'erc)
-
(autoload 'erc-tls "erc" "\
ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC over TLS.
@@ -10985,6 +9930,7 @@ Non-interactively, it takes the keyword arguments
password
(full-name (erc-compute-full-name))
client-certificate
+ id
That is, if called with
@@ -11006,67 +9952,207 @@ Example usage:
(erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
- '(\"/home/bandali/my-cert.key\"
+ \\='(\"/home/bandali/my-cert.key\"
\"/home/bandali/my-cert.crt\"))
-\(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE)" t nil)
+When present, ID should be an opaque object for identifying the
+connection unequivocally. (In most cases, this would be a string or a
+symbol composed of letters from the Latin alphabet.) This option is
+generally unneeded, however. See info node `(erc) Connecting' for use
+cases. Not available interactively.
+(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE ID)" '((let ((erc-default-port erc-default-port-tls)) (erc-select-read-args))) nil)
(autoload 'erc-handle-irc-url "erc" "\
Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
-\(fn HOST PORT CHANNEL USER PASSWORD)" nil nil)
-
+(fn HOST PORT CHANNEL USER PASSWORD)" nil nil)
(register-definition-prefixes "erc" '("define-erc-module" "erc-"))
-;;;***
-;;;### (autoloads nil "erc-backend" "erc/erc-backend.el" (0 0 0 0))
+;;; Generated autoloads from erc/erc-autoaway.el
+
+(register-definition-prefixes "erc-autoaway" '("erc-auto"))
+
+
;;; Generated autoloads from erc/erc-backend.el
(register-definition-prefixes "erc-backend" '("erc-"))
-;;;***
-;;;### (autoloads nil "erc-goodies" "erc/erc-goodies.el" (0 0 0 0))
+;;; Generated autoloads from erc/erc-button.el
+
+(register-definition-prefixes "erc-button" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-capab.el
+
+(register-definition-prefixes "erc-capab" '("erc-capab-identify-"))
+
+
+;;; Generated autoloads from erc/erc-compat.el
+
+(register-definition-prefixes "erc-compat" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-dcc.el
+
+(register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/"))
+
+
+;;; Generated autoloads from erc/erc-desktop-notifications.el
+
+(register-definition-prefixes "erc-desktop-notifications" '("erc-notifications-"))
+
+
+;;; Generated autoloads from erc/erc-ezbounce.el
+
+(register-definition-prefixes "erc-ezbounce" '("erc-ezb-"))
+
+
+;;; Generated autoloads from erc/erc-fill.el
+
+(register-definition-prefixes "erc-fill" '("erc-"))
+
+
;;; Generated autoloads from erc/erc-goodies.el
(register-definition-prefixes "erc-goodies" '("erc-"))
-;;;***
-;;;### (autoloads nil "erc-ibuffer" "erc/erc-ibuffer.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-ibuffer.el
(register-definition-prefixes "erc-ibuffer" '("erc-"))
-;;;***
-;;;### (autoloads nil "erc-lang" "erc/erc-lang.el" (0 0 0 0))
+;;; Generated autoloads from erc/erc-identd.el
+
+(register-definition-prefixes "erc-identd" '("erc-identd-"))
+
+
+;;; Generated autoloads from erc/erc-imenu.el
+
+(register-definition-prefixes "erc-imenu" '("erc-unfill-notice"))
+
+
+;;; Generated autoloads from erc/erc-join.el
+
+(register-definition-prefixes "erc-join" '("erc-"))
+
+
;;; Generated autoloads from erc/erc-lang.el
-(register-definition-prefixes "erc-lang" '("erc-cmd-LANG" "iso-638-languages" "language"))
+(register-definition-prefixes "erc-lang" '("erc-cmd-LANG" "iso-639-1-languages" "language"))
+
+
+;;; Generated autoloads from erc/erc-list.el
+
+(register-definition-prefixes "erc-list" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-log.el
+
+(register-definition-prefixes "erc-log" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-match.el
+
+(register-definition-prefixes "erc-match" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-menu.el
+
+(register-definition-prefixes "erc-menu" '("erc-menu-"))
+
+
+;;; Generated autoloads from erc/erc-netsplit.el
+
+(register-definition-prefixes "erc-netsplit" '("erc-"))
-;;;***
-;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from erc/erc-networks.el
(autoload 'erc-determine-network "erc-networks" "\
Return the name of the network or \"Unknown\" as a symbol.
Use the server parameter NETWORK if provided, otherwise parse the
server name and search for a match in `erc-networks-alist'." nil nil)
-
+(make-obsolete 'erc-determine-network '"maybe see `erc-networks--determine'" "29.1")
(autoload 'erc-server-select "erc-networks" "\
Interactively select a server to connect to using `erc-server-alist'." t nil)
-
(register-definition-prefixes "erc-networks" '("erc-"))
-;;;***
-;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (0 0 0 0))
+;;; Generated autoloads from erc/erc-notify.el
+
+(register-definition-prefixes "erc-notify" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-page.el
+
+(register-definition-prefixes "erc-page" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-pcomplete.el
+
+(register-definition-prefixes "erc-pcomplete" '("erc-pcomplet" "pcomplete"))
+
+
+;;; Generated autoloads from erc/erc-replace.el
+
+(register-definition-prefixes "erc-replace" '("erc-replace-"))
+
+
+;;; Generated autoloads from erc/erc-ring.el
+
+(register-definition-prefixes "erc-ring" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-services.el
+
+(register-definition-prefixes "erc-services" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-sound.el
+
+(register-definition-prefixes "erc-sound" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-speedbar.el
+
+(register-definition-prefixes "erc-speedbar" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-spelling.el
+
+(register-definition-prefixes "erc-spelling" '("erc-spelling-"))
+
+
+;;; Generated autoloads from erc/erc-stamp.el
+
+(register-definition-prefixes "erc-stamp" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-status-sidebar.el
+
+(register-definition-prefixes "erc-status-sidebar" '("erc-status-sidebar-"))
+
+
+;;; Generated autoloads from erc/erc-track.el
+
+(register-definition-prefixes "erc-track" '("erc-"))
+
+
+;;; Generated autoloads from erc/erc-truncate.el
+
+(register-definition-prefixes "erc-truncate" '("erc-max-buffer-size"))
+
+
+;;; Generated autoloads from erc/erc-xdcc.el
+
+(register-definition-prefixes "erc-xdcc" '("erc-"))
+
+
;;; Generated autoloads from emacs-lisp/ert.el
(autoload 'ert-deftest "ert" "\
@@ -11088,12 +10174,10 @@ Macros in BODY are expanded when the test is defined, not when it
is run. If a macro (possibly with side effects) is to be tested,
it has to be wrapped in `(eval (quote ...))'.
-\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] BODY...)" nil t)
-
-(function-put 'ert-deftest 'doc-string-elt '3)
-
-(function-put 'ert-deftest 'lisp-indent-function '2)
+If NAME is already defined as a test and Emacs is running
+in batch mode, an error is signalled.
+(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] BODY...)" nil 'macro)
(autoload 'ert-run-tests-batch "ert" "\
Run the tests specified by SELECTOR, printing results to the terminal.
@@ -11104,8 +10188,7 @@ ert-run-tests-batch-and-exit\" useful.
Returns the stats object.
-\(fn &optional SELECTOR)" nil nil)
-
+(fn &optional SELECTOR)" nil nil)
(autoload 'ert-run-tests-batch-and-exit "ert" "\
Like `ert-run-tests-batch', but exits Emacs when done.
@@ -11114,124 +10197,101 @@ on unexpected results, or 2 if the tool detected an error outside
of the tests (e.g. invalid SELECTOR or bug in the code that runs
the tests).
-\(fn &optional SELECTOR)" nil nil)
-
+(fn &optional SELECTOR)" nil nil)
(autoload 'ert-run-tests-interactively "ert" "\
Run the tests specified by SELECTOR and display the results in a buffer.
SELECTOR works as described in `ert-select-tests'.
-OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they
-are used for automated self-tests and specify which buffer to use
-and how to display message.
-
-\(fn SELECTOR &optional OUTPUT-BUFFER-NAME MESSAGE-FN)" t nil)
+(fn SELECTOR)" t nil)
(defalias 'ert #'ert-run-tests-interactively)
-
(autoload 'ert-describe-test "ert" "\
Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
-\(fn TEST-OR-TEST-NAME)" t nil)
-
+(fn TEST-OR-TEST-NAME)" t nil)
(register-definition-prefixes "ert" '("ert-"))
-;;;***
-;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/ert-x.el
(autoload 'ert-kill-all-test-buffers "ert-x" "\
Kill all test buffers that are still live." t nil)
-
(register-definition-prefixes "ert-x" '("ert-"))
-;;;***
-;;;### (autoloads nil "esh-arg" "eshell/esh-arg.el" (0 0 0 0))
+;;; Generated autoloads from progmodes/erts-mode.el
+
+(autoload 'erts-mode "erts-mode" "\
+Major mode for editing erts (Emacs testing) files.
+This mode mainly provides some font locking.
+
+\\{erts-mode-map}
+
+(fn)" t nil)
+(register-definition-prefixes "erts-mode" '("erts-"))
+
+
;;; Generated autoloads from eshell/esh-arg.el
(register-definition-prefixes "esh-arg" '("eshell-"))
-;;;***
-;;;### (autoloads nil "esh-cmd" "eshell/esh-cmd.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-cmd.el
(register-definition-prefixes "esh-cmd" '("eshell" "pcomplete/eshell-mode/eshell-debug"))
-;;;***
-;;;### (autoloads nil "esh-ext" "eshell/esh-ext.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-ext.el
(register-definition-prefixes "esh-ext" '("eshell"))
-;;;***
-;;;### (autoloads nil "esh-io" "eshell/esh-io.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-io.el
(register-definition-prefixes "esh-io" '("eshell-"))
-;;;***
-;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-mode.el
(autoload 'eshell-mode "esh-mode" "\
Emacs shell interactive mode.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'eshell-bookmark-jump "esh-mode" "\
Default bookmark handler for Eshell buffers.
-\(fn BOOKMARK)" nil nil)
-
+(fn BOOKMARK)" nil nil)
(register-definition-prefixes "esh-mode" '("eshell"))
-;;;***
-;;;### (autoloads nil "esh-module" "eshell/esh-module.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from eshell/esh-module.el
(register-definition-prefixes "esh-module" '("eshell-"))
-;;;***
-;;;### (autoloads nil "esh-opt" "eshell/esh-opt.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-opt.el
(register-definition-prefixes "esh-opt" '("eshell-"))
-;;;***
-;;;### (autoloads nil "esh-proc" "eshell/esh-proc.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-proc.el
(register-definition-prefixes "esh-proc" '("eshell"))
-;;;***
-;;;### (autoloads nil "esh-util" "eshell/esh-util.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-util.el
(register-definition-prefixes "esh-util" '("eshell-"))
-;;;***
-;;;### (autoloads nil "esh-var" "eshell/esh-var.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-var.el
(register-definition-prefixes "esh-var" '("eshell" "pcomplete/eshell-mode/"))
-;;;***
-;;;### (autoloads nil "eshell" "eshell/eshell.el" (0 0 0 0))
;;; Generated autoloads from eshell/eshell.el
-(push (purecopy '(eshell 2 4 2)) package--builtin-versions)
+(push (purecopy '(eshell 2 4 2)) package--builtin-versions)
(autoload 'eshell "eshell" "\
Create an interactive Eshell buffer.
Start a new Eshell session, or switch to an already active
@@ -11249,14 +10309,12 @@ value of `eshell-buffer-name', which see.
Eshell is a shell-like command interpreter. For more
information on Eshell, see Info node `(eshell)Top'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'eshell-command "eshell" "\
Execute the Eshell command string COMMAND.
With prefix ARG, insert output into the current buffer at point.
-\(fn &optional COMMAND ARG)" t nil)
-
+(fn &optional COMMAND ARG)" t nil)
(autoload 'eshell-command-result "eshell" "\
Execute the given Eshell COMMAND, and return the result.
The result might be any Lisp object.
@@ -11264,13 +10322,10 @@ If STATUS-VAR is a symbol, it will be set to the exit status of the
command. This is the only way to determine whether the value returned
corresponding to a successful execution.
-\(fn COMMAND &optional STATUS-VAR)" nil nil)
-
+(fn COMMAND &optional STATUS-VAR)" nil nil)
(register-definition-prefixes "eshell" '("eshell-"))
-;;;***
-;;;### (autoloads nil "etags" "progmodes/etags.el" (0 0 0 0))
;;; Generated autoloads from progmodes/etags.el
(defvar tags-file-name nil "\
@@ -11281,59 +10336,44 @@ setting the value of this variable, whether buffer-local or global.
Use the `etags' program to make a tags table file.")
(put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: "))
(put 'tags-file-name 'safe-local-variable 'stringp)
-
(defvar tags-case-fold-search 'default "\
Whether tags operations should be case-sensitive.
A value of t means case-insensitive, a value of nil means case-sensitive.
Any other value means use the setting of `case-fold-search'.")
-
(custom-autoload 'tags-case-fold-search "etags" t)
-
(put 'tags-case-fold-search 'safe-local-variable 'symbolp)
-
(defvar tags-table-list nil "\
List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
Use the `etags' program to make a tags table file.")
-
(custom-autoload 'tags-table-list "etags" t)
-
(defvar tags-compression-info-list (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz")) "\
List of extensions tried by etags when `auto-compression-mode' is on.
An empty string means search the non-compressed file.")
-
(custom-autoload 'tags-compression-info-list "etags" t)
-
(defvar tags-add-tables 'ask-user "\
Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).
Any other value means ask the user whether to add a new tags table
to the current list (as opposed to starting a new list).")
-
(custom-autoload 'tags-add-tables "etags" t)
-
(defvar find-tag-hook nil "\
Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
not the value in the buffer \\[find-tag] goes to.")
-
(custom-autoload 'find-tag-hook "etags" t)
-
(defvar find-tag-default-function nil "\
A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used.")
-
(custom-autoload 'find-tag-default-function "etags" t)
-
(autoload 'tags-table-mode "etags" "\
Major mode for tags table file buffers.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'visit-tags-table "etags" "\
Tell tags commands to use tags table file FILE.
FILE should be the name of a file created with the `etags' program.
@@ -11346,8 +10386,7 @@ When you find a tag with \\[find-tag], the buffer it finds the tag
in is given a local value of this variable which is the name of the tags
file the tag was in.
-\(fn FILE &optional LOCAL)" t nil)
-
+(fn FILE &optional LOCAL)" t nil)
(autoload 'visit-tags-table-buffer "etags" "\
Select the buffer containing the current tags table.
Optional arg CONT specifies which tags table to visit.
@@ -11361,21 +10400,18 @@ Optional second arg CBUF, if non-nil, specifies the initial buffer,
which is important if that buffer has a local value of `tags-file-name'.
Returns t if it visits a tags table, or nil if there are no more in the list.
-\(fn &optional CONT CBUF)" nil nil)
-
+(fn &optional CONT CBUF)" nil nil)
(autoload 'tags-table-files "etags" "\
Return a list of files in the current tags table.
Assumes the tags table is the current buffer. The file names are returned
as they appeared in the `etags' command that created the table, usually
without directory names." nil nil)
-
(autoload 'tags-lazy-completion-table "etags" nil nil nil)
(defun tags-completion-at-point-function ()
(if (or tags-table-list tags-file-name)
(progn
(load "etags")
(tags-completion-at-point-function))))
-
(autoload 'find-tag-noselect "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
Returns the buffer containing the tag's definition and moves its point there,
@@ -11396,8 +10432,7 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
-\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
-
+(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
(autoload 'find-tag "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
Select the buffer containing the tag's definition, and move point there.
@@ -11417,10 +10452,8 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
-\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
-
-(make-obsolete 'find-tag 'xref-find-definitions '"25.1")
-
+(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
+(make-obsolete 'find-tag 'xref-find-definitions "25.1")
(autoload 'find-tag-other-window "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
Select the buffer containing the tag's definition in another window, and
@@ -11441,10 +10474,8 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
-\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
-
-(make-obsolete 'find-tag-other-window 'xref-find-definitions-other-window '"25.1")
-
+(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
+(make-obsolete 'find-tag-other-window 'xref-find-definitions-other-window "25.1")
(autoload 'find-tag-other-frame "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
Select the buffer containing the tag's definition in another frame, and
@@ -11465,10 +10496,8 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
-\(fn TAGNAME &optional NEXT-P)" t nil)
-
-(make-obsolete 'find-tag-other-frame 'xref-find-definitions-other-frame '"25.1")
-
+(fn TAGNAME &optional NEXT-P)" t nil)
+(make-obsolete 'find-tag-other-frame 'xref-find-definitions-other-frame "25.1")
(autoload 'find-tag-regexp "etags" "\
Find tag (in current tags table) whose name matches REGEXP.
Select the buffer containing the tag's definition and move point there.
@@ -11487,14 +10516,10 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
-\(fn REGEXP &optional NEXT-P OTHER-WINDOW)" t nil)
-
-(make-obsolete 'find-tag-regexp 'xref-find-apropos '"25.1")
-
-(defalias 'pop-tag-mark 'xref-pop-marker-stack)
-
+(fn REGEXP &optional NEXT-P OTHER-WINDOW)" t nil)
+(make-obsolete 'find-tag-regexp 'xref-find-apropos "25.1")
+(defalias 'pop-tag-mark 'xref-go-back)
(defalias 'next-file 'tags-next-file)
-
(autoload 'tags-next-file "etags" "\
Select next file among files in current tags table.
@@ -11508,17 +10533,14 @@ Non-nil second argument NOVISIT means use a temporary buffer
Value is nil if the file was already visited;
if the file was newly read in, the value is the filename.
-\(fn &optional INITIALIZE NOVISIT)" t nil)
-
+(fn &optional INITIALIZE NOVISIT)" t nil)
(autoload 'tags-loop-continue "etags" "\
Continue last \\[tags-search] or \\[tags-query-replace] command.
Used noninteractively with non-nil argument to begin such a command (the
argument is passed to `next-file', which see).
-\(fn &optional FIRST-TIME)" t nil)
-
-(make-obsolete 'tags-loop-continue 'fileloop-continue '"27.1")
-
+(fn &optional FIRST-TIME)" t nil)
+(make-obsolete 'tags-loop-continue 'fileloop-continue "27.1")
(autoload 'tags-search "etags" "\
Search through all files listed in tags table for match for REGEXP.
Stops when a match is found.
@@ -11529,8 +10551,7 @@ files to search. The search will be restricted to these files.
Also see the documentation of the `tags-file-name' variable.
-\(fn REGEXP &optional FILES)" t nil)
-
+(fn REGEXP &optional FILES)" t nil)
(autoload 'tags-query-replace "etags" "\
Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
@@ -11544,10 +10565,8 @@ type \\[help-command] at that time.
For non-interactive use, this is superseded by `fileloop-initialize-replace'.
-\(fn FROM TO &optional DELIMITED FILES)" t nil)
-
+(fn FROM TO &optional DELIMITED FILES)" t nil)
(set-advertised-calling-convention 'tags-query-replace '(from to &optional delimited) '"27.1")
-
(autoload 'list-tags "etags" "\
Display list of tags in file FILE.
This searches only the first table in the list, and no included
@@ -11556,52 +10575,38 @@ usually without a directory specification. If called
interactively, FILE defaults to the file name of the current
buffer.
-\(fn FILE &optional NEXT-MATCH)" t nil)
-
+(fn FILE &optional NEXT-MATCH)" t nil)
(autoload 'tags-apropos "etags" "\
Display list of all tags in tags table REGEXP matches.
-\(fn REGEXP)" t nil)
-
-(make-obsolete 'tags-apropos 'xref-find-apropos '"25.1")
-
+(fn REGEXP)" t nil)
+(make-obsolete 'tags-apropos 'xref-find-apropos "25.1")
(autoload 'select-tags-table "etags" "\
Select a tags table file from a menu of those you have already used.
The list of tags tables to select from is stored in `tags-table-set-list';
see the doc of that variable if you want to add names to the list." t nil)
-
(autoload 'complete-tag "etags" "\
Perform tags completion on the text around point.
Completes to the set of names listed in the current tags table.
The string to complete is chosen in the same way as the default
for \\[find-tag] (which see)." t nil)
-
(autoload 'etags--xref-backend "etags" nil nil nil)
-
(register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function"))
-;;;***
-;;;### (autoloads nil "etc-authors-mode" "textmodes/etc-authors-mode.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/etc-authors-mode.el
(autoload 'etc-authors-mode "etc-authors-mode" "\
Major mode for viewing \"etc/AUTHORS\" from the Emacs distribution.
Provides some basic font locking and not much else.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "etc-authors-mode" '("etc-authors-"))
-;;;***
-;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from language/ethio-util.el
(autoload 'setup-ethiopic-environment-internal "ethio-util" nil nil nil)
-
(autoload 'ethio-sera-to-fidel-buffer "ethio-util" "\
Convert the current buffer from SERA to FIDEL.
@@ -11618,8 +10623,7 @@ even if the buffer is read-only.
See also the descriptions of the variables
`ethio-use-colon-for-colon' and `ethio-use-three-dot-question'.
-\(fn &optional SECONDARY FORCE)" t nil)
-
+(fn &optional SECONDARY FORCE)" t nil)
(autoload 'ethio-sera-to-fidel-region "ethio-util" "\
Convert the characters in region from SERA to FIDEL.
@@ -11636,15 +10640,13 @@ conversion even if the buffer is read-only.
See also the descriptions of the variables
`ethio-use-colon-for-colon' and `ethio-use-three-dot-question'.
-\(fn BEGIN END &optional SECONDARY FORCE)" t nil)
-
+(fn BEGIN END &optional SECONDARY FORCE)" t nil)
(autoload 'ethio-sera-to-fidel-marker "ethio-util" "\
Convert the regions surrounded by \"<sera>\" and \"</sera>\" from SERA to FIDEL.
Assume that each region begins with `ethio-primary-language'.
The markers \"<sera>\" and \"</sera>\" themselves are not deleted.
-\(fn &optional FORCE)" t nil)
-
+(fn &optional FORCE)" t nil)
(autoload 'ethio-fidel-to-sera-buffer "ethio-util" "\
Replace all the FIDEL characters in the current buffer to the SERA format.
The variable `ethio-primary-language' specifies the primary
@@ -11661,8 +10663,7 @@ See also the descriptions of the variables
`ethio-use-colon-for-colon', `ethio-use-three-dot-question',
`ethio-quote-vowel-always' and `ethio-numeric-reduction'.
-\(fn &optional SECONDARY FORCE)" t nil)
-
+(fn &optional SECONDARY FORCE)" t nil)
(autoload 'ethio-fidel-to-sera-region "ethio-util" "\
Replace all the FIDEL characters in the region to the SERA format.
@@ -11680,17 +10681,14 @@ See also the descriptions of the variables
`ethio-use-colon-for-colon', `ethio-use-three-dot-question',
`ethio-quote-vowel-always' and `ethio-numeric-reduction'.
-\(fn BEGIN END &optional SECONDARY FORCE)" t nil)
-
+(fn BEGIN END &optional SECONDARY FORCE)" t nil)
(autoload 'ethio-fidel-to-sera-marker "ethio-util" "\
Convert the regions surrounded by \"<sera>\" and \"</sera>\" from FIDEL to SERA.
The markers \"<sera>\" and \"</sera>\" themselves are not deleted.
-\(fn &optional FORCE)" t nil)
-
+(fn &optional FORCE)" t nil)
(autoload 'ethio-modify-vowel "ethio-util" "\
Modify the vowel of the FIDEL that is under the cursor." t nil)
-
(autoload 'ethio-replace-space "ethio-util" "\
Replace ASCII spaces with Ethiopic word separators in the region.
@@ -11704,19 +10702,15 @@ If CH = 3, with the Ethiopic colon-like word separator.
The 2nd and 3rd arguments BEGIN and END specify the region.
-\(fn CH BEGIN END)" t nil)
-
+(fn CH BEGIN END)" t nil)
(autoload 'ethio-input-special-character "ethio-util" "\
This function is deprecated.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'ethio-fidel-to-tex-buffer "ethio-util" "\
Convert each fidel characters in the current buffer into a fidel-tex command." t nil)
-
(autoload 'ethio-tex-to-fidel-buffer "ethio-util" "\
Convert fidel-tex commands in the current buffer into fidel chars." t nil)
-
(autoload 'ethio-fidel-to-java-buffer "ethio-util" "\
Convert Ethiopic characters into the Java escape sequences.
@@ -11725,32 +10719,29 @@ character's codepoint (in hex) in Unicode.
If `ethio-java-save-lowercase' is non-nil, use [0-9a-f].
Otherwise, [0-9A-F]." nil nil)
-
(autoload 'ethio-java-to-fidel-buffer "ethio-util" "\
Convert the Java escape sequences into corresponding Ethiopic characters." nil nil)
-
(autoload 'ethio-find-file "ethio-util" "\
Transliterate file content into Ethiopic depending on filename suffix." nil nil)
-
(autoload 'ethio-write-file "ethio-util" "\
Transliterate Ethiopic characters in ASCII depending on the file extension." nil nil)
-
(autoload 'ethio-insert-ethio-space "ethio-util" "\
Insert the Ethiopic word delimiter (the colon-like character).
With ARG, insert that many delimiters.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'ethio-composition-function "ethio-util" "\
-\(fn POS TO FONT-OBJECT STRING DIRECTION)" nil nil)
-
+(fn POS TO FONT-OBJECT STRING DIRECTION)" nil nil)
(register-definition-prefixes "ethio-util" '("ethio-" "exit-ethiopic-environment"))
-;;;***
-;;;### (autoloads nil "eudc" "net/eudc.el" (0 0 0 0))
+;;; Generated autoloads from leim/quail/ethiopic.el
+
+(register-definition-prefixes "quail/ethiopic" '("ethio-select-a-translation"))
+
+
;;; Generated autoloads from net/eudc.el
(autoload 'eudc-set-server "eudc" "\
@@ -11758,20 +10749,25 @@ Set the directory server to SERVER using PROTOCOL.
Unless NO-SAVE is non-nil, the server is saved as the default
server for future sessions.
-\(fn SERVER PROTOCOL &optional NO-SAVE)" t nil)
-
+(fn SERVER PROTOCOL &optional NO-SAVE)" t nil)
(autoload 'eudc-get-email "eudc" "\
Get the email field of NAME from the directory server.
If ERROR is non-nil, report an error if there is none.
-\(fn NAME &optional ERROR)" t nil)
-
+(fn NAME &optional ERROR)" t nil)
(autoload 'eudc-get-phone "eudc" "\
Get the phone field of NAME from the directory server.
If ERROR is non-nil, report an error if there is none.
-\(fn NAME &optional ERROR)" t nil)
+(fn NAME &optional ERROR)" t nil)
+(autoload 'eudc-expand-try-all "eudc" "\
+Wrap `eudc-expand-inline' with a prefix argument.
+If TRY-ALL-SERVERS -- the prefix argument when called
+interactively -- is non-nil, collect results from all servers.
+If TRY-ALL-SERVERS is nil, do not try subsequent servers after
+one server returns any match.
+(fn &optional TRY-ALL-SERVERS)" t nil)
(autoload 'eudc-expand-inline "eudc" "\
Query the directory server, and expand the query string before point.
The query string consists of the buffer substring from the point back to
@@ -11780,143 +10776,142 @@ The variable `eudc-inline-query-format' controls how to associate the
individual inline query words with directory attribute names.
After querying the server for the given string, the expansion specified by
`eudc-inline-expansion-format' is inserted in the buffer at point.
-If REPLACE is non-nil, then this expansion replaces the name in the buffer.
-`eudc-expansion-overwrites-query' being non-nil inverts the meaning of REPLACE.
+If SAVE-QUERY-AS-KILL is non-nil, then save the pre-expansion
+text to the kill ring. `eudc-expansion-save-query-as-kill' being
+non-nil inverts the meaning of SAVE-QUERY-AS-KILL.
Multiple servers can be tried with the same query until one finds a match,
-see `eudc-inline-expansion-servers'.
+see `eudc-inline-expansion-servers'. If TRY-ALL-SERVERS is
+non-nil, collect results from all servers.
-\(fn &optional REPLACE)" t nil)
+(fn &optional SAVE-QUERY-AS-KILL TRY-ALL-SERVERS)" t nil)
+(autoload 'eudc-format-inline-expansion-result "eudc" "\
+Format a query result according to `eudc-inline-expansion-format'.
+(fn RES QUERY-ATTRS)" nil nil)
(autoload 'eudc-query-with-words "eudc" "\
Query the directory server, and return the matching responses.
The variable `eudc-inline-query-format' controls how to associate the
individual QUERY-WORDS with directory attribute names.
After querying the server for the given string, the expansion
specified by `eudc-inline-expansion-format' is applied to the
-matches before returning them.inserted in the buffer at point.
+matches before returning them.
Multiple servers can be tried with the same query until one finds a match,
-see `eudc-inline-expansion-servers'.
-
-\(fn QUERY-WORDS)" nil nil)
+see `eudc-inline-expansion-servers'. When TRY-ALL-SERVERS is non-nil,
+keep collecting results from subsequent servers after the first match.
+(fn QUERY-WORDS &optional TRY-ALL-SERVERS)" nil nil)
(autoload 'eudc-query-form "eudc" "\
Display a form to query the directory server.
If given a non-nil argument GET-FIELDS-FROM-SERVER, the function first
queries the server for the existing fields and displays a corresponding form.
-\(fn &optional GET-FIELDS-FROM-SERVER)" t nil)
-
+(fn &optional GET-FIELDS-FROM-SERVER)" t nil)
(autoload 'eudc-load-eudc "eudc" "\
Load the Emacs Unified Directory Client.
This does nothing except loading eudc by autoload side-effect." t nil)
-
(defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] `(menu-item ,(purecopy "Get Phone") eudc-get-phone :help ,(purecopy "Get the phone field of name from the directory server"))) (define-key map [email] `(menu-item ,(purecopy "Get Email") eudc-get-email :help ,(purecopy "Get the email field of NAME from the directory server"))) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline :help ,(purecopy "Query the directory server, and expand the query string before point"))) (define-key map [query] `(menu-item ,(purecopy "Query with Form") eudc-query-form :help ,(purecopy "Display a form to query the directory server"))) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] `(menu-item ,(purecopy "New Server") eudc-set-server :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) (define-key map [load] `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc :help ,(purecopy "Load the Emacs Unified Directory Client"))) map))
-
(fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))
-
(register-definition-prefixes "eudc" '("eudc-"))
-;;;***
-;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (0 0 0 0))
;;; Generated autoloads from net/eudc-bob.el
(autoload 'eudc-display-generic-binary "eudc-bob" "\
Display a button for unidentified binary DATA.
-\(fn DATA)" nil nil)
-
+(fn DATA)" nil nil)
(autoload 'eudc-display-url "eudc-bob" "\
Display URL and make it clickable.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'eudc-display-mail "eudc-bob" "\
Display e-mail address and make it clickable.
-\(fn MAIL)" nil nil)
-
+(fn MAIL)" nil nil)
(autoload 'eudc-display-sound "eudc-bob" "\
Display a button to play the sound DATA.
-\(fn DATA)" nil nil)
-
+(fn DATA)" nil nil)
(autoload 'eudc-display-jpeg-inline "eudc-bob" "\
Display the JPEG DATA inline at point if possible.
-\(fn DATA)" nil nil)
-
+(fn DATA)" nil nil)
(autoload 'eudc-display-jpeg-as-button "eudc-bob" "\
Display a button for the JPEG DATA.
-\(fn DATA)" nil nil)
-
+(fn DATA)" nil nil)
(register-definition-prefixes "eudc-bob" '("eudc-bob-"))
-;;;***
-;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (0 0 0 0))
+;;; Generated autoloads from net/eudc-capf.el
+
+(autoload 'eudc-capf-complete "eudc-capf" "\
+Email address completion function for `completion-at-point-functions'.
+
+This function checks whether the current major mode is one of the
+modes listed in `eudc-capf-modes', and whether point is on a line
+with a message header listing email recipients, that is, a line
+whose beginning matches `message-email-recipient-header-regexp',
+and, if the check succeeds, searches for records matching the
+words before point.
+
+The return value is either nil when no match is found, or a
+completion table as required for functions listed in
+`completion-at-point-functions'." nil nil)
+(autoload 'eudc-capf-message-expand-name "eudc-capf" "\
+Email address completion function for `message-completion-alist'.
+
+When this function is added to `message-completion-alist',
+replacing any existing entry for `message-expand-name' there,
+with an appropriate regular expression such as for example
+`message-email-recipient-header-regexp', then EUDC will be
+queried for email addresses, and the results delivered to
+`completion-at-point'." nil nil)
+(register-definition-prefixes "eudc-capf" '("eudc-capf-modes"))
+
+
;;; Generated autoloads from net/eudc-export.el
(autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\
Insert record at point into the BBDB database.
This function can only be called from a directory query result buffer." t nil)
-
(autoload 'eudc-try-bbdb-insert "eudc-export" "\
Call `eudc-insert-record-at-point-into-bbdb' if on a record." t nil)
-
(register-definition-prefixes "eudc-export" '("eudc-"))
-;;;***
-;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from net/eudc-hotlist.el
(autoload 'eudc-edit-hotlist "eudc-hotlist" "\
Edit the hotlist of directory servers in a specialized buffer." t nil)
-
(register-definition-prefixes "eudc-hotlist" '("eudc-hotlist-"))
-;;;***
-;;;### (autoloads nil "eudc-vars" "net/eudc-vars.el" (0 0 0 0))
;;; Generated autoloads from net/eudc-vars.el
(register-definition-prefixes "eudc-vars" '("eudc-"))
-;;;***
-;;;### (autoloads nil "eudcb-bbdb" "net/eudcb-bbdb.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-bbdb.el
(register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-"))
-;;;***
-;;;### (autoloads nil "eudcb-ldap" "net/eudcb-ldap.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-ldap.el
(register-definition-prefixes "eudcb-ldap" '("eudc-"))
-;;;***
-;;;### (autoloads nil "eudcb-mab" "net/eudcb-mab.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-mab.el
(register-definition-prefixes "eudcb-mab" '("eudc-"))
-;;;***
-;;;### (autoloads nil "eudcb-macos-contacts" "net/eudcb-macos-contacts.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from net/eudcb-macos-contacts.el
(register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-"))
-;;;***
-;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/ewoc.el
(autoload 'ewoc-create "ewoc" "\
@@ -11938,13 +10933,10 @@ Normally, a newline is automatically inserted after the header,
the footer and every node's printed representation. Optional
fourth arg NOSEP non-nil inhibits this.
-\(fn PRETTY-PRINTER &optional HEADER FOOTER NOSEP)" nil nil)
-
+(fn PRETTY-PRINTER &optional HEADER FOOTER NOSEP)" nil nil)
(register-definition-prefixes "ewoc" '("ewoc-"))
-;;;***
-;;;### (autoloads nil "eww" "net/eww.el" (0 0 0 0))
;;; Generated autoloads from net/eww.el
(defvar eww-suggest-uris '(eww-links-at-point thing-at-point-url-at-point eww-current-url) "\
@@ -11952,9 +10944,7 @@ List of functions called to form the list of default URIs for `eww'.
Each of the elements is a function returning either a string or a list
of strings. The results will be joined into a single list with
duplicate entries (if any) removed.")
-
(custom-autoload 'eww-suggest-uris "eww" t)
-
(autoload 'eww-browse "eww" "\
Function to be run to parse command line URLs.
This is meant to be used for MIME handlers or command line use.
@@ -11968,41 +10958,36 @@ This can also be used on the command line directly:
emacs -f eww-browse https://gnu.org
will start Emacs and browse the GNU web site." t nil)
-
(autoload 'eww "eww" "\
Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'.
-If called with a prefix ARG, use a new buffer instead of reusing
-the default EWW buffer.
+If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
+new buffer instead of reusing the default EWW buffer.
If BUFFER, the data to be rendered is in that buffer. In that
case, this function doesn't actually fetch URL. BUFFER will be
killed after rendering.
-\(fn URL &optional ARG BUFFER)" t nil)
+(fn URL &optional NEW-BUFFER BUFFER)" t nil)
(defalias 'browse-web 'eww)
-
(autoload 'eww-open-file "eww" "\
Render FILE using EWW.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'eww-search-words "eww" "\
Search the web for the text in the region.
If region is active (and not whitespace), search the web for
the text between region beginning and end. Else, prompt the
user for a search string. See the variable `eww-search-prefix'
for the search engine used." t nil)
-
(autoload 'eww-mode "eww" "\
Mode for browsing the web.
\\{eww-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'eww-browse-url "eww" "\
Ask the EWW browser to load URL.
@@ -12018,38 +11003,30 @@ in the tab-bar on an existing frame. See more options in
Non-interactively, this uses the optional second argument NEW-WINDOW
instead of `browse-url-new-window-flag'.
-\(fn URL &optional NEW-WINDOW)" nil nil)
-
+(fn URL &optional NEW-WINDOW)" nil nil)
(autoload 'eww-list-bookmarks "eww" "\
Display the bookmarks." t nil)
-
(autoload 'eww-bookmark-jump "eww" "\
Default bookmark handler for EWW buffers.
-\(fn BOOKMARK)" nil nil)
-
+(fn BOOKMARK)" nil nil)
(register-definition-prefixes "eww" '("erc--download-directory" "eww-"))
-;;;***
-;;;### (autoloads nil "executable" "progmodes/executable.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from progmodes/executable.el
(autoload 'executable-command-find-posix-p "executable" "\
Check if PROGRAM handles arguments Posix-style.
If PROGRAM is non-nil, use that instead of \"find\".
-\(fn &optional PROGRAM)" nil nil)
-
+(fn &optional PROGRAM)" nil nil)
(autoload 'executable-interpret "executable" "\
Run script with user-specified args, and collect output in a buffer.
While script runs asynchronously, you can use the \\[next-error]
command to find the next error. The buffer is also in `comint-mode' and
`compilation-shell-minor-mode', so that you can answer any prompts.
-\(fn COMMAND)" t nil)
-
+(fn COMMAND)" t nil)
(autoload 'executable-set-magic "executable" "\
Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
The variables `executable-magicless-file-regexp', `executable-prefix-env',
@@ -12057,25 +11034,19 @@ The variables `executable-magicless-file-regexp', `executable-prefix-env',
when and how magic numbers are inserted or replaced and scripts made
executable.
-\(fn INTERPRETER &optional ARGUMENT NO-QUERY-FLAG INSERT-FLAG)" t nil)
-
+(fn INTERPRETER &optional ARGUMENT NO-QUERY-FLAG INSERT-FLAG)" t nil)
(autoload 'executable-make-buffer-file-executable-if-script-p "executable" "\
Make file executable according to umask if not already executable.
If file already has any execute bits set at all, do not change existing
file modes." nil nil)
-
(register-definition-prefixes "executable" '("executable-"))
-;;;***
-;;;### (autoloads nil "exif" "image/exif.el" (0 0 0 0))
;;; Generated autoloads from image/exif.el
(register-definition-prefixes "exif" '("exif-"))
-;;;***
-;;;### (autoloads nil "expand" "expand.el" (0 0 0 0))
;;; Generated autoloads from expand.el
(autoload 'expand-add-abbrevs "expand" "\
@@ -12100,34 +11071,36 @@ cyclically with the functions `expand-jump-to-previous-slot' and
If ARG is omitted, point is placed at the end of the expanded text.
-\(fn TABLE ABBREVS)" nil nil)
-
+(fn TABLE ABBREVS)" nil nil)
(autoload 'expand-abbrev-hook "expand" "\
Abbrev hook used to do the expansion job of expand abbrevs.
See `expand-add-abbrevs'. Value is non-nil if expansion was done." nil nil)
-
(autoload 'expand-jump-to-previous-slot "expand" "\
Move the cursor to the previous slot in the last abbrev expansion.
This is used only in conjunction with `expand-add-abbrevs'." t nil)
-
(autoload 'expand-jump-to-next-slot "expand" "\
Move the cursor to the next slot in the last abbrev expansion.
This is used only in conjunction with `expand-add-abbrevs'." t nil)
(define-key abbrev-map "p" 'expand-jump-to-previous-slot)
(define-key abbrev-map "n" 'expand-jump-to-next-slot)
-
(register-definition-prefixes "expand" '("expand-"))
-;;;***
-;;;### (autoloads nil "ezimage" "ezimage.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/expandproto.el
+
+(register-definition-prefixes "srecode/expandproto" '("srecode-"))
+
+
+;;; Generated autoloads from cedet/srecode/extract.el
+
+(register-definition-prefixes "srecode/extract" '("srecode-extract"))
+
+
;;; Generated autoloads from ezimage.el
(register-definition-prefixes "ezimage" '("defezimage" "ezimage-"))
-;;;***
-;;;### (autoloads nil "f90" "progmodes/f90.el" (0 0 0 0))
;;; Generated autoloads from progmodes/f90.el
(autoload 'f90-mode "f90" "\
@@ -12190,13 +11163,10 @@ Variables controlling indentation style and extra features:
Turning on F90 mode calls the value of the variable `f90-mode-hook'
with no args, if that value is non-nil.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "f90" '("f90-"))
-;;;***
-;;;### (autoloads nil "face-remap" "face-remap.el" (0 0 0 0))
;;; Generated autoloads from face-remap.el
(autoload 'face-remap-add-relative "face-remap" "\
@@ -12221,15 +11191,13 @@ attributes.
The base (lowest priority) remapping may be set to something
other than the normal definition of FACE via `face-remap-set-base'.
-\(fn FACE &rest SPECS)" nil nil)
-
+(fn FACE &rest SPECS)" nil nil)
(autoload 'face-remap-reset-base "face-remap" "\
Set the base remapping of FACE to the normal definition of FACE.
This causes the remappings specified by `face-remap-add-relative'
to apply on top of the normal definition of FACE.
-\(fn FACE)" nil nil)
-
+(fn FACE)" nil nil)
(autoload 'face-remap-set-base "face-remap" "\
Set the base remapping of FACE in the current buffer to SPECS.
This causes the remappings specified by `face-remap-add-relative'
@@ -12244,8 +11212,7 @@ to use the normal definition of FACE as the base remapping; note that
this is different from SPECS containing a single value nil, which means
not to inherit from the global definition of FACE at all.
-\(fn FACE &rest SPECS)" nil nil)
-
+(fn FACE &rest SPECS)" nil nil)
(autoload 'text-scale-set "face-remap" "\
Set the scale factor of the default face in the current buffer to LEVEL.
If LEVEL is non-zero, `text-scale-mode' is enabled, otherwise it is disabled.
@@ -12255,10 +11222,9 @@ Each step scales the height of the default face by the variable
`text-scale-mode-step' (a negative number decreases the height by
the same amount).
-\(fn LEVEL)" t nil)
-
+(fn LEVEL)" t nil)
(autoload 'text-scale-increase "face-remap" "\
-Increase the height of the default face in the current buffer by INC steps.
+Increase the font size of the default face in current buffer by INC steps.
If the new height is other than the default, `text-scale-mode' is enabled.
Each step scales the height of the default face by the variable
@@ -12266,33 +11232,30 @@ Each step scales the height of the default face by the variable
height by the same amount). As a special case, an argument of 0
will remove any scaling currently active.
-\(fn INC)" t nil)
-
+(fn INC)" t nil)
(autoload 'text-scale-decrease "face-remap" "\
-Decrease the height of the default face in the current buffer by DEC steps.
+Decrease the font size of the default face in the current buffer by DEC steps.
See `text-scale-increase' for more details.
-\(fn DEC)" t nil)
+(fn DEC)" t nil)
(define-key ctl-x-map [(control ?+)] 'text-scale-adjust)
(define-key ctl-x-map [(control ?-)] 'text-scale-adjust)
(define-key ctl-x-map [(control ?=)] 'text-scale-adjust)
(define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
-
(autoload 'text-scale-adjust "face-remap" "\
-Adjust the height of the default face by INC.
-
+Adjust the font size in the current buffer by INC steps.
INC may be passed as a numeric prefix argument.
The actual adjustment made depends on the final component of the
keybinding used to invoke the command, with all modifiers removed:
- +, = Increase the height of the default face by one step
- - Decrease the height of the default face by one step
- 0 Reset the height of the default face to the global default
+ \\`+', \\`=' Increase font size in current buffer by one step
+ \\`-' Decrease font size in current buffer by one step
+ \\`0' Reset the font size to the global default
After adjusting, continue to read input events and further adjust
-the face height as long as the input event read
-\(with all modifiers removed) is one of the above characters.
+the font size as long as the input event read
+(with all modifiers removed) is one of the above characters.
Each step scales the height of the default face by the variable
`text-scale-mode-step' (a negative number of steps decreases the
@@ -12305,30 +11268,69 @@ even when it is bound in a non-top-level keymap. For binding in
a top-level keymap, `text-scale-increase' or
`text-scale-decrease' may be more appropriate.
-\(fn INC)" t nil)
+Most faces are affected by these font size changes, but not faces
+that have an explicit `:height' setting. The two exceptions to
+this are the `default' and `header-line' faces: they will both be
+scaled even if they have an explicit `:height' setting.
+
+See also the related command `global-text-scale-adjust'.
+
+(fn INC)" t nil)
+ (define-key global-map [pinch] 'text-scale-pinch)
+(autoload 'text-scale-pinch "face-remap" "\
+Adjust the height of the default face by the scale in the pinch event EVENT.
+
+(fn EVENT)" t nil)
+ (define-key ctl-x-map [(control meta ?+)] 'global-text-scale-adjust)
+ (define-key ctl-x-map [(control meta ?=)] 'global-text-scale-adjust)
+ (define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust)
+ (define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust)
+(autoload 'global-text-scale-adjust "face-remap" "\
+Globally adjust the font size by INCREMENT.
+
+Interactively, INCREMENT may be passed as a numeric prefix argument.
+
+The adjustment made depends on the final component of the key binding
+used to invoke the command, with all modifiers removed:
+
+ \\`+', \\`=' Globally increase the height of the default face
+ \\`-' Globally decrease the height of the default face
+ \\`0' Globally reset the height of the default face
+
+After adjusting, further adjust the font size as long as the key,
+with all modifiers removed, is one of the above characters.
+Buffer-local face adjustements have higher priority than global
+face adjustments.
+
+The variable `global-text-scale-adjust-resizes-frames' controls
+whether the frames are resized to keep the same number of lines
+and characters per line when the font size is adjusted.
+
+See also the related command `text-scale-adjust'.
+
+(fn INCREMENT)" t nil)
(autoload 'buffer-face-mode "face-remap" "\
Minor mode for a buffer-specific default face.
+When enabled, the face specified by the variable
+`buffer-face-mode-face' is used to display the buffer text.
+
This is a minor mode. If called interactively, toggle the
-`Buffer-Face mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Buffer-Face mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `buffer-face-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-When enabled, the face specified by the variable
-`buffer-face-mode-face' is used to display the buffer text.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'buffer-face-set "face-remap" "\
Enable `buffer-face-mode', using face specs SPECS.
Each argument in SPECS should be a face, i.e. either a face name
@@ -12340,8 +11342,7 @@ one face is listed, that specifies an aggregate face, like in a
This function makes the variable `buffer-face-mode-face' buffer
local, and sets it to FACE.
-\(fn &rest SPECS)" t nil)
-
+(fn &rest SPECS)" t nil)
(autoload 'buffer-face-toggle "face-remap" "\
Toggle `buffer-face-mode', using face specs SPECS.
Each argument in SPECS should be a face, i.e. either a face name
@@ -12357,25 +11358,20 @@ face, then is left enabled, but the face changed to reflect SPECS.
This function will make the variable `buffer-face-mode-face'
buffer local, and set it to SPECS.
-\(fn &rest SPECS)" t nil)
-
+(fn &rest SPECS)" t nil)
(autoload 'variable-pitch-mode "face-remap" "\
Variable-pitch default-face mode.
An interface to `buffer-face-mode' which uses the `variable-pitch' face.
Besides the choice of face, it is the same as `buffer-face-mode'.
-\(fn &optional ARG)" t nil)
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "global-text-scale-adjust-" "internal-lisp-face-attributes" "text-scale-"))
-(register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "internal-lisp-face-attributes" "text-scale-"))
-
-;;;***
-;;;### (autoloads nil "facemenu" "facemenu.el" (0 0 0 0))
;;; Generated autoloads from facemenu.el
- (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
+ (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
(define-key global-map [C-down-mouse-2] 'facemenu-menu)
-
(autoload 'list-colors-display "facemenu" "\
Display names of defined colors, and show what they look like.
If the optional argument LIST is non-nil, it should be a list of
@@ -12391,19 +11387,15 @@ If the optional argument CALLBACK is non-nil, it should be a
function to call each time the user types RET or clicks on a
color. The function should accept a single argument, the color name.
-\(fn &optional LIST BUFFER-NAME CALLBACK)" t nil)
-
+(fn &optional LIST BUFFER-NAME CALLBACK)" t nil)
(register-definition-prefixes "facemenu" '("facemenu-" "list-colors-"))
-;;;***
-;;;### (autoloads nil "faceup" "emacs-lisp/faceup.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/faceup.el
-(push (purecopy '(faceup 0 0 6)) package--builtin-versions)
+(push (purecopy '(faceup 0 0 6)) package--builtin-versions)
(autoload 'faceup-view-buffer "faceup" "\
Display the faceup representation of the current buffer." t nil)
-
(autoload 'faceup-write-file "faceup" "\
Save the faceup representation of the current buffer to the file FILE-NAME.
@@ -12414,57 +11406,52 @@ If optional second arg CONFIRM is non-nil, this function
asks for confirmation before overwriting an existing file.
Interactively, confirmation is required unless you supply a prefix argument.
-\(fn &optional FILE-NAME CONFIRM)" t nil)
-
+(fn &optional FILE-NAME CONFIRM)" t nil)
(autoload 'faceup-render-view-buffer "faceup" "\
Convert BUFFER containing Faceup markup to a new buffer and display it.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'faceup-clean-buffer "faceup" "\
Remove faceup markup from buffer." t nil)
-
(autoload 'faceup-defexplainer "faceup" "\
Define an Ert explainer function for FUNCTION.
FUNCTION must return an explanation when the test fails and
`faceup-test-explain' is set.
-\(fn FUNCTION)" nil t)
-
+(fn FUNCTION)" nil t)
(register-definition-prefixes "faceup" '("faceup-"))
-;;;***
-;;;### (autoloads nil "feedmail" "mail/feedmail.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/analyze/fcn.el
+
+(register-definition-prefixes "semantic/analyze/fcn" '("semantic-analyze-"))
+
+
;;; Generated autoloads from mail/feedmail.el
-(push (purecopy '(feedmail 11)) package--builtin-versions)
+(push (purecopy '(feedmail 11)) package--builtin-versions)
(autoload 'feedmail-send-it "feedmail" "\
Send the current mail buffer using the Feedmail package.
This is a suitable value for `send-mail-function'. It can be used
with various lower-level mechanisms to provide features such as queueing." nil nil)
-
(autoload 'feedmail-run-the-queue-no-prompts "feedmail" "\
Like `feedmail-run-the-queue', but suppress confirmation prompts.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'feedmail-run-the-queue-global-prompt "feedmail" "\
Like `feedmail-run-the-queue', but with a global confirmation prompt.
This is generally most useful if run non-interactively, since you can
bail out with an appropriate answer to the global confirmation prompt.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'feedmail-run-the-queue "feedmail" "\
Visit each message in the feedmail queue directory and send it out.
Return value is a list of three things: number of messages sent, number of
messages skipped, and number of non-message things in the queue (commonly
backup file names and the like).
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'feedmail-queue-reminder "feedmail" "\
Perform some kind of reminder activity about queued and draft messages.
Called with an optional symbol argument which says what kind of event
@@ -12484,20 +11471,15 @@ expected to perform the reminder activity. You can supply your own reminder
functions by redefining `feedmail-queue-reminder-alist'. If you don't want any
reminders, you can set `feedmail-queue-reminder-alist' to nil.
-\(fn &optional WHAT-EVENT)" t nil)
-
+(fn &optional WHAT-EVENT)" t nil)
(register-definition-prefixes "feedmail" '("feedmail-"))
-;;;***
-;;;### (autoloads nil "ffap" "ffap.el" (0 0 0 0))
;;; Generated autoloads from ffap.el
(defvar ffap-file-finder 'find-file "\
The command called by `find-file-at-point' to find a file.")
-
(custom-autoload 'ffap-file-finder "ffap" t)
-
(autoload 'ffap-next "ffap" "\
Search buffer for next file or URL, and run ffap.
Optional argument BACK says to search backwards.
@@ -12506,8 +11488,7 @@ Interactively: use a single prefix \\[universal-argument] to search backwards,
double prefix to wrap forward, triple to wrap backwards.
Actual search is done by the function `ffap-next-guess'.
-\(fn &optional BACK WRAP)" t nil)
-
+(fn &optional BACK WRAP)" t nil)
(autoload 'find-file-at-point "ffap" "\
Find FILENAME, guessing a default from text around point.
If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
@@ -12518,10 +11499,8 @@ See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
`ffap-file-name-with-spaces', and the functions `ffap-file-at-point'
and `ffap-url-at-point'.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(defalias 'ffap 'find-file-at-point)
-
(autoload 'ffap-menu "ffap" "\
Put up a menu of files and URLs mentioned in this buffer.
Then set mark, jump to choice, and try to fetch it. The menu is
@@ -12529,8 +11508,7 @@ cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
The optional RESCAN argument (a prefix, interactively) forces
a rebuild. Searches with `ffap-menu-regexp'.
-\(fn &optional RESCAN)" t nil)
-
+(fn &optional RESCAN)" t nil)
(autoload 'ffap-at-mouse "ffap" "\
Find file or URL guessed from text around mouse click.
Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
@@ -12539,26 +11517,25 @@ Return value:
* if the fallback is called, return whatever it returns
* otherwise, nil
-\(fn E)" t nil)
-
+(fn E)" t nil)
(autoload 'dired-at-point "ffap" "\
Start Dired, defaulting to file at point. See `ffap'.
If `dired-at-point-require-prefix' is set, the prefix meaning is reversed.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'ffap-guess-file-name-at-point "ffap" "\
Try to get a file name at point.
This hook is intended to be put in `file-name-at-point-functions'." nil nil)
-
(autoload 'ffap-bindings "ffap" "\
Evaluate the forms in variable `ffap-bindings'." t nil)
-
(register-definition-prefixes "ffap" '("dired-at-point-" "ffap-" "find-file-literally-at-point"))
-;;;***
-;;;### (autoloads nil "filecache" "filecache.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/fields.el
+
+(register-definition-prefixes "srecode/fields" '("srecode-"))
+
+
;;; Generated autoloads from filecache.el
(autoload 'file-cache-add-directory "filecache" "\
@@ -12566,8 +11543,7 @@ Add all files in DIRECTORY to the file cache.
If called from Lisp with a non-nil REGEXP argument is non-nil,
only add files whose names match REGEXP.
-\(fn DIRECTORY &optional REGEXP)" t nil)
-
+(fn DIRECTORY &optional REGEXP)" t nil)
(autoload 'file-cache-add-directory-list "filecache" "\
Add DIRECTORIES (a list of directory names) to the file cache.
If called interactively, read the directory names one by one.
@@ -12575,25 +11551,21 @@ If the optional REGEXP argument is non-nil, only files which match it
will be added to the cache. Note that the REGEXP is applied to the
files in each directory, not to the directory list itself.
-\(fn DIRECTORIES &optional REGEXP)" t nil)
-
+(fn DIRECTORIES &optional REGEXP)" t nil)
(autoload 'file-cache-add-file "filecache" "\
Add FILE to the file cache.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'file-cache-add-directory-using-find "filecache" "\
Use the `find' command to add files to the file cache.
Find is run in DIRECTORY.
-\(fn DIRECTORY)" t nil)
-
+(fn DIRECTORY)" t nil)
(autoload 'file-cache-add-directory-using-locate "filecache" "\
Use the `locate' command to add files to the file cache.
STRING is passed as an argument to the locate command.
-\(fn STRING)" t nil)
-
+(fn STRING)" t nil)
(autoload 'file-cache-add-directory-recursively "filecache" "\
Add DIR and any subdirectories to the file-cache.
This function does not use any external programs.
@@ -12601,23 +11573,19 @@ If the optional REGEXP argument is non-nil, only files which match it
will be added to the cache. Note that the REGEXP is applied to the
files in each directory, not to the directory list itself.
-\(fn DIR &optional REGEXP)" t nil)
-
+(fn DIR &optional REGEXP)" t nil)
(autoload 'file-cache-minibuffer-complete "filecache" "\
Complete a filename in the minibuffer using a preloaded cache.
Filecache does two kinds of substitution: it completes on names in
the cache, and, once it has found a unique name, it cycles through
the directories that the name is available in. With a prefix argument,
the name is considered already unique; only the second substitution
-\(directories) is done.
-
-\(fn ARG)" t nil)
+(directories) is done.
+(fn ARG)" t nil)
(register-definition-prefixes "filecache" '("file-cache-"))
-;;;***
-;;;### (autoloads nil "fileloop" "fileloop.el" (0 0 0 0))
;;; Generated autoloads from fileloop.el
(autoload 'fileloop-initialize "fileloop" "\
@@ -12631,13 +11599,11 @@ to perform the operation on the current file buffer and when done
should return non-nil to mean that we should immediately continue
operating on the next file and nil otherwise.
-\(fn FILES SCAN-FUNCTION OPERATE-FUNCTION)" nil nil)
-
+(fn FILES SCAN-FUNCTION OPERATE-FUNCTION)" nil nil)
(autoload 'fileloop-initialize-search "fileloop" "\
-\(fn REGEXP FILES CASE-FOLD)" nil nil)
-
+(fn REGEXP FILES CASE-FOLD)" nil nil)
(autoload 'fileloop-initialize-replace "fileloop" "\
Initialize a new round of query&replace on several files.
FROM is a regexp and TO is the replacement to use.
@@ -12651,13 +11617,10 @@ CASE-FOLD can be t, nil, or `default':
`case-fold-search' instead.
DELIMITED if non-nil means replace only word-delimited matches.
-\(fn FROM TO FILES CASE-FOLD &optional DELIMITED)" nil nil)
-
+(fn FROM TO FILES CASE-FOLD &optional DELIMITED)" nil nil)
(register-definition-prefixes "fileloop" '("fileloop-"))
-;;;***
-;;;### (autoloads nil "filenotify" "filenotify.el" (0 0 0 0))
;;; Generated autoloads from filenotify.el
(autoload 'file-notify-handle-event "filenotify" "\
@@ -12665,15 +11628,16 @@ Handle a file system monitoring event, coming from backends.
If OBJECT is a filewatch event, call its callback.
Otherwise, signal a `file-notify-error'.
-\(fn OBJECT)" t nil)
-
+(fn OBJECT)" t nil)
(function-put 'file-notify-handle-event 'completion-predicate #'ignore)
-
(register-definition-prefixes "filenotify" '("file-notify-"))
-;;;***
-;;;### (autoloads nil "files-x" "files-x.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/files.el
+
+(register-definition-prefixes "ede/files" '("ede-"))
+
+
;;; Generated autoloads from files-x.el
(autoload 'add-file-local-variable "files-x" "\
@@ -12687,13 +11651,11 @@ If there is no Local Variables list in the current file buffer
then this function adds the first line containing the string
`Local Variables:' and the last line containing the string `End:'.
-\(fn VARIABLE VALUE &optional INTERACTIVE)" t nil)
-
+(fn VARIABLE VALUE &optional INTERACTIVE)" t nil)
(autoload 'delete-file-local-variable "files-x" "\
Delete all settings of file-local VARIABLE from the Local Variables list.
-\(fn VARIABLE &optional INTERACTIVE)" t nil)
-
+(fn VARIABLE &optional INTERACTIVE)" t nil)
(autoload 'add-file-local-variable-prop-line "files-x" "\
Add file-local VARIABLE with its VALUE to the -*- line.
@@ -12704,35 +11666,27 @@ the -*- line.
If there is no -*- line at the beginning of the current file buffer
then this function adds it.
-\(fn VARIABLE VALUE &optional INTERACTIVE)" t nil)
-
+(fn VARIABLE VALUE &optional INTERACTIVE)" t nil)
(autoload 'delete-file-local-variable-prop-line "files-x" "\
Delete all settings of file-local VARIABLE from the -*- line.
-\(fn VARIABLE &optional INTERACTIVE)" t nil)
-
+(fn VARIABLE &optional INTERACTIVE)" t nil)
(autoload 'add-dir-local-variable "files-x" "\
Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el.
-\(fn MODE VARIABLE VALUE)" t nil)
-
+(fn MODE VARIABLE VALUE)" t nil)
(autoload 'delete-dir-local-variable "files-x" "\
Delete all MODE settings of file-local VARIABLE from .dir-locals.el.
-\(fn MODE VARIABLE)" t nil)
-
+(fn MODE VARIABLE)" t nil)
(autoload 'copy-file-locals-to-dir-locals "files-x" "\
Copy file-local variables to .dir-locals.el." t nil)
-
(autoload 'copy-dir-locals-to-file-locals "files-x" "\
Copy directory-local variables to the Local Variables list." t nil)
-
(autoload 'copy-dir-locals-to-file-locals-prop-line "files-x" "\
Copy directory-local variables to the -*- line." t nil)
-
(defvar enable-connection-local-variables t "\
Non-nil means enable use of connection-local variables.")
-
(autoload 'connection-local-set-profiles "files-x" "\
Add PROFILES for CRITERIA.
CRITERIA is a plist identifying a connection and the application
@@ -12745,8 +11699,7 @@ PROFILES are applied to the corresponding process buffer. The
variables for a connection profile are defined using
`connection-local-set-profile-variables'.
-\(fn CRITERIA &rest PROFILES)" nil nil)
-
+(fn CRITERIA &rest PROFILES)" nil nil)
(autoload 'connection-local-set-profile-variables "files-x" "\
Map the symbol PROFILE to a list of variable settings.
VARIABLES is a list that declares connection-local variables for
@@ -12760,51 +11713,66 @@ variables are set in the server's process buffer according to the
VARIABLES list of the connection profile. The list is processed
in order.
-\(fn PROFILE VARIABLES)" nil nil)
-
+(fn PROFILE VARIABLES)" nil nil)
(autoload 'hack-connection-local-variables-apply "files-x" "\
Apply connection-local variables identified by CRITERIA.
Other local variables, like file-local and dir-local variables,
will not be changed.
-\(fn CRITERIA)" nil nil)
-
+(fn CRITERIA)" nil nil)
(autoload 'with-connection-local-variables "files-x" "\
Apply connection-local variables according to `default-directory'.
Execute BODY, and unwind connection-local variables.
-\(fn &rest BODY)" nil t)
+(fn &rest BODY)" nil t)
+(autoload 'with-connection-local-variables-1 "files-x" "\
+Apply connection-local variables according to `default-directory'.
+Call BODY-FUN with no args, and then unwind connection-local variables.
+(fn BODY-FUN)" nil nil)
(autoload 'path-separator "files-x" "\
The connection-local value of `path-separator'." nil nil)
-
(autoload 'null-device "files-x" "\
The connection-local value of `null-device'." nil nil)
-
(register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable"))
-;;;***
-;;;### (autoloads nil "filesets" "filesets.el" (0 0 0 0))
;;; Generated autoloads from filesets.el
(autoload 'filesets-init "filesets" "\
Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu." nil nil)
-
(register-definition-prefixes "filesets" '("filesets-"))
-;;;***
-;;;### (autoloads nil "find-cmd" "find-cmd.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/symref/filter.el
+
+(register-definition-prefixes "semantic/symref/filter" '("semantic-symref-"))
+
+
+;;; Generated autoloads from cedet/srecode/filters.el
+
+(register-definition-prefixes "srecode/filters" '("srecode-comment-prefix"))
+
+
+;;; Generated autoloads from cedet/srecode/find.el
+
+(register-definition-prefixes "srecode/find" '("srecode-"))
+
+
+;;; Generated autoloads from cedet/semantic/find.el
+
+(register-definition-prefixes "semantic/find" '("semantic-"))
+
+
;;; Generated autoloads from find-cmd.el
-(push (purecopy '(find-cmd 0 6)) package--builtin-versions)
+(push (purecopy '(find-cmd 0 6)) package--builtin-versions)
(autoload 'find-cmd "find-cmd" "\
Initiate the building of a find command.
For example:
-\(find-cmd \\='(prune (name \".svn\" \".git\" \".CVS\"))
+(find-cmd \\='(prune (name \".svn\" \".git\" \".CVS\"))
\\='(and (or (name \"*.pl\" \"*.pm\" \"*.t\")
(mtime \"+1\"))
(fstype \"nfs\" \"ufs\"))))
@@ -12812,13 +11780,10 @@ For example:
`default-directory' is used as the initial search path. The
result is a string that should be ready for the command line.
-\(fn &rest SUBFINDS)" nil nil)
-
+(fn &rest SUBFINDS)" nil nil)
(register-definition-prefixes "find-cmd" '("find-"))
-;;;***
-;;;### (autoloads nil "find-dired" "find-dired.el" (0 0 0 0))
;;; Generated autoloads from find-dired.el
(autoload 'find-dired "find-dired" "\
@@ -12833,8 +11798,20 @@ use in place of \"-ls\" as the final argument.
Collect output in the \"*Find*\" buffer. To kill the job before
it finishes, type \\[kill-find].
-\(fn DIR ARGS)" t nil)
+(fn DIR ARGS)" t nil)
+(autoload 'find-dired-with-command "find-dired" "\
+Run `find' and go into Dired mode on a buffer of the output.
+The user-supplied COMMAND is run after changing into DIR and should look like
+
+ find . GLOBALARGS \\( ARGS \\) -ls
+The car of the variable `find-ls-option' specifies what to
+use in place of \"-ls\" as the starting input.
+
+Collect output in the \"*Find*\" buffer. To kill the job before
+it finishes, type \\[kill-find].
+
+(fn DIR COMMAND)" t nil)
(autoload 'find-name-dired "find-dired" "\
Search DIR recursively for files matching the globbing PATTERN,
and run Dired on those files.
@@ -12845,8 +11822,7 @@ The default command run (after changing into DIR) is
See `find-name-arg' to customize the arguments.
-\(fn DIR PATTERN)" t nil)
-
+(fn DIR PATTERN)" t nil)
(autoload 'find-grep-dired "find-dired" "\
Find files in DIR that contain matches for REGEXP and start Dired on output.
The command run (after changing into DIR) is
@@ -12857,13 +11833,10 @@ The command run (after changing into DIR) is
where the first string in the value of the variable `find-ls-option'
specifies what to use in place of \"-ls\" as the final argument.
-\(fn DIR REGEXP)" t nil)
-
+(fn DIR REGEXP)" t nil)
(register-definition-prefixes "find-dired" '("find-" "kill-find" "lookfor-dired"))
-;;;***
-;;;### (autoloads nil "find-file" "find-file.el" (0 0 0 0))
;;; Generated autoloads from find-file.el
(defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") \, (lambda nil (match-string 2)))) "\
@@ -12873,19 +11846,15 @@ If REGEXP matches the current line (from the beginning of the line),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
filename that EXTRACT returned.")
-
(custom-autoload 'ff-special-constructs "find-file" t)
-
(autoload 'ff-get-other-file "find-file" "\
Find the header or source file corresponding to this file.
See also the documentation for `ff-find-other-file'.
If optional IN-OTHER-WINDOW is non-nil, find the file in another window.
-\(fn &optional IN-OTHER-WINDOW)" t nil)
-
+(fn &optional IN-OTHER-WINDOW)" t nil)
(defalias 'ff-find-related-file #'ff-find-other-file)
-
(autoload 'ff-find-other-file "find-file" "\
Find the header or source file corresponding to this file.
Being on a `#include' line pulls in that file.
@@ -12943,23 +11912,16 @@ Variables of interest include:
- `ff-file-created-hook'
List of functions to be called if the other file has been created.
-\(fn &optional IN-OTHER-WINDOW IGNORE-INCLUDE EVENT)" t nil)
-
+(fn &optional IN-OTHER-WINDOW IGNORE-INCLUDE EVENT)" t nil)
(define-obsolete-function-alias 'ff-mouse-find-other-file #'ff-find-other-file "28.1")
-
(define-obsolete-function-alias 'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window "28.1")
-
(autoload 'ff-find-other-file-other-window "find-file" "\
Visit the file you point at in another window.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(register-definition-prefixes "find-file" '("cc-" "ff-" "modula2-other-file-alist"))
-;;;***
-;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/find-func.el
(autoload 'find-library "find-func" "\
@@ -12970,29 +11932,28 @@ Interactively, prompt for LIBRARY using the one at or near point.
This function searches `find-library-source-path' if non-nil, and
`load-path' otherwise.
-\(fn LIBRARY)" t nil)
+See the `find-library-include-other-files' user option for
+customizing the candidate completions.
+(fn LIBRARY)" t nil)
(autoload 'read-library-name "find-func" "\
Read and return a library name, defaulting to the one near point.
A library name is the filename of an Emacs Lisp library located
in a directory under `load-path' (or `find-library-source-path',
if non-nil)." nil nil)
-
(autoload 'find-library-other-window "find-func" "\
Find the Emacs Lisp source of LIBRARY in another window.
See `find-library' for more details.
-\(fn LIBRARY)" t nil)
-
+(fn LIBRARY)" t nil)
(autoload 'find-library-other-frame "find-func" "\
Find the Emacs Lisp source of LIBRARY in another frame.
See `find-library' for more details.
-\(fn LIBRARY)" t nil)
-
+(fn LIBRARY)" t nil)
(autoload 'find-function-search-for-symbol "find-func" "\
Search for SYMBOL's definition of type TYPE in LIBRARY.
Visit the library in a buffer, and return a cons cell (BUFFER . POSITION),
@@ -13003,8 +11964,7 @@ Otherwise, TYPE specifies the kind of definition,
and it is interpreted via `find-function-regexp-alist'.
The search is done in the source for library LIBRARY.
-\(fn SYMBOL TYPE LIBRARY)" nil nil)
-
+(fn SYMBOL TYPE LIBRARY)" nil nil)
(autoload 'find-function-noselect "find-func" "\
Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
@@ -13017,8 +11977,7 @@ If FUNCTION is a built-in function, this function normally
attempts to find it in the Emacs C sources; however, if LISP-ONLY
is non-nil, signal an error instead.
-\(fn FUNCTION &optional LISP-ONLY)" nil nil)
-
+(fn FUNCTION &optional LISP-ONLY)" nil nil)
(autoload 'find-function "find-func" "\
Find the definition of the FUNCTION near point.
@@ -13029,22 +11988,19 @@ Set mark before moving, if the buffer already existed.
See also `find-function-recenter-line' and `find-function-after-hook'.
-\(fn FUNCTION)" t nil)
-
+(fn FUNCTION)" t nil)
(autoload 'find-function-other-window "find-func" "\
Find, in another window, the definition of FUNCTION near point.
See `find-function' for more details.
-\(fn FUNCTION)" t nil)
-
+(fn FUNCTION)" t nil)
(autoload 'find-function-other-frame "find-func" "\
Find, in another frame, the definition of FUNCTION near point.
See `find-function' for more details.
-\(fn FUNCTION)" t nil)
-
+(fn FUNCTION)" t nil)
(autoload 'find-variable-noselect "find-func" "\
Return a pair `(BUFFER . POINT)' pointing to the definition of VARIABLE.
@@ -13052,8 +12008,7 @@ Finds the library containing the definition of VARIABLE in a buffer and
the point of the definition. The buffer is not selected.
If the variable's definition can't be found in the buffer, return (BUFFER).
-\(fn VARIABLE &optional FILE)" nil nil)
-
+(fn VARIABLE &optional FILE)" nil nil)
(autoload 'find-variable "find-func" "\
Find the definition of the VARIABLE at or before point.
@@ -13065,22 +12020,19 @@ Set mark before moving, if the buffer already existed.
See also `find-function-recenter-line' and `find-function-after-hook'.
-\(fn VARIABLE)" t nil)
-
+(fn VARIABLE)" t nil)
(autoload 'find-variable-other-window "find-func" "\
Find, in another window, the definition of VARIABLE near point.
See `find-variable' for more details.
-\(fn VARIABLE)" t nil)
-
+(fn VARIABLE)" t nil)
(autoload 'find-variable-other-frame "find-func" "\
Find, in another frame, the definition of VARIABLE near point.
See `find-variable' for more details.
-\(fn VARIABLE)" t nil)
-
+(fn VARIABLE)" t nil)
(autoload 'find-definition-noselect "find-func" "\
Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
If the definition can't be found in the buffer, return (BUFFER).
@@ -13088,8 +12040,7 @@ TYPE says what type of definition: nil for a function, `defvar' for a
variable, `defface' for a face. This function does not switch to the
buffer nor display it.
-\(fn SYMBOL TYPE &optional FILE)" nil nil)
-
+(fn SYMBOL TYPE &optional FILE)" nil nil)
(autoload 'find-face-definition "find-func" "\
Find the definition of FACE. FACE defaults to the name near point.
@@ -13101,81 +12052,62 @@ Set mark before moving, if the buffer already existed.
See also `find-function-recenter-line' and `find-function-after-hook'.
-\(fn FACE)" t nil)
-
+(fn FACE)" t nil)
(autoload 'find-function-on-key "find-func" "\
Find the function that KEY invokes. KEY is a string.
Set mark before moving, if the buffer already existed.
-\(fn KEY)" t nil)
-
+(fn KEY)" t nil)
(autoload 'find-function-on-key-other-window "find-func" "\
Find, in the other window, the function that KEY invokes.
See `find-function-on-key'.
-\(fn KEY)" t nil)
-
+(fn KEY)" t nil)
(autoload 'find-function-on-key-other-frame "find-func" "\
Find, in the other frame, the function that KEY invokes.
See `find-function-on-key'.
-\(fn KEY)" t nil)
-
+(fn KEY)" t nil)
(autoload 'find-function-at-point "find-func" "\
Find directly the function at point in the other window." t nil)
-
(autoload 'find-variable-at-point "find-func" "\
Find directly the variable at point in the other window." t nil)
-
(autoload 'find-function-setup-keys "find-func" "\
Define some key bindings for the `find-function' family of functions." nil nil)
+(register-definition-prefixes "find-func" '("find-" "read-library-name--find-files"))
-(register-definition-prefixes "find-func" '("find-"))
-
-;;;***
-;;;### (autoloads nil "find-lisp" "find-lisp.el" (0 0 0 0))
;;; Generated autoloads from find-lisp.el
(autoload 'find-lisp-find-dired "find-lisp" "\
Find files in DIR, matching REGEXP.
-\(fn DIR REGEXP)" t nil)
-
+(fn DIR REGEXP)" t nil)
(autoload 'find-lisp-find-dired-subdirectories "find-lisp" "\
Find all subdirectories of DIR.
-\(fn DIR)" t nil)
-
+(fn DIR)" t nil)
(autoload 'find-lisp-find-dired-filter "find-lisp" "\
Change the filter on a `find-lisp-find-dired' buffer to REGEXP.
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(register-definition-prefixes "find-lisp" '("find-lisp-"))
-;;;***
-;;;### (autoloads nil "finder" "finder.el" (0 0 0 0))
;;; Generated autoloads from finder.el
(autoload 'finder-list-keywords "finder" "\
Display descriptions of the keywords in the Finder buffer." t nil)
-
(autoload 'finder-commentary "finder" "\
Display FILE's commentary section.
FILE should be in a form suitable for passing to `locate-library'.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'finder-by-keyword "finder" "\
Find packages matching a given keyword." t nil)
-
(register-definition-prefixes "finder" '("finder-" "generated-finder-keywords-file"))
-;;;***
-;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (0 0 0 0))
;;; Generated autoloads from flow-ctrl.el
(autoload 'enable-flow-control "flow-ctrl" "\
@@ -13183,8 +12115,7 @@ Toggle flow control handling.
When handling is enabled, user can type C-s as C-\\, and C-q as C-^.
With arg, enable flow control mode if arg is positive, otherwise disable.
-\(fn &optional ARGUMENT)" t nil)
-
+(fn &optional ARGUMENT)" t nil)
(autoload 'enable-flow-control-on "flow-ctrl" "\
Enable flow control if using one of a specified set of terminal types.
Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control
@@ -13192,20 +12123,16 @@ on VT-100 and H19 terminals. When flow control is enabled,
you must type C-\\ to get the effect of a C-s, and type C-^
to get the effect of a C-q.
-\(fn &rest LOSING-TERMINAL-TYPES)" nil nil)
-
+(fn &rest LOSING-TERMINAL-TYPES)" nil nil)
(register-definition-prefixes "flow-ctrl" '("flow-control-c-"))
-;;;***
-;;;### (autoloads nil "flow-fill" "mail/flow-fill.el" (0 0 0 0))
;;; Generated autoloads from mail/flow-fill.el
(autoload 'fill-flowed-encode "flow-fill" "\
-\(fn &optional BUFFER)" nil nil)
-
+(fn &optional BUFFER)" nil nil)
(autoload 'fill-flowed "flow-fill" "\
Apply RFC2646 decoding to BUFFER.
If BUFFER is nil, default to the current buffer.
@@ -13213,16 +12140,13 @@ If BUFFER is nil, default to the current buffer.
If DELETE-SPACE, delete RFC2646 spaces padding at the end of
lines.
-\(fn &optional BUFFER DELETE-SPACE)" nil nil)
-
+(fn &optional BUFFER DELETE-SPACE)" nil nil)
(register-definition-prefixes "flow-fill" '("fill-flowed-"))
-;;;***
-;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0))
;;; Generated autoloads from progmodes/flymake.el
-(push (purecopy '(flymake 1 2 2)) package--builtin-versions)
+(push (purecopy '(flymake 1 2 2)) package--builtin-versions)
(autoload 'flymake-log "flymake" "\
Log, at level LEVEL, the message MSG formatted with ARGS.
LEVEL is passed to `display-warning', which is used to display
@@ -13230,8 +12154,7 @@ the warning. If this form is included in a file,
the generated warning contains an indication of the file that
generated it.
-\(fn LEVEL MSG &rest ARGS)" nil t)
-
+(fn LEVEL MSG &rest ARGS)" nil t)
(autoload 'flymake-make-diagnostic "flymake" "\
Make a Flymake diagnostic for LOCUS's region from BEG to END.
LOCUS is a buffer object or a string designating a file name.
@@ -13253,8 +12176,7 @@ created diagnostic, overriding the default properties and any
properties listed in the `flymake-overlay-control' property of
the diagnostic's type symbol.
-\(fn LOCUS BEG END TYPE TEXT &optional DATA OVERLAY-PROPERTIES)" nil nil)
-
+(fn LOCUS BEG END TYPE TEXT &optional DATA OVERLAY-PROPERTIES)" nil nil)
(autoload 'flymake-diagnostics "flymake" "\
Get Flymake diagnostics in region determined by BEG and END.
@@ -13262,32 +12184,16 @@ If neither BEG or END is supplied, use whole accessible buffer,
otherwise if BEG is non-nil and END is nil, consider only
diagnostics at BEG.
-\(fn &optional BEG END)" nil nil)
-
+(fn &optional BEG END)" nil nil)
(autoload 'flymake-diag-region "flymake" "\
Compute BUFFER's region (BEG . END) corresponding to LINE and COL.
If COL is nil, return a region just for LINE. Return nil if the
region is invalid. This function saves match data.
-\(fn BUFFER LINE &optional COL)" nil nil)
-
+(fn BUFFER LINE &optional COL)" nil nil)
(autoload 'flymake-mode "flymake" "\
Toggle Flymake mode on or off.
-This is a minor mode. If called interactively, toggle the `Flymake
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `flymake-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Flymake is an Emacs minor mode for on-the-fly syntax checking.
Flymake collects diagnostic information from multiple sources,
called backends, and visually annotates the buffer with the
@@ -13302,6 +12208,13 @@ The commands `flymake-goto-next-error' and
`flymake-goto-prev-error' can be used to navigate among Flymake
diagnostics annotated in the buffer.
+By default, `flymake-mode' doesn't override the \\[next-error] command, but
+if you're using Flymake a lot (and don't use the regular compilation
+mechanisms that often), it can be useful to put something like
+the following in your init file:
+
+ (setq next-error-function \\='flymake-goto-next-error)
+
The visual appearance of each type of diagnostic can be changed
by setting properties `flymake-overlay-control', `flymake-bitmap'
and `flymake-severity' on the symbols of diagnostic types (like
@@ -13318,20 +12231,28 @@ suitable for the current buffer. The commands
`flymake-reporting-backends' summarize the situation, as does the
special *Flymake log* buffer.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Flymake mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `flymake-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'flymake-mode-on "flymake" "\
Turn Flymake mode on." nil nil)
-
(autoload 'flymake-mode-off "flymake" "\
Turn Flymake mode off." nil nil)
-
(register-definition-prefixes "flymake" '("flymake-"))
-;;;***
-;;;### (autoloads nil "flymake-cc" "progmodes/flymake-cc.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from progmodes/flymake-cc.el
(autoload 'flymake-cc "flymake-cc" "\
@@ -13340,45 +12261,24 @@ This backend uses `flymake-cc-command' (which see) to launch a
process that is passed the current buffer's contents via stdin.
REPORT-FN is Flymake's callback.
-\(fn REPORT-FN &rest ARGS)" nil nil)
-
+(fn REPORT-FN &rest ARGS)" nil nil)
(register-definition-prefixes "flymake-cc" '("flymake-cc-"))
-;;;***
-;;;### (autoloads nil "flymake-proc" "progmodes/flymake-proc.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/flymake-proc.el
-(push (purecopy '(flymake-proc 1 0)) package--builtin-versions)
+(push (purecopy '(flymake-proc 1 0)) package--builtin-versions)
(register-definition-prefixes "flymake-proc" '("flymake-proc-"))
-;;;***
-;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (0 0 0 0))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
Turn on `flyspell-mode' for comments and strings." t nil)
(defvar flyspell-mode nil "Non-nil if Flyspell mode is enabled.")
-
(autoload 'flyspell-mode "flyspell" "\
Toggle on-the-fly spell checking (Flyspell mode).
-This is a minor mode. If called interactively, toggle the `Flyspell
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `flyspell-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Flyspell mode is a buffer-local minor mode. When enabled, it
spawns a single Ispell process and checks each word. The default
flyspell behavior is to highlight incorrect words.
@@ -13402,72 +12302,60 @@ invoking `ispell-change-dictionary'.
Consider using the `ispell-parser' to check your text. For instance
consider adding:
-\(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex)))
+(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex)))
in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Flyspell mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `flyspell-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'turn-on-flyspell "flyspell" "\
Unconditionally turn on Flyspell mode." nil nil)
-
(autoload 'turn-off-flyspell "flyspell" "\
Unconditionally turn off Flyspell mode." nil nil)
-
(autoload 'flyspell-mode-off "flyspell" "\
Turn Flyspell mode off." nil nil)
-
(autoload 'flyspell-region "flyspell" "\
Flyspell text between BEG and END.
Make sure `flyspell-mode' is turned on if you want the highlight
of a misspelled word removed when you've corrected it.
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'flyspell-buffer "flyspell" "\
Flyspell whole buffer." t nil)
-
(register-definition-prefixes "flyspell" '("flyspell-" "mail-mode-flyspell-verify" "make-flyspell-overlay" "sgml-mode-flyspell-verify" "tex"))
-;;;***
-;;;### (autoloads nil "foldout" "foldout.el" (0 0 0 0))
;;; Generated autoloads from foldout.el
-(push (purecopy '(foldout 1 10)) package--builtin-versions)
+(push (purecopy '(foldout 1 10)) package--builtin-versions)
(register-definition-prefixes "foldout" '("foldout-"))
-;;;***
-;;;### (autoloads nil "follow" "follow.el" (0 0 0 0))
;;; Generated autoloads from follow.el
(autoload 'turn-on-follow-mode "follow" "\
Turn on Follow mode. Please see the function `follow-mode'." nil nil)
-
(autoload 'turn-off-follow-mode "follow" "\
Turn off Follow mode. Please see the function `follow-mode'." nil nil)
-
(autoload 'follow-mode "follow" "\
Toggle Follow mode.
-This is a minor mode. If called interactively, toggle the `Follow
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `follow-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Follow mode is a minor mode that combines windows into one tall
virtual window. This is accomplished by two main techniques:
@@ -13497,8 +12385,21 @@ This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
\\{follow-mode-map}
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Follow mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `follow-mode'.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'follow-scroll-up-window "follow" "\
Scroll text in a Follow mode window up by that window's size.
The other windows in the window chain will scroll synchronously.
@@ -13511,8 +12412,7 @@ Negative ARG means scroll downward.
Works like `scroll-up' when not in Follow mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'follow-scroll-down-window "follow" "\
Scroll text in a Follow mode window down by that window's size.
The other windows in the window chain will scroll synchronously.
@@ -13525,8 +12425,7 @@ Negative ARG means scroll upward.
Works like `scroll-down' when not in Follow mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'follow-scroll-up "follow" "\
Scroll text in a Follow mode window chain up.
@@ -13538,8 +12437,7 @@ Negative ARG means scroll downward.
Works like `scroll-up' when not in Follow mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'follow-scroll-down "follow" "\
Scroll text in a Follow mode window chain down.
@@ -13551,8 +12449,7 @@ Negative ARG means scroll upward.
Works like `scroll-down' when not in Follow mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'follow-delete-other-windows-and-split "follow" "\
Create two side by side windows and enter Follow mode.
@@ -13561,58 +12458,54 @@ in the selected window. All other windows, in the current
frame, are deleted and the selected window is split in two
side-by-side windows. Follow mode is activated, hence the
two windows always will display two successive pages.
-\(If one window is moved, the other one will follow.)
+(If one window is moved, the other one will follow.)
If ARG is positive, the leftmost window is selected. If negative,
the rightmost is selected. If ARG is nil, the leftmost window is
selected if the original window is the first one in the frame.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "follow" '("follow-"))
-;;;***
-;;;### (autoloads nil "fontset" "international/fontset.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from international/fontset.el
-(register-definition-prefixes "fontset" '("charset-script-alist" "create-" "fontset-" "generate-fontset-menu" "set" "standard-fontset-spec" "x-" "xlfd-"))
+(register-definition-prefixes "fontset" '("build-default-fontset-data" "charset-script-alist" "create-" "fontset-" "generate-fontset-menu" "set" "standard-fontset-spec" "x-" "xlfd-"))
-;;;***
-;;;### (autoloads nil "footnote" "mail/footnote.el" (0 0 0 0))
;;; Generated autoloads from mail/footnote.el
(autoload 'footnote-mode "footnote" "\
Toggle Footnote mode.
-This is a minor mode. If called interactively, toggle the `Footnote
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+Footnote mode is a buffer-local minor mode. If enabled, it
+provides footnote support for `message-mode'. To get started,
+play around with the following keys:
+\\{footnote-minor-mode-map}
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+This is a minor mode. If called interactively, toggle the
+`Footnote mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `footnote-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-Footnote mode is a buffer-local minor mode. If enabled, it
-provides footnote support for `message-mode'. To get started,
-play around with the following keys:
-\\{footnote-minor-mode-map}
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "footnote" '("footnote-"))
-\(fn &optional ARG)" t nil)
+
+;;; Generated autoloads from cedet/semantic/format.el
-(register-definition-prefixes "footnote" '("footnote-"))
+(register-definition-prefixes "semantic/format" '("semantic-"))
-;;;***
-;;;### (autoloads nil "format-spec" "format-spec.el" (0 0 0 0))
;;; Generated autoloads from format-spec.el
(autoload 'format-spec "format-spec" "\
@@ -13663,13 +12556,10 @@ any occurrences of \"%%\" in FORMAT verbatim in the result.
If SPLIT, instead of returning a single string, a list of strings
is returned, where each format spec is its own element.
-\(fn FORMAT SPECIFICATION &optional IGNORE-MISSING SPLIT)" nil nil)
-
+(fn FORMAT SPECIFICATION &optional IGNORE-MISSING SPLIT)" nil nil)
(register-definition-prefixes "format-spec" '("format-spec-"))
-;;;***
-;;;### (autoloads nil "forms" "forms.el" (0 0 0 0))
;;; Generated autoloads from forms.el
(autoload 'forms-mode "forms" "\
@@ -13691,23 +12581,18 @@ Commands: Equivalent keys in read-only mode:
C-c C-s forms-search-forward s
C-c C-x forms-exit x
-\(fn &optional PRIMARY)" t nil)
-
+(fn &optional PRIMARY)" t nil)
(autoload 'forms-find-file "forms" "\
Visit a file in Forms mode.
-\(fn FN)" t nil)
-
+(fn FN)" t nil)
(autoload 'forms-find-file-other-window "forms" "\
Visit a file in Forms mode in other window.
-\(fn FN)" t nil)
-
+(fn FN)" t nil)
(register-definition-prefixes "forms" '("forms-"))
-;;;***
-;;;### (autoloads nil "fortran" "progmodes/fortran.el" (0 0 0 0))
;;; Generated autoloads from progmodes/fortran.el
(autoload 'fortran-mode "fortran" "\
@@ -13780,13 +12665,10 @@ Variables controlling indentation style and extra features:
Turning on Fortran mode calls the value of the variable `fortran-mode-hook'
with no args, if that value is non-nil.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "fortran" '("fortran-"))
-;;;***
-;;;### (autoloads nil "fortune" "play/fortune.el" (0 0 0 0))
;;; Generated autoloads from play/fortune.el
(autoload 'fortune-add-fortune "fortune" "\
@@ -13795,24 +12677,21 @@ Add STRING to a fortune file FILE.
Interactively, if called with a prefix argument,
read the file name to use. Otherwise use the value of `fortune-file'.
-\(fn STRING FILE)" t nil)
-
+(fn STRING FILE)" t nil)
(autoload 'fortune-from-region "fortune" "\
Append the current region to a local fortune-like data file.
Interactively, if called with a prefix argument,
read the file name to use. Otherwise use the value of `fortune-file'.
-\(fn BEG END FILE)" t nil)
-
+(fn BEG END FILE)" t nil)
(autoload 'fortune-compile "fortune" "\
Compile fortune file.
If called with a prefix asks for the FILE to compile, otherwise uses
the value of `fortune-file'. This currently cannot handle directories.
-\(fn &optional FILE)" t nil)
-
+(fn &optional FILE)" t nil)
(autoload 'fortune-to-signature "fortune" "\
Create signature from output of the fortune program.
@@ -13821,15 +12700,13 @@ otherwise uses the value of `fortune-file'. If you want to have fortune
choose from a set of files in a directory, call interactively with prefix
and choose the directory as the fortune-file.
-\(fn &optional FILE)" t nil)
-
+(fn &optional FILE)" t nil)
(autoload 'fortune-message "fortune" "\
Display a fortune cookie to the mini-buffer.
If called with a prefix, it has the same behavior as `fortune'.
Optional FILE is a fortune file from which a cookie will be selected.
-\(fn &optional FILE)" t nil)
-
+(fn &optional FILE)" t nil)
(autoload 'fortune "fortune" "\
Display a fortune cookie.
If called with a prefix asks for the FILE to choose the fortune from,
@@ -13837,23 +12714,18 @@ otherwise uses the value of `fortune-file'. If you want to have fortune
choose from a set of files in a directory, call interactively with prefix
and choose the directory as the fortune-file.
-\(fn &optional FILE)" t nil)
-
+(fn &optional FILE)" t nil)
(register-definition-prefixes "fortune" '("fortune-"))
-;;;***
-;;;### (autoloads nil "frameset" "frameset.el" (0 0 0 0))
;;; Generated autoloads from frameset.el
-(defvar frameset-session-filter-alist '((name . :never) (left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) "\
+(defvar frameset-session-filter-alist (append '((left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) (mapcar (lambda (p) (cons p :never)) frame-internal-parameters)) "\
Minimum set of parameters to filter for live (on-session) framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
-
-(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\
+(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (bottom . frameset-filter-shelve-param) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:bottom . frameset-filter-unshelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:left . frameset-filter-unshelve-param) (GUI:right . frameset-filter-unshelve-param) (GUI:top . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (left . frameset-filter-shelve-param) (parent-frame . :never) (mouse-wheel-frame . :never) (right . frameset-filter-shelve-param) (top . frameset-filter-shelve-param) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-system . :never)) frameset-session-filter-alist) "\
Parameters to filter for persistent framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
-
(defvar frameset-filter-alist frameset-persistent-filter-alist "\
Alist of frame parameters and filtering functions.
@@ -13909,7 +12781,6 @@ It must return:
Frame parameters not on this alist are passed intact, as if they were
defined with ACTION = nil.")
-
(autoload 'frameset-frame-id "frameset" "\
Return the frame id of FRAME, if it has one; else, return nil.
A frame id is a string that uniquely identifies a frame.
@@ -13918,20 +12789,17 @@ invocations, and once assigned is never changed unless the same
frame is duplicated (via `frameset-restore'), in which case the
newest frame keeps the id and the old frame's is set to nil.
-\(fn FRAME)" nil nil)
-
+(fn FRAME)" nil nil)
(autoload 'frameset-frame-id-equal-p "frameset" "\
Return non-nil if FRAME's id matches ID.
-\(fn FRAME ID)" nil nil)
-
+(fn FRAME ID)" nil nil)
(autoload 'frameset-frame-with-id "frameset" "\
Return the live frame with id ID, if exists; else nil.
If FRAME-LIST is a list of frames, check these frames only.
If nil, check all live frames.
-\(fn ID &optional FRAME-LIST)" nil nil)
-
+(fn ID &optional FRAME-LIST)" nil nil)
(autoload 'frameset-save "frameset" "\
Return a frameset for FRAME-LIST, a list of frames.
Dead frames and non-frame objects are silently removed from the list.
@@ -13944,8 +12812,7 @@ PREDICATE is a predicate function, which must return non-nil for frames that
should be saved; if PREDICATE is nil, all frames from FRAME-LIST are saved.
PROPERTIES is a user-defined property list to add to the frameset.
-\(fn FRAME-LIST &key APP NAME DESCRIPTION FILTERS PREDICATE PROPERTIES)" nil nil)
-
+(fn FRAME-LIST &key APP NAME DESCRIPTION FILTERS PREDICATE PROPERTIES)" nil nil)
(autoload 'frameset-restore "frameset" "\
Restore a FRAMESET into the current display(s).
@@ -14005,8 +12872,7 @@ restoration, including those that have been reused or created anew.
All keyword parameters default to nil.
-\(fn FRAMESET &key PREDICATE FILTERS REUSE-FRAMES FORCE-DISPLAY FORCE-ONSCREEN CLEANUP-FRAMES)" nil nil)
-
+(fn FRAMESET &key PREDICATE FILTERS REUSE-FRAMES FORCE-DISPLAY FORCE-ONSCREEN CLEANUP-FRAMES)" nil nil)
(autoload 'frameset-to-register "frameset" "\
Store the current frameset in register REGISTER.
Use \\[jump-to-register] to restore the frameset.
@@ -14014,69 +12880,78 @@ Argument is a character, naming the register.
Interactively, reads the register using `register-read-with-preview'.
-\(fn REGISTER)" t nil)
-
+(fn REGISTER)" t nil)
(register-definition-prefixes "frameset" '("frameset-"))
-;;;***
-;;;### (autoloads nil "fringe" "fringe.el" (0 0 0 0))
;;; Generated autoloads from fringe.el
-(unless (fboundp 'define-fringe-bitmap) (defun define-fringe-bitmap (_bitmap _bits &optional _height _width _align) "Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH.\nBITMAP is a symbol identifying the new fringe bitmap.\nBITS is either a string or a vector of integers.\nHEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS.\nWIDTH must be an integer between 1 and 16, or nil which defaults to 8.\nOptional fifth arg ALIGN may be one of ‘top’, ‘center’, or ‘bottom’,\nindicating the positioning of the bitmap relative to the rows where it\nis used; the default is to center the bitmap. Fifth arg may also be a\nlist (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap\nshould be repeated.\nIf BITMAP already exists, the existing definition is replaced."))
-
+(unless (fboundp 'define-fringe-bitmap) (defun define-fringe-bitmap (_bitmap _bits &optional _height _width _align) "Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH.
+BITMAP is a symbol identifying the new fringe bitmap.
+BITS is either a string or a vector of integers.
+HEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS.
+WIDTH must be an integer between 1 and 16, or nil which defaults to 8.
+Optional fifth arg ALIGN may be one of `top', `center', or `bottom',
+indicating the positioning of the bitmap relative to the rows where it
+is used; the default is to center the bitmap. Fifth arg may also be a
+list (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap
+should be repeated.
+If BITMAP already exists, the existing definition is replaced."))
(register-definition-prefixes "fringe" '("fringe-" "set-fringe-"))
-;;;***
-;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/fw.el
+
+(register-definition-prefixes "semantic/fw" '("semantic"))
+
+
;;; Generated autoloads from play/gamegrid.el
(register-definition-prefixes "gamegrid" '("gamegrid-"))
-;;;***
-;;;### (autoloads nil "gametree" "play/gametree.el" (0 0 0 0))
;;; Generated autoloads from play/gametree.el
(register-definition-prefixes "gametree" '("gametree-"))
-;;;***
-;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/bovine/gcc.el
+
+(register-definition-prefixes "semantic/bovine/gcc" '("semantic-"))
+
+
;;; Generated autoloads from progmodes/gdb-mi.el
(defvar gdb-enable-debug nil "\
Non-nil if Gdb-Enable-Debug mode is enabled.
See the `gdb-enable-debug' command
for a description of this minor mode.")
-
(custom-autoload 'gdb-enable-debug "gdb-mi" nil)
-
(autoload 'gdb-enable-debug "gdb-mi" "\
Toggle logging of transaction between Emacs and Gdb.
+
The log is stored in `gdb-debug-log' as an alist with elements
whose cons is send, send-item or recv and whose cdr is the string
being transferred. This list may grow up to a size of
`gdb-debug-log-max' after which the oldest element (at the end of
the list) is deleted every time a new one is added (at the front).
-This is a minor mode. If called interactively, toggle the
-`Gdb-Enable-Debug mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Gdb-Enable-Debug mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='gdb-enable-debug)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'gdb "gdb-mi" "\
Run gdb passing it COMMAND-LINE as arguments.
@@ -14135,28 +13010,21 @@ detailed description of this mode.
| | D gdb-delete-breakpoint |
+-----------------------------------+----------------------------------+
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-" "hollow-right-triangle" "nil"))
-;;;***
-;;;### (autoloads nil "generator" "emacs-lisp/generator.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/generator.el
(register-definition-prefixes "generator" '("cps-" "iter-"))
-;;;***
-;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/generic.el
(defvar generic-mode-list nil "\
A list of mode names for `generic-mode'.
Do not add entries to this list directly; use `define-generic-mode'
instead (which see).")
-
(autoload 'define-generic-mode "generic" "\
Create a new generic mode MODE.
@@ -14195,17 +13063,13 @@ mode hook `MODE-hook'.
See the file generic-x.el for some examples of `define-generic-mode'.
-\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t)
-
-(function-put 'define-generic-mode 'lisp-indent-function '1)
-
-(function-put 'define-generic-mode 'doc-string-elt '7)
-
+(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t)
+(function-put 'define-generic-mode 'lisp-indent-function 1)
+(function-put 'define-generic-mode 'doc-string-elt 7)
(autoload 'generic-mode-internal "generic" "\
Go into the generic mode MODE.
-\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST FUNCTION-LIST)" nil nil)
-
+(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST FUNCTION-LIST)" nil nil)
(autoload 'generic-mode "generic" "\
Enter generic mode MODE.
@@ -14216,8 +13080,7 @@ own mode, but have comment characters, keywords, and the like.)
To define a generic-mode, use the function `define-generic-mode'.
Some generic modes are defined in `generic-x.el'.
-\(fn MODE)" t nil)
-
+(fn MODE)" t nil)
(autoload 'generic-make-keywords-list "generic" "\
Return a `font-lock-keywords' construct that highlights KEYWORD-LIST.
KEYWORD-LIST is a list of keyword strings that should be
@@ -14227,59 +13090,86 @@ PREFIX and SUFFIX. Then it returns a construct based on this
regular expression that can be used as an element of
`font-lock-keywords'.
-\(fn KEYWORD-LIST FACE &optional PREFIX SUFFIX)" nil nil)
+(fn KEYWORD-LIST FACE &optional PREFIX SUFFIX)" nil nil)
+(make-obsolete 'generic-make-keywords-list 'regexp-opt "24.4")
+(register-definition-prefixes "generic" '("generic-"))
-(make-obsolete 'generic-make-keywords-list 'regexp-opt '"24.4")
+
+;;; Generated autoloads from cedet/ede/generic.el
-(register-definition-prefixes "generic" '("generic-"))
+(register-definition-prefixes "ede/generic" '("ede-generic-"))
-;;;***
-;;;### (autoloads nil "generic-x" "generic-x.el" (0 0 0 0))
-;;; Generated autoloads from generic-x.el
+;;; Generated autoloads from cedet/srecode/getset.el
-(register-definition-prefixes "generic-x" '("default-generic-mode" "generic-"))
+(register-definition-prefixes "srecode/getset" '("srecode-"))
-;;;***
-;;;### (autoloads nil "glasses" "progmodes/glasses.el" (0 0 0 0))
;;; Generated autoloads from progmodes/glasses.el
(autoload 'glasses-mode "glasses" "\
Minor mode for making identifiers likeThis readable.
-This is a minor mode. If called interactively, toggle the `Glasses
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+When this mode is active, it tries to add virtual
+separators (like underscores) at places they belong to.
+
+This is a minor mode. If called interactively, toggle the
+`Glasses mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `glasses-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-When this mode is active, it tries to add virtual
-separators (like underscores) at places they belong to.
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "glasses" '("glasses-"))
-\(fn &optional ARG)" t nil)
+
+;;; Generated autoloads from cedet/semantic/symref/global.el
-(register-definition-prefixes "glasses" '("glasses-"))
+(register-definition-prefixes "semantic/symref/global" '("semantic-symref-global--line-re"))
+
+
+;;; Generated autoloads from textmodes/glyphless-mode.el
+
+(autoload 'glyphless-display-mode "glyphless-mode" "\
+Minor mode for displaying glyphless characters in the current buffer.
+
+If enabled, all glyphless characters will be displayed as boxes
+that display their acronyms.
+
+This is a minor mode. If called interactively, toggle the
+`Glyphless-Display mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `glyphless-display-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "glyphless-mode" '("glyphless-mode-"))
-;;;***
-;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (0 0 0 0))
;;; Generated autoloads from gnus/gmm-utils.el
(autoload 'gmm-regexp-concat "gmm-utils" "\
Potentially concat a list of regexps into a single one.
The concatenation is done with logical ORs.
-\(fn REGEXP)" nil nil)
-
+(fn REGEXP)" nil nil)
(autoload 'gmm-message "gmm-utils" "\
If LEVEL is lower than `gmm-verbose' print ARGS using `message'.
@@ -14290,19 +13180,16 @@ Guideline for numbers:
7 - not very important messages on stuff
9 - messages inside loops.
-\(fn LEVEL &rest ARGS)" nil nil)
-
+(fn LEVEL &rest ARGS)" nil nil)
(autoload 'gmm-error "gmm-utils" "\
Beep an error if LEVEL is equal to or less than `gmm-verbose'.
ARGS are passed to `message'.
-\(fn LEVEL &rest ARGS)" nil nil)
-
+(fn LEVEL &rest ARGS)" nil nil)
(autoload 'gmm-widget-p "gmm-utils" "\
Non-nil if SYMBOL is a widget.
-\(fn SYMBOL)" nil nil)
-
+(fn SYMBOL)" nil nil)
(autoload 'gmm-tool-bar-from-list "gmm-utils" "\
Make a tool bar from ICON-LIST.
@@ -14321,27 +13208,22 @@ runs the command find-file\", then use `new-file' in ZAP-LIST.
DEFAULT-MAP specifies the default key map for ICON-LIST.
-\(fn ICON-LIST ZAP-LIST DEFAULT-MAP)" nil nil)
-
+(fn ICON-LIST ZAP-LIST DEFAULT-MAP)" nil nil)
(register-definition-prefixes "gmm-utils" '("defun-gmm" "gmm-"))
-;;;***
-;;;### (autoloads nil "gnus" "gnus/gnus.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus.el
+
(push (purecopy '(gnus 5 13)) package--builtin-versions)
(custom-autoload 'gnus-select-method "gnus")
-
(autoload 'gnus-child-no-server "gnus" "\
Read network news as a child, without connecting to the local server.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'gnus-slave-no-server "gnus" "\
Read network news as a child, without connecting to the local server.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'gnus-no-server "gnus" "\
Read network news.
If ARG is a positive number, Gnus will use that as the startup level.
@@ -14351,18 +13233,15 @@ an NNTP server to use.
As opposed to `gnus', this command will not connect to the local
server.
-\(fn &optional ARG CHILD)" t nil)
-
+(fn &optional ARG CHILD)" t nil)
(autoload 'gnus-child "gnus" "\
Read news as a child.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'gnus-slave "gnus" "\
Read news as a child.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'gnus-other-frame "gnus" "\
Pop up a frame to read news.
This will call one of the Gnus commands which is specified by the user
@@ -14374,39 +13253,31 @@ such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is
omitted or the function `make-frame-on-display' is not available, the
current display is used.
-\(fn &optional ARG DISPLAY)" t nil)
-
+(fn &optional ARG DISPLAY)" t nil)
(autoload 'gnus "gnus" "\
Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use.
-\(fn &optional ARG DONT-CONNECT CHILD)" t nil)
-
+(fn &optional ARG DONT-CONNECT CHILD)" t nil)
(register-definition-prefixes "gnus" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-agent.el
(autoload 'gnus-unplugged "gnus-agent" "\
Start Gnus unplugged." t nil)
-
(autoload 'gnus-plugged "gnus-agent" "\
Start Gnus plugged." t nil)
-
(autoload 'gnus-child-unplugged "gnus-agent" "\
Read news as a child unplugged.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'gnus-slave-unplugged "gnus-agent" "\
Read news as a child unplugged.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'gnus-agentize "gnus-agent" "\
Allow Gnus to be an offline newsreader.
@@ -14417,10 +13288,8 @@ customize `gnus-agent' to nil.
This will modify the `gnus-setup-news-hook', and
`message-send-mail-real-function' variables, and install the Gnus agent
minor mode in all Gnus buffers." t nil)
-
(autoload 'gnus-agent-possibly-save-gcc "gnus-agent" "\
Save GCC if Gnus is unplugged." nil nil)
-
(autoload 'gnus-agent-rename-group "gnus-agent" "\
Rename fully-qualified OLD-GROUP as NEW-GROUP.
Always updates the agent, even when disabled, as the old agent
@@ -14428,8 +13297,7 @@ files would corrupt gnus when the agent was next enabled.
Depends upon the caller to determine whether group renaming is
supported.
-\(fn OLD-GROUP NEW-GROUP)" nil nil)
-
+(fn OLD-GROUP NEW-GROUP)" nil nil)
(autoload 'gnus-agent-delete-group "gnus-agent" "\
Delete fully-qualified GROUP.
Always updates the agent, even when disabled, as the old agent
@@ -14437,87 +13305,65 @@ files would corrupt gnus when the agent was next enabled.
Depends upon the caller to determine whether group deletion is
supported.
-\(fn GROUP)" nil nil)
-
+(fn GROUP)" nil nil)
(autoload 'gnus-agent-get-undownloaded-list "gnus-agent" "\
Construct list of articles that have not been downloaded." nil nil)
-
(autoload 'gnus-agent-possibly-alter-active "gnus-agent" "\
Possibly expand a group's active range to include articles
downloaded into the agent.
-\(fn GROUP ACTIVE &optional INFO)" nil nil)
-
+(fn GROUP ACTIVE &optional INFO)" nil nil)
(autoload 'gnus-agent-find-parameter "gnus-agent" "\
Search for GROUPs SYMBOL in the group's parameters, the group's
topic parameters, the group's category, or the customizable
variables. Returns the first non-nil value found.
-\(fn GROUP SYMBOL)" nil nil)
-
+(fn GROUP SYMBOL)" nil nil)
(autoload 'gnus-agent-batch-fetch "gnus-agent" "\
Start Gnus and fetch session." t nil)
-
(autoload 'gnus-agent-batch "gnus-agent" "\
Start Gnus, send queue and fetch session." t nil)
-
(autoload 'gnus-agent-regenerate "gnus-agent" "\
Regenerate all agent covered files.
CLEAN is obsolete and ignored.
-\(fn &optional CLEAN REREAD)" t nil)
-
+(fn &optional CLEAN REREAD)" t nil)
(register-definition-prefixes "gnus-agent" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
Make the current buffer look like a nice article." nil nil)
+(register-definition-prefixes "gnus-art" '(":keymap" "article-" "gnus-"))
-(register-definition-prefixes "gnus-art" '("article-" "gnus-"))
-
-;;;***
-;;;### (autoloads nil "gnus-async" "gnus/gnus-async.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-async.el
(register-definition-prefixes "gnus-async" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-bcklg" "gnus/gnus-bcklg.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-bcklg.el
(register-definition-prefixes "gnus-bcklg" '("gnus-backlog-"))
-;;;***
-;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from gnus/gnus-bookmark.el
(autoload 'gnus-bookmark-set "gnus-bookmark" "\
Set a bookmark for this article." '(gnus-article-mode gnus-summary-mode) nil)
-
(autoload 'gnus-bookmark-jump "gnus-bookmark" "\
Jump to a Gnus bookmark (BMK-NAME).
-\(fn &optional BMK-NAME)" t nil)
-
+(fn &optional BMK-NAME)" t nil)
(autoload 'gnus-bookmark-bmenu-list "gnus-bookmark" "\
Display a list of existing Gnus bookmarks.
The list is displayed in a buffer named `*Gnus Bookmark List*'.
The leftmost column displays a D if the bookmark is flagged for
deletion, or > if it is flagged for displaying." t nil)
-
(register-definition-prefixes "gnus-bookmark" '("gnus-bookmark-"))
-;;;***
-;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cache.el
(autoload 'gnus-jog-cache "gnus-cache" "\
@@ -14525,17 +13371,14 @@ Go through all groups and put the articles into the cache.
Usage:
$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" t nil)
-
(autoload 'gnus-cache-generate-active "gnus-cache" "\
Generate the cache active file.
-\(fn &optional DIRECTORY)" t nil)
-
+(fn &optional DIRECTORY)" t nil)
(autoload 'gnus-cache-generate-nov-databases "gnus-cache" "\
Generate NOV files recursively starting in DIR.
-\(fn DIR)" t nil)
-
+(fn DIR)" t nil)
(autoload 'gnus-cache-rename-group "gnus-cache" "\
Rename OLD-GROUP as NEW-GROUP.
Always updates the cache, even when disabled, as the old cache
@@ -14543,8 +13386,7 @@ files would corrupt Gnus when the cache was next enabled. It
depends on the caller to determine whether group renaming is
supported.
-\(fn OLD-GROUP NEW-GROUP)" nil nil)
-
+(fn OLD-GROUP NEW-GROUP)" nil nil)
(autoload 'gnus-cache-delete-group "gnus-cache" "\
Delete GROUP from the cache.
Always updates the cache, even when disabled, as the old cache
@@ -14552,41 +13394,30 @@ files would corrupt gnus when the cache was next enabled.
Depends upon the caller to determine whether group deletion is
supported.
-\(fn GROUP)" nil nil)
-
+(fn GROUP)" nil nil)
(register-definition-prefixes "gnus-cache" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-cite" "gnus/gnus-cite.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cite.el
(register-definition-prefixes "gnus-cite" '("gnus-" "turn-o"))
-;;;***
-;;;### (autoloads nil "gnus-cloud" "gnus/gnus-cloud.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cloud.el
(register-definition-prefixes "gnus-cloud" '("gnus-cloud-"))
-;;;***
-;;;### (autoloads nil "gnus-cus" "gnus/gnus-cus.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cus.el
(register-definition-prefixes "gnus-cus" '("category-fields" "gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-dbus" "gnus/gnus-dbus.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-dbus.el
(register-definition-prefixes "gnus-dbus" '("gnus-dbus-"))
-;;;***
-;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-delay.el
(autoload 'gnus-delay-article "gnus-delay" "\
@@ -14606,11 +13437,9 @@ The value of `message-draft-headers' determines which headers are
generated when the article is delayed. Remaining headers are
generated when the article is sent.
-\(fn DELAY)" '(message-mode) nil)
-
+(fn DELAY)" '(message-mode) nil)
(autoload 'gnus-delay-send-queue "gnus-delay" "\
Send all the delayed messages that are due now." t nil)
-
(autoload 'gnus-delay-initialize "gnus-delay" "\
Initialize the gnus-delay package.
This sets up a key binding in `message-mode' to delay a message.
@@ -14619,151 +13448,115 @@ This tells Gnus to look for delayed messages after getting new news.
The optional arg NO-KEYMAP is ignored.
Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
-\(fn &optional NO-KEYMAP NO-CHECK)" nil nil)
-
+(fn &optional NO-KEYMAP NO-CHECK)" nil nil)
(register-definition-prefixes "gnus-delay" '("gnus-delay-"))
-;;;***
-;;;### (autoloads nil "gnus-demon" "gnus/gnus-demon.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-demon.el
(register-definition-prefixes "gnus-demon" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-diary.el
(autoload 'gnus-user-format-function-d "gnus-diary" "\
-\(fn HEADER)" nil nil)
-
+(fn HEADER)" nil nil)
(autoload 'gnus-user-format-function-D "gnus-diary" "\
-\(fn HEADER)" nil nil)
-
+(fn HEADER)" nil nil)
(register-definition-prefixes "gnus-diary" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-dired.el
(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\
Convenience method to turn on `gnus-dired-mode'." t nil)
-
(register-definition-prefixes "gnus-dired" '("gnus-dired-"))
-;;;***
-;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-draft.el
(autoload 'gnus-draft-reminder "gnus-draft" "\
Reminder user if there are unsent drafts." t nil)
-
(register-definition-prefixes "gnus-draft" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-dup" "gnus/gnus-dup.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-dup.el
(register-definition-prefixes "gnus-dup" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-eform" "gnus/gnus-eform.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-eform.el
(register-definition-prefixes "gnus-eform" '("gnus-edit-form"))
-;;;***
-;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-fun.el
(autoload 'gnus--random-face-with-type "gnus-fun" "\
Return file from DIR with extension EXT.
Omit matches of OMIT, and process them by FUN.
-\(fn DIR EXT OMIT FUN)" nil nil)
-
+(fn DIR EXT OMIT FUN)" nil nil)
(autoload 'message-goto-eoh "message" nil t)
-
(autoload 'gnus-random-x-face "gnus-fun" "\
Return X-Face header data chosen randomly from `gnus-x-face-directory'.
Files matching `gnus-x-face-omit-files' are not considered." t nil)
-
(autoload 'gnus-insert-random-x-face-header "gnus-fun" "\
Insert a random X-Face header from `gnus-x-face-directory'." t nil)
-
(autoload 'gnus-x-face-from-file "gnus-fun" "\
Insert an X-Face header based on an image FILE.
Depending on `gnus-convert-image-to-x-face-command' it may accept
different input formats.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'gnus-face-from-file "gnus-fun" "\
Return a Face header based on an image FILE.
Depending on `gnus-convert-image-to-face-command' it may accept
different input formats.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'gnus-convert-face-to-png "gnus-fun" "\
Convert FACE (which is base64-encoded) to a PNG.
The PNG is returned as a string.
-\(fn FACE)" nil nil)
-
+(fn FACE)" nil nil)
(autoload 'gnus-convert-png-to-face "gnus-fun" "\
Convert FILE to a Face.
FILE should be a PNG file that's 48x48 and smaller than or equal to
726 bytes.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'gnus-random-face "gnus-fun" "\
Return randomly chosen Face from `gnus-face-directory'.
Files matching `gnus-face-omit-files' are not considered." t nil)
-
(autoload 'gnus-insert-random-face-header "gnus-fun" "\
Insert a random Face header from `gnus-face-directory'." nil nil)
-
(register-definition-prefixes "gnus-fun" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from gnus/gnus-gravatar.el
(autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\
Display gravatar in the From header.
If gravatar is already displayed, remove it.
-\(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil)
-
+(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-treat-mail-gravatar "gnus-gravatar" "\
Display gravatars in the Cc and To headers.
If gravatars are already displayed, remove them.
-\(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil)
-
+(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil)
(register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-"))
-;;;***
-;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-group.el
(autoload 'gnus-fetch-group "gnus-group" "\
@@ -14771,125 +13564,98 @@ Start Gnus if necessary and enter GROUP.
If ARTICLES, display those articles.
Returns whether the fetching was successful or not.
-\(fn GROUP &optional ARTICLES)" t nil)
-
+(fn GROUP &optional ARTICLES)" t nil)
(autoload 'gnus-fetch-group-other-frame "gnus-group" "\
Pop up a frame and enter GROUP.
-\(fn GROUP)" t nil)
-
+(fn GROUP)" t nil)
(autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group" "\
Browse Emacs bug reports with IDS in an ephemeral group.
The arguments have the same meaning as those of
`gnus-read-ephemeral-bug-group', which see.
-\(fn IDS &optional WINDOW-CONF)" t nil)
-
-(register-definition-prefixes "gnus-group" '("gnus-"))
+(fn IDS &optional WINDOW-CONF)" t nil)
+(register-definition-prefixes "gnus-group" '(":keymap" "gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-html.el
(autoload 'gnus-article-html "gnus-html" "\
-\(fn &optional HANDLE)" nil nil)
-
+(fn &optional HANDLE)" nil nil)
(autoload 'gnus-html-prefetch-images "gnus-html" "\
-\(fn SUMMARY)" nil nil)
-
+(fn SUMMARY)" nil nil)
(register-definition-prefixes "gnus-html" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-icalendar" "gnus/gnus-icalendar.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from gnus/gnus-icalendar.el
(autoload 'gnus-icalendar-mm-inline "gnus-icalendar" "\
-\(fn HANDLE)" nil nil)
-
+(fn HANDLE)" nil nil)
(register-definition-prefixes "gnus-icalendar" '("gnus-icalendar"))
-;;;***
-;;;### (autoloads nil "gnus-int" "gnus/gnus-int.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-int.el
(register-definition-prefixes "gnus-int" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-kill.el
(defalias 'gnus-batch-kill 'gnus-batch-score)
-
(autoload 'gnus-batch-score "gnus-kill" "\
Run batched scoring.
Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" t nil)
-
(register-definition-prefixes "gnus-kill" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-logic" "gnus/gnus-logic.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-logic.el
(register-definition-prefixes "gnus-logic" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-mh" "gnus/gnus-mh.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-mh.el
(register-definition-prefixes "gnus-mh" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-ml.el
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil nil nil)
-
(autoload 'gnus-mailing-list-insinuate "gnus-ml" "\
Setup group parameters from List-Post header.
If FORCE is non-nil, replace the old ones.
-\(fn &optional FORCE)" t nil)
-
+(fn &optional FORCE)" t nil)
(autoload 'gnus-mailing-list-mode "gnus-ml" "\
Minor mode for providing mailing-list commands.
+\\{gnus-mailing-list-mode-map}
+
This is a minor mode. If called interactively, toggle the
-`Gnus-Mailing-List mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Gnus-Mailing-List mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `gnus-mailing-list-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\\{gnus-mailing-list-mode-map}
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "gnus-ml" '("gnus-mailing-list-"))
-;;;***
-;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-mlspl.el
(autoload 'gnus-group-split-setup "gnus-mlspl" "\
@@ -14914,8 +13680,7 @@ elaborate fancy splits may also be useful to split mail that doesn't
match any of the group-specified splitting rules. See
`gnus-group-split-fancy' for details.
-\(fn &optional AUTO-UPDATE CATCH-ALL)" t nil)
-
+(fn &optional AUTO-UPDATE CATCH-ALL)" t nil)
(autoload 'gnus-group-split-update "gnus-mlspl" "\
Computes `nnmail-split-fancy' from group params and CATCH-ALL.
It does this by calling (gnus-group-split-fancy nil nil CATCH-ALL).
@@ -14923,19 +13688,17 @@ It does this by calling (gnus-group-split-fancy nil nil CATCH-ALL).
If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used
instead. This variable is set by `gnus-group-split-setup'.
-\(fn &optional CATCH-ALL)" t nil)
-
+(fn &optional CATCH-ALL)" t nil)
(autoload 'gnus-group-split "gnus-mlspl" "\
Use information from group parameters in order to split mail.
See `gnus-group-split-fancy' for more information.
`gnus-group-split' is a valid value for `nnmail-split-methods'." nil nil)
-
(autoload 'gnus-group-split-fancy "gnus-mlspl" "\
Uses information from group parameters in order to split mail.
It can be embedded into `nnmail-split-fancy' lists with the SPLIT
-\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL)
+(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL)
GROUPS may be a regular expression or a list of group names, that will
be used to select candidate groups. If it is omitted or nil, all
@@ -14964,31 +13727,28 @@ as the last element of a `|' SPLIT.
For example, given the following group parameters:
nnml:mail.bar:
-\((to-address . \"bar@femail.com\")
+((to-address . \"bar@femail.com\")
(split-regexp . \".*@femail\\\\.com\"))
nnml:mail.foo:
-\((to-list . \"foo@nowhere.gov\")
+((to-list . \"foo@nowhere.gov\")
(extra-aliases \"foo@localhost\" \"foo-redist@home\")
(split-exclude \"bugs-foo\" \"rambling-foo\")
(admin-address . \"foo-request@nowhere.gov\"))
nnml:mail.others:
-\((split-spec . catch-all))
+((split-spec . catch-all))
Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
-\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
+(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
\"mail.bar\")
(any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\"
- \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
\"mail.others\")
-\(fn &optional GROUPS NO-CROSSPOST CATCH-ALL)" nil nil)
-
+(fn &optional GROUPS NO-CROSSPOST CATCH-ALL)" nil nil)
(register-definition-prefixes "gnus-mlspl" '("gnus-group-split-"))
-;;;***
-;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-msg.el
(autoload 'gnus-msg-mail "gnus-msg" "\
@@ -14998,26 +13758,19 @@ Gcc: header for archiving purposes.
If Gnus isn't running, a plain `message-mail' setup is used
instead.
-\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-ACTION YANK-ACTION SEND-ACTIONS RETURN-ACTION)" t nil)
-
+(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-ACTION YANK-ACTION SEND-ACTIONS RETURN-ACTION)" t nil)
(autoload 'gnus-button-mailto "gnus-msg" "\
Mail to ADDRESS.
-\(fn ADDRESS)" nil nil)
-
+(fn ADDRESS)" nil nil)
(autoload 'gnus-button-reply "gnus-msg" "\
Like `message-reply'.
-\(fn &optional TO-ADDRESS WIDE)" t nil)
-
+(fn &optional TO-ADDRESS WIDE)" t nil)
(define-mail-user-agent 'gnus-user-agent 'gnus-msg-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
+(register-definition-prefixes "gnus-msg" '(":prefix" "gnus-"))
-(register-definition-prefixes "gnus-msg" '("gnus-"))
-
-;;;***
-;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from gnus/gnus-notifications.el
(autoload 'gnus-notifications "gnus-notifications" "\
@@ -15028,31 +13781,23 @@ notification using `notifications-notify' for it.
This is typically a function to add in
`gnus-after-getting-new-news-hook'" nil nil)
-
(register-definition-prefixes "gnus-notifications" '("gnus-notifications-"))
-;;;***
-;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-picon.el
(autoload 'gnus-treat-from-picon "gnus-picon" "\
Display picons in the From header.
If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil)
-
(autoload 'gnus-treat-mail-picon "gnus-picon" "\
Display picons in the Cc and To headers.
If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil)
-
(autoload 'gnus-treat-newsgroups-picon "gnus-picon" "\
Display picons in the Newsgroups and Followup-To headers.
If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil)
-
(register-definition-prefixes "gnus-picon" '("gnus-picon-"))
-;;;***
-;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-range.el
(autoload 'gnus-sorted-difference "gnus-range" "\
@@ -15060,231 +13805,172 @@ Return a list of elements of LIST1 that do not appear in LIST2.
Both lists have to be sorted over <.
The tail of LIST1 is not copied.
-\(fn LIST1 LIST2)" nil nil)
-
+(fn LIST1 LIST2)" nil nil)
(autoload 'gnus-sorted-ndifference "gnus-range" "\
Return a list of elements of LIST1 that do not appear in LIST2.
Both lists have to be sorted over <.
LIST1 is modified.
-\(fn LIST1 LIST2)" nil nil)
-
+(fn LIST1 LIST2)" nil nil)
(autoload 'gnus-sorted-complement "gnus-range" "\
Return a list of elements that are in LIST1 or LIST2 but not both.
Both lists have to be sorted over <.
-\(fn LIST1 LIST2)" nil nil)
-
+(fn LIST1 LIST2)" nil nil)
(autoload 'gnus-intersection "gnus-range" "\
-\(fn LIST1 LIST2)" nil nil)
-
-(make-obsolete 'gnus-intersection 'seq-intersection '"28.1")
-
+(fn LIST1 LIST2)" nil nil)
+(make-obsolete 'gnus-intersection 'seq-intersection "28.1")
(autoload 'gnus-sorted-intersection "gnus-range" "\
Return intersection of LIST1 and LIST2.
LIST1 and LIST2 have to be sorted over <.
-\(fn LIST1 LIST2)" nil nil)
-
-(autoload 'gnus-sorted-range-intersection "gnus-range" "\
-Return intersection of RANGE1 and RANGE2.
-RANGE1 and RANGE2 have to be sorted over <.
-
-\(fn RANGE1 RANGE2)" nil nil)
-
-(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
-
+(fn LIST1 LIST2)" nil nil)
+(defalias 'gnus-set-sorted-intersection #'gnus-sorted-nintersection)
(autoload 'gnus-sorted-nintersection "gnus-range" "\
Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1.
LIST1 and LIST2 have to be sorted over <.
-\(fn LIST1 LIST2)" nil nil)
-
+(fn LIST1 LIST2)" nil nil)
(autoload 'gnus-sorted-union "gnus-range" "\
Return union of LIST1 and LIST2.
LIST1 and LIST2 have to be sorted over <.
-\(fn LIST1 LIST2)" nil nil)
-
+(fn LIST1 LIST2)" nil nil)
(autoload 'gnus-sorted-nunion "gnus-range" "\
Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1.
LIST1 and LIST2 have to be sorted over <.
-\(fn LIST1 LIST2)" nil nil)
-
+(fn LIST1 LIST2)" nil nil)
(autoload 'gnus-add-to-sorted-list "gnus-range" "\
Add NUM into sorted LIST by side effect.
-\(fn LIST NUM)" nil nil)
-
+(fn LIST NUM)" nil nil)
(register-definition-prefixes "gnus-range" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from gnus/gnus-registry.el
(autoload 'gnus-registry-initialize "gnus-registry" "\
Initialize the Gnus registry." t nil)
-
(register-definition-prefixes "gnus-registry" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-rfc1843" "gnus/gnus-rfc1843.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from gnus/gnus-rfc1843.el
(register-definition-prefixes "gnus-rfc1843" '("rfc1843-"))
-;;;***
-;;;### (autoloads nil "gnus-salt" "gnus/gnus-salt.el" (0 0 0 0))
+;;; Generated autoloads from gnus/gnus-rmail.el
+
+(register-definition-prefixes "gnus-rmail" '("gnus-"))
+
+
;;; Generated autoloads from gnus/gnus-salt.el
(register-definition-prefixes "gnus-salt" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-score" "gnus/gnus-score.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-score.el
(register-definition-prefixes "gnus-score" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-search" "gnus/gnus-search.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from gnus/gnus-search.el
(register-definition-prefixes "gnus-search" '("gnus-search-"))
-;;;***
-;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-sieve.el
(autoload 'gnus-sieve-update "gnus-sieve" "\
Update the Sieve script in gnus-sieve-file, by replacing the region
between gnus-sieve-region-start and gnus-sieve-region-end with
-\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost), then
+(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost), then
execute gnus-sieve-update-shell-command.
See the documentation for these variables and functions for details." t nil)
-
(autoload 'gnus-sieve-generate "gnus-sieve" "\
Generate the Sieve script in gnus-sieve-file, by replacing the region
between gnus-sieve-region-start and gnus-sieve-region-end with
-\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost).
+(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost).
See the documentation for these variables and functions for details." t nil)
-
(autoload 'gnus-sieve-article-add-rule "gnus-sieve" nil '(gnus-article-mode gnus-summary-mode) nil)
-
(register-definition-prefixes "gnus-sieve" '("gnus-sieve-"))
-;;;***
-;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-spec.el
(autoload 'gnus-update-format "gnus-spec" "\
Update the format specification near point.
-\(fn VAR)" t nil)
-
+(fn VAR)" t nil)
(register-definition-prefixes "gnus-spec" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-srvr" "gnus/gnus-srvr.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-srvr.el
(register-definition-prefixes "gnus-srvr" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-start.el
(autoload 'gnus-declare-backend "gnus-start" "\
Declare back end NAME with ABILITIES as a Gnus back end.
-\(fn NAME &rest ABILITIES)" nil nil)
-
+(fn NAME &rest ABILITIES)" nil nil)
(register-definition-prefixes "gnus-start" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-sum.el
(autoload 'gnus-summary-bookmark-jump "gnus-sum" "\
Handler function for record returned by `gnus-summary-bookmark-make-record'.
BOOKMARK is a bookmark name or a bookmark record.
-\(fn BOOKMARK)" nil nil)
-
-(register-definition-prefixes "gnus-sum" '("gnus-"))
+(fn BOOKMARK)" nil nil)
+(register-definition-prefixes "gnus-sum" '(":keymap" "gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-topic" "gnus/gnus-topic.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-topic.el
(register-definition-prefixes "gnus-topic" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-undo" "gnus/gnus-undo.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-undo.el
(register-definition-prefixes "gnus-undo" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-util" "gnus/gnus-util.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-util.el
(register-definition-prefixes "gnus-util" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-uu" "gnus/gnus-uu.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-uu.el
(register-definition-prefixes "gnus-uu" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-vm" "gnus/gnus-vm.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-vm.el
(register-definition-prefixes "gnus-vm" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-win.el
(autoload 'gnus-add-configuration "gnus-win" "\
Add the window configuration CONF to `gnus-buffer-configuration'.
-\(fn CONF)" nil nil)
-
+(fn CONF)" nil nil)
(register-definition-prefixes "gnus-win" '("gnus-"))
-;;;***
-;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0))
;;; Generated autoloads from net/gnutls.el
(register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream"))
-;;;***
-;;;### (autoloads nil "gomoku" "play/gomoku.el" (0 0 0 0))
;;; Generated autoloads from play/gomoku.el
(autoload 'gomoku "gomoku" "\
@@ -15306,13 +13992,10 @@ Gomoku game, and ought to be upgraded to use the full modern rules.
Use \\[describe-mode] for more info.
-\(fn &optional N M)" t nil)
-
+(fn &optional N M)" t nil)
(register-definition-prefixes "gomoku" '("gomoku-"))
-;;;***
-;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (0 0 0 0))
;;; Generated autoloads from net/goto-addr.el
(autoload 'goto-address-at-point "goto-addr" "\
@@ -15321,8 +14004,7 @@ Send mail to address at point. See documentation for
`goto-address-find-address-at-point'. If no address is found
there, then load the URL at or before point.
-\(fn &optional EVENT)" t nil)
-
+(fn &optional EVENT)" t nil)
(autoload 'goto-address "goto-addr" "\
Sets up goto-address functionality in the current buffer.
Allows user to use mouse/keyboard command to click to go to a URL
@@ -15333,28 +14015,25 @@ only on URLs and e-mail addresses.
Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
`goto-address-highlight-p' for more information)." t nil)
(put 'goto-address 'safe-local-eval-function t)
-
(autoload 'goto-address-mode "goto-addr" "\
Minor mode to buttonize URLs and e-mail addresses in the current buffer.
This is a minor mode. If called interactively, toggle the
-`Goto-Address mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+`Goto-Address mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `goto-address-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(put 'global-goto-address-mode 'globalized-minor-mode t)
-
(defvar global-goto-address-mode nil "\
Non-nil if Global Goto-Address mode is enabled.
See the `global-goto-address-mode' command
@@ -15362,9 +14041,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-goto-address-mode'.")
-
(custom-autoload 'global-goto-address-mode "goto-addr" nil)
-
(autoload 'global-goto-address-mode "goto-addr" "\
Toggle Goto-Address mode in all buffers.
With prefix ARG, enable Global Goto-Address mode if ARG is positive;
@@ -15379,32 +14056,52 @@ Goto-Address mode is enabled in all buffers where
See `goto-address-mode' for more information on Goto-Address mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'goto-address-prog-mode "goto-addr" "\
Like `goto-address-mode', but only for comments and strings.
This is a minor mode. If called interactively, toggle the
-`Goto-Address-Prog mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Goto-Address-Prog mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `goto-address-prog-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "goto-addr" '("goto-addr"))
-;;;***
-;;;### (autoloads nil "gravatar" "image/gravatar.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/wisent/grammar.el
+
+(autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\
+Major mode for editing Wisent grammars.
+
+(fn)" t nil)
+(register-definition-prefixes "semantic/wisent/grammar" '("semantic-grammar-" "wisent-"))
+
+
+;;; Generated autoloads from cedet/semantic/bovine/grammar.el
+
+(autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\
+Major mode for editing Bovine grammars.
+
+(fn)" t nil)
+(register-definition-prefixes "semantic/bovine/grammar" '("bovine-" "semantic-grammar-"))
+
+
+;;; Generated autoloads from cedet/semantic/grammar.el
+
+(register-definition-prefixes "semantic/grammar" '("semantic-"))
+
+
;;; Generated autoloads from image/gravatar.el
(autoload 'gravatar-retrieve "gravatar" "\
@@ -15413,27 +14110,21 @@ When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS),
where GRAVATAR is either an image descriptor, or the symbol
`error' if the retrieval failed.
-\(fn MAIL-ADDRESS CALLBACK &optional CBARGS)" nil nil)
-
+(fn MAIL-ADDRESS CALLBACK &optional CBARGS)" nil nil)
(autoload 'gravatar-retrieve-synchronously "gravatar" "\
Synchronously retrieve a gravatar for MAIL-ADDRESS.
Value is either an image descriptor, or the symbol `error' if the
retrieval failed.
-\(fn MAIL-ADDRESS)" nil nil)
-
+(fn MAIL-ADDRESS)" nil nil)
(register-definition-prefixes "gravatar" '("gravatar-"))
-;;;***
-;;;### (autoloads nil "grep" "progmodes/grep.el" (0 0 0 0))
;;; Generated autoloads from progmodes/grep.el
(defvar grep-window-height nil "\
Number of lines in a grep window. If nil, use `compilation-window-height'.")
-
(custom-autoload 'grep-window-height "grep" t)
-
(defvar grep-command nil "\
The default grep command for \\[grep].
If the grep program used supports an option to always include file names
@@ -15443,9 +14134,7 @@ include it when specifying `grep-command'.
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
\\[customize] or call the function `grep-apply-setting'.")
-
(custom-autoload 'grep-command "grep" nil)
-
(defvar grep-find-command nil "\
The default find command for \\[grep-find].
In interactive usage, the actual value of this variable is set up
@@ -15456,32 +14145,24 @@ This variable can either be a string, or a cons of the
form (COMMAND . POSITION). In the latter case, COMMAND will be
used as the default command, and point will be placed at POSITION
for easier editing.")
-
(custom-autoload 'grep-find-command "grep" nil)
-
(defvar grep-setup-hook nil "\
List of hook functions run by `grep-process-setup' (see `run-hooks').")
-
(custom-autoload 'grep-setup-hook "grep" t)
-
(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg 1)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches" 1 nil nil 0 1)) "\
Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
-
(defvar grep-program (purecopy "grep") "\
The default grep program for `grep-command' and `grep-find-command'.
This variable's value takes effect when `grep-compute-defaults' is called.")
-
(defvar find-program (purecopy "find") "\
The default find program.
This is used by commands like `grep-find-command', `find-dired'
and others.")
-
(defvar xargs-program (purecopy "xargs") "\
The default xargs program for `grep-find-command'.
See `grep-find-use-xargs'.
This variable's value takes effect when `grep-compute-defaults' is called.")
-
(defvar grep-find-use-xargs nil "\
How to invoke find and grep.
If `exec', use `find -exec {} ;'.
@@ -15491,31 +14172,24 @@ If `gnu-sort', use `find -print0', `sort -z' and `xargs -0'.
Any other value means to use `find -print' and `xargs'.
This variable's value takes effect when `grep-compute-defaults' is called.")
-
(custom-autoload 'grep-find-use-xargs "grep" nil)
-
(defvar grep-history nil "\
History list for grep.")
-
(defvar grep-find-history nil "\
History list for `grep-find'.")
-
(autoload 'grep-process-setup "grep" "\
Setup compilation variables and buffer for `grep'.
Set up `compilation-exit-message-function' and run `grep-setup-hook'." nil nil)
-
(autoload 'grep-compute-defaults "grep" "\
Compute the defaults for the `grep' command.
The value depends on `grep-command', `grep-template',
`grep-use-null-device', `grep-find-command', `grep-find-template',
-`grep-use-null-filename-separator', `grep-find-use-xargs' and
-`grep-highlight-matches'." nil nil)
-
+`grep-use-null-filename-separator', `grep-find-use-xargs',
+`grep-highlight-matches', and `grep-quoting-style'." nil nil)
(autoload 'grep-mode "grep" "\
Sets `grep-last-buffer' and `compilation-window-height'.
-\(fn)" nil nil)
-
+(fn)" nil nil)
(autoload 'grep "grep" "\
Run Grep with user-specified COMMAND-ARGS.
The output from the command goes to the \"*grep*\" buffer.
@@ -15538,8 +14212,7 @@ tag the cursor is over, substituting it into the last Grep command
in the Grep command history (or into `grep-command' if that history
list is empty).
-\(fn COMMAND-ARGS)" t nil)
-
+(fn COMMAND-ARGS)" t nil)
(autoload 'grep-find "grep" "\
Run grep via find, with user-specified args COMMAND-ARGS.
Collect output in the \"*grep*\" buffer.
@@ -15549,10 +14222,8 @@ to find the text that grep hits refer to.
This command uses a special history list for its arguments, so you can
easily repeat a find command.
-\(fn COMMAND-ARGS)" t nil)
-
-(defalias 'find-grep 'grep-find)
-
+(fn COMMAND-ARGS)" t nil)
+(defalias 'find-grep #'grep-find)
(autoload 'lgrep "grep" "\
Run grep, searching for REGEXP in FILES in directory DIR.
The search is limited to file names matching shell pattern FILES.
@@ -15574,8 +14245,7 @@ This command shares argument histories with \\[rgrep] and \\[grep].
If CONFIRM is non-nil, the user will be given an opportunity to edit the
command before it's run.
-\(fn REGEXP &optional FILES DIR CONFIRM)" t nil)
-
+(fn REGEXP &optional FILES DIR CONFIRM)" t nil)
(autoload 'rgrep "grep" "\
Recursively grep for REGEXP in FILES in directory tree rooted at DIR.
The search is limited to file names matching shell pattern FILES.
@@ -15601,8 +14271,11 @@ to specify a command to run.
If CONFIRM is non-nil, the user will be given an opportunity to edit the
command before it's run.
-\(fn REGEXP &optional FILES DIR CONFIRM)" t nil)
+Interactively, the user can use the \\`M-c' command while entering
+the regexp to indicate whether the grep should be case sensitive
+or not.
+(fn REGEXP &optional FILES DIR CONFIRM)" t nil)
(autoload 'zrgrep "grep" "\
Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR.
Like `rgrep' but uses `zgrep' for `grep-program', sets the default
@@ -15611,22 +14284,21 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'.
If CONFIRM is non-nil, the user will be given an opportunity to edit the
command before it's run.
-\(fn REGEXP &optional FILES DIR CONFIRM TEMPLATE)" t nil)
+(fn REGEXP &optional FILES DIR CONFIRM TEMPLATE)" t nil)
+(defalias 'rzgrep #'zrgrep)
+(register-definition-prefixes "grep" '("grep-" "kill-grep" "rgrep-"))
-(defalias 'rzgrep 'zrgrep)
+
+;;; Generated autoloads from cedet/semantic/symref/grep.el
-(register-definition-prefixes "grep" '("grep-" "kill-grep" "rgrep-"))
+(register-definition-prefixes "semantic/symref/grep" '("semantic-symref-"))
-;;;***
-;;;### (autoloads nil "gssapi" "gnus/gssapi.el" (0 0 0 0))
;;; Generated autoloads from gnus/gssapi.el
(register-definition-prefixes "gssapi" '("gssapi-program" "open-gssapi-stream"))
-;;;***
-;;;### (autoloads nil "gud" "progmodes/gud.el" (0 0 0 0))
;;; Generated autoloads from progmodes/gud.el
(autoload 'gud-gdb "gud" "\
@@ -15640,22 +14312,19 @@ will run in *gud-PID*, otherwise it will run in *gud*; in these
cases the initial working directory is the `default-directory' of
the buffer in which this command was invoked.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'sdb "gud" "\
Run sdb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'dbx "gud" "\
Run dbx on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'xdb "gud" "\
Run xdb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
@@ -15664,8 +14333,7 @@ and source-file directory for your debugger.
You can set the variable `gud-xdb-directories' to a list of program source
directories if your program contains sources from more than one directory.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'perldb "gud" "\
Debug a perl program with gud.
Interactively, this will prompt you for a command line.
@@ -15676,8 +14344,7 @@ Noninteractively, COMMAND-LINE should be on the form
The directory containing the perl program becomes the initial
working directory and source-file directory for your debugger.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'pdb "gud" "\
Run COMMAND-LINE in the `*gud-FILE*' buffer to debug Python programs.
@@ -15689,15 +14356,13 @@ If called interactively, the command line will be prompted for.
The directory containing this file becomes the initial working
directory and source-file directory for your debugger.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'guiler "gud" "\
Run guiler on program FILE in buffer `*gud-FILE*'.
The directory containing FILE becomes the initial working directory
and source-file directory for your debugger.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'jdb "gud" "\
Run jdb with command line COMMAND-LINE in a buffer.
The buffer is named \"*gud*\" if no initial class is given or
@@ -15712,13 +14377,11 @@ original source file access method.
For general information about commands available to control jdb from
gud, see `gud-mode'.
-\(fn COMMAND-LINE)" t nil)
-
+(fn COMMAND-LINE)" t nil)
(autoload 'gdb-script-mode "gud" "\
Major mode for editing GDB scripts.
-\(fn)" t nil)
-
+(fn)" t nil)
(defvar gud-tooltip-mode nil "\
Non-nil if Gud-Tooltip mode is enabled.
See the `gud-tooltip-mode' command
@@ -15726,33 +14389,28 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `gud-tooltip-mode'.")
-
(custom-autoload 'gud-tooltip-mode "gud" nil)
-
(autoload 'gud-tooltip-mode "gud" "\
Toggle the display of GUD tooltips.
-This is a minor mode. If called interactively, toggle the
-`Gud-Tooltip mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Gud-Tooltip mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='gud-tooltip-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "gud" '("gdb-" "gud-"))
-;;;***
-;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/gv.el
(autoload 'gv-get "gv" "\
@@ -15765,8 +14423,7 @@ with a (not necessarily copyable) Elisp expression that returns the value to
set it to.
DO must return an Elisp expression.
-\(fn PLACE DO)" nil nil)
-
+(fn PLACE DO)" nil nil)
(autoload 'gv-letplace "gv" "\
Build the code manipulating the generalized variable PLACE.
GETTER will be bound to a copyable expression that returns the value
@@ -15778,35 +14435,25 @@ and SETTER.
The returned value will then be an Elisp expression that first evaluates
all the parts of PLACE that can be evaluated and then runs E.
-\(fn (GETTER SETTER) PLACE &rest BODY)" nil t)
-
-(function-put 'gv-letplace 'lisp-indent-function '2)
-
+(fn (GETTER SETTER) PLACE &rest BODY)" nil t)
+(function-put 'gv-letplace 'lisp-indent-function 2)
(autoload 'gv-define-expander "gv" "\
Use HANDLER to handle NAME as a generalized var.
NAME is a symbol: the name of a function, macro, or special form.
HANDLER is a function which takes an argument DO followed by the same
arguments as NAME. DO is a function as defined in `gv-get'.
-\(fn NAME HANDLER)" nil t)
-
-(function-put 'gv-define-expander 'lisp-indent-function '1)
-
+(fn NAME HANDLER)" nil t)
+(function-put 'gv-define-expander 'lisp-indent-function 1)
(autoload 'gv--defun-declaration "gv" "\
-\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
-
+(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
(defsubst gv--expander-defun-declaration (&rest args) (apply #'gv--defun-declaration 'gv-expander args))
-
(defsubst gv--setter-defun-declaration (&rest args) (apply #'gv--defun-declaration 'gv-setter args))
-
(or (assq 'gv-expander defun-declarations-alist) (let ((x (list 'gv-expander #'gv--expander-defun-declaration))) (push x macro-declarations-alist) (push x defun-declarations-alist)))
-
(or (assq 'gv-setter defun-declarations-alist) (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist))
-
(let ((spec (get 'compiler-macro 'edebug-declaration-spec))) (put 'gv-expander 'edebug-declaration-spec spec) (put 'gv-setter 'edebug-declaration-spec spec))
-
(autoload 'gv-define-setter "gv" "\
Define a setter method for generalized variable NAME.
This macro is an easy-to-use substitute for `gv-define-expander' that works
@@ -15819,10 +14466,8 @@ which can do arbitrary things, whereas the other arguments are all guaranteed
to be pure and copyable. Example use:
(gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))
-\(fn NAME ARGLIST &rest BODY)" nil t)
-
-(function-put 'gv-define-setter 'lisp-indent-function '2)
-
+(fn NAME ARGLIST &rest BODY)" nil t)
+(function-put 'gv-define-setter 'lisp-indent-function 2)
(autoload 'gv-define-simple-setter "gv" "\
Define a simple setter method for generalized variable NAME.
This macro is an easy-to-use substitute for `gv-define-expander' that works
@@ -15836,8 +14481,7 @@ instead the assignment is turned into something equivalent to
temp)
so as to preserve the semantics of `setf'.
-\(fn NAME SETTER &optional FIX-RETURN)" nil t)
-
+(fn NAME SETTER &optional FIX-RETURN)" nil t)
(autoload 'setf "gv" "\
Set each PLACE to the value of its VAL.
This is a generalized version of `setq'; the PLACEs may be symbolic
@@ -15845,10 +14489,8 @@ references such as (car x) or (aref x i), as well as plain symbols.
For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
The return value is the last VAL in the list.
-\(fn PLACE VAL PLACE VAL ...)" nil t)
-
+(fn PLACE VAL PLACE VAL ...)" nil t)
(def-edebug-elem-spec 'gv-place '(form))
-
(autoload 'gv-ref "gv" "\
Return a reference to PLACE.
This is like the `&' operator of the C language.
@@ -15856,13 +14498,10 @@ Note: this only works reliably with lexical binding mode, except for very
simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic
binding mode.
-\(fn PLACE)" nil t)
-
+(fn PLACE)" nil t)
(register-definition-prefixes "gv" '("gv-"))
-;;;***
-;;;### (autoloads nil "handwrite" "play/handwrite.el" (0 0 0 0))
;;; Generated autoloads from play/handwrite.el
(autoload 'handwrite "handwrite" "\
@@ -15874,89 +14513,81 @@ Variables: `handwrite-linespace' (default 12)
`handwrite-fontsize' (default 11)
`handwrite-numlines' (default 60)
`handwrite-pagenumbering' (default nil)" t nil)
-
(register-definition-prefixes "handwrite" '("handwrite-" "menu-bar-handwrite-map"))
-;;;***
-;;;### (autoloads nil "hanja-util" "language/hanja-util.el" (0 0
-;;;;;; 0 0))
+;;; Generated autoloads from leim/quail/hangul.el
+
+(autoload 'hangul-input-method-activate "quail/hangul" "\
+Activate Hangul input method INPUT-METHOD.
+FUNC is a function to handle input key.
+HELP-TEXT is a text set in `hangul-input-method-help-text'.
+
+(fn INPUT-METHOD FUNC HELP-TEXT &rest ARGS)" nil nil)
+(register-definition-prefixes "quail/hangul" '("alphabetp" "hangul" "notzerop"))
+
+
;;; Generated autoloads from language/hanja-util.el
(register-definition-prefixes "hanja-util" '("han"))
-;;;***
-;;;### (autoloads nil "hanoi" "play/hanoi.el" (0 0 0 0))
;;; Generated autoloads from play/hanoi.el
(autoload 'hanoi "hanoi" "\
Towers of Hanoi diversion. Use NRINGS rings.
-\(fn NRINGS)" t nil)
-
+(fn NRINGS)" t nil)
(autoload 'hanoi-unix "hanoi" "\
Towers of Hanoi, UNIX doomsday version.
Displays 32-ring towers that have been progressing at one move per
second since 1970-01-01 00:00:00 GMT.
Repent before ring 31 moves." t nil)
-
(autoload 'hanoi-unix-64 "hanoi" "\
Like `hanoi-unix', but pretend to have a 64-bit clock.
This is, necessarily (as of Emacs 20.3), a crock. When the
`current-time' interface is made s2G-compliant, hanoi.el will need
to be updated." t nil)
-
(register-definition-prefixes "hanoi" '("hanoi-"))
-;;;***
-;;;### (autoloads nil "hashcash" "mail/hashcash.el" (0 0 0 0))
;;; Generated autoloads from mail/hashcash.el
(autoload 'hashcash-insert-payment "hashcash" "\
Insert X-Payment and X-Hashcash headers with a payment for ARG.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'hashcash-insert-payment-async "hashcash" "\
Insert X-Payment and X-Hashcash headers with a payment for ARG
Only start calculation. Results are inserted when ready.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'hashcash-verify-payment "hashcash" "\
Verify a hashcash payment.
-\(fn TOKEN &optional RESOURCE AMOUNT)" nil nil)
-
+(fn TOKEN &optional RESOURCE AMOUNT)" nil nil)
(autoload 'mail-add-payment "hashcash" "\
Add X-Payment: and X-Hashcash: headers with a hashcash payment
for each recipient address. Prefix arg sets default payment temporarily.
Set ASYNC to t to start asynchronous calculation. (See
`mail-add-payment-async').
-\(fn &optional ARG ASYNC)" t nil)
-
+(fn &optional ARG ASYNC)" t nil)
(autoload 'mail-add-payment-async "hashcash" "\
Add X-Payment: and X-Hashcash: headers with a hashcash payment
for each recipient address. Prefix arg sets default payment temporarily.
Calculation is asynchronous.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'mail-check-payment "hashcash" "\
Look for a valid X-Payment: or X-Hashcash: header.
Prefix arg sets default accept amount temporarily.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "hashcash" '("hashcash-"))
-;;;***
-;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (0 0 0 0))
;;; Generated autoloads from help-at-pt.el
(autoload 'help-at-pt-string "help-at-pt" "\
@@ -15967,38 +14598,36 @@ If KBD is non-nil, `kbd-help' is used instead, and any
`help-echo' property is ignored. In this case, the return value
can also be t, if that is the value of the `kbd-help' property.
-\(fn &optional KBD)" nil nil)
-
+(fn &optional KBD)" nil nil)
(autoload 'help-at-pt-kbd-string "help-at-pt" "\
Return the keyboard help string at point.
If the `kbd-help' text or overlay property at point produces a
string, return it. Otherwise, use the `help-echo' property.
If this produces no string either, return nil." nil nil)
-
(autoload 'display-local-help "help-at-pt" "\
Display local help in the echo area.
-This displays a short help message, namely the string produced by
-the `kbd-help' property at point. If `kbd-help' does not produce
-a string, but the `help-echo' property does, then that string is
-printed instead.
+This command, by default, displays a short help message, namely
+the string produced by the `kbd-help' property at point. If
+`kbd-help' does not produce a string, but the `help-echo'
+property does, then that string is printed instead.
The string is passed through `substitute-command-keys' before it
is displayed.
-A numeric argument ARG prevents display of a message in case
-there is no help. While ARG can be used interactively, it is
-mainly meant for use from Lisp.
+If INHIBIT-WARNING is non-nil, this prevents display of a message
+in case there is no help.
-\(fn &optional ARG)" t nil)
+If DESCRIBE-BUTTON in non-nil (interactively, the prefix arg), and
+there's a button/widget at point, pop a buffer describing that
+button/widget instead.
+(fn &optional INHIBIT-WARNING DESCRIBE-BUTTON)" t nil)
(autoload 'help-at-pt-cancel-timer "help-at-pt" "\
Cancel any timer set by `help-at-pt-set-timer'.
This disables `help-at-pt-display-when-idle'." t nil)
-
(autoload 'help-at-pt-set-timer "help-at-pt" "\
Enable `help-at-pt-display-when-idle'.
This is done by setting a timer, if none is currently active." t nil)
-
(defvar help-at-pt-display-when-idle 'never "\
Automatically show local help on point-over.
If the value is t, the string obtained from any `kbd-help' or
@@ -16029,9 +14658,7 @@ enabling buffer local values. It sets the actual value to nil.
Thus, Custom distinguishes between a nil value and other values
that disable the feature, which Custom identifies with `never'.
The default is `never'.")
-
(custom-autoload 'help-at-pt-display-when-idle "help-at-pt" nil)
-
(autoload 'scan-buf-move-to-region "help-at-pt" "\
Go to the start of the next region with non-nil PROP property.
Then run HOOK, which should be a quoted symbol that is a normal
@@ -16049,8 +14676,7 @@ do not run HOOK. If there are not enough regions to move over,
an error results and the number of available regions is mentioned
in the error message. Point is not moved and HOOK is not run.
-\(fn PROP &optional ARG HOOK)" nil nil)
-
+(fn PROP &optional ARG HOOK)" nil nil)
(autoload 'scan-buf-next-region "help-at-pt" "\
Go to the start of the next region with non-nil help-echo.
Print the help found there using `display-local-help'. Adjacent
@@ -16071,8 +14697,7 @@ help-echo region without any local help being available. This is
because `help-echo' can be a function evaluating to nil. This
rarely happens in practice.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'scan-buf-previous-region "help-at-pt" "\
Go to the start of the previous region with non-nil help-echo.
Print the help found there using `display-local-help'. Adjacent
@@ -16080,13 +14705,10 @@ areas with different non-nil help-echo properties are considered
different regions. With numeric argument ARG, behaves like
`scan-buf-next-region' with argument -ARG.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "help-at-pt" '("help-at-pt-" "scan-buf-move-hook"))
-;;;***
-;;;### (autoloads nil "help-fns" "help-fns.el" (0 0 0 0))
;;; Generated autoloads from help-fns.el
(autoload 'describe-function "help-fns" "\
@@ -16096,21 +14718,18 @@ When called from Lisp, FUNCTION may also be a function object.
See the `help-enable-symbol-autoload' variable for special
handling of autoloaded functions.
-\(fn FUNCTION)" t nil)
-
+(fn FUNCTION)" t nil)
(autoload 'describe-command "help-fns" "\
Display the full documentation of COMMAND (a symbol).
When called from Lisp, COMMAND may also be a function object.
-\(fn COMMAND)" t nil)
-
+(fn COMMAND)" t nil)
(autoload 'help-C-file-name "help-fns" "\
Return the name of the C file where SUBR-OR-VAR is defined.
KIND should be `var' for a variable or `subr' for a subroutine.
If we can't find the file name, nil is returned.
-\(fn SUBR-OR-VAR KIND)" nil nil)
-
+(fn SUBR-OR-VAR KIND)" nil nil)
(autoload 'find-lisp-object-file-name "help-fns" "\
Guess the file that defined the Lisp object OBJECT, of type TYPE.
OBJECT should be a symbol associated with a function, variable, or face;
@@ -16122,32 +14741,33 @@ If TYPE is not a symbol, search for a function definition.
The return value is the absolute name of a readable file where OBJECT is
defined. If several such files exist, preference is given to a file
found via `load-path'. The return value can also be `C-source', which
-means that OBJECT is a function or variable defined in C. If no
-suitable file is found, return nil.
+means that OBJECT is a function or variable defined in C, but
+it's currently unknown where. If no suitable file is found,
+return nil.
-\(fn OBJECT TYPE)" nil nil)
+If ALSO-C-SOURCE is non-nil, instead of returning `C-source',
+this function will attempt to locate the definition of OBJECT in
+the C sources, too.
+(fn OBJECT TYPE &optional ALSO-C-SOURCE)" nil nil)
(autoload 'describe-function-1 "help-fns" "\
-\(fn FUNCTION)" nil nil)
-
+(fn FUNCTION)" nil nil)
(autoload 'variable-at-point "help-fns" "\
Return the bound variable symbol found at or before point.
Return 0 if there is no such symbol.
If ANY-SYMBOL is non-nil, don't insist the symbol be bound.
-\(fn &optional ANY-SYMBOL)" nil nil)
-
+(fn &optional ANY-SYMBOL)" nil nil)
(autoload 'describe-variable "help-fns" "\
Display the full documentation of VARIABLE (a symbol).
Returns the documentation as a string, also.
If VARIABLE has a buffer-local value in BUFFER or FRAME
-\(default to the current buffer and current frame),
+(default to the current buffer and current frame),
it is displayed along with the global value.
-\(fn VARIABLE &optional BUFFER FRAME)" t nil)
-
+(fn VARIABLE &optional BUFFER FRAME)" t nil)
(autoload 'describe-face "help-fns" "\
Display the properties of face FACE on FRAME.
Interactively, FACE defaults to the faces of the character after point
@@ -16157,8 +14777,7 @@ If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame.
-\(fn FACE &optional FRAME)" t nil)
-
+(fn FACE &optional FRAME)" t nil)
(autoload 'describe-symbol "help-fns" "\
Display the full documentation of SYMBOL.
Will show the info of SYMBOL as a function, variable, and/or face.
@@ -16166,30 +14785,26 @@ Optional arguments BUFFER and FRAME specify for which buffer and
frame to show the information about SYMBOL; they default to the
current buffer and the selected frame, respectively.
-\(fn SYMBOL &optional BUFFER FRAME)" t nil)
-
+(fn SYMBOL &optional BUFFER FRAME)" t nil)
(autoload 'describe-syntax "help-fns" "\
Describe the syntax specifications in the syntax table of BUFFER.
The descriptions are inserted in a help buffer, which is then displayed.
BUFFER defaults to the current buffer.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'describe-categories "help-fns" "\
Describe the category specifications in the current category table.
The descriptions are inserted in a buffer, which is then displayed.
If BUFFER is non-nil, then describe BUFFER's category table instead.
BUFFER should be a buffer or a buffer name.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'describe-keymap "help-fns" "\
Describe key bindings in KEYMAP.
When called interactively, prompt for a variable that has a
keymap value.
-\(fn KEYMAP)" t nil)
-
+(fn KEYMAP)" t nil)
(autoload 'describe-mode "help-fns" "\
Display documentation of current major mode and minor modes.
A brief summary of the minor modes comes first, followed by the
@@ -16203,8 +14818,7 @@ whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
documentation for the major and minor modes of that buffer.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'describe-widget "help-fns" "\
Display a buffer with information about a widget.
You can use this command to describe buttons (e.g., the links in a *Help*
@@ -16218,23 +14832,18 @@ When called from Lisp, POS may be a buffer position or a mouse position list.
Calls each function of the list `describe-widget-functions' in turn, until
one of them returns non-nil.
-\(fn &optional POS)" t nil)
-
+(fn &optional POS)" t nil)
(autoload 'doc-file-to-man "help-fns" "\
Produce an nroff buffer containing the doc-strings from the DOC file.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'doc-file-to-info "help-fns" "\
Produce a texinfo buffer with sorted doc-strings from the DOC file.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(register-definition-prefixes "help-fns" '("describe-" "help-" "keymap-name-history"))
-;;;***
-;;;### (autoloads nil "help-macro" "help-macro.el" (0 0 0 0))
;;; Generated autoloads from help-macro.el
(defvar three-step-help nil "\
@@ -16243,30 +14852,30 @@ The three steps are simple prompt, prompt with all options, and
window listing and describing the options.
A value of nil means skip the middle step, so that \\[help-command] \\[help-command]
gives the window that lists the options.")
-
(custom-autoload 'three-step-help "help-macro" t)
-
(register-definition-prefixes "help-macro" '("make-help-screen"))
-;;;***
-;;;### (autoloads nil "help-mode" "help-mode.el" (0 0 0 0))
;;; Generated autoloads from help-mode.el
+(autoload 'help-mode--add-function-link "help-mode" "\
+
+
+(fn STR FUN)" nil nil)
(autoload 'help-mode "help-mode" "\
Major mode for viewing help text and navigating references in it.
-Entry to this mode runs the normal hook `help-mode-hook'.
+Also see the `help-enable-variable-value-editing' variable.
+
Commands:
\\{help-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'help-mode-setup "help-mode" "\
Enter Help mode in the current buffer." nil nil)
-
+(make-obsolete 'help-mode-setup 'nil "29.1")
(autoload 'help-mode-finish "help-mode" "\
Finalize Help mode setup in current buffer." nil nil)
-
+(make-obsolete 'help-mode-finish 'nil "29.1")
(autoload 'help-setup-xref "help-mode" "\
Invoked from commands using the \"*Help*\" buffer to install some xref info.
@@ -16279,16 +14888,14 @@ This should be called very early, before the output buffer is cleared,
because we want to record the \"previous\" position of point so we can
restore it properly when going back.
-\(fn ITEM INTERACTIVE-P)" nil nil)
-
+(fn ITEM INTERACTIVE-P)" nil nil)
(autoload 'help-buffer "help-mode" "\
Return the name of a buffer for inserting help.
-If `help-xref-following' is non-nil, this is the name of the
-current buffer. Signal an error if this buffer is not derived
-from `help-mode'.
+If `help-xref-following' is non-nil and the current buffer is
+derived from `help-mode', this is the name of the current buffer.
+
Otherwise, return \"*Help*\", creating a buffer with that name if
it does not already exist." nil nil)
-
(autoload 'help-make-xrefs "help-mode" "\
Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -16303,15 +14910,14 @@ preceded by the word `variable' or `option'.
If the variable `help-xref-mule-regexp' is non-nil, find also
cross-reference information related to multilingual environment
-\(e.g., coding-systems). This variable is also used to disambiguate
+(e.g., coding-systems). This variable is also used to disambiguate
the type of reference as the same way as `help-xref-symbol-regexp'.
A special reference `back' is made to return back through a stack of
help buffers. Variable `help-back-label' specifies the text for
that.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'help-xref-button "help-mode" "\
Make a hyperlink for cross-reference text previously matched.
MATCH-NUMBER is the subexpression of interest in the last matched
@@ -16319,55 +14925,45 @@ regexp. TYPE is the type of button to use. Any remaining arguments are
passed to the button's help-function when it is invoked.
See `help-make-xrefs'.
-\(fn MATCH-NUMBER TYPE &rest ARGS)" nil nil)
+This function removes quotes surrounding the match if the
+variable `help-clean-buttons' is non-nil.
+(fn MATCH-NUMBER TYPE &rest ARGS)" nil nil)
(autoload 'help-insert-xref-button "help-mode" "\
Insert STRING and make a hyperlink from cross-reference text on it.
TYPE is the type of button to use. Any remaining arguments are passed
to the button's help-function when it is invoked.
See `help-make-xrefs'.
-\(fn STRING TYPE &rest ARGS)" nil nil)
-
+(fn STRING TYPE &rest ARGS)" nil nil)
(autoload 'help-xref-on-pp "help-mode" "\
Add xrefs for symbols in `pp's output between FROM and TO.
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")
-
(autoload 'help-bookmark-jump "help-mode" "\
Jump to `help-mode' bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
BOOKMARK is a bookmark name or a bookmark record.
-\(fn BOOKMARK)" nil nil)
-
+(fn BOOKMARK)" nil nil)
(register-definition-prefixes "help-mode" '("describe-symbol-backends" "help-"))
-;;;***
-;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/helper.el
(autoload 'Helper-describe-bindings "helper" "\
Describe local key bindings of current mode." t nil)
-
(autoload 'Helper-help "helper" "\
Provide help for current mode." t nil)
-
(register-definition-prefixes "helper" '("Helper-"))
-;;;***
-;;;### (autoloads nil "hex-util" "hex-util.el" (0 0 0 0))
;;; Generated autoloads from hex-util.el
(register-definition-prefixes "hex-util" '("decode-hex-string" "encode-hex-string"))
-;;;***
-;;;### (autoloads nil "hexl" "hexl.el" (0 0 0 0))
;;; Generated autoloads from hexl.el
(autoload 'hexl-mode "hexl" "\
@@ -16452,43 +15048,40 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
\\[describe-bindings] for advanced commands.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'hexl-find-file "hexl" "\
Edit file FILENAME as a binary file in hex dump format.
Switch to a buffer visiting file FILENAME, creating one if none exists,
and edit the file in `hexl-mode'. The buffer's coding-system will be
no-conversion, unlike if you visit it normally and then invoke `hexl-mode'.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'hexlify-buffer "hexl" "\
Convert a binary buffer to hexl format.
This discards the buffer's undo information." t nil)
-
(register-definition-prefixes "hexl" '("dehexlify-buffer" "hexl-"))
-;;;***
-;;;### (autoloads nil "hi-lock" "hi-lock.el" (0 0 0 0))
-;;; Generated autoloads from hi-lock.el
+;;; Generated autoloads from hfy-cmap.el
-(autoload 'hi-lock-mode "hi-lock" "\
-Toggle selective highlighting of patterns (Hi Lock mode).
+(autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\
+Load an X11 style rgb.txt FILE.
+Search `hfy-rgb-load-path' if FILE is not specified.
+Loads the variable `hfy-rgb-txt-color-map', which is used by
+`hfy-fallback-color-values'.
-This is a minor mode. If called interactively, toggle the `Hi-Lock
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+(fn &optional FILE)" t nil)
+(autoload 'hfy-fallback-color-values "hfy-cmap" "\
+Use a fallback method for obtaining the rgb values for a color.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+(fn COLOR-STRING)" nil nil)
+(register-definition-prefixes "hfy-cmap" '("hfy-" "htmlfontify-unload-rgb-file"))
-To check whether the minor mode is enabled in the current buffer,
-evaluate `hi-lock-mode'.
+
+;;; Generated autoloads from hi-lock.el
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+(autoload 'hi-lock-mode "hi-lock" "\
+Toggle selective highlighting of patterns (Hi Lock mode).
Hi Lock mode is automatically enabled when you invoke any of the
highlighting commands listed below, such as \\[highlight-regexp].
@@ -16550,10 +15143,22 @@ position (number of characters into buffer)
Hi-lock: end is found. A mode is excluded if it's in the list
`hi-lock-exclude-modes'.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Hi-Lock mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-(put 'global-hi-lock-mode 'globalized-minor-mode t)
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hi-lock-mode'.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(put 'global-hi-lock-mode 'globalized-minor-mode t)
(defvar global-hi-lock-mode nil "\
Non-nil if Global Hi-Lock mode is enabled.
See the `global-hi-lock-mode' command
@@ -16561,9 +15166,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-hi-lock-mode'.")
-
(custom-autoload 'global-hi-lock-mode "hi-lock" nil)
-
(autoload 'global-hi-lock-mode "hi-lock" "\
Toggle Hi-Lock mode in all buffers.
With prefix ARG, enable Global Hi-Lock mode if ARG is positive;
@@ -16578,10 +15181,8 @@ Hi-Lock mode is enabled in all buffers where
See `hi-lock-mode' for more information on Hi-Lock mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
-
(autoload 'hi-lock-line-face-buffer "hi-lock" "\
Highlight all lines that match REGEXP using FACE.
The lines that match REGEXP will be displayed by merging
@@ -16598,10 +15199,8 @@ Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type.
-\(fn REGEXP &optional FACE)" t nil)
-
+(fn REGEXP &optional FACE)" t nil)
(defalias 'highlight-regexp 'hi-lock-face-buffer)
-
(autoload 'hi-lock-face-buffer "hi-lock" "\
Set face of each match of REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
@@ -16623,10 +15222,8 @@ is considered \"enabled\" in a buffer if its `major-mode'
causes `font-lock-specified-p' to return non-nil, which means
the major mode specifies support for Font Lock.
-\(fn REGEXP &optional FACE SUBEXP LIGHTER)" t nil)
-
+(fn REGEXP &optional FACE SUBEXP LIGHTER)" t nil)
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
-
(autoload 'hi-lock-face-phrase-buffer "hi-lock" "\
Set face of each match of phrase REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
@@ -16643,10 +15240,8 @@ is considered \"enabled\" in a buffer if its `major-mode'
causes `font-lock-specified-p' to return non-nil, which means
the major mode specifies support for Font Lock.
-\(fn REGEXP &optional FACE)" t nil)
-
+(fn REGEXP &optional FACE)" t nil)
(defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point)
-
(autoload 'hi-lock-face-symbol-at-point "hi-lock" "\
Highlight each instance of the symbol at point.
Uses the next face from `hi-lock-face-defaults' without prompting,
@@ -16661,9 +15256,7 @@ in which case the highlighting will not update as you type. The Font
Lock mode is considered \"enabled\" in a buffer if its `major-mode'
causes `font-lock-specified-p' to return non-nil, which means
the major mode specifies support for Font Lock." t nil)
-
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
-
(autoload 'hi-lock-unface-buffer "hi-lock" "\
Remove highlighting of each match to REGEXP set by hi-lock.
Interactively, prompt for REGEXP, accepting only regexps
@@ -16671,42 +15264,27 @@ previously inserted by hi-lock interactive functions.
If REGEXP is t (or if \\[universal-argument] was specified interactively),
then remove all hi-lock highlighting.
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(autoload 'hi-lock-write-interactive-patterns "hi-lock" "\
Write interactively added patterns, if any, into buffer at point.
Interactively added patterns are those normally specified using
`highlight-regexp' and `highlight-lines-matching-regexp'; they can
be found in variable `hi-lock-interactive-patterns'." t nil)
-
(autoload 'hi-lock-find-patterns "hi-lock" "\
Add patterns from the current buffer to the list of hi-lock patterns." t nil)
+(autoload 'hi-lock-context-menu "hi-lock" "\
+Populate MENU with a menu item to highlight symbol at CLICK.
-(register-definition-prefixes "hi-lock" '("hi-lock-" "turn-on-hi-lock-if-enabled"))
+(fn MENU CLICK)" nil nil)
+(register-definition-prefixes "hi-lock" '("hi-lock-" "highlight-symbol-at-mouse" "turn-on-hi-lock-if-enabled"))
-;;;***
-;;;### (autoloads nil "hideif" "progmodes/hideif.el" (0 0 0 0))
;;; Generated autoloads from progmodes/hideif.el
(autoload 'hide-ifdef-mode "hideif" "\
Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode).
-This is a minor mode. If called interactively, toggle the `Hide-Ifdef
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `hide-ifdef-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Hide-Ifdef mode is a buffer-local minor mode for use with C and
C-like major modes. When enabled, code within #ifdef constructs
that the C preprocessor would eliminate may be hidden from view.
@@ -16741,13 +15319,24 @@ Several variables affect how the hiding is done:
\\{hide-ifdef-mode-map}
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Hide-Ifdef mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hide-ifdef-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef"))
-;;;***
-;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (0 0 0 0))
;;; Generated autoloads from progmodes/hideshow.el
(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
@@ -16777,24 +15366,9 @@ use of ADJUST-BEG-FUNC.
If any of the elements is left nil or omitted, hideshow tries to guess
appropriate values. The regexps should not contain leading or trailing
whitespace. Case does not matter.")
-
(autoload 'hs-minor-mode "hideshow" "\
Minor mode to selectively hide/show code and comment blocks.
-This is a minor mode. If called interactively, toggle the `hs minor
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `hs-minor-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When hideshow minor mode is on, the menu bar is augmented with hideshow
commands and the hideshow commands are enabled.
The value (hs . t) is added to `buffer-invisibility-spec'.
@@ -16811,43 +15385,36 @@ Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'.
Key bindings:
\\{hs-minor-mode-map}
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the `hs
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hs-minor-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'turn-off-hideshow "hideshow" "\
Unconditionally turn off `hs-minor-mode'." nil nil)
-
(register-definition-prefixes "hideshow" '("hs-"))
-;;;***
-;;;### (autoloads nil "hierarchy" "emacs-lisp/hierarchy.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/hierarchy.el
(register-definition-prefixes "hierarchy" '("hierarchy-"))
-;;;***
-;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (0 0 0 0))
;;; Generated autoloads from hilit-chg.el
(autoload 'highlight-changes-mode "hilit-chg" "\
Toggle highlighting changes in this buffer (Highlight Changes mode).
-This is a minor mode. If called interactively, toggle the
-`Highlight-Changes mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `highlight-changes-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When Highlight Changes is enabled, changes are marked with a text
property. Normally they are displayed in a distinctive face, but
command \\[highlight-changes-visible-mode] can be used to toggle
@@ -16863,25 +15430,24 @@ through various faces.
buffer with the contents of a file
\\[highlight-compare-buffers] highlights differences between two buffers.
-\(fn &optional ARG)" t nil)
-
-(autoload 'highlight-changes-visible-mode "hilit-chg" "\
-Toggle visibility of highlighting due to Highlight Changes mode.
-
This is a minor mode. If called interactively, toggle the
-`Highlight-Changes-Visible mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
+`Highlight-Changes mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
-evaluate `highlight-changes-visible-mode'.
+evaluate `highlight-changes-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(autoload 'highlight-changes-visible-mode "hilit-chg" "\
+Toggle visibility of highlighting due to Highlight Changes mode.
Highlight Changes Visible mode only has an effect when Highlight
Changes mode is on. When enabled, the changed text is displayed
@@ -16892,22 +15458,33 @@ The default value can be customized with variable
This command does not itself set Highlight Changes mode.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Highlight-Changes-Visible mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `highlight-changes-visible-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'highlight-changes-remove-highlight "hilit-chg" "\
Remove the change face from the region between BEG and END.
This allows you to manually remove highlighting from uninteresting changes.
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'highlight-changes-next-change "hilit-chg" "\
Move to the beginning of the next change, if in Highlight Changes mode." t nil)
-
(autoload 'highlight-changes-previous-change "hilit-chg" "\
Move to the beginning of the previous change, if in Highlight Changes mode." t nil)
-
(autoload 'highlight-changes-rotate-faces "hilit-chg" "\
-Rotate the faces if in Highlight Changes mode and the changes are visible.
+\"Age\" changes if in Highlight Changes mode and the changes are visible.
Current changes are displayed in the face described by the first element
of `highlight-changes-face-list', one level older changes are shown in
@@ -16919,7 +15496,6 @@ this function to `write-file-functions' as a buffer-local value. To do
this, eval the following in the buffer to be saved:
(add-hook \\='write-file-functions \\='highlight-changes-rotate-faces nil t)" t nil)
-
(autoload 'highlight-compare-buffers "hilit-chg" "\
Compare two buffers and highlight the differences.
@@ -16935,8 +15511,7 @@ If a buffer is read-only, differences will be highlighted but no property
changes are made, so \\[highlight-changes-next-change] and
\\[highlight-changes-previous-change] will not work.
-\(fn BUF-A BUF-B)" t nil)
-
+(fn BUF-A BUF-B)" t nil)
(autoload 'highlight-compare-with-file "hilit-chg" "\
Compare this buffer with a file, and highlight differences.
@@ -16951,10 +15526,8 @@ If the buffer is read-only, differences will be highlighted but no property
changes are made, so \\[highlight-changes-next-change] and
\\[highlight-changes-previous-change] will not work.
-\(fn FILE-B)" t nil)
-
+(fn FILE-B)" t nil)
(put 'global-highlight-changes-mode 'globalized-minor-mode t)
-
(defvar global-highlight-changes-mode nil "\
Non-nil if Global Highlight-Changes mode is enabled.
See the `global-highlight-changes-mode' command
@@ -16962,9 +15535,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-highlight-changes-mode'.")
-
(custom-autoload 'global-highlight-changes-mode "hilit-chg" nil)
-
(autoload 'global-highlight-changes-mode "hilit-chg" "\
Toggle Highlight-Changes mode in all buffers.
With prefix ARG, enable Global Highlight-Changes mode if ARG is
@@ -16980,22 +15551,17 @@ Highlight-Changes mode is enabled in all buffers where
See `highlight-changes-mode' for more information on Highlight-Changes
mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "hilit-chg" '("highlight-" "hilit-chg-"))
-;;;***
-;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (0 0 0 0))
;;; Generated autoloads from hippie-exp.el
(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\
The list of expansion functions tried in order by `hippie-expand'.
To change the behavior of `hippie-expand', remove, change the order of,
or insert functions in this list.")
-
(custom-autoload 'hippie-expand-try-functions-list "hippie-exp" t)
-
(autoload 'hippie-expand "hippie-exp" "\
Try to expand text before point, using multiple methods.
The expansion functions in `hippie-expand-try-functions-list' are
@@ -17006,39 +15572,21 @@ With a positive numeric argument, jumps directly to the ARG next
function in this list. With a negative argument or just \\[universal-argument],
undoes the expansion.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'make-hippie-expand-function "hippie-exp" "\
Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose.
-\(fn TRY-LIST &optional VERBOSE)" nil nil)
-
+(fn TRY-LIST &optional VERBOSE)" nil nil)
(register-definition-prefixes "hippie-exp" '("he-" "hippie-expand-" "try-"))
-;;;***
-;;;### (autoloads nil "hl-line" "hl-line.el" (0 0 0 0))
;;; Generated autoloads from hl-line.el
(autoload 'hl-line-mode "hl-line" "\
Toggle highlighting of the current line (Hl-Line mode).
-This is a minor mode. If called interactively, toggle the `Hl-Line
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `hl-line-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Hl-Line mode is a buffer-local minor mode. If
`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the
line about the buffer's point in all windows. Caveat: the
@@ -17049,8 +15597,21 @@ non-selected window. Hl-Line mode uses the function
When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
line about point in the selected window only.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Hl-Line mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hl-line-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(defvar global-hl-line-mode nil "\
Non-nil if Global Hl-Line mode is enabled.
See the `global-hl-line-mode' command
@@ -17058,26 +15619,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-hl-line-mode'.")
-
(custom-autoload 'global-hl-line-mode "hl-line" nil)
-
(autoload 'global-hl-line-mode "hl-line" "\
Toggle line highlighting in all buffers (Global Hl-Line mode).
-This is a minor mode. If called interactively, toggle the `Global
-Hl-Line mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='global-hl-line-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode
highlights the line about the current buffer's point in all live
windows.
@@ -17085,110 +15630,88 @@ windows.
Global-Hl-Line mode uses the function `global-hl-line-highlight'
on `post-command-hook'.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Global Hl-Line mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='global-hl-line-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-"))
-;;;***
-;;;### (autoloads nil "hmac-def" "net/hmac-def.el" (0 0 0 0))
;;; Generated autoloads from net/hmac-def.el
(register-definition-prefixes "hmac-def" '("define-hmac-function"))
-;;;***
-;;;### (autoloads nil "hmac-md5" "net/hmac-md5.el" (0 0 0 0))
;;; Generated autoloads from net/hmac-md5.el
(register-definition-prefixes "hmac-md5" '("hmac-md5" "md5-binary"))
-;;;***
-;;;### (autoloads nil "holidays" "calendar/holidays.el" (0 0 0 0))
;;; Generated autoloads from calendar/holidays.el
(defvar holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fools' Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\
General holidays. Default value is for the United States.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-general-holidays "holidays" t)
-
(put 'holiday-general-holidays 'risky-local-variable t)
-
(defvar holiday-oriental-holidays (mapcar 'purecopy '((holiday-chinese-new-year) (if calendar-chinese-all-holidays-flag (append (holiday-chinese 1 15 "Lantern Festival") (holiday-chinese-qingming) (holiday-chinese 5 5 "Dragon Boat Festival") (holiday-chinese 7 7 "Double Seventh Festival") (holiday-chinese 8 15 "Mid-Autumn Festival") (holiday-chinese 9 9 "Double Ninth Festival") (holiday-chinese-winter-solstice))))) "\
Oriental holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-oriental-holidays "holidays" t)
-
(put 'holiday-oriental-holidays 'risky-local-variable t)
-
(defvar holiday-local-holidays nil "\
Local holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-local-holidays "holidays" t)
-
(put 'holiday-local-holidays 'risky-local-variable t)
-
(defvar holiday-other-holidays nil "\
User defined holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-other-holidays "holidays" t)
-
(put 'holiday-other-holidays 'risky-local-variable t)
-
(defvar holiday-hebrew-holidays (mapcar 'purecopy '((holiday-hebrew-passover) (holiday-hebrew-rosh-hashanah) (holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (append (holiday-hebrew-tisha-b-av) (holiday-hebrew-misc))))) "\
Jewish holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-hebrew-holidays "holidays" t)
-
(put 'holiday-hebrew-holidays 'risky-local-variable t)
-
(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\
Christian holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-christian-holidays "holidays" t)
-
(put 'holiday-christian-holidays 'risky-local-variable t)
-
(defvar holiday-islamic-holidays (mapcar 'purecopy '((holiday-islamic-new-year) (holiday-islamic 9 1 "Ramadan Begins") (if calendar-islamic-all-holidays-flag (append (holiday-islamic 1 10 "Ashura") (holiday-islamic 3 12 "Mulad-al-Nabi") (holiday-islamic 7 26 "Shab-e-Mi'raj") (holiday-islamic 8 15 "Shab-e-Bara't") (holiday-islamic 9 27 "Shab-e Qadr") (holiday-islamic 10 1 "Id-al-Fitr") (holiday-islamic 12 10 "Id-al-Adha"))))) "\
Islamic holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-islamic-holidays "holidays" t)
-
(put 'holiday-islamic-holidays 'risky-local-variable t)
-
(defvar holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Báb") (holiday-fixed 5 29 "Ascension of Bahá’u’lláh") (holiday-fixed 7 9 "Martyrdom of the Báb") (holiday-fixed 10 20 "Birth of the Báb") (holiday-fixed 11 12 "Birth of Bahá’u’lláh") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá"))))) "\
Bahá’í holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-bahai-holidays "holidays" t)
-
(put 'holiday-bahai-holidays 'risky-local-variable t)
-
(defvar holiday-solar-holidays (mapcar 'purecopy '((solar-equinoxes-solstices) (holiday-sexp calendar-daylight-savings-starts (format "Daylight Saving Time Begins %s" (solar-time-string (/ calendar-daylight-savings-starts-time (float 60)) calendar-standard-time-zone-name))) (holiday-sexp calendar-daylight-savings-ends (format "Daylight Saving Time Ends %s" (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) calendar-daylight-time-zone-name))))) "\
Sun-related holidays.
See the documentation for `calendar-holidays' for details.")
-
(custom-autoload 'holiday-solar-holidays "holidays" t)
-
(put 'holiday-solar-holidays 'risky-local-variable t)
-
(put 'calendar-holidays 'risky-local-variable t)
-
(autoload 'holidays "holidays" "\
Display the holidays for last month, this month, and next month.
If called with an optional prefix argument ARG, prompts for month and year.
This function is suitable for execution in an init file.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'list-holidays "holidays" "\
Display holidays for years Y1 to Y2 (inclusive).
Y2 defaults to Y1. The optional list of holidays L defaults to
@@ -17209,18 +15732,24 @@ of a holiday list.
The optional LABEL is used to label the buffer created.
-\(fn Y1 &optional Y2 L LABEL)" t nil)
+The list of holiday lists is computed by the
+`holiday-available-holiday-lists' and you can alter the results
+by redefining that function, or use `add-function' to add
+values.
+(fn Y1 &optional Y2 L LABEL)" t nil)
(defalias 'holiday-list 'list-holidays)
-
(register-definition-prefixes "holidays" '("calendar-" "holiday-"))
-;;;***
-;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/html.el
+
+(register-definition-prefixes "semantic/html" '("semantic-"))
+
+
;;; Generated autoloads from htmlfontify.el
-(push (purecopy '(htmlfontify 0 21)) package--builtin-versions)
+(push (purecopy '(htmlfontify 0 21)) package--builtin-versions)
(autoload 'htmlfontify-buffer "htmlfontify" "\
Create a new buffer, named for the current buffer + a .html extension,
containing an inline CSS-stylesheet and formatted CSS-markup HTML
@@ -17239,21 +15768,32 @@ If the SRCDIR and FILE arguments are set, lookup etags derived
entries in the `hfy-tags-cache' and add HTML anchors and
hyperlinks as appropriate.
-\(fn &optional SRCDIR FILE)" t nil)
-
+(fn &optional SRCDIR FILE)" t nil)
(autoload 'htmlfontify-copy-and-link-dir "htmlfontify" "\
Trawl SRCDIR and write fontified-and-hyperlinked output in DSTDIR.
F-EXT and L-EXT specify values for `hfy-extn' and `hfy-link-extn'.
You may also want to set `hfy-page-header' and `hfy-page-footer'.
-\(fn SRCDIR DSTDIR &optional F-EXT L-EXT)" t nil)
-
+(fn SRCDIR DSTDIR &optional F-EXT L-EXT)" t nil)
(register-definition-prefixes "htmlfontify" '("hfy-" "htmlfontify-"))
-;;;***
-;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/ia.el
+
+(register-definition-prefixes "semantic/ia" '("semantic-ia-"))
+
+
+;;; Generated autoloads from cedet/semantic/ia-sb.el
+
+(register-definition-prefixes "semantic/ia-sb" '("semantic-ia-s"))
+
+
+;;; Generated autoloads from ibuf-ext.el
+
+(register-definition-prefixes "ibuf-ext" '("ibuffer-"))
+
+
;;; Generated autoloads from ibuf-macs.el
(autoload 'define-ibuffer-column "ibuf-macs" "\
@@ -17279,10 +15819,7 @@ inlined into the compiled format versions. This means that if you
change its definition, you should explicitly call
`ibuffer-recompile-formats'.
-\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-column 'lisp-indent-function 'defun)
-
+(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-sorter "ibuf-macs" "\
Define a method of sorting named NAME.
DOCUMENTATION is the documentation of the function, which will be called
@@ -17293,12 +15830,7 @@ For sorting, the forms in BODY will be evaluated with `a' bound to one
buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
-\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-sorter 'lisp-indent-function '1)
-
-(function-put 'define-ibuffer-sorter 'doc-string-elt '2)
-
+(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-op "ibuf-macs" "\
Generate a function which operates on a buffer.
OP becomes the name of the function; if it doesn't begin with
@@ -17337,12 +15869,7 @@ BODY define the operation; they are forms to evaluate per each
marked buffer. BODY is evaluated with `buf' bound to the
buffer object.
-\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-op 'lisp-indent-function '2)
-
-(function-put 'define-ibuffer-op 'doc-string-elt '3)
-
+(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-filter "ibuf-macs" "\
Define a filter named NAME.
DOCUMENTATION is the documentation of the function.
@@ -17357,17 +15884,10 @@ not a particular buffer should be displayed or not. The forms in BODY
will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
-\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-filter 'lisp-indent-function '2)
-
-(function-put 'define-ibuffer-filter 'doc-string-elt '2)
-
+(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil 'macro)
(register-definition-prefixes "ibuf-macs" '("ibuffer-"))
-;;;***
-;;;### (autoloads nil "ibuffer" "ibuffer.el" (0 0 0 0))
;;; Generated autoloads from ibuffer.el
(autoload 'ibuffer-list-buffers "ibuffer" "\
@@ -17375,15 +15895,13 @@ Display a list of buffers, in another window.
If optional argument FILES-ONLY is non-nil, then add a filter for
buffers which are visiting a file.
-\(fn &optional FILES-ONLY)" t nil)
-
+(fn &optional FILES-ONLY)" t nil)
(autoload 'ibuffer-other-window "ibuffer" "\
Like `ibuffer', but displayed in another window by default.
If optional argument FILES-ONLY is non-nil, then add a filter for
buffers which are visiting a file.
-\(fn &optional FILES-ONLY)" t nil)
-
+(fn &optional FILES-ONLY)" t nil)
(autoload 'ibuffer "ibuffer" "\
Begin using Ibuffer to edit a list of buffers.
Type \\<ibuffer-mode-map>\\[describe-mode] after entering ibuffer for more information.
@@ -17402,20 +15920,15 @@ FORMATS is the value to use for `ibuffer-formats'.
If specified, then the variable `ibuffer-formats' will have
that value locally in this buffer.
-\(fn &optional OTHER-WINDOW-P NAME QUALIFIERS NOSELECT SHRINK FILTER-GROUPS FORMATS)" t nil)
-
+(fn &optional OTHER-WINDOW-P NAME QUALIFIERS NOSELECT SHRINK FILTER-GROUPS FORMATS)" t nil)
(autoload 'ibuffer-jump "ibuffer" "\
Call Ibuffer and set point at the line listing the current buffer.
If optional arg OTHER-WINDOW is non-nil, then use another window.
-\(fn &optional OTHER-WINDOW)" t nil)
-
+(fn &optional OTHER-WINDOW)" t nil)
(register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked" "mark" "mod" "name" "process" "read-only" "recency" "size"))
-;;;***
-;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/icalendar.el
(autoload 'icalendar-export-file "icalendar" "\
@@ -17423,8 +15936,7 @@ Export diary file to iCalendar format.
All diary entries in the file DIARY-FILENAME are converted to iCalendar
format. The result is appended to the file ICAL-FILENAME.
-\(fn DIARY-FILENAME ICAL-FILENAME)" t nil)
-
+(fn DIARY-FILENAME ICAL-FILENAME)" t nil)
(autoload 'icalendar-export-region "icalendar" "\
Export region in diary file to iCalendar format.
All diary entries in the region from MIN to MAX in the current buffer are
@@ -17434,8 +15946,7 @@ This function attempts to return t if something goes wrong. In this
case an error string which describes all the errors and problems is
written into the buffer `*icalendar-errors*'.
-\(fn MIN MAX ICAL-FILENAME)" t nil)
-
+(fn MIN MAX ICAL-FILENAME)" t nil)
(autoload 'icalendar-import-file "icalendar" "\
Import an iCalendar file and append to a diary file.
Argument ICAL-FILENAME output iCalendar file.
@@ -17443,8 +15954,7 @@ Argument DIARY-FILENAME input `diary-file'.
Optional argument NON-MARKING determines whether events are created as
non-marking or not.
-\(fn ICAL-FILENAME DIARY-FILENAME &optional NON-MARKING)" t nil)
-
+(fn ICAL-FILENAME DIARY-FILENAME &optional NON-MARKING)" t nil)
(autoload 'icalendar-import-buffer "icalendar" "\
Extract iCalendar events from current buffer.
@@ -17463,13 +15973,10 @@ Return code t means that importing worked well, return code nil
means that an error has occurred. Error messages will be in the
buffer `*icalendar-errors*'.
-\(fn &optional DIARY-FILENAME DO-NOT-ASK NON-MARKING)" t nil)
-
+(fn &optional DIARY-FILENAME DO-NOT-ASK NON-MARKING)" t nil)
(register-definition-prefixes "icalendar" '("icalendar-"))
-;;;***
-;;;### (autoloads nil "icomplete" "icomplete.el" (0 0 0 0))
;;; Generated autoloads from icomplete.el
(defvar fido-mode nil "\
@@ -17479,31 +15986,28 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `fido-mode'.")
-
(custom-autoload 'fido-mode "icomplete" nil)
-
(autoload 'fido-mode "icomplete" "\
An enhanced `icomplete-mode' that emulates `ido-mode'.
-This is a minor mode. If called interactively, toggle the `Fido mode'
-mode. If the prefix argument is positive, enable the mode, and if it
-is zero or negative, disable the mode.
+This global minor mode makes minibuffer completion behave
+more like `ido-mode' than regular `icomplete-mode'.
+
+This is a global minor mode. If called interactively, toggle the
+`Fido mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='fido-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-This global minor mode makes minibuffer completion behave
-more like `ido-mode' than regular `icomplete-mode'.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(defvar icomplete-mode nil "\
Non-nil if Icomplete mode is enabled.
See the `icomplete-mode' command
@@ -17511,26 +16015,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `icomplete-mode'.")
-
(custom-autoload 'icomplete-mode "icomplete" nil)
-
(autoload 'icomplete-mode "icomplete" "\
Toggle incremental minibuffer completion (Icomplete mode).
-This is a minor mode. If called interactively, toggle the `Icomplete
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='icomplete-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When this global minor mode is enabled, typing in the minibuffer
continuously displays a list of possible completions that match
the string you have typed. See `icomplete-completions' for a
@@ -17544,8 +16032,21 @@ completions:
\\{icomplete-minibuffer-map}
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Icomplete mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='icomplete-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(defvar icomplete-vertical-mode nil "\
Non-nil if Icomplete-Vertical mode is enabled.
See the `icomplete-vertical-mode' command
@@ -17553,34 +16054,32 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `icomplete-vertical-mode'.")
-
(custom-autoload 'icomplete-vertical-mode "icomplete" nil)
-
(autoload 'icomplete-vertical-mode "icomplete" "\
Toggle vertical candidate display in `icomplete-mode' or `fido-mode'.
-This is a minor mode. If called interactively, toggle the
-`Icomplete-Vertical mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='icomplete-vertical-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
If none of these modes are on, turn on `icomplete-mode'.
As many completion candidates as possible are displayed, depending on
the value of `max-mini-window-height', and the way the mini-window is
resized depends on `resize-mini-windows'.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Icomplete-Vertical mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='icomplete-vertical-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(defvar fido-vertical-mode nil "\
Non-nil if Fido-Vertical mode is enabled.
See the `fido-vertical-mode' command
@@ -17588,39 +16087,35 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `fido-vertical-mode'.")
-
(custom-autoload 'fido-vertical-mode "icomplete" nil)
-
(autoload 'fido-vertical-mode "icomplete" "\
Toggle vertical candidate display in `fido-mode'.
+
When turning on, if non-vertical `fido-mode' is off, turn it on.
If it's on, just add the vertical display.
-This is a minor mode. If called interactively, toggle the
-`Fido-Vertical mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Fido-Vertical mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='fido-vertical-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-\(fn &optional ARG)" t nil)
+(fn &optional ARG)" t nil)
(when (locate-library "obsolete/iswitchb")
(autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t)
(make-obsolete 'iswitchb-mode
"use `icomplete-mode' or `ido-mode' instead." "24.4"))
-
(register-definition-prefixes "icomplete" '("icomplete-"))
-;;;***
-;;;### (autoloads nil "icon" "progmodes/icon.el" (0 0 0 0))
;;; Generated autoloads from progmodes/icon.el
(autoload 'icon-mode "icon" "\
@@ -17656,30 +16151,25 @@ Variables controlling indentation style:
Turning on Icon mode calls the value of the variable `icon-mode-hook'
with no args, if that value is non-nil.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "icon" '("beginning-of-icon-defun" "calculate-icon-indent" "electric-icon-brace" "end-of-icon-defun" "icon-" "indent-icon-exp" "mark-icon-function"))
-;;;***
-;;;### (autoloads nil "idlw-complete-structtag" "progmodes/idlw-complete-structtag.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/idle.el
+
+(register-definition-prefixes "semantic/idle" '("define-semantic-idle-service" "global-semantic-idle-summary-mode" "semantic-"))
+
+
;;; Generated autoloads from progmodes/idlw-complete-structtag.el
(register-definition-prefixes "idlw-complete-structtag" '("idlwave-"))
-;;;***
-;;;### (autoloads nil "idlw-help" "progmodes/idlw-help.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/idlw-help.el
(register-definition-prefixes "idlw-help" '("idlwave-"))
-;;;***
-;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from progmodes/idlw-shell.el
(autoload 'idlwave-shell "idlw-shell" "\
@@ -17698,26 +16188,20 @@ The buffer is put in `idlwave-shell-mode', providing commands for sending
input and controlling the IDL job. See help on `idlwave-shell-mode'.
See also the variable `idlwave-shell-prompt-pattern'.
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)
-
-\(fn &optional ARG)" t nil)
+(Type \\[describe-mode] in the shell buffer for a list of commands.)
+(fn &optional ARG)" t nil)
(register-definition-prefixes "idlw-shell" '("idlwave-"))
-;;;***
-;;;### (autoloads nil "idlw-toolbar" "progmodes/idlw-toolbar.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/idlw-toolbar.el
-(register-definition-prefixes "idlw-toolbar" '("idlwave-toolbar-"))
+(register-definition-prefixes "idlw-toolbar" '("idlwave-toolbar"))
-;;;***
-;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (0 0 0 0))
;;; Generated autoloads from progmodes/idlwave.el
-(push (purecopy '(idlwave 6 1 22)) package--builtin-versions)
+(push (purecopy '(idlwave 6 1 22)) package--builtin-versions)
(autoload 'idlwave-mode "idlwave" "\
Major mode for editing IDL source files (version 6.1_em22).
@@ -17838,13 +16322,10 @@ The main features of this mode are
\\{idlwave-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "idlwave" '("idlwave-"))
-;;;***
-;;;### (autoloads nil "ido" "ido.el" (0 0 0 0))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
@@ -17858,9 +16339,7 @@ The following values are possible:
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'.")
-
(custom-autoload 'ido-mode "ido" nil)
-
(autoload 'ido-mode "ido" "\
Toggle Ido mode on or off.
With ARG, turn Ido mode on if arg is positive, off otherwise.
@@ -17871,8 +16350,7 @@ However, if ARG arg equals `files', remap only commands for files, or
if it equals `buffers', remap only commands for buffer switching.
This function also adds a hook to the minibuffer.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'ido-switch-buffer "ido" "\
Switch to another buffer.
The buffer is displayed according to `ido-default-buffer-method' -- the
@@ -17905,12 +16383,10 @@ RET Select the buffer at the front of the list of matches.
\\[ido-enter-find-file] Drop into `ido-find-file'.
\\[ido-kill-buffer-at-head] Kill buffer at head of buffer list.
\\[ido-toggle-ignore] Toggle ignoring buffers listed in `ido-ignore-buffers'." t nil)
-
(autoload 'ido-switch-buffer-other-window "ido" "\
Switch to another buffer and show it in another window.
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'." t nil)
-
(autoload 'ido-display-buffer "ido" "\
Display a buffer in another window but don't select it.
@@ -17921,33 +16397,27 @@ window.
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'.
-\(fn &optional ACTION)" t nil)
-
+(fn &optional ACTION)" t nil)
(autoload 'ido-display-buffer-other-frame "ido" "\
Display a buffer preferably in another frame.
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'." t nil)
-
(autoload 'ido-kill-buffer "ido" "\
Kill a buffer.
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'." t nil)
-
(autoload 'ido-insert-buffer "ido" "\
Insert contents of a buffer in current buffer after point.
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'." t nil)
-
(autoload 'ido-switch-buffer-other-frame "ido" "\
Switch to another buffer and show it in another frame.
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'." t nil)
-
(autoload 'ido-find-file-in-dir "ido" "\
Switch to another file starting from DIR.
-\(fn DIR)" t nil)
-
+(fn DIR)" t nil)
(autoload 'ido-find-file "ido" "\
Edit file with name obtained via minibuffer.
The file is displayed according to `ido-default-file-method' -- the
@@ -17991,72 +16461,58 @@ RET Select the file at the front of the list of matches.
\\[ido-completion-help] Show list of matching files in separate window.
\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
\\[ido-reread-directory] Reread the current directory." t nil)
-
(autoload 'ido-find-file-other-window "ido" "\
Switch to another file and show it in another window.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-find-alternate-file "ido" "\
Find another file, select its buffer, kill previous buffer.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-find-alternate-file-other-window "ido" "\
Find file as a replacement for the file in the next window.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-find-file-read-only "ido" "\
Edit file read-only with name obtained via minibuffer.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-find-file-read-only-other-window "ido" "\
Edit file read-only in other window with name obtained via minibuffer.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-find-file-read-only-other-frame "ido" "\
Edit file read-only in other frame with name obtained via minibuffer.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-display-file "ido" "\
Display a file in another window but don't select it.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-find-file-other-frame "ido" "\
Switch to another file and show it in another frame.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-write-file "ido" "\
Write current buffer to a file.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-insert-file "ido" "\
Insert contents of file in current buffer.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-dired "ido" "\
Call `dired' the Ido way.
The directory is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-dired-other-window "ido" "\
\"Edit\" a directory. Like `ido-dired' but select in another window.
The directory is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-dired-other-frame "ido" "\
\"Edit\" a directory. Like `ido-dired' but make a new frame.
The directory is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'." t nil)
-
(autoload 'ido-read-buffer "ido" "\
Ido replacement for the built-in `read-buffer'.
Return the name of a buffer selected.
@@ -18066,22 +16522,19 @@ If REQUIRE-MATCH is non-nil, an existing buffer must be selected.
Optional arg PREDICATE if non-nil is a function limiting the
buffers that can be considered.
-\(fn PROMPT &optional DEFAULT REQUIRE-MATCH PREDICATE)" nil nil)
-
+(fn PROMPT &optional DEFAULT REQUIRE-MATCH PREDICATE)" nil nil)
(autoload 'ido-read-file-name "ido" "\
Ido replacement for the built-in `read-file-name'.
Read file name, prompting with PROMPT and completing in directory DIR.
See `read-file-name' for additional parameters.
-\(fn PROMPT &optional DIR DEFAULT-FILENAME MUSTMATCH INITIAL PREDICATE)" nil nil)
-
+(fn PROMPT &optional DIR DEFAULT-FILENAME MUSTMATCH INITIAL PREDICATE)" nil nil)
(autoload 'ido-read-directory-name "ido" "\
Ido replacement for the built-in `read-directory-name'.
Read directory name, prompting with PROMPT and completing in directory DIR.
See `read-directory-name' for additional parameters.
-\(fn PROMPT &optional DIR DEFAULT-DIRNAME MUSTMATCH INITIAL)" nil nil)
-
+(fn PROMPT &optional DIR DEFAULT-DIRNAME MUSTMATCH INITIAL)" nil nil)
(autoload 'ido-completing-read "ido" "\
Ido replacement for the built-in `completing-read'.
Read a string in the minibuffer with Ido-style completion.
@@ -18098,13 +16551,15 @@ If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
HIST, if non-nil, specifies a history list.
DEF, if non-nil, is the default value.
-\(fn PROMPT CHOICES &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
-
+(fn PROMPT CHOICES &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
(register-definition-prefixes "ido" '("ido-"))
-;;;***
-;;;### (autoloads nil "ielm" "ielm.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/symref/idutils.el
+
+(register-definition-prefixes "semantic/symref/idutils" '("semantic-symref-idutils--line-re"))
+
+
;;; Generated autoloads from ielm.el
(autoload 'ielm "ielm" "\
@@ -18113,50 +16568,44 @@ Switches to the buffer named BUF-NAME if provided (`*ielm*' by default),
or creates it if it does not exist.
See `inferior-emacs-lisp-mode' for details.
-\(fn &optional BUF-NAME)" t nil)
-
+(fn &optional BUF-NAME)" t nil)
(register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode"))
-;;;***
-;;;### (autoloads nil "ietf-drums" "mail/ietf-drums.el" (0 0 0 0))
;;; Generated autoloads from mail/ietf-drums.el
(register-definition-prefixes "ietf-drums" '("ietf-drums-"))
-;;;***
-;;;### (autoloads nil "iimage" "iimage.el" (0 0 0 0))
+;;; Generated autoloads from mail/ietf-drums-date.el
+
+(register-definition-prefixes "ietf-drums-date" '("date-parse-error" "ietf-drums-"))
+
+
;;; Generated autoloads from iimage.el
(define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1")
-
(autoload 'iimage-mode "iimage" "\
Toggle Iimage mode on or off.
-This is a minor mode. If called interactively, toggle the `Iimage
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Iimage mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `iimage-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\\{iimage-mode-map}
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode"))
-;;;***
-;;;### (autoloads nil "image" "image.el" (0 0 0 0))
;;; Generated autoloads from image.el
(autoload 'image-type-from-data "image" "\
@@ -18164,27 +16613,24 @@ Determine the image type from image data DATA.
Value is a symbol specifying the image type or nil if type cannot
be determined.
-\(fn DATA)" nil nil)
-
+(fn DATA)" nil nil)
(autoload 'image-type-from-buffer "image" "\
Determine the image type from data in the current buffer.
Value is a symbol specifying the image type or nil if type cannot
be determined." nil nil)
-
(autoload 'image-type-from-file-header "image" "\
Determine the type of image file FILE from its first few bytes.
Value is a symbol specifying the image type, or nil if type cannot
be determined.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'image-type-from-file-name "image" "\
Determine the type of image file FILE from its name.
Value is a symbol specifying the image type, or nil if type cannot
be determined.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
+(make-obsolete 'image-type-from-file-name 'image-supported-file-p "29.1")
(autoload 'image-type "image" "\
Determine and return image type.
SOURCE is an image file name or image data.
@@ -18198,14 +16644,12 @@ data. If DATA-P is a symbol with a name on the format
`image/jpeg', that may be used as a hint to determine the image
type if we can't otherwise guess it.
-\(fn SOURCE &optional TYPE DATA-P)" nil nil)
-
+(fn SOURCE &optional TYPE DATA-P)" nil nil)
(autoload 'image-type-available-p "image" "\
Return t if image type TYPE is available.
Image types are symbols like `xbm' or `jpeg'.
-\(fn TYPE)" nil nil)
-
+(fn TYPE)" nil nil)
(autoload 'image-type-auto-detected-p "image" "\
Return t if the current buffer contains an auto-detectable image.
This function is intended to be used from `magic-fallback-mode-alist'.
@@ -18215,7 +16659,6 @@ its beginning matches an image type in `image-type-header-regexps',
and that image type is present in `image-type-auto-detectable' with a
non-nil value. If that value is non-nil, but not t, then the image type
must be available." nil nil)
-
(autoload 'create-image "image" "\
Create an image.
FILE-OR-DATA is an image file name or image data.
@@ -18241,8 +16684,7 @@ Image file names that are not absolute are searched for in the
\"images\" sub-directory of `data-directory' and
`x-bitmap-file-path' (in that order).
-\(fn FILE-OR-DATA &optional TYPE DATA-P &rest PROPS)" nil nil)
-
+(fn FILE-OR-DATA &optional TYPE DATA-P &rest PROPS)" nil nil)
(autoload 'put-image "image" "\
Put image IMAGE in front of POS in the current buffer.
IMAGE must be an image created with `create-image' or `defimage'.
@@ -18256,8 +16698,7 @@ display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
means display it in the right marginal area.
-\(fn IMAGE POS &optional STRING AREA)" nil nil)
-
+(fn IMAGE POS &optional STRING AREA)" nil nil)
(autoload 'insert-image "image" "\
Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
@@ -18277,8 +16718,11 @@ specifying the X and Y positions and WIDTH and HEIGHT of image area
to insert. A float value 0.0 - 1.0 means relative to the width or
height of the image; integer values are taken as pixel values.
-\(fn IMAGE &optional STRING AREA SLICE)" nil nil)
+Normally `isearch' is able to search for STRING in the buffer
+even if it's hidden behind a displayed image. If INHIBIT-ISEARCH
+is non-nil, this is inhibited.
+(fn IMAGE &optional STRING AREA SLICE INHIBIT-ISEARCH)" nil nil)
(autoload 'insert-sliced-image "image" "\
Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
@@ -18290,15 +16734,13 @@ display it in the left marginal area, a value of `right-margin'
means display it in the right marginal area.
The image is automatically split into ROWS x COLS slices.
-\(fn IMAGE &optional STRING AREA ROWS COLS)" nil nil)
-
+(fn IMAGE &optional STRING AREA ROWS COLS)" nil nil)
(autoload 'remove-images "image" "\
Remove images between START and END in BUFFER.
Remove only images that were put in BUFFER with calls to `put-image'.
BUFFER nil or omitted means use the current buffer.
-\(fn START END &optional BUFFER)" nil nil)
-
+(fn START END &optional BUFFER)" nil nil)
(autoload 'find-image "image" "\
Find an image, choosing one of a list of image specifications.
@@ -18306,13 +16748,15 @@ SPECS is a list of image specifications.
Each image specification in SPECS is a property list. The contents of
a specification are image type dependent. All specifications must at
-least contain the properties `:type TYPE' and either `:file FILE' or
-`:data DATA', where TYPE is a symbol specifying the image type,
-e.g. `xbm', FILE is the file to load the image from, and DATA is a
-string containing the actual image data. The specification whose TYPE
-is supported, and FILE exists, is used to construct the image
-specification to be returned. Return nil if no specification is
-satisfied.
+least contain either the property `:file FILE' or `:data DATA',
+where FILE is the file to load the image from, and DATA is a string
+containing the actual image data. If the property `:type TYPE' is
+omitted or nil, try to determine the image type from its first few
+bytes of image data. If that doesn't work, and the property `:file
+FILE' provide a file name, use its file extension as image type.
+If `:type TYPE' is provided, it must match the actual type
+determined for FILE or DATA by `create-image'. Return nil if no
+specification is satisfied.
If CACHE is non-nil, results are cached and returned on subsequent calls.
@@ -18320,8 +16764,7 @@ The image is looked for in `image-load-path'.
Image files should not be larger than specified by `max-image-size'.
-\(fn SPECS &optional CACHE)" nil nil)
-
+(fn SPECS &optional CACHE)" nil nil)
(autoload 'defimage "image" "\
Define SYMBOL as an image, and return SYMBOL.
@@ -18342,10 +16785,9 @@ Example:
(defimage test-image ((:type xpm :file \"~/test1.xpm\")
(:type xbm :file \"~/test1.xbm\")))
-\(fn SYMBOL SPECS &optional DOC)" nil t)
-
-(function-put 'defimage 'doc-string-elt '3)
-
+(fn SYMBOL SPECS &optional DOC)" nil t)
+(function-put 'defimage 'doc-string-elt 3)
+(function-put 'defimage 'lisp-indent-function 'defun)
(autoload 'imagemagick-register-types "image" "\
Register file types that can be handled by ImageMagick.
This function is called at startup, after loading the init file.
@@ -18357,23 +16799,19 @@ Emacs visits them in Image mode. They are also added to
recognizes these files as having image type `imagemagick'.
If Emacs is compiled without ImageMagick support, this does nothing." nil nil)
-
+(autoload 'image-at-point-p "image" "\
+Return non-nil if there is an image at point." nil nil)
(register-definition-prefixes "image" '("find-image--cache" "image" "unknown-image-type"))
-;;;***
-;;;### (autoloads nil "image-converter" "image/image-converter.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from image/image-converter.el
(register-definition-prefixes "image-converter" '("image-convert"))
-;;;***
-;;;### (autoloads nil "image-dired" "image-dired.el" (0 0 0 0))
;;; Generated autoloads from image-dired.el
-(push (purecopy '(image-dired 0 4 11)) package--builtin-versions)
+(push (purecopy '(image-dired 0 4 11)) package--builtin-versions)
(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\
Toggle thumbnails in front of file names in the Dired buffer.
If no marked file could be found, insert or hide thumbnails on the
@@ -18381,8 +16819,7 @@ current line. ARG, if non-nil, specifies the files to use instead
of the marked files. If ARG is an integer, use the next ARG (or
previous -ARG, if ARG<0) files.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'image-dired-dired-with-window-configuration "image-dired" "\
Open directory DIR and create a default window configuration.
@@ -18401,8 +16838,7 @@ If called with prefix argument ARG, skip splitting of windows.
The current window configuration is saved and can be restored by
calling `image-dired-restore-window-configuration'.
-\(fn DIR &optional ARG)" t nil)
-
+(fn DIR &optional ARG)" t nil)
(autoload 'image-dired-display-thumbs "image-dired" "\
Display thumbnails of all marked files, in `image-dired-thumbnail-buffer'.
If a thumbnail image does not exist for a file, it is created on the
@@ -18424,97 +16860,91 @@ used or not. If non-nil, use `display-buffer' instead of
`image-dired-previous-line-and-display' where we do not want the
thumbnail buffer to be selected.
-\(fn &optional ARG APPEND DO-NOT-POP)" t nil)
-
+(fn &optional ARG APPEND DO-NOT-POP)" t nil)
(autoload 'image-dired-show-all-from-dir "image-dired" "\
-Make a preview buffer for all images in DIR and display it.
-If the number of files in DIR matching `image-file-name-regexp'
-exceeds `image-dired-show-all-from-dir-max-files', a warning will be
-displayed.
+Make a thumbnail buffer for all images in DIR and display it.
+Any file matching `image-file-name-regexp' is considered an image
+file.
-\(fn DIR)" t nil)
+If the number of image files in DIR exceeds
+`image-dired-show-all-from-dir-max-files', ask for confirmation
+before creating the thumbnail buffer. If that variable is nil,
+never ask for confirmation.
+(fn DIR)" t nil)
(defalias 'image-dired 'image-dired-show-all-from-dir)
-
-(define-obsolete-function-alias 'tumme 'image-dired "24.4")
-
(autoload 'image-dired-tag-files "image-dired" "\
Tag marked file(s) in Dired. With prefix ARG, tag file at point.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'image-dired-delete-tag "image-dired" "\
Remove tag for selected file(s).
With prefix argument ARG, remove tag from file at point.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'image-dired-jump-thumbnail-buffer "image-dired" "\
Jump to thumbnail buffer." t nil)
-
(autoload 'image-dired-minor-mode "image-dired" "\
Setup easy-to-use keybindings for the commands to be used in Dired mode.
+
Note that n, p and <down> and <up> will be hijacked and bound to
-`image-dired-dired-x-line'.
+`image-dired-dired-next-line' and `image-dired-dired-previous-line'.
This is a minor mode. If called interactively, toggle the
-`Image-Dired minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Image-Dired minor mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `image-dired-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
-
-(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode "26.1")
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'image-dired-display-thumbs-append "image-dired" "\
Append thumbnails to `image-dired-thumbnail-buffer'." t nil)
-
(autoload 'image-dired-display-thumb "image-dired" "\
Shorthand for `image-dired-display-thumbs' with prefix argument." t nil)
-
(autoload 'image-dired-dired-display-external "image-dired" "\
Display file at point using an external viewer." t nil)
-
(autoload 'image-dired-dired-display-image "image-dired" "\
Display current image file.
See documentation for `image-dired-display-image' for more information.
With prefix argument ARG, display image in its original size.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'image-dired-dired-comment-files "image-dired" "\
Add comment to current or marked files in Dired." t nil)
-
(autoload 'image-dired-mark-tagged-files "image-dired" "\
-Use regexp to mark files with matching tag.
+Use REGEXP to mark files with matching tag.
A `tag' is a keyword, a piece of meta data, associated with an
image file and stored in image-dired's database file. This command
lets you input a regexp and this will be matched against all tags
on all image files in the database file. The files that have a
-matching tag will be marked in the Dired buffer." t nil)
+matching tag will be marked in the Dired buffer.
+(fn REGEXP)" t nil)
(autoload 'image-dired-dired-edit-comment-and-tags "image-dired" "\
Edit comment and tags of current or marked image files.
Edit comment and tags for all marked image files in an
easy-to-use form." t nil)
+(autoload 'image-dired-bookmark-jump "image-dired" "\
+Default bookmark handler for Image-Dired buffers.
+(fn BOOKMARK)" nil nil)
+(define-obsolete-function-alias 'tumme #'image-dired "24.4")
+(define-obsolete-function-alias 'image-dired-setup-dired-keybindings #'image-dired-minor-mode "26.1")
(register-definition-prefixes "image-dired" '("image-dired-"))
-;;;***
-;;;### (autoloads nil "image-file" "image-file.el" (0 0 0 0))
;;; Generated autoloads from image-file.el
-(defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\
+(defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp")) "\
A list of image-file filename extensions.
Filenames having one of these extensions are considered image files,
in addition to those matching `image-file-name-regexps'.
@@ -18523,9 +16953,7 @@ See `auto-image-file-mode'; if `auto-image-file-mode' is enabled,
setting this variable directly does not take effect unless
`auto-image-file-mode' is re-enabled; this happens automatically when
the variable is set using \\[customize].")
-
(custom-autoload 'image-file-name-extensions "image-file" nil)
-
(defvar image-file-name-regexps nil "\
List of regexps matching image-file filenames.
Filenames matching one of these regexps are considered image files,
@@ -18535,20 +16963,16 @@ See function `auto-image-file-mode'; if `auto-image-file-mode' is
enabled, setting this variable directly does not take effect unless
`auto-image-file-mode' is re-enabled; this happens automatically when
the variable is set using \\[customize].")
-
(custom-autoload 'image-file-name-regexps "image-file" nil)
-
(autoload 'image-file-name-regexp "image-file" "\
Return a regular expression matching image-file filenames." nil nil)
-
(autoload 'insert-image-file "image-file" "\
Insert the image file FILE into the current buffer.
Optional arguments VISIT, BEG, END, and REPLACE are interpreted
as for the command `insert-file-contents'. Return list of
absolute file name and number of characters inserted.
-\(fn FILE &optional VISIT BEG END REPLACE)" nil nil)
-
+(fn FILE &optional VISIT BEG END REPLACE)" nil nil)
(defvar auto-image-file-mode nil "\
Non-nil if Auto-Image-File mode is enabled.
See the `auto-image-file-mode' command
@@ -18556,92 +16980,84 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `auto-image-file-mode'.")
-
(custom-autoload 'auto-image-file-mode "image-file" nil)
-
(autoload 'auto-image-file-mode "image-file" "\
Toggle visiting of image files as images (Auto Image File mode).
-This is a minor mode. If called interactively, toggle the
+An image file is one whose name has an extension in
+`image-file-name-extensions', or matches a regexp in
+`image-file-name-regexps'.
+
+This is a global minor mode. If called interactively, toggle the
`Auto-Image-File mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='auto-image-file-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-An image file is one whose name has an extension in
-`image-file-name-extensions', or matches a regexp in
-`image-file-name-regexps'.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "image-file" '("image-file-"))
-;;;***
-;;;### (autoloads nil "image-mode" "image-mode.el" (0 0 0 0))
;;; Generated autoloads from image-mode.el
(autoload 'image-mode "image-mode" "\
Major mode for image files.
-You can use \\<image-mode-map>\\[image-toggle-display] or \\<image-mode-map>\\[image-toggle-hex-display]
-to toggle between display as an image and display as text or hex.
+You can use \\<image-mode-map>\\[image-toggle-display] or \\[image-toggle-hex-display] to toggle between display
+as an image and display as text or hex.
Key bindings:
\\{image-mode-map}" t nil)
-
(autoload 'image-minor-mode "image-mode" "\
Toggle Image minor mode in this buffer.
+Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
+to switch back to `image-mode' and display an image file as the
+actual image.
+
This is a minor mode. If called interactively, toggle the `Image
minor mode' mode. If the prefix argument is positive, enable the
mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `image-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
-to switch back to `image-mode' and display an image file as the
-actual image.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'image-mode-to-text "image-mode" "\
Set a non-image mode as major mode in combination with image minor mode.
A non-mage major mode found from `auto-mode-alist' or fundamental mode
displays an image file as text." nil nil)
-
(autoload 'image-bookmark-jump "image-mode" "\
-\(fn BMK)" nil nil)
-
+(fn BMK)" nil nil)
(register-definition-prefixes "image-mode" '("image-"))
-;;;***
-;;;### (autoloads nil "imap" "net/imap.el" (0 0 0 0))
;;; Generated autoloads from net/imap.el
(register-definition-prefixes "imap" '("imap-"))
-;;;***
-;;;### (autoloads nil "imenu" "imenu.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/imenu.el
+
+(register-definition-prefixes "semantic/imenu" '("semantic-"))
+
+
;;; Generated autoloads from imenu.el
(defvar imenu-sort-function nil "\
@@ -18657,10 +17073,8 @@ Set it to `imenu--sort-by-name' if you want alphabetic sorting.
The function should take two arguments and return t if the first
element should come before the second. The arguments are cons cells;
-\(NAME . POSITION). Look at `imenu--sort-by-name' for an example.")
-
+(NAME . POSITION). Look at `imenu--sort-by-name' for an example.")
(custom-autoload 'imenu-sort-function "imenu" t)
-
(defvar-local imenu-generic-expression nil "\
List of definition matchers for creating an Imenu index.
Each element of this list should have the form
@@ -18696,7 +17110,6 @@ used by `fortran-mode' with `imenu-syntax-alist' set locally so that
characters which normally have \"symbol\" syntax are considered to have
\"word\" syntax during matching.")
(put 'imenu-generic-expression 'risky-local-variable t)
-
(defvar-local imenu-create-index-function 'imenu-default-create-index-function "\
The function to use for creating an index alist of the current buffer.
@@ -18705,7 +17118,6 @@ an index alist of the current buffer. The function is
called within a `save-excursion'.
See `imenu--index-alist' for the format of the buffer index alist.")
-
(defvar-local imenu-prev-index-position-function 'beginning-of-defun "\
Function for finding the next index position.
@@ -18716,14 +17128,12 @@ file.
The function should leave point at the place to be connected to the
index and it should return nil when it doesn't find another index.")
-
(defvar-local imenu-extract-index-name-function nil "\
Function for extracting the index item name, given a position.
This function is called after `imenu-prev-index-position-function'
finds a position for an index item, with point at that position.
It should return the name for that index item.")
-
(defvar-local imenu-name-lookup-function nil "\
Function to compare string with index item.
@@ -18734,12 +17144,10 @@ If nil, comparison is done with `string='.
Set this to some other function for more advanced comparisons,
such as \"begins with\" or \"name matches and number of
arguments match\".")
-
(defvar-local imenu-default-goto-function 'imenu-default-goto-function "\
The default function called when selecting an Imenu item.
The function in this variable is called when selecting a normal index-item.")
(put 'imenu--index-alist 'risky-local-variable t)
-
(defvar-local imenu-syntax-alist nil "\
Alist of syntax table modifiers to use while in `imenu--generic-function'.
@@ -18750,70 +17158,66 @@ a string, all the characters in the string get the specified syntax.
This is typically used to give word syntax to characters which
normally have symbol syntax to simplify `imenu-expression'
and speed-up matching.")
-
(defvar-local imenu-case-fold-search t "\
Defines whether `imenu--generic-function' should fold case when matching.
This variable should be set (only) by initialization code
for modes which use `imenu--generic-function'. If it is not set, but
`font-lock-defaults' is set, then font-lock's setting is used.")
-
(autoload 'imenu-add-to-menubar "imenu" "\
Add an `imenu' entry to the menu bar for the current buffer.
NAME is a string used to name the menu bar item.
See the command `imenu' for more information.
-\(fn NAME)" t nil)
-
+(fn NAME)" t nil)
(autoload 'imenu-add-menubar-index "imenu" "\
Add an Imenu \"Index\" entry on the menu bar for the current buffer.
A trivial interface to `imenu-add-to-menubar' suitable for use in a hook." t nil)
-
(autoload 'imenu "imenu" "\
Jump to a place in the buffer chosen using a buffer menu or mouse menu.
INDEX-ITEM specifies the position. See `imenu-choose-buffer-index'
for more information.
-\(fn INDEX-ITEM)" t nil)
-
+(fn INDEX-ITEM)" t nil)
(register-definition-prefixes "imenu" '("imenu-"))
-;;;***
-;;;### (autoloads nil "ind-util" "language/ind-util.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/decorate/include.el
+
+(register-definition-prefixes "semantic/decorate/include" '("semantic-decoration-"))
+
+
;;; Generated autoloads from language/ind-util.el
(autoload 'indian-compose-region "ind-util" "\
Compose the region according to `composition-function-table'.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'indian-compose-string "ind-util" "\
-\(fn STRING)" nil nil)
-
+(fn STRING)" nil nil)
(autoload 'in-is13194-post-read-conversion "ind-util" "\
-\(fn LEN)" nil nil)
-
+(fn LEN)" nil nil)
(autoload 'in-is13194-pre-write-conversion "ind-util" "\
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(autoload 'indian-2-column-to-ucs-region "ind-util" "\
Convert old Emacs Devanagari characters to UCS.
-\(fn FROM TO)" t nil)
+(fn FROM TO)" t nil)
+(register-definition-prefixes "ind-util" '("combinatorial" "indian-" "is13194-"))
-(register-definition-prefixes "ind-util" '("indian-" "is13194-"))
+
+;;; Generated autoloads from leim/quail/indian.el
+
+(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u" "inscript-" "quail-"))
-;;;***
-;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (0 0 0 0))
;;; Generated autoloads from progmodes/inf-lisp.el
(autoload 'inferior-lisp "inf-lisp" "\
@@ -18828,20 +17232,16 @@ of `inferior-lisp-program'). Runs the hooks from
If any parts of the command name contains spaces, they should be
quoted using shell quote syntax.
-\(Type \\[describe-mode] in the process buffer for a list of commands.)
-
-\(fn CMD)" t nil)
+(Type \\[describe-mode] in the process buffer for a list of commands.)
+(fn CMD)" t nil)
(defalias 'run-lisp 'inferior-lisp)
-
(register-definition-prefixes "inf-lisp" '("inferior-lisp-" "lisp-" "switch-to-lisp"))
-;;;***
-;;;### (autoloads nil "info" "info.el" (0 0 0 0))
;;; Generated autoloads from info.el
-(defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/"))) (suffixes '("share/" "")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\
+(defvar Info-default-directory-list nil "\
Default list of directories to search for Info documentation files.
They are searched in the order they are given in the list.
Therefore, the directory of Info files that come with Emacs
@@ -18852,22 +17252,16 @@ first in this list.
Once Info is started, the list of directories to search
comes from the variable `Info-directory-list'.
-This variable `Info-default-directory-list' is used as the default
-for initializing `Info-directory-list' when Info is started, unless
-the environment variable INFOPATH is set.
-
-Although this is a customizable variable, that is mainly for technical
-reasons. Normally, you should either set INFOPATH or customize
-`Info-additional-directory-list', rather than changing this variable." :initialize #'custom-initialize-delay :type '(repeat directory))
+This variable is used as the default for initializing
+`Info-directory-list' when Info is started, unless the
+environment variable INFOPATH is set.")
(custom-autoload 'Info-default-directory-list "info" t)
-
(autoload 'info-other-window "info" "\
Like `info' but show the Info buffer in another window.
-\(fn &optional FILE-OR-NODE BUFFER)" t nil)
+(fn &optional FILE-OR-NODE BUFFER)" t nil)
(put 'info 'info-file (purecopy "emacs"))
-
(autoload 'info "info" "\
Enter Info, the documentation browser.
Optional argument FILE-OR-NODE specifies the file to examine;
@@ -18890,29 +17284,23 @@ in all the directories in that path.
See a list of available Info commands in `Info-mode'.
-\(fn &optional FILE-OR-NODE BUFFER)" t nil)
-
+(fn &optional FILE-OR-NODE BUFFER)" t nil)
(autoload 'info-emacs-manual "info" "\
Display the Emacs manual in Info mode." t nil)
-
(autoload 'info-emacs-bug "info" "\
Display the \"Reporting Bugs\" section of the Emacs manual in Info mode." t nil)
-
(autoload 'info-standalone "info" "\
Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
In standalone mode, \\<Info-mode-map>\\[quit-window] exits Emacs itself." nil nil)
-
(autoload 'Info-on-current-buffer "info" "\
Use Info mode to browse the current Info buffer.
With a prefix arg, this queries for the node name to visit first;
otherwise, that defaults to `Top'.
-\(fn &optional NODENAME)" t nil)
-
+(fn &optional NODENAME)" t nil)
(autoload 'Info-directory "info" "\
Go to the Info directory node." t nil)
-
(autoload 'Info-index "info" "\
Look up a string TOPIC in the index for this manual and go to that entry.
If there are no exact matches to the specified topic, this chooses
@@ -18920,22 +17308,21 @@ the first match which is a case-insensitive substring of a topic.
Use the \\<Info-mode-map>\\[Info-index-next] command to see the other matches.
Give an empty topic name to go to the Index node itself.
-\(fn TOPIC)" t nil)
-
+(fn TOPIC)" t nil)
(autoload 'info-apropos "info" "\
-Grovel indices of all known Info files on your system for STRING.
-Build a menu of the possible matches.
+Search indices of all known Info files on your system for STRING.
+If REGEXP (interactively, the prefix), use a regexp match.
-\(fn STRING)" t nil)
+Display a menu of the possible matches.
+(fn STRING &optional REGEXP)" t nil)
(autoload 'info-finder "info" "\
Display descriptions of the keywords in the Finder virtual manual.
In interactive use, a prefix argument directs this command to read
a list of keywords separated by comma. After that, it displays a node
with a list of packages that contain all specified keywords.
-\(fn &optional KEYWORDS)" t nil)
-
+(fn &optional KEYWORDS)" t nil)
(autoload 'Info-mode "info" "\
Info mode provides commands for browsing through the Info documentation tree.
Documentation in Info is divided into \"nodes\", each of which discusses
@@ -18999,9 +17386,8 @@ Advanced commands:
\\[universal-argument] \\[info] Move to new Info file with completion.
\\[universal-argument] N \\[info] Select Info buffer with prefix number in the name *info*<N>.
-\(fn)" t nil)
+(fn)" t nil)
(put 'Info-goto-emacs-command-node 'info-file (purecopy "emacs"))
-
(autoload 'Info-goto-emacs-command-node "info" "\
Go to the Info node in the Emacs manual for command COMMAND.
The command is found by looking up in Emacs manual's indices
@@ -19009,9 +17395,8 @@ or in another manual found via COMMAND's `info-file' property or
the variable `Info-file-list-for-emacs'.
COMMAND must be a symbol or string.
-\(fn COMMAND)" t nil)
+(fn COMMAND)" t nil)
(put 'Info-goto-emacs-key-command-node 'info-file (purecopy "emacs"))
-
(autoload 'Info-goto-emacs-key-command-node "info" "\
Go to the node in the Emacs manual which describes the command bound to KEY.
KEY is a string.
@@ -19020,18 +17405,15 @@ The command is found by looking up in Emacs manual's indices
or in another manual found via COMMAND's `info-file' property or
the variable `Info-file-list-for-emacs'.
-\(fn KEY)" t nil)
-
+(fn KEY)" t nil)
(autoload 'Info-speedbar-browser "info" "\
Initialize speedbar to display an Info node browser.
This will add a speedbar major display mode." t nil)
-
(autoload 'Info-bookmark-jump "info" "\
This implements the `handler' function interface for the record
type returned by `Info-bookmark-make-record', which see.
-\(fn BMK)" nil nil)
-
+(fn BMK)" nil nil)
(autoload 'info-display-manual "info" "\
Display an Info buffer displaying MANUAL.
If there is an existing Info buffer for MANUAL, display it.
@@ -19039,13 +17421,10 @@ Otherwise, visit the manual in a new Info buffer. In interactive
use, a prefix argument directs this command to limit the
completion alternatives to currently visited manuals.
-\(fn MANUAL)" t nil)
-
+(fn MANUAL)" t nil)
(register-definition-prefixes "info" '("Info-" "info-"))
-;;;***
-;;;### (autoloads nil "info-look" "info-look.el" (0 0 0 0))
;;; Generated autoloads from info-look.el
(autoload 'info-lookup-reset "info-look" "\
@@ -19054,48 +17433,56 @@ This command is useful if the user wants to start at the beginning without
quitting Emacs, for example, after some Info documents were updated on the
system." t nil)
(put 'info-lookup-symbol 'info-file "emacs")
-
(autoload 'info-lookup-symbol "info-look" "\
-Display the definition of SYMBOL, as found in the relevant manual.
-When this command is called interactively, it reads SYMBOL from the
-minibuffer. In the minibuffer, use \\<minibuffer-local-completion-map>\\[next-history-element] to yank the default argument
-value into the minibuffer so you can edit it. The default symbol is the
-one found at point.
+Look up and display documentation of SYMBOL in the relevant Info manual.
+SYMBOL should be an identifier: a function or method, a macro, a variable,
+a data type, a class, etc.
-With prefix arg MODE a query for the symbol help mode is offered.
+Interactively, prompt for SYMBOL; you can use \\<minibuffer-local-completion-map>\\[next-history-element] in the minibuffer
+to yank the default argument value into the minibuffer so you can edit it.
+The default symbol is the one found at point.
-\(fn SYMBOL &optional MODE)" t nil)
- (put 'info-lookup-file 'info-file "emacs")
+MODE is the major mode whose Info manuals to search for the documentation
+of SYMBOL. It defaults to the current buffer's `major-mode'; if that
+mode doesn't have any Info manuals known to Emacs, the command will
+prompt for MODE to use, with completion. With prefix arg, the command
+always prompts for MODE.
+
+Is SAME-WINDOW, try to reuse the current window instead of
+popping up a new one.
+(fn SYMBOL &optional MODE SAME-WINDOW)" t nil)
+ (put 'info-lookup-file 'info-file "emacs")
(autoload 'info-lookup-file "info-look" "\
-Display the documentation of a file.
-When this command is called interactively, it reads FILE from the minibuffer.
-In the minibuffer, use \\<minibuffer-local-completion-map>\\[next-history-element] to yank the default file name
-into the minibuffer so you can edit it.
-The default file name is the one found at point.
+Look up and display documentation of FILE in the relevant Info manual.
+FILE should be the name of a file; a notable example is a standard header
+file that is part of the C or C++ standard library.
-With prefix arg MODE a query for the file help mode is offered.
+Interactively, prompt for FILE; you can use \\<minibuffer-local-completion-map>\\[next-history-element] in the minibuffer
+to yank the default argument value into the minibuffer so you can edit it.
+The default file name is the one found at point.
-\(fn FILE &optional MODE)" t nil)
+MODE is the major mode whose Info manuals to search for the documentation
+of FILE. It defaults to the current buffer's `major-mode'; if that
+mode doesn't have any Info manuals known to Emacs, the command will
+prompt for MODE to use, with completion. With prefix arg, the command
+always prompts for MODE.
+(fn FILE &optional MODE)" t nil)
(autoload 'info-complete-symbol "info-look" "\
Perform completion on symbol preceding point.
-\(fn &optional MODE)" t nil)
-
+(fn &optional MODE)" t nil)
(autoload 'info-complete-file "info-look" "\
Perform completion on file preceding point.
-\(fn &optional MODE)" t nil)
-
+(fn &optional MODE)" t nil)
(register-definition-prefixes "info-look" '("info-"))
-;;;***
-;;;### (autoloads nil "info-xref" "info-xref.el" (0 0 0 0))
;;; Generated autoloads from info-xref.el
-(push (purecopy '(info-xref 3)) package--builtin-versions)
+(push (purecopy '(info-xref 3)) package--builtin-versions)
(autoload 'info-xref-check "info-xref" "\
Check external references in FILENAME, an info document.
Interactively from an `Info-mode' or `texinfo-mode' buffer the
@@ -19122,8 +17509,7 @@ not external references, which makes it rather easy for mistakes
to creep in or node name changes to go unnoticed.
`Info-validate' doesn't check external references either.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'info-xref-check-all "info-xref" "\
Check external references in all info documents in the info path.
`Info-directory-list' and `Info-additional-directory-list' are
@@ -19136,7 +17522,6 @@ particular the Emacs manuals normally don't. If you have a
source code directory in `Info-directory-list' then a lot of
extraneous files might be read. This will be time consuming but
should be harmless." t nil)
-
(autoload 'info-xref-check-all-custom "info-xref" "\
Check info references in all customize groups and variables.
Info references can be in `custom-manual' or `info-link' entries
@@ -19145,7 +17530,6 @@ of the `custom-links' for a variable.
Any `custom-load' autoloads in variables are loaded in order to
get full link information. This will be a lot of Lisp packages
and can take a long time." t nil)
-
(autoload 'info-xref-docstrings "info-xref" "\
Check docstring info node references in source files.
The given files are searched for docstring hyperlinks like
@@ -19167,25 +17551,19 @@ and links can be in the file commentary or elsewhere too. Even
.elc files can usually be checked successfully if you don't have
the sources handy.
-\(fn FILENAME-LIST)" t nil)
-
+(fn FILENAME-LIST)" t nil)
(register-definition-prefixes "info-xref" '("info-xref-"))
-;;;***
-;;;### (autoloads nil "informat" "informat.el" (0 0 0 0))
;;; Generated autoloads from informat.el
(autoload 'Info-tagify "informat" "\
Create or update Info file tag table in current buffer or in a region.
-\(fn &optional INPUT-BUFFER-NAME)" t nil)
-
+(fn &optional INPUT-BUFFER-NAME)" t nil)
(defvar Info-split-threshold 262144 "\
The number of characters by which `Info-split' splits an info file.")
-
(custom-autoload 'Info-split-threshold "informat" t)
-
(autoload 'Info-split "informat" "\
Split an info file into an indirect file plus bounded-size subfiles.
Each subfile will be up to the number of characters that
@@ -19199,22 +17577,17 @@ The subfiles are written in the same directory the original file is
in, with names generated by appending `-' and a number to the original
file name. The indirect file still functions as an Info file, but it
contains just the tag table and a directory of subfiles." t nil)
-
(autoload 'Info-validate "informat" "\
Check current buffer for validity as an Info file.
Check that every node pointer points to an existing node." t nil)
-
(autoload 'batch-info-validate "informat" "\
Run `Info-validate' on the files remaining on the command line.
Must be used only with -batch, and kills Emacs on completion.
Each file will be processed even if an error occurred previously.
For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" nil nil)
-
(register-definition-prefixes "informat" '("Info-validate-"))
-;;;***
-;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/inline.el
(autoload 'define-inline "inline" "\
@@ -19223,62 +17596,53 @@ Define an inline function NAME with arguments ARGS and body in BODY.
This is like `defmacro', but has several advantages.
See Info node `(elisp)Defining Functions' for more details.
-\(fn NAME ARGS &rest BODY)" nil t)
-
+(fn NAME ARGS &rest BODY)" nil t)
(function-put 'define-inline 'lisp-indent-function 'defun)
+(function-put 'define-inline 'doc-string-elt 3)
+(register-definition-prefixes "inline" '("inline-"))
-(function-put 'define-inline 'doc-string-elt '3)
+
+;;; Generated autoloads from cedet/srecode/insert.el
-(register-definition-prefixes "inline" '("inline-"))
+(register-definition-prefixes "srecode/insert" '("srecode-"))
+
+
+;;; Generated autoloads from leim/quail/ipa.el
+
+(register-definition-prefixes "quail/ipa" '("ipa-x-sampa-"))
-;;;***
-;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from international/isearch-x.el
(autoload 'isearch-toggle-specified-input-method "isearch-x" "\
Select an input method and turn it on in interactive search." t nil)
-
(autoload 'isearch-toggle-input-method "isearch-x" "\
Toggle input method in interactive search." t nil)
-
(autoload 'isearch-transient-input-method "isearch-x" "\
Activate transient input method in interactive search." t nil)
-
(autoload 'isearch-process-search-multibyte-characters "isearch-x" "\
-\(fn LAST-CHAR &optional COUNT)" nil nil)
-
+(fn LAST-CHAR &optional COUNT)" nil nil)
(register-definition-prefixes "isearch-x" '("isearch-"))
-;;;***
-;;;### (autoloads nil "isearchb" "isearchb.el" (0 0 0 0))
;;; Generated autoloads from isearchb.el
-(push (purecopy '(isearchb 1 5)) package--builtin-versions)
+(push (purecopy '(isearchb 1 5)) package--builtin-versions)
(autoload 'isearchb-activate "isearchb" "\
Active isearchb mode for subsequent alphanumeric keystrokes.
Executing this command again will terminate the search; or, if
the search has not yet begun, will toggle to the last buffer
accessed via isearchb." t nil)
-
(register-definition-prefixes "isearchb" '("isearchb"))
-;;;***
-;;;### (autoloads nil "iso-ascii" "international/iso-ascii.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from international/iso-ascii.el
(register-definition-prefixes "iso-ascii" '("iso-ascii-"))
-;;;***
-;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from international/iso-cvt.el
(autoload 'iso-spanish "iso-cvt" "\
@@ -19287,112 +17651,90 @@ Translate the region between FROM and TO using the table
`iso-spanish-trans-tab'.
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-german "iso-cvt" "\
Translate net conventions for German to ISO 8859-1.
Translate the region FROM and TO using the table
`iso-german-trans-tab'.
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-iso2tex "iso-cvt" "\
Translate ISO 8859-1 characters to TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2tex-trans-tab'.
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-tex2iso "iso-cvt" "\
Translate TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-tex2iso-trans-tab'.
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-gtex2iso "iso-cvt" "\
Translate German TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-gtex2iso-trans-tab'.
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-iso2gtex "iso-cvt" "\
Translate ISO 8859-1 characters to German TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2gtex-trans-tab'.
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-iso2duden "iso-cvt" "\
Translate ISO 8859-1 characters to Duden sequences.
Translate the region between FROM and TO using the table
`iso-iso2duden-trans-tab'.
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-iso2sgml "iso-cvt" "\
Translate ISO 8859-1 characters in the region to SGML entities.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-sgml2iso "iso-cvt" "\
Translate SGML entities in the region to ISO 8859-1 characters.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist').
-\(fn FROM TO &optional BUFFER)" t nil)
-
+(fn FROM TO &optional BUFFER)" t nil)
(autoload 'iso-cvt-read-only "iso-cvt" "\
Warn that format is read-only.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'iso-cvt-write-only "iso-cvt" "\
Warn that format is write-only.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'iso-cvt-define-menu "iso-cvt" "\
Add submenus to the File menu, to convert to and from various formats." t nil)
-
(register-definition-prefixes "iso-cvt" '("iso-"))
-;;;***
-;;;### (autoloads nil "iso8601" "calendar/iso8601.el" (0 0 0 0))
;;; Generated autoloads from calendar/iso8601.el
(register-definition-prefixes "iso8601" '("iso8601-"))
-;;;***
-;;;### (autoloads nil "ispell" "textmodes/ispell.el" (0 0 0 0))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
-
(defvar ispell-personal-dictionary nil "\
File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary for your spelling checker is used.")
-
(custom-autoload 'ispell-personal-dictionary "ispell" t)
-
(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p)
-
(defconst ispell-menu-map (let ((map (make-sparse-keymap "Spell"))) (define-key map [ispell-change-dictionary] `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit dictionary file name"))) (define-key map [ispell-kill-ispell] `(menu-item ,(purecopy "Kill Process") (lambda nil (interactive) (ispell-kill-ispell nil 'clear)) :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) :help ,(purecopy "Terminate Ispell subprocess"))) (define-key map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor"))) (define-key map [ispell-continue] `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue :enable (and (boundp 'ispell-region-end) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help ,(purecopy "Continue spell checking last region"))) (define-key map [ispell-word] `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key map [ispell-comments-and-strings] `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings"))) (define-key map [ispell-region] `(menu-item ,(purecopy "Spell-Check Region") ispell-region :enable mark-active :help ,(purecopy "Spell-check text in marked region"))) (define-key map [ispell-message] `(menu-item ,(purecopy "Spell-Check Message") ispell-message :visible (eq major-mode 'mail-mode) :help ,(purecopy "Skip headers and included message text"))) (define-key map [ispell-buffer] `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer :help ,(purecopy "Check spelling of selected buffer"))) map) "\
Key map for ispell menu.")
-
(fset 'ispell-menu-map (symbol-value 'ispell-menu-map))
-
(defvar ispell-skip-region-alist `((ispell-words-keyword forward-line) (ispell-dictionary-keyword forward-line) (ispell-pdict-keyword forward-line) (ispell-parsing-keyword forward-line) (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") \, (purecopy "^---*END PGP [A-Z ]*--*")) (,(purecopy "^begin [0-9][0-9][0-9] [^ \11]+$") \, (purecopy "\nend\n")) (,(purecopy "^%!PS-Adobe-[123].0") \, (purecopy "\n%%EOF\n")) (,(purecopy "^---* \\(Start of \\)?[Ff]orwarded [Mm]essage") \, (purecopy "^---* End of [Ff]orwarded [Mm]essage"))) "\
Alist expressing beginning and end of regions not to spell check.
The alist key must be a regular expression.
@@ -19401,15 +17743,13 @@ Valid forms include:
(KEY . REGEXP) - skip to the end of REGEXP. REGEXP may be string or symbol.
(KEY REGEXP) - skip to end of REGEXP. REGEXP must be a string.
(KEY FUNCTION ARGS) - FUNCTION called with ARGS returns end of region.")
-
-(defvar ispell-tex-skip-alists (purecopy '((("\\\\addcontentsline" ispell-tex-arg-end 2) ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ("\\\\cref" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) ("\\\\document\\(class\\|style\\)" . "\\\\begin[ \11\n]*{[ \11\n]*document[ \11\n]*}")) (("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0) ("list" ispell-tex-arg-end 2) ("program" . "\\\\end[ \11\n]*{[ \11\n]*program[ \11\n]*}") ("verbatim\\*?" . "\\\\end[ \11\n]*{[ \11\n]*verbatim\\*?[ \11\n]*}")))) "\
+(defvar ispell-tex-skip-alists (purecopy '((("\\\\addcontentsline" ispell-tex-arg-end 2) ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ("\\\\cref" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) ("\\\\document\\(class\\|style\\)" . "\\\\begin[ \11\n]*{document}")) (("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0) ("list" ispell-tex-arg-end 2) ("program" . "\\\\end[ \11]*{program}") ("verbatim\\*?" . "\\\\end[ \11]*{verbatim\\*?}")))) "\
Lists of regions to be skipped in TeX mode.
First list is used raw.
Second list has key placed inside \\begin{}.
Delete or add any regions you want to be automatically selected
for skipping in latex mode.")
-
(defconst ispell-html-skip-alists '(("<[cC][oO][dD][eE]\\>[^>]*>" "</[cC][oO][dD][eE]*>") ("<[sS][cC][rR][iI][pP][tT]\\>[^>]*>" "</[sS][cC][rR][iI][pP][tT]>") ("<[aA][pP][pP][lL][eE][tT]\\>[^>]*>" "</[aA][pP][pP][lL][eE][tT]>") ("<[vV][eE][rR][bB]\\>[^>]*>" "<[vV][eE][rR][bB]\\>[^>]*>") ("<[tT][tT]/" "/") ("<[^ \11\n>]" ">") ("&[^ \11\n;]" "[; \11\n]")) "\
Lists of start and end keys to skip in HTML buffers.
Same format as `ispell-skip-region-alist'.
@@ -19417,7 +17757,6 @@ Note - substrings of other matches must come last
(e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
(put 'ispell-local-pdict 'safe-local-variable 'stringp)
(define-key esc-map "$" 'ispell-word)
-
(autoload 'ispell-word "ispell" "\
Check spelling of word under or before the cursor.
If the word is not found in dictionary, display possible corrections
@@ -19425,7 +17764,7 @@ in a window allowing you to choose one.
If optional argument FOLLOWING is non-nil or if `ispell-following-word'
is non-nil when called interactively, then the following word
-\(rather than preceding) is checked when the cursor is not over a word.
+(rather than preceding) is checked when the cursor is not over a word.
When the optional argument QUIETLY is non-nil or `ispell-quietly' is non-nil
when called interactively, non-corrective messages are suppressed.
@@ -19445,48 +17784,44 @@ Return values:
nil word is correct or spelling is accepted.
0 word is inserted into buffer-local definitions.
\"word\" word corrected from word list.
-\(\"word\" arg) word is hand entered.
+(\"word\" arg) word is hand entered.
quit spell session exited.
-\(fn &optional FOLLOWING QUIETLY CONTINUE REGION)" t nil)
-
+(fn &optional FOLLOWING QUIETLY CONTINUE REGION)" t nil)
(autoload 'ispell-pdict-save "ispell" "\
Check to see if the personal dictionary has been modified.
If so, ask if it needs to be saved.
-\(fn &optional NO-QUERY FORCE-SAVE)" t nil)
-
+(fn &optional NO-QUERY FORCE-SAVE)" t nil)
(autoload 'ispell-help "ispell" "\
Display a list of the options available when a misspelling is encountered.
Selections are:
-DIGIT: Replace the word with a digit offered in the *Choices* buffer.
-SPC: Accept word this time.
-`i': Accept word and insert into private dictionary.
-`a': Accept word for this session.
-`A': Accept word and place in `buffer-local dictionary'.
-`r': Replace word with typed-in value. Rechecked.
-`R': Replace word with typed-in value. Query-replaced in buffer. Rechecked.
-`?': Show these commands.
-`x': Exit spelling buffer. Move cursor to original point.
-`X': Exit spelling buffer. Leaves cursor at the current point, and permits
+\\`0'..\\`9' Replace the word with a digit offered in the *Choices* buffer.
+\\`SPC' Accept word this time.
+\\`i' Accept word and insert into private dictionary.
+\\`a' Accept word for this session.
+\\`A' Accept word and place in `buffer-local dictionary'.
+\\`r' Replace word with typed-in value. Rechecked.
+\\`R' Replace word with typed-in value. Query-replaced in buffer. Rechecked.
+\\`?' Show these commands.
+\\`x' Exit spelling buffer. Move cursor to original point.
+\\`X' Exit spelling buffer. Leaves cursor at the current point, and permits
the aborted check to be completed later.
-`q': Quit spelling session (Kills ispell process).
-`l': Look up typed-in replacement in alternate dictionary. Wildcards okay.
-`u': Like `i', but the word is lower-cased first.
-`m': Place typed-in value in personal dictionary, then recheck current word.
-`C-l': Redraw screen.
-`C-r': Recursive edit.
-`C-z': Suspend Emacs or iconify frame." nil nil)
-
+\\`q' Quit spelling session (Kills ispell process).
+\\`l' Look up typed-in replacement in alternate dictionary. Wildcards okay.
+\\`u' Like \\`i', but the word is lower-cased first.
+\\`m' Place typed-in value in personal dictionary, then recheck current word.
+\\`C-l' Redraw screen.
+\\`C-r' Recursive edit.
+\\`C-z' Suspend Emacs or iconify frame." nil nil)
(autoload 'ispell-kill-ispell "ispell" "\
Kill current Ispell process (so that you may start a fresh one).
With NO-ERROR, just return non-nil if there was no Ispell running.
With CLEAR, buffer session localwords are cleaned.
-\(fn &optional NO-ERROR CLEAR)" t nil)
-
+(fn &optional NO-ERROR CLEAR)" t nil)
(autoload 'ispell-change-dictionary "ispell" "\
Change to dictionary DICT for Ispell.
With a prefix arg, set it \"globally\", for all buffers.
@@ -19494,15 +17829,15 @@ Without a prefix arg, set it \"locally\", just for this buffer.
By just answering RET you can find out what the current dictionary is.
-\(fn DICT &optional ARG)" t nil)
-
+(fn DICT &optional ARG)" t nil)
(autoload 'ispell-region "ispell" "\
Interactively check a region for spelling errors.
+Leave the mark at the last misspelled word that the user was queried about.
+
Return nil if spell session was terminated, otherwise returns shift offset
amount for last line processed.
-\(fn REG-START REG-END &optional RECHECKP SHIFT)" t nil)
-
+(fn REG-START REG-END &optional RECHECKP SHIFT)" t nil)
(autoload 'ispell-comments-and-strings "ispell" "\
Check comments and strings in the current buffer for spelling errors.
If called interactively with an active region, check only comments and
@@ -19510,23 +17845,19 @@ strings in the region.
When called from Lisp, START and END buffer positions can be provided
to limit the check.
-\(fn &optional START END)" t nil)
-
+(fn &optional START END)" t nil)
(autoload 'ispell-comment-or-string-at-point "ispell" "\
Check the comment or string containing point for spelling errors." t nil)
-
(autoload 'ispell-buffer "ispell" "\
-Check the current buffer for spelling errors interactively." t nil)
-
+Check the current buffer for spelling errors interactively.
+Leave the mark at the last misspelled word that the user was queried about." t nil)
(autoload 'ispell-buffer-with-debug "ispell" "\
`ispell-buffer' with some output sent to `ispell-debug-buffer'.
If APPEND is non-nil, don't erase previous debugging output.
-\(fn &optional APPEND)" t nil)
-
+(fn &optional APPEND)" t nil)
(autoload 'ispell-continue "ispell" "\
Continue a halted spelling session beginning with the current word." t nil)
-
(autoload 'ispell-complete-word "ispell" "\
Try to complete the word before or at point.
If optional INTERIOR-FRAG is non-nil, then the word may be a character
@@ -19534,11 +17865,9 @@ sequence inside of a word.
Standard ispell choices are then available.
-\(fn &optional INTERIOR-FRAG)" t nil)
-
+(fn &optional INTERIOR-FRAG)" t nil)
(autoload 'ispell-complete-word-interior-frag "ispell" "\
Completes word matching character sequence inside a word." t nil)
-
(autoload 'ispell "ispell" "\
Interactively check a region or buffer for spelling errors.
If `transient-mark-mode' is on, and a region is active, spell-check
@@ -19548,24 +17877,9 @@ Ispell dictionaries are not distributed with Emacs. If you are
looking for a dictionary, please see the distribution of the GNU ispell
program, or do an Internet search; there are various dictionaries
available on the net." t nil)
-
(autoload 'ispell-minor-mode "ispell" "\
Toggle last-word spell checking (Ispell minor mode).
-This is a minor mode. If called interactively, toggle the `ISpell
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `ispell-minor-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Ispell minor mode is a buffer-local minor mode. When enabled,
typing SPC or RET warns you if the previous word is incorrectly
spelled.
@@ -19577,16 +17891,29 @@ SPC.
For spell-checking \"on the fly\", not just after typing SPC or
RET, use `flyspell-mode'.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`ISpell minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `ispell-minor-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'ispell-message "ispell" "\
Check the spelling of a mail message or news post.
Don't check spelling of message headers except the Subject field.
Don't check included messages.
To abort spell checking of a message region and send the message anyway,
-use the `x' command. (Any subsequent regions will be checked.)
-The `X' command aborts sending the message so that you can edit the buffer.
+use the \\`x' command. (Any subsequent regions will be checked.)
+The \\`X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
in your init file:
@@ -19598,136 +17925,128 @@ in your init file:
You can bind this to the key C-c i in GNUS or mail by adding to
`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
(lambda () (local-set-key \"\\C-ci\" \\='ispell-message))" t nil)
-
(register-definition-prefixes "ispell" '("check-ispell-version" "ispell-"))
-;;;***
-;;;### (autoloads nil "ja-dic-cnv" "international/ja-dic-cnv.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from international/ja-dic-cnv.el
(register-definition-prefixes "ja-dic-cnv" '("batch-skkdic-convert" "ja-dic-filename" "skkdic-"))
-;;;***
-;;;### (autoloads nil "ja-dic-utl" "international/ja-dic-utl.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from international/ja-dic-utl.el
(register-definition-prefixes "ja-dic-utl" '("skkdic-"))
-;;;***
-;;;### (autoloads nil "japan-util" "language/japan-util.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from language/japan-util.el
(autoload 'setup-japanese-environment-internal "japan-util" nil nil nil)
-
(autoload 'japanese-katakana "japan-util" "\
Convert argument to Katakana and return that.
The argument may be a character or string. The result has the same type.
The argument object is not altered--the value is a copy.
Optional argument HANKAKU t means to convert to `hankaku' Katakana
-\(`japanese-jisx0201-kana'), in which case return value
+(`japanese-jisx0201-kana'), in which case return value
may be a string even if OBJ is a character if two Katakanas are
necessary to represent OBJ.
-\(fn OBJ &optional HANKAKU)" nil nil)
-
+(fn OBJ &optional HANKAKU)" nil nil)
(autoload 'japanese-hiragana "japan-util" "\
Convert argument to Hiragana and return that.
The argument may be a character or string. The result has the same type.
The argument object is not altered--the value is a copy.
-\(fn OBJ)" nil nil)
-
+(fn OBJ)" nil nil)
(autoload 'japanese-hankaku "japan-util" "\
Convert argument to `hankaku' and return that.
The argument may be a character or string. The result has the same type.
The argument object is not altered--the value is a copy.
Optional argument ASCII-ONLY non-nil means to return only ASCII character.
-\(fn OBJ &optional ASCII-ONLY)" nil nil)
-
+(fn OBJ &optional ASCII-ONLY)" nil nil)
(autoload 'japanese-zenkaku "japan-util" "\
Convert argument to `zenkaku' and return that.
The argument may be a character or string. The result has the same type.
The argument object is not altered--the value is a copy.
-\(fn OBJ)" nil nil)
-
+(fn OBJ)" nil nil)
(autoload 'japanese-katakana-region "japan-util" "\
Convert Japanese `hiragana' chars in the region to `katakana' chars.
Optional argument HANKAKU t means to convert to `hankaku katakana' character
of which charset is `japanese-jisx0201-kana'.
-\(fn FROM TO &optional HANKAKU)" t nil)
-
+(fn FROM TO &optional HANKAKU)" t nil)
(autoload 'japanese-hiragana-region "japan-util" "\
Convert Japanese `katakana' chars in the region to `hiragana' chars.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'japanese-hankaku-region "japan-util" "\
Convert Japanese `zenkaku' chars in the region to `hankaku' chars.
`Zenkaku' chars belong to `japanese-jisx0208'
`Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'.
Optional argument ASCII-ONLY non-nil means to convert only to ASCII char.
-\(fn FROM TO &optional ASCII-ONLY)" t nil)
-
+(fn FROM TO &optional ASCII-ONLY)" t nil)
(autoload 'japanese-zenkaku-region "japan-util" "\
Convert hankaku' chars in the region to Japanese `zenkaku' chars.
`Zenkaku' chars belong to `japanese-jisx0208'
`Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'.
Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char.
-\(fn FROM TO &optional KATAKANA-ONLY)" t nil)
-
+(fn FROM TO &optional KATAKANA-ONLY)" t nil)
(autoload 'read-hiragana-string "japan-util" "\
Read a Hiragana string from the minibuffer, prompting with string PROMPT.
If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
-\(fn PROMPT &optional INITIAL-INPUT)" nil nil)
-
+(fn PROMPT &optional INITIAL-INPUT)" nil nil)
(register-definition-prefixes "japan-util" '("japanese-"))
-;;;***
-;;;### (autoloads nil "jka-compr" "jka-compr.el" (0 0 0 0))
+;;; Generated autoloads from leim/quail/japanese.el
+
+(register-definition-prefixes "quail/japanese" '("quail-japanese-"))
+
+
+;;; Generated autoloads from cedet/semantic/java.el
+
+(register-definition-prefixes "semantic/java" '("semantic-"))
+
+
+;;; Generated autoloads from cedet/semantic/wisent/java-tags.el
+
+(register-definition-prefixes "semantic/wisent/java-tags" '("semantic-" "wisent-java-parse-error"))
+
+
+;;; Generated autoloads from cedet/semantic/wisent/javascript.el
+
+(register-definition-prefixes "semantic/wisent/javascript" '("semantic-" "wisent-javascript-jv-expand-tag"))
+
+
;;; Generated autoloads from jka-compr.el
(defvar jka-compr-inhibit nil "\
Non-nil means inhibit automatic uncompression temporarily.
Lisp programs can bind this to t to do that.
It is not recommended to set this variable permanently to anything but nil.")
-
(autoload 'jka-compr-handler "jka-compr" "\
-\(fn OPERATION &rest ARGS)" nil nil)
-
+(fn OPERATION &rest ARGS)" nil nil)
(autoload 'jka-compr-uninstall "jka-compr" "\
Uninstall jka-compr.
This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
and `inhibit-local-variables-suffixes' that were added
by `jka-compr-install'." nil nil)
-
(register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-"))
-;;;***
-;;;### (autoloads nil "js" "progmodes/js.el" (0 0 0 0))
;;; Generated autoloads from progmodes/js.el
-(push (purecopy '(js 9)) package--builtin-versions)
+(push (purecopy '(js 9)) package--builtin-versions)
(autoload 'js-mode "js" "\
Major mode for editing JavaScript.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'js-jsx-mode "js" "\
Major mode for editing JavaScript+JSX.
@@ -19741,69 +18060,51 @@ could set `js-jsx-syntax' to t in your init file, or in a
`js-jsx-enable' in `js-mode-hook'. You may be better served by
one of the aforementioned options instead of using this mode.
-\(fn)" t nil)
+(fn)" t nil)
(defalias 'javascript-mode 'js-mode)
-
(dolist (name (list "node" "nodejs" "gjs" "rhino")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode)))
+(register-definition-prefixes "js" '("js-"))
-(register-definition-prefixes "js" '("js-" "with-js"))
-
-;;;***
-;;;### (autoloads nil "json" "json.el" (0 0 0 0))
;;; Generated autoloads from json.el
-(push (purecopy '(json 1 5)) package--builtin-versions)
+(push (purecopy '(json 1 5)) package--builtin-versions)
(register-definition-prefixes "json" '("json-"))
-;;;***
-;;;### (autoloads nil "jsonrpc" "jsonrpc.el" (0 0 0 0))
;;; Generated autoloads from jsonrpc.el
-(push (purecopy '(jsonrpc 1 0 14)) package--builtin-versions)
+(push (purecopy '(jsonrpc 1 0 15)) package--builtin-versions)
(register-definition-prefixes "jsonrpc" '("jsonrpc-"))
-;;;***
-;;;### (autoloads nil "kermit" "kermit.el" (0 0 0 0))
;;; Generated autoloads from kermit.el
(register-definition-prefixes "kermit" '("kermit-"))
-;;;***
-;;;### (autoloads nil "keypad" "emulation/keypad.el" (0 0 0 0))
;;; Generated autoloads from emulation/keypad.el
(defvar keypad-setup nil "\
Specifies the keypad setup for unshifted keypad keys when NumLock is off.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified.")
-
(custom-autoload 'keypad-setup "keypad" nil)
-
(defvar keypad-numlock-setup nil "\
Specifies the keypad setup for unshifted keypad keys when NumLock is on.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified.")
-
(custom-autoload 'keypad-numlock-setup "keypad" nil)
-
(defvar keypad-shifted-setup nil "\
Specifies the keypad setup for shifted keypad keys when NumLock is off.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified.")
-
(custom-autoload 'keypad-shifted-setup "keypad" nil)
-
(defvar keypad-numlock-shifted-setup nil "\
Specifies the keypad setup for shifted keypad keys when NumLock is off.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified.")
-
(custom-autoload 'keypad-numlock-shifted-setup "keypad" nil)
-
(autoload 'keypad-setup "keypad" "\
Set keypad bindings in `function-key-map' according to SETUP.
If optional second argument NUMLOCK is non-nil, the NumLock On bindings
@@ -19824,12 +18125,9 @@ keys are bound.
If SETUP is `numeric' and the optional fourth argument DECIMAL is non-nil,
the decimal key on the keypad is mapped to DECIMAL instead of `.'
-\(fn SETUP &optional NUMLOCK SHIFT DECIMAL)" nil nil)
+(fn SETUP &optional NUMLOCK SHIFT DECIMAL)" nil nil)
-;;;***
-;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from international/kinsoku.el
(autoload 'kinsoku "kinsoku" "\
@@ -19846,13 +18144,10 @@ shorter.
in one place, and is used for the text processing described above in
the context of text formatting.
-\(fn LINEBEG)" nil nil)
-
+(fn LINEBEG)" nil nil)
(register-definition-prefixes "kinsoku" '("kinsoku-"))
-;;;***
-;;;### (autoloads nil "kkc" "international/kkc.el" (0 0 0 0))
;;; Generated autoloads from international/kkc.el
(defvar kkc-after-update-conversion-functions nil "\
@@ -19861,7 +18156,6 @@ With this input method, a user can select a proper conversion from
candidate list. Each time he changes the selection, functions in this
list are called with two arguments; starting and ending buffer
positions that contains the current selection.")
-
(autoload 'kkc-region "kkc" "\
Convert Kana string in the current region to Kanji-Kana mixed string.
Users can select a desirable conversion interactively.
@@ -19870,14 +18164,12 @@ positions FROM and TO (integers or markers) specifying the target region.
When it returns, the point is at the tail of the selected conversion,
and the return value is the length of the conversion.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(register-definition-prefixes "kkc" '("kkc-"))
-;;;***
-;;;### (autoloads nil "kmacro" "kmacro.el" (0 0 0 0))
;;; Generated autoloads from kmacro.el
+
(global-set-key "\C-x(" #'kmacro-start-macro)
(global-set-key "\C-x)" #'kmacro-end-macro)
(global-set-key "\C-xe" #'kmacro-end-and-call-macro)
@@ -19885,13 +18177,8 @@ and the return value is the length of the conversion.
(global-set-key [f4] #'kmacro-end-or-call-macro)
(global-set-key "\C-x\C-k" #'kmacro-keymap)
(autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap)
-
-(autoload 'kmacro-exec-ring-item "kmacro" "\
-Execute item ITEM from the macro ring.
-ARG is the number of times to execute the item.
-
-\(fn ITEM ARG)" nil nil)
-
+(define-obsolete-function-alias 'kmacro-exec-ring-item #'funcall "29.1" "Execute item ITEM from the macro ring.
+ARG is the number of times to execute the item.")
(autoload 'kmacro-start-macro "kmacro" "\
Record subsequent keyboard input, defining a keyboard macro.
The commands are recorded even as they are executed.
@@ -19915,8 +18202,7 @@ Use \\[kmacro-name-last-macro] to give it a name that will remain valid even
after another macro is defined.
Use \\[kmacro-bind-to-key] to bind it to a key sequence.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'kmacro-end-macro "kmacro" "\
Finish defining a keyboard macro.
The definition was started by \\[kmacro-start-macro].
@@ -19928,8 +18214,7 @@ With numeric arg, repeat macro now that many times,
counting the definition just completed as the first repetition.
An argument of zero means repeat until error.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'kmacro-call-macro "kmacro" "\
Call the keyboard MACRO that you defined with \\[kmacro-start-macro].
A prefix argument serves as a repeat count. Zero means repeat until error.
@@ -19943,8 +18228,7 @@ for details on how to adjust or disable this behavior.
To give a macro a name so you can call it even after defining others,
use \\[kmacro-name-last-macro].
-\(fn ARG &optional NO-REPEAT END-MACRO MACRO)" t nil)
-
+(fn ARG &optional NO-REPEAT END-MACRO MACRO)" t nil)
(autoload 'kmacro-start-macro-or-insert-counter "kmacro" "\
Record subsequent keyboard input, defining a keyboard macro.
The commands are recorded even as they are executed.
@@ -19966,15 +18250,13 @@ The macro counter can be set directly via \\[kmacro-set-counter] and \\[kmacro-a
The format of the inserted value of the counter can be controlled
via \\[kmacro-set-format].
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'kmacro-end-or-call-macro "kmacro" "\
End kbd macro if currently being defined; else call last kbd macro.
With numeric prefix ARG, repeat macro that many times.
With \\[universal-argument], call second macro in macro ring.
-\(fn ARG &optional NO-REPEAT)" t nil)
-
+(fn ARG &optional NO-REPEAT)" t nil)
(autoload 'kmacro-end-and-call-macro "kmacro" "\
Call last keyboard macro, ending it first if currently being defined.
With numeric prefix ARG, repeat macro that many times.
@@ -19983,45 +18265,45 @@ Zero argument means repeat until there is an error.
To give a macro a name, so you can call it even after defining other
macros, use \\[kmacro-name-last-macro].
-\(fn ARG &optional NO-REPEAT)" t nil)
-
+(fn ARG &optional NO-REPEAT)" t nil)
(autoload 'kmacro-end-call-mouse "kmacro" "\
Move point to the position clicked with the mouse and call last kbd macro.
If kbd macro currently being defined end it before activating it.
-\(fn EVENT)" t nil)
+(fn EVENT)" t nil)
+(autoload 'kmacro "kmacro" "\
+Create a `kmacro' for macro bound to symbol or key.
+KEYS should be a vector or a string that obeys `key-valid-p'.
+(fn KEYS &optional COUNTER FORMAT)" nil nil)
(autoload 'kmacro-lambda-form "kmacro" "\
-Create lambda form for macro bound to symbol or key.
-\(fn MAC &optional COUNTER FORMAT)" nil nil)
+(fn MAC &optional COUNTER FORMAT)" nil nil)
+(make-obsolete 'kmacro-lambda-form 'kmacro "29.1")
(register-definition-prefixes "kmacro" '("kmacro-"))
-;;;***
-;;;### (autoloads nil "korea-util" "language/korea-util.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from language/korea-util.el
(defvar default-korean-keyboard (purecopy (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\
The kind of Korean keyboard for Korean (Hangul) input method.
\"\" for 2, \"3\" for 3, and \"3f\" for 3f.")
-
(autoload 'setup-korean-environment-internal "korea-util" nil nil nil)
-
(register-definition-prefixes "korea-util" '("exit-korean-environment" "isearch-" "korean-key-bindings" "quail-hangul-switch-" "toggle-korean-input-method"))
-;;;***
-;;;### (autoloads nil "lao-util" "language/lao-util.el" (0 0 0 0))
+;;; Generated autoloads from leim/quail/lao.el
+
+(register-definition-prefixes "quail/lao" '("lao-" "quail-lao-update-translation"))
+
+
;;; Generated autoloads from language/lao-util.el
(autoload 'lao-compose-string "lao-util" "\
-\(fn STR)" nil nil)
-
+(fn STR)" nil nil)
(autoload 'lao-transcribe-single-roman-syllable-to-lao "lao-util" "\
Transcribe a Romanized Lao syllable in the region FROM and TO to Lao string.
Only the first syllable is transcribed.
@@ -20032,63 +18314,48 @@ LAO-STRING is the Lao character transcription of it.
Optional 3rd arg STR, if non-nil, is a string to search for Roman Lao
syllable. In that case, FROM and TO are indexes to STR.
-\(fn FROM TO &optional STR)" nil nil)
-
+(fn FROM TO &optional STR)" nil nil)
(autoload 'lao-transcribe-roman-to-lao-string "lao-util" "\
Transcribe Romanized Lao string STR to Lao character string.
-\(fn STR)" nil nil)
-
+(fn STR)" nil nil)
(autoload 'lao-composition-function "lao-util" "\
-\(fn GSTRING DIRECTION)" nil nil)
-
+(fn GSTRING DIRECTION)" nil nil)
(autoload 'lao-compose-region "lao-util" "\
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(register-definition-prefixes "lao-util" '("lao-"))
-;;;***
-;;;### (autoloads nil "latexenc" "international/latexenc.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from international/latexenc.el
(defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-9) ("latin9" . iso-8859-15) ("latin10" . iso-8859-16) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\
Mapping from LaTeX encodings in \"inputenc.sty\" to Emacs coding systems.
LaTeX encodings are specified with \"\\usepackage[encoding]{inputenc}\".
Used by the function `latexenc-find-file-coding-system'.")
-
(custom-autoload 'latex-inputenc-coding-alist "latexenc" t)
-
(autoload 'latexenc-inputenc-to-coding-system "latexenc" "\
Return the corresponding coding-system for the specified input encoding.
Return nil if no matching coding system can be found.
-\(fn INPUTENC)" nil nil)
-
+(fn INPUTENC)" nil nil)
(autoload 'latexenc-coding-system-to-inputenc "latexenc" "\
Return the corresponding input encoding for the specified coding system.
Return nil if no matching input encoding can be found.
-\(fn CS)" nil nil)
-
+(fn CS)" nil nil)
(autoload 'latexenc-find-file-coding-system "latexenc" "\
Determine the coding system of a LaTeX file if it uses \"inputenc.sty\".
The mapping from LaTeX's \"inputenc.sty\" encoding names to Emacs
coding system names is determined from `latex-inputenc-coding-alist'.
-\(fn ARG-LIST)" nil nil)
-
+(fn ARG-LIST)" nil nil)
(register-definition-prefixes "latexenc" '("latexenc-dont-use-"))
-;;;***
-;;;### (autoloads nil "latin1-disp" "international/latin1-disp.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from international/latin1-disp.el
(defvar latin1-display nil "\
@@ -20105,9 +18372,7 @@ charsets if you don't have a Unicode font with which to display them.
Setting this variable directly does not take effect;
use either \\[customize] or the function `latin1-display'.")
-
(custom-autoload 'latin1-display "latin1-disp" nil)
-
(autoload 'latin1-display "latin1-disp" "\
Set up Latin-1/ASCII display for the arguments character SETS.
See option `latin1-display' for the method. The members of the list
@@ -20115,8 +18380,7 @@ must be in `latin1-display-sets'. With no arguments, reset the
display for all of `latin1-display-sets'. See also
`latin1-display-setup'.
-\(fn &rest SETS)" nil nil)
-
+(fn &rest SETS)" nil nil)
(defvar latin1-display-ucs-per-lynx nil "\
Set up Latin-1/ASCII display for Unicode characters.
This uses the transliterations of the Lynx browser. The display isn't
@@ -20124,70 +18388,48 @@ changed if the display can render Unicode characters.
Setting this variable directly does not take effect;
use either \\[customize] or the function `latin1-display'.")
-
(custom-autoload 'latin1-display-ucs-per-lynx "latin1-disp" nil)
-
(register-definition-prefixes "latin1-disp" '("latin1-display-"))
-;;;***
-;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/ld-script.el
(autoload 'ld-script-mode "ld-script" "\
A major mode to edit GNU ld script files.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "ld-script" '("ld-script-"))
-;;;***
-;;;### (autoloads nil "ldap" "net/ldap.el" (0 0 0 0))
;;; Generated autoloads from net/ldap.el
(register-definition-prefixes "ldap" '("ldap-"))
-;;;***
-;;;### (autoloads nil "legacy-gnus-agent" "gnus/legacy-gnus-agent.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from gnus/legacy-gnus-agent.el
(register-definition-prefixes "legacy-gnus-agent" '("gnus-agent-"))
-;;;***
-;;;### (autoloads nil "less-css-mode" "textmodes/less-css-mode.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from textmodes/less-css-mode.el
(put 'less-css-compile-at-save 'safe-local-variable #'booleanp)
-
(put 'less-css-lessc-options 'safe-local-variable t)
-
(put 'less-css-output-directory 'safe-local-variable #'stringp)
-
(put 'less-css-input-file-name 'safe-local-variable #'stringp)
(add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode))
-
(autoload 'less-css-mode "less-css-mode" "\
Major mode for editing Less files (http://lesscss.org/).
Special commands:
\\{less-css-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "less-css-mode" '("less-css-"))
-;;;***
-;;;### (autoloads nil "let-alist" "emacs-lisp/let-alist.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/let-alist.el
-(push (purecopy '(let-alist 1 0 6)) package--builtin-versions)
+(push (purecopy '(let-alist 1 0 6)) package--builtin-versions)
(autoload 'let-alist "let-alist" "\
Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
Dotted symbol is any symbol starting with a `.'. Only those present
@@ -20217,15 +18459,21 @@ the variables of the outer one. You can, however, access alists
inside the original alist by using dots inside the symbol, as
displayed in the example above.
-\(fn ALIST &rest BODY)" nil t)
+(fn ALIST &rest BODY)" nil t)
+(function-put 'let-alist 'lisp-indent-function 1)
+(register-definition-prefixes "let-alist" '("let-alist--"))
-(function-put 'let-alist 'lisp-indent-function '1)
+
+;;; Generated autoloads from cedet/semantic/lex.el
-(register-definition-prefixes "let-alist" '("let-alist--"))
+(register-definition-prefixes "semantic/lex" '("define-lex" "semantic-"))
+
+
+;;; Generated autoloads from cedet/semantic/lex-spp.el
+
+(register-definition-prefixes "semantic/lex-spp" '("define-lex-spp-" "semantic-lex-"))
-;;;***
-;;;### (autoloads nil "life" "play/life.el" (0 0 0 0))
;;; Generated autoloads from play/life.el
(autoload 'life "life" "\
@@ -20238,38 +18486,37 @@ generations (the default is `life-step-time').
When called from Lisp, optional argument STEP-TIME is the time to
sleep in seconds.
-\(fn &optional STEP-TIME)" t nil)
-
+(fn &optional STEP-TIME)" t nil)
(register-definition-prefixes "life" '("life-"))
-;;;***
-;;;### (autoloads nil "linum" "linum.el" (0 0 0 0))
;;; Generated autoloads from linum.el
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
+This mode has been largely replaced by `display-line-numbers-mode'
+(which is much faster and has fewer interaction problems with other
+modes).
+
+Linum mode is a buffer-local minor mode.
+
This is a minor mode. If called interactively, toggle the `Linum
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `linum-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-Linum mode is a buffer-local minor mode.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(put 'global-linum-mode 'globalized-minor-mode t)
-
(defvar global-linum-mode nil "\
Non-nil if Global Linum mode is enabled.
See the `global-linum-mode' command
@@ -20277,9 +18524,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-linum-mode'.")
-
(custom-autoload 'global-linum-mode "linum" nil)
-
(autoload 'global-linum-mode "linum" "\
Toggle Linum mode in all buffers.
With prefix ARG, enable Global Linum mode if ARG is positive;
@@ -20293,21 +18538,59 @@ Linum mode is enabled in all buffers where `linum-on' would do it.
See `linum-mode' for more information on Linum mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "linum" '("linum-"))
-;;;***
-;;;### (autoloads nil "lisp-mnt" "emacs-lisp/lisp-mnt.el" (0 0 0
-;;;;;; 0))
+;;; Generated autoloads from cedet/ede/linux.el
+
+(register-definition-prefixes "ede/linux" '("ede-linux-" "project-linux-"))
+
+
;;; Generated autoloads from emacs-lisp/lisp-mnt.el
(register-definition-prefixes "lisp-mnt" '("lm-"))
-;;;***
-;;;### (autoloads nil "loadhist" "loadhist.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/symref/list.el
+
+(register-definition-prefixes "semantic/symref/list" '("semantic-symref-"))
+
+
+;;; Generated autoloads from emacs-lisp/loaddefs-gen.el
+
+(put 'generated-autoload-file 'safe-local-variable 'stringp)
+(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
+(autoload 'loaddefs-generate "loaddefs-gen" "\
+Generate loaddefs files for Lisp files in the directories DIRS.
+DIR can be either a single directory or a list of directories.
+
+The autoloads will be written to OUTPUT-FILE. If any Lisp file
+binds `generated-autoload-file' as a file-local variable, write
+its autoloads into the specified file instead.
+
+The function does NOT recursively descend into subdirectories of the
+directory or directories specified.
+
+If EXTRA-DATA, include this string at the start of the generated
+file. This will also force generation of OUTPUT-FILE even if
+there are no autoloads to put into the file.
+
+If INCLUDE-PACKAGE-VERSION, include package version data.
+
+If GENERATE-FULL, don't update, but regenerate all the loaddefs files.
+
+(fn DIR OUTPUT-FILE &optional EXCLUDED-FILES EXTRA-DATA INCLUDE-PACKAGE-VERSION GENERATE-FULL)" nil nil)
+(autoload 'loaddefs-generate-batch "loaddefs-gen" "\
+Generate loaddefs.el files in batch mode.
+This scans for ;;;###autoload forms and related things.
+
+The first element on the command line should be the (main)
+loaddefs.el output file, and the rest are the directories to
+use." nil nil)
+(register-definition-prefixes "loaddefs-gen" '("autoload-" "generated-autoload-" "loaddefs-generate--"))
+
+
;;; Generated autoloads from loadhist.el
(autoload 'unload-feature "loadhist" "\
@@ -20333,21 +18616,21 @@ definitions in the variable `unload-function-defs-list' and could
remove symbols from it in the event that the package has done
something strange, such as redefining an Emacs function.
-\(fn FEATURE &optional FORCE)" t nil)
-
+(fn FEATURE &optional FORCE)" t nil)
(register-definition-prefixes "loadhist" '("feature-" "file-" "loadhist-" "read-feature" "unload-"))
-;;;***
-;;;### (autoloads nil "locate" "locate.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/locate.el
+
+(register-definition-prefixes "ede/locate" '("ede-locate-"))
+
+
;;; Generated autoloads from locate.el
(defvar locate-ls-subdir-switches (purecopy "-al") "\
`ls' switches for inserting subdirectories in `*Locate*' buffers.
This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches.")
-
(custom-autoload 'locate-ls-subdir-switches "locate" t)
-
(autoload 'locate "locate" "\
Run the program `locate', putting results in `*Locate*' buffer.
Pass it SEARCH-STRING as argument. Interactively, prompt for SEARCH-STRING.
@@ -20370,8 +18653,7 @@ the docstring of that function for its meaning.
After preparing the results buffer, this runs `dired-mode-hook' and
then `locate-post-command-hook'.
-\(fn SEARCH-STRING &optional FILTER ARG)" t nil)
-
+(fn SEARCH-STRING &optional FILTER ARG)" t nil)
(autoload 'locate-with-filter "locate" "\
Run the executable program `locate' with a filter.
This function is similar to the function `locate', which see.
@@ -20387,13 +18669,10 @@ ARG is the interactive prefix arg, which has the same effect as in `locate'.
When called from Lisp, this function is identical with `locate',
except that FILTER is not optional.
-\(fn SEARCH-STRING FILTER &optional ARG)" t nil)
-
+(fn SEARCH-STRING FILTER &optional ARG)" t nil)
(register-definition-prefixes "locate" '("locate-"))
-;;;***
-;;;### (autoloads nil "log-edit" "vc/log-edit.el" (0 0 0 0))
;;; Generated autoloads from vc/log-edit.el
(autoload 'log-edit "log-edit" "\
@@ -20420,36 +18699,63 @@ If BUFFER is non-nil, `log-edit' will switch to that buffer, use it
to edit the log message and go back to the current buffer when
done. Otherwise, this function will use the current buffer.
-\(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil)
-
+(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil)
(register-definition-prefixes "log-edit" '("log-edit-"))
-;;;***
-;;;### (autoloads nil "log-view" "vc/log-view.el" (0 0 0 0))
;;; Generated autoloads from vc/log-view.el
(autoload 'log-view-mode "log-view" "\
Major mode for browsing CVS log output.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "log-view" '("log-view-"))
-;;;***
-;;;### (autoloads nil "lpr" "lpr.el" (0 0 0 0))
+;;; Generated autoloads from longlines.el
+
+(autoload 'longlines-mode "longlines" "\
+Toggle Long Lines mode in this buffer.
+
+When Long Lines mode is enabled, long lines are wrapped if they
+extend beyond `fill-column'. The soft newlines used for line
+wrapping will not show up when the text is yanked or saved to
+disk.
+
+If the variable `longlines-auto-wrap' is non-nil, lines are
+automatically wrapped whenever the buffer is changed. You can
+always call `fill-paragraph' to fill individual paragraphs.
+
+If the variable `longlines-show-hard-newlines' is non-nil, hard
+newlines are indicated with a symbol.
+
+This is a minor mode. If called interactively, toggle the
+`Longlines mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `longlines-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "longlines" '("longlines-"))
+
+
;;; Generated autoloads from lpr.el
(defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\
Non-nil if running on MS-DOS or MS Windows.")
-
(defvar lpr-lp-system (memq system-type '(usg-unix-v hpux)) "\
Non-nil if running on a system type that uses the \"lp\" command.")
-
(defvar printer-name (and (eq system-type 'ms-dos) "PRN") "\
The name of a local printer to which data is sent for printing.
-\(Note that PostScript files are sent to `ps-printer-name', which see.)
+(Note that PostScript files are sent to `ps-printer-name', which see.)
On Unix-like systems, a string value should be a name understood by
lpr's -P option; otherwise the value should be nil.
@@ -20461,17 +18767,13 @@ printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or
\"//hostname/printer\" for a shared network printer. You can also set
it to the name of a file, in which case the output gets appended to that
file. If you want to discard the printed output, set this to \"NUL\".")
-
(custom-autoload 'printer-name "lpr" t)
-
(defvar lpr-switches nil "\
List of strings to pass as extra options for the printer program.
It is recommended to set `printer-name' instead of including an explicit
switch on this list.
See `lpr-command'.")
-
(custom-autoload 'lpr-switches "lpr" t)
-
(defvar lpr-command (purecopy (cond (lpr-windows-system "") (lpr-lp-system "lp") (t "lpr"))) "\
Name of program for printing a file.
@@ -20482,14 +18784,11 @@ Windows NT and Novell Netware respectively) are handled specially, using
`printer-name' as the destination for output; any other program is
treated like `lpr' except that an explicit filename is given as the last
argument.")
-
(custom-autoload 'lpr-command "lpr" t)
-
(autoload 'lpr-buffer "lpr" "\
Print buffer contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command." t nil)
-
(autoload 'print-buffer "lpr" "\
Paginate and print buffer contents.
@@ -20503,14 +18802,12 @@ in the print command itself; we expect them to request pagination.
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command." t nil)
-
(autoload 'lpr-region "lpr" "\
Print region contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'print-region "lpr" "\
Paginate and print the region contents.
@@ -20525,26 +18822,24 @@ in the print command itself; we expect them to request pagination.
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(register-definition-prefixes "lpr" '("lpr-" "print"))
-;;;***
-;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (0 0 0 0))
+;;; Generated autoloads from leim/quail/lrt.el
+
+(register-definition-prefixes "quail/lrt" '("quail-lrt-update-translation"))
+
+
;;; Generated autoloads from ls-lisp.el
(defvar ls-lisp-support-shell-wildcards t "\
Non-nil means ls-lisp treats file patterns as shell wildcards.
Otherwise they are treated as Emacs regexps (for backward compatibility).")
-
(custom-autoload 'ls-lisp-support-shell-wildcards "ls-lisp" t)
-
(register-definition-prefixes "ls-lisp" '("ls-lisp-"))
-;;;***
-;;;### (autoloads nil "lunar" "calendar/lunar.el" (0 0 0 0))
;;; Generated autoloads from calendar/lunar.el
(autoload 'lunar-phases "lunar" "\
@@ -20552,34 +18847,27 @@ Display the quarters of the moon for last month, this month, and next month.
If called with an optional prefix argument ARG, prompts for month and year.
This function is suitable for execution in an init file.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "lunar" '("calendar-lunar-phases" "diary-lunar-phases" "eclipse-check" "lunar-"))
-;;;***
-;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (0 0 0 0))
;;; Generated autoloads from progmodes/m4-mode.el
(autoload 'm4-mode "m4-mode" "\
A major mode to edit m4 macro files.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "m4-mode" '("m4-"))
-;;;***
-;;;### (autoloads nil "macros" "macros.el" (0 0 0 0))
;;; Generated autoloads from macros.el
(defalias 'name-last-kbd-macro #'kmacro-name-last-macro)
-
(autoload 'insert-kbd-macro "macros" "\
Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
MACRONAME should be a symbol.
Optional second arg KEYS means also record the keys it is on
-\(this is the prefix argument, when calling interactively).
+(this is the prefix argument, when calling interactively).
This Lisp code will, when executed, define the kbd macro with the same
definition it has now. If you say to record the keys, the Lisp code
@@ -20590,8 +18878,7 @@ bindings.
To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
use this command, and then save the file.
-\(fn MACRONAME &optional KEYS)" t nil)
-
+(fn MACRONAME &optional KEYS)" t nil)
(autoload 'kbd-macro-query "macros" "\
Query user during kbd macro execution.
@@ -20610,8 +18897,7 @@ Your options are: \\<query-replace-map>
\\[recenter] Redisplay the screen, then ask again.
\\[edit] Enter recursive edit; ask again when you exit from that.
-\(fn FLAG)" t nil)
-
+(fn FLAG)" t nil)
(autoload 'apply-macro-to-region-lines "macros" "\
Apply last keyboard macro to all lines in the region.
For each line that begins in the region, move to the beginning of
@@ -20653,14 +18939,11 @@ and write a macro to massage a word into a table entry:
and then select the region of un-tablified names and use
`\\[apply-macro-to-region-lines]' to build the table from the names.
-\(fn TOP BOTTOM &optional MACRO)" t nil)
+(fn TOP BOTTOM &optional MACRO)" t nil)
(define-key ctl-x-map "q" 'kbd-macro-query)
+(register-definition-prefixes "macros" '("macro"))
-(register-definition-prefixes "macros" '("macros--insert-vector-macro"))
-
-;;;***
-;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-extr.el
(autoload 'mail-extract-address-components "mail-extr" "\
@@ -20678,8 +18961,8 @@ each recipient. If ALL is nil, then if ADDRESS contains more than
one recipients, all but the first is ignored.
ADDRESS may be a string or a buffer. If it is a buffer, the visible
-\(narrowed) portion of the buffer will be interpreted as the address.
-\(This feature exists so that the clever caller might be able to avoid
+(narrowed) portion of the buffer will be interpreted as the address.
+(This feature exists so that the clever caller might be able to avoid
consing a string.)
This function is primarily meant for when you're displaying the
@@ -20691,73 +18974,53 @@ non-display use, you should probably use
than `mail-header-parse-address', but does less post-processing
to the results.
-\(fn ADDRESS &optional ALL)" nil nil)
-
+(fn ADDRESS &optional ALL)" nil nil)
(autoload 'what-domain "mail-extr" "\
Convert mail domain DOMAIN to the country it corresponds to.
-\(fn DOMAIN)" t nil)
-
+(fn DOMAIN)" t nil)
(register-definition-prefixes "mail-extr" '("mail-extr-"))
-;;;***
-;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-hist.el
(autoload 'mail-hist-define-keys "mail-hist" "\
Define keys for accessing mail header history. For use in hooks." nil nil)
-
(autoload 'mail-hist-enable "mail-hist" nil nil nil)
-
(defvar mail-hist-keep-history t "\
Non-nil means keep a history for headers and text of outgoing mail.")
-
(custom-autoload 'mail-hist-keep-history "mail-hist" t)
-
(autoload 'mail-hist-put-headers-into-history "mail-hist" "\
Put headers and contents of this message into mail header history.
Each header has its own independent history, as does the body of the
message.
This function normally would be called when the message is sent." nil nil)
-
(register-definition-prefixes "mail-hist" '("mail-hist-"))
-;;;***
-;;;### (autoloads nil "mail-parse" "mail/mail-parse.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-parse.el
(register-definition-prefixes "mail-parse" '("mail-"))
-;;;***
-;;;### (autoloads nil "mail-prsvr" "mail/mail-prsvr.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-prsvr.el
(register-definition-prefixes "mail-prsvr" '("mail-parse-"))
-;;;***
-;;;### (autoloads nil "mail-source" "gnus/mail-source.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from gnus/mail-source.el
(register-definition-prefixes "mail-source" '("mail-source"))
-;;;***
-;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-utils.el
(defvar mail-use-rfc822 nil "\
If non-nil, use a full, hairy RFC 822 (or later) parser on mail addresses.
Otherwise, (the default) use a smaller, somewhat faster, and
often correct parser.")
-
(custom-autoload 'mail-use-rfc822 "mail-utils" t)
-
(defvar mail-dont-reply-to-names nil "\
Regexp specifying addresses to prune from a reply message.
If this is nil, it is set the first time you compose a reply, to
@@ -20765,14 +19028,11 @@ a value which excludes your own email address.
Matching addresses are excluded from the Cc field in replies, and
also the To field, unless this would leave an empty To field.")
-
(custom-autoload 'mail-dont-reply-to-names "mail-utils" t)
-
(autoload 'mail-file-babyl-p "mail-utils" "\
Return non-nil if FILE is a Babyl file.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'mail-quote-printable "mail-utils" "\
Convert a string to the \"quoted printable\" Q encoding if necessary.
If the string contains only ASCII characters and no troublesome ones,
@@ -20781,22 +19041,19 @@ we return it unconverted.
If the optional argument WRAPPER is non-nil,
we add the wrapper characters =?ISO-8859-1?Q?....?=.
-\(fn STRING &optional WRAPPER)" nil nil)
-
+(fn STRING &optional WRAPPER)" nil nil)
(autoload 'mail-quote-printable-region "mail-utils" "\
Convert the region to the \"quoted printable\" Q encoding.
If the optional argument WRAPPER is non-nil,
we add the wrapper characters =?ISO-8859-1?Q?....?=.
-\(fn BEG END &optional WRAPPER)" t nil)
-
+(fn BEG END &optional WRAPPER)" t nil)
(autoload 'mail-unquote-printable "mail-utils" "\
Undo the \"quoted printable\" encoding.
If the optional argument WRAPPER is non-nil,
we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
-\(fn STRING &optional WRAPPER)" nil nil)
-
+(fn STRING &optional WRAPPER)" nil nil)
(autoload 'mail-unquote-printable-region "mail-utils" "\
Undo the \"quoted printable\" encoding in buffer from BEG to END.
If the optional argument WRAPPER is non-nil,
@@ -20808,8 +19065,7 @@ If UNIBYTE is non-nil, insert converted characters as unibyte.
That is useful if you are going to character code decoding afterward,
as Rmail does.
-\(fn BEG END &optional WRAPPER NOERROR UNIBYTE)" t nil)
-
+(fn BEG END &optional WRAPPER NOERROR UNIBYTE)" t nil)
(autoload 'mail-fetch-field "mail-utils" "\
Return the value of the header field whose type is FIELD-NAME.
If second arg LAST is non-nil, use the last field of type FIELD-NAME.
@@ -20820,13 +19076,10 @@ included in the result.
The buffer should be narrowed to just the header, else false
matches may be returned from the message body.
-\(fn FIELD-NAME &optional LAST ALL LIST DELETE)" nil nil)
-
+(fn FIELD-NAME &optional LAST ALL LIST DELETE)" nil nil)
(register-definition-prefixes "mail-utils" '("mail-"))
-;;;***
-;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (0 0 0 0))
;;; Generated autoloads from mail/mailabbrev.el
(defvar mail-abbrevs-mode nil "\
@@ -20836,42 +19089,37 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `mail-abbrevs-mode'.")
-
(custom-autoload 'mail-abbrevs-mode "mailabbrev" nil)
-
(autoload 'mail-abbrevs-mode "mailabbrev" "\
Toggle abbrev expansion of mail aliases (Mail Abbrevs mode).
-This is a minor mode. If called interactively, toggle the
-`Mail-Abbrevs mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='mail-abbrevs-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Mail Abbrevs mode is a global minor mode. When enabled,
abbrev-like expansion is performed when editing certain mail
headers (those specified by `mail-abbrev-mode-regexp'), based on
the entries in your `mail-personal-alias-file'.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Mail-Abbrevs mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='mail-abbrevs-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'mail-abbrevs-setup "mailabbrev" "\
Initialize use of the `mailabbrev' package." nil nil)
-
(autoload 'build-mail-abbrevs "mailabbrev" "\
Read mail aliases from personal mail alias file and set `mail-abbrevs'.
By default this is the file specified by `mail-personal-alias-file'.
-\(fn &optional FILE RECURSIVEP)" nil nil)
-
+(fn &optional FILE RECURSIVEP)" nil nil)
(autoload 'define-mail-abbrev "mailabbrev" "\
Define NAME as a mail alias abbrev that translates to DEFINITION.
If DEFINITION contains multiple addresses, separate them with commas.
@@ -20881,13 +19129,10 @@ from a mailrc file. In that case, addresses are separated with
spaces and addresses with embedded spaces are surrounded by
double-quotes.
-\(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
-
+(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
(register-definition-prefixes "mailabbrev" '("mail-" "merge-mail-abbrevs" "rebuild-mail-abbrevs"))
-;;;***
-;;;### (autoloads nil "mailalias" "mail/mailalias.el" (0 0 0 0))
;;; Generated autoloads from mail/mailalias.el
(defvar mail-complete-style 'angles "\
@@ -20898,9 +19143,7 @@ If `parens', they look like:
king@grassland.com (Elvis Parsley)
If `angles', they look like:
Elvis Parsley <king@grassland.com>")
-
(custom-autoload 'mail-complete-style "mailalias" t)
-
(autoload 'expand-mail-aliases "mailalias" "\
Expand all mail aliases in suitable header fields found between BEG and END.
If interactive, expand in header fields.
@@ -20910,8 +19153,7 @@ their `Resent-' variants.
Optional second arg EXCLUDE may be a regular expression defining text to be
removed from alias expansions.
-\(fn BEG END &optional EXCLUDE)" t nil)
-
+(fn BEG END &optional EXCLUDE)" t nil)
(autoload 'define-mail-alias "mailalias" "\
Define NAME as a mail alias that translates to DEFINITION.
This means that sending a message to NAME will actually send to DEFINITION.
@@ -20921,52 +19163,44 @@ If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION
can be separated by spaces; an address can contain spaces
if it is quoted with double-quotes.
-\(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
-
+(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
(autoload 'mail-completion-at-point-function "mailalias" "\
Compute completion data for mail aliases.
For use on `completion-at-point-functions'." nil nil)
-
(autoload 'mail-complete "mailalias" "\
Perform completion on header field or word preceding point.
Completable headers are according to `mail-complete-alist'. If none matches
current header, calls `mail-complete-function' and passes prefix ARG if any.
-\(fn ARG)" t nil)
-
-(make-obsolete 'mail-complete 'mail-completion-at-point-function '"24.1")
-
+(fn ARG)" t nil)
+(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1")
(register-definition-prefixes "mailalias" '("build-mail-aliases" "mail-"))
-;;;***
-;;;### (autoloads nil "mailcap" "net/mailcap.el" (0 0 0 0))
;;; Generated autoloads from net/mailcap.el
+(autoload 'mailcap-mime-type-to-extension "mailcap" "\
+Return a file name extension based on a MIME-TYPE.
+For instance, `image/png' will result in `png'.
+
+(fn MIME-TYPE)" nil nil)
(register-definition-prefixes "mailcap" '("mailcap-"))
-;;;***
-;;;### (autoloads nil "mailclient" "mail/mailclient.el" (0 0 0 0))
;;; Generated autoloads from mail/mailclient.el
(autoload 'mailclient-send-it "mailclient" "\
Pass current buffer on to the system's mail client.
Suitable value for `send-mail-function'.
The mail client is taken to be the handler of mailto URLs." nil nil)
-
(register-definition-prefixes "mailclient" '("mailclient-"))
-;;;***
-;;;### (autoloads nil "mailheader" "mail/mailheader.el" (0 0 0 0))
;;; Generated autoloads from mail/mailheader.el
(register-definition-prefixes "mailheader" '("mail-header"))
-;;;***
-;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0))
;;; Generated autoloads from net/mairix.el
(autoload 'mairix-search "mairix" "\
@@ -20974,51 +19208,49 @@ Call Mairix with SEARCH.
If THREADS is non-nil, also display whole threads of found
messages. Results will be put into the default search file.
-\(fn SEARCH THREADS)" t nil)
-
+(fn SEARCH THREADS)" t nil)
(autoload 'mairix-use-saved-search "mairix" "\
Use a saved search for querying Mairix." t nil)
-
(autoload 'mairix-edit-saved-searches-customize "mairix" "\
Edit the list of saved searches in a customization buffer." t nil)
-
(autoload 'mairix-search-from-this-article "mairix" "\
Search messages from sender of the current article.
This is effectively a shortcut for calling `mairix-search' with
f:current_from. If prefix THREADS is non-nil, include whole
threads.
-\(fn THREADS)" t nil)
-
+(fn THREADS)" t nil)
(autoload 'mairix-search-thread-this-article "mairix" "\
Search thread for the current article.
This is effectively a shortcut for calling `mairix-search'
with m:msgid of the current article and enabled threads." t nil)
-
(autoload 'mairix-widget-search-based-on-article "mairix" "\
Create mairix query based on current article using widgets." t nil)
-
(autoload 'mairix-edit-saved-searches "mairix" "\
Edit current mairix searches." t nil)
-
(autoload 'mairix-widget-search "mairix" "\
Create mairix query interactively using graphical widgets.
MVALUES may contain values from current article.
-\(fn &optional MVALUES)" t nil)
-
+(fn &optional MVALUES)" t nil)
(autoload 'mairix-update-database "mairix" "\
Call mairix for updating the database for SERVERS.
Mairix will be called asynchronously unless
`mairix-synchronous-update' is t. Mairix will be called with
`mairix-update-options'." t nil)
-
(register-definition-prefixes "mairix" '("mairix-"))
-;;;***
-;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (0 0 0
-;;;;;; 0))
+;;; Generated autoloads from cedet/semantic/bovine/make.el
+
+(register-definition-prefixes "semantic/bovine/make" '("makefile-mode" "semantic-"))
+
+
+;;; Generated autoloads from cedet/ede/make.el
+
+(register-definition-prefixes "ede/make" '("ede-"))
+
+
;;; Generated autoloads from progmodes/make-mode.el
(autoload 'makefile-mode "make-mode" "\
@@ -21106,53 +19338,51 @@ Makefile mode can be configured by modifying the following variables:
on one of those in the minibuffer whenever you enter a `.'.
at the beginning of a line in Makefile mode.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'makefile-automake-mode "make-mode" "\
An adapted `makefile-mode' that knows about automake.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'makefile-gmake-mode "make-mode" "\
An adapted `makefile-mode' that knows about gmake.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'makefile-makepp-mode "make-mode" "\
An adapted `makefile-mode' that knows about makepp.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'makefile-bsdmake-mode "make-mode" "\
An adapted `makefile-mode' that knows about BSD make.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'makefile-imake-mode "make-mode" "\
An adapted `makefile-mode' that knows about imake.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "make-mode" '("makefile-"))
-;;;***
-;;;### (autoloads nil "makesum" "makesum.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/makefile-edit.el
+
+(register-definition-prefixes "ede/makefile-edit" '("makefile-"))
+
+
+;;; Generated autoloads from textmodes/makeinfo.el
+
+(register-definition-prefixes "makeinfo" '("makeinfo-"))
+
+
;;; Generated autoloads from makesum.el
(autoload 'make-command-summary "makesum" "\
Make a summary of current key bindings in the buffer *Summary*.
Previous contents of that buffer are killed first." t nil)
-
(register-definition-prefixes "makesum" '("double-column"))
-;;;***
-;;;### (autoloads nil "man" "man.el" (0 0 0 0))
;;; Generated autoloads from man.el
(defalias 'manual-entry 'man)
-
(autoload 'man "man" "\
Get a Un*x manual page and put it in a buffer.
This command is the top-level command in the man package.
@@ -21194,50 +19424,38 @@ Note that in some cases you will need to use \\[quoted-insert] to quote the
SPC character in the above examples, because this command attempts
to auto-complete your input based on the installed manual pages.
-\(fn MAN-ARGS)" t nil)
-
+(fn MAN-ARGS)" t nil)
(autoload 'man-follow "man" "\
Get a Un*x manual page of the item under point and put it in a buffer.
-\(fn MAN-ARGS)" '(man-common) nil)
-
+(fn MAN-ARGS)" '(man-common) nil)
(autoload 'Man-bookmark-jump "man" "\
Default bookmark handler for Man buffers.
-\(fn BOOKMARK)" nil nil)
+(fn BOOKMARK)" nil nil)
+(autoload 'Man-context-menu "man" "\
+Populate MENU with commands that open a man page at point.
+(fn MENU CLICK)" nil nil)
(register-definition-prefixes "man" '("Man-" "man"))
-;;;***
-;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 3 2 1)) package--builtin-versions)
+(push (purecopy '(map 3 2 1)) package--builtin-versions)
(register-definition-prefixes "map" '("map-"))
-;;;***
-;;;### (autoloads nil "master" "master.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/map.el
+
+(register-definition-prefixes "srecode/map" '("srecode-"))
+
+
;;; Generated autoloads from master.el
(autoload 'master-mode "master" "\
Toggle Master mode.
-This is a minor mode. If called interactively, toggle the `Master
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `master-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When Master mode is enabled, you can scroll the slave buffer
using the following commands:
@@ -21247,13 +19465,24 @@ The slave buffer is stored in the buffer-local variable `master-of'.
You can set this variable using `master-set-slave'. You can show
yourself the value of `master-of' by calling `master-show-slave'.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Master mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `master-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "master" '("master-"))
-;;;***
-;;;### (autoloads nil "mb-depth" "mb-depth.el" (0 0 0 0))
;;; Generated autoloads from mb-depth.el
(defvar minibuffer-depth-indicate-mode nil "\
@@ -21263,47 +19492,39 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `minibuffer-depth-indicate-mode'.")
-
(custom-autoload 'minibuffer-depth-indicate-mode "mb-depth" nil)
-
(autoload 'minibuffer-depth-indicate-mode "mb-depth" "\
Toggle Minibuffer Depth Indication mode.
-This is a minor mode. If called interactively, toggle the
+Minibuffer Depth Indication mode is a global minor mode. When
+enabled, any recursive use of the minibuffer will show the
+recursion depth in the minibuffer prompt. This is only useful if
+`enable-recursive-minibuffers' is non-nil.
+
+This is a global minor mode. If called interactively, toggle the
`Minibuffer-Depth-Indicate mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='minibuffer-depth-indicate-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-Minibuffer Depth Indication mode is a global minor mode. When
-enabled, any recursive use of the minibuffer will show the
-recursion depth in the minibuffer prompt. This is only useful if
-`enable-recursive-minibuffers' is non-nil.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "mb-depth" '("minibuffer-depth-"))
-;;;***
-;;;### (autoloads nil "md4" "md4.el" (0 0 0 0))
;;; Generated autoloads from md4.el
(register-definition-prefixes "md4" '("md4"))
-;;;***
-;;;### (autoloads nil "memory-report" "emacs-lisp/memory-report.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/memory-report.el
(autoload 'memory-report "memory-report" "\
@@ -21312,197 +19533,156 @@ Generate a report of how Emacs is using memory.
This report is approximate, and will commonly over-count memory
usage by variables, because shared data structures will usually
by counted more than once." t nil)
-
(register-definition-prefixes "memory-report" '("memory-report-"))
-;;;***
-;;;### (autoloads nil "message" "gnus/message.el" (0 0 0 0))
;;; Generated autoloads from gnus/message.el
(define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
-
(autoload 'message-mode "message" "\
Major mode for editing mail and news to be sent.
Like `text-mode', but with these additional commands:
\\{message-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'message-mail "message" "\
Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION
is a function used to switch to and display the mail buffer.
-\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest _)" t nil)
-
+(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest _)" t nil)
(autoload 'message-news "message" "\
Start editing a news article to be sent.
-\(fn &optional NEWSGROUPS SUBJECT)" t nil)
-
+(fn &optional NEWSGROUPS SUBJECT)" t nil)
(autoload 'message-reply "message" "\
Start editing a reply to the article in the current buffer.
-\(fn &optional TO-ADDRESS WIDE SWITCH-FUNCTION)" t nil)
-
+(fn &optional TO-ADDRESS WIDE SWITCH-FUNCTION)" t nil)
(autoload 'message-wide-reply "message" "\
Make a \"wide\" reply to the message in the current buffer.
-\(fn &optional TO-ADDRESS)" t nil)
-
+(fn &optional TO-ADDRESS)" t nil)
(autoload 'message-followup "message" "\
Follow up to the message in the current buffer.
If TO-NEWSGROUPS, use that as the new Newsgroups line.
-\(fn &optional TO-NEWSGROUPS)" t nil)
-
+(fn &optional TO-NEWSGROUPS)" t nil)
(autoload 'message-cancel-news "message" "\
Cancel an article you posted.
If ARG, allow editing of the cancellation message.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'message-supersede "message" "\
Start composing a message to supersede the current message.
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID." t nil)
-
(autoload 'message-recover "message" "\
Reread contents of current buffer from its last auto-save file." t nil)
-
(autoload 'message-forward "message" "\
Forward the current message via mail.
Optional NEWS will use news to forward instead of mail.
Optional DIGEST will use digest to forward.
-\(fn &optional NEWS DIGEST)" t nil)
-
+(fn &optional NEWS DIGEST)" t nil)
(autoload 'message-forward-make-body "message" "\
-\(fn FORWARD-BUFFER &optional DIGEST)" nil nil)
-
+(fn FORWARD-BUFFER &optional DIGEST)" nil nil)
(autoload 'message-forward-rmail-make-body "message" "\
-\(fn FORWARD-BUFFER)" nil nil)
-
+(fn FORWARD-BUFFER)" nil nil)
(autoload 'message-insinuate-rmail "message" "\
Let RMAIL use message to forward." t nil)
-
(autoload 'message-resend "message" "\
Resend the current article to ADDRESS.
-\(fn ADDRESS)" t nil)
-
+(fn ADDRESS)" t nil)
(autoload 'message-bounce "message" "\
Re-mail the current message.
This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
you." t nil)
-
(autoload 'message-mail-other-window "message" "\
Like `message-mail' command, but display mail buffer in another window.
-\(fn &optional TO SUBJECT)" t nil)
-
+(fn &optional TO SUBJECT)" t nil)
(autoload 'message-mail-other-frame "message" "\
Like `message-mail' command, but display mail buffer in another frame.
-\(fn &optional TO SUBJECT)" t nil)
-
+(fn &optional TO SUBJECT)" t nil)
(autoload 'message-news-other-window "message" "\
Start editing a news article to be sent.
-\(fn &optional NEWSGROUPS SUBJECT)" t nil)
-
+(fn &optional NEWSGROUPS SUBJECT)" t nil)
(autoload 'message-news-other-frame "message" "\
Start editing a news article to be sent.
-\(fn &optional NEWSGROUPS SUBJECT)" t nil)
-
+(fn &optional NEWSGROUPS SUBJECT)" t nil)
(autoload 'message-bold-region "message" "\
Bold all nonblank characters in the region.
Works by overstriking characters.
Called from program, takes two arguments START and END
which specify the range to operate on.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'message-unbold-region "message" "\
Remove all boldness (overstruck characters) in the region.
Called from program, takes two arguments START and END
which specify the range to operate on.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'message-mailto "message" "\
Command to parse command line mailto: links.
This is meant to be used for MIME handlers: Setting the handler
for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
will then start up Emacs ready to compose mail. For emacsclient use
- emacsclient -e '(message-mailto \"%u\")'
-
-\(fn &optional URL)" t nil)
+ emacsclient -e \\='(message-mailto \"%u\")'
+(fn &optional URL)" t nil)
(register-definition-prefixes "message" '("message-"))
-;;;***
-;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/meta-mode.el
-(push (purecopy '(meta-mode 1 0)) package--builtin-versions)
+(push (purecopy '(meta-mode 1 0)) package--builtin-versions)
(autoload 'metafont-mode "meta-mode" "\
Major mode for editing Metafont sources.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'metapost-mode "meta-mode" "\
Major mode for editing MetaPost sources.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "meta-mode" '("font-lock-match-meta-declaration-item-and-skip-to-next" "meta"))
-;;;***
-;;;### (autoloads nil "mh-acros" "mh-e/mh-acros.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-acros.el
(register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating"))
-;;;***
-;;;### (autoloads nil "mh-alias" "mh-e/mh-alias.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-alias.el
(register-definition-prefixes "mh-alias" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-buffers" "mh-e/mh-buffers.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-buffers.el
(register-definition-prefixes "mh-buffers" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-comp.el
(autoload 'mh-smail "mh-comp" "\
Compose a message with the MH mail system.
See `mh-send' for more details on composing mail." t nil)
-
(autoload 'mh-smail-other-window "mh-comp" "\
Compose a message with the MH mail system in other window.
See `mh-send' for more details on composing mail." t nil)
-
(autoload 'mh-smail-batch "mh-comp" "\
Compose a message with the MH mail system.
@@ -21516,10 +19696,8 @@ SUBJECT, and OTHER-HEADERS. Additional arguments are IGNORED.
This function remains for Emacs 21 compatibility. New
applications should use `mh-user-agent-compose'.
-\(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
-
+(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
(define-mail-user-agent 'mh-e-user-agent 'mh-user-agent-compose 'mh-send-letter 'mh-fully-kill-draft 'mh-before-send-letter-hook)
-
(autoload 'mh-user-agent-compose "mh-comp" "\
Set up mail composition draft with the MH mail system.
This is the `mail-user-agent' entry point to MH-E. This function
@@ -21536,8 +19714,7 @@ are strings.
Any additional arguments are IGNORED.
-\(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
-
+(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
(autoload 'mh-send-letter "mh-comp" "\
Save draft and send message.
@@ -21563,8 +19740,7 @@ use `mh-send-prog' to tell MH-E the name.
The hook `mh-annotate-msg-hook' is run after annotating the
message and scan line.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'mh-fully-kill-draft "mh-comp" "\
Quit editing and delete draft message.
@@ -21572,36 +19748,25 @@ If for some reason you are not happy with the draft, you can use
this command to kill the draft buffer and delete the draft
message. Use the command \\[kill-buffer] if you don't want to
delete the draft message." t nil)
-
(register-definition-prefixes "mh-comp" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-compat" "mh-e/mh-compat.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-compat.el
(register-definition-prefixes "mh-compat" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-e.el
-(push (purecopy '(mh-e 8 6 -4)) package--builtin-versions)
+(push (purecopy '(mh-e 8 6 -4)) package--builtin-versions)
(put 'mh-progs 'risky-local-variable t)
-
(put 'mh-lib 'risky-local-variable t)
-
(put 'mh-lib-progs 'risky-local-variable t)
-
(autoload 'mh-version "mh-e" "\
Display version information about MH-E and the MH mail handling system." t nil)
-
(register-definition-prefixes "mh-e" '("defcustom-mh" "defface-mh" "defgroup-mh" "mh-"))
-;;;***
-;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-folder.el
(autoload 'mh-rmail "mh-folder" "\
@@ -21611,8 +19776,7 @@ Scan an MH folder if ARG is non-nil.
This function is an entry point to MH-E, the Emacs interface to
the MH mail system.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'mh-nmail "mh-folder" "\
Check for new mail in inbox folder.
Scan an MH folder if ARG is non-nil.
@@ -21620,8 +19784,7 @@ Scan an MH folder if ARG is non-nil.
This function is an entry point to MH-E, the Emacs interface to
the MH mail system.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'mh-folder-mode "mh-folder" "\
Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
@@ -21678,135 +19841,95 @@ perform the operation on all messages in that region.
\\{mh-folder-mode-map}
-\(fn)" t nil)
-
-(register-definition-prefixes "mh-folder" '("mh-"))
+(fn)" t nil)
+(register-definition-prefixes "mh-folder" '(":keymap" "mh-"))
-;;;***
-;;;### (autoloads nil "mh-funcs" "mh-e/mh-funcs.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-funcs.el
(register-definition-prefixes "mh-funcs" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-identity" "mh-e/mh-identity.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from mh-e/mh-identity.el
(register-definition-prefixes "mh-identity" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-inc" "mh-e/mh-inc.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-inc.el
(register-definition-prefixes "mh-inc" '("mh-inc-spool-"))
-;;;***
-;;;### (autoloads nil "mh-junk" "mh-e/mh-junk.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-junk.el
(register-definition-prefixes "mh-junk" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-letter" "mh-e/mh-letter.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-letter.el
-(register-definition-prefixes "mh-letter" '("mh-"))
+(register-definition-prefixes "mh-letter" '(":keymap" "mh-"))
-;;;***
-;;;### (autoloads nil "mh-limit" "mh-e/mh-limit.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-limit.el
(register-definition-prefixes "mh-limit" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-mime" "mh-e/mh-mime.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-mime.el
(register-definition-prefixes "mh-mime" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-print" "mh-e/mh-print.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-print.el
(register-definition-prefixes "mh-print" '("mh-p"))
-;;;***
-;;;### (autoloads nil "mh-scan" "mh-e/mh-scan.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-scan.el
(register-definition-prefixes "mh-scan" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-search" "mh-e/mh-search.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-search.el
-(register-definition-prefixes "mh-search" '("mh-"))
+(register-definition-prefixes "mh-search" '(":keymap" "mh-"))
-;;;***
-;;;### (autoloads nil "mh-seq" "mh-e/mh-seq.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-seq.el
(register-definition-prefixes "mh-seq" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-show" "mh-e/mh-show.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-show.el
-(register-definition-prefixes "mh-show" '("mh-"))
+(register-definition-prefixes "mh-show" '(":keymap" "mh-"))
-;;;***
-;;;### (autoloads nil "mh-speed" "mh-e/mh-speed.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-speed.el
-(register-definition-prefixes "mh-speed" '("mh-"))
+(register-definition-prefixes "mh-speed" '(":keymap" "mh-"))
-;;;***
-;;;### (autoloads nil "mh-thread" "mh-e/mh-thread.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-thread.el
(register-definition-prefixes "mh-thread" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-tool-bar" "mh-e/mh-tool-bar.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from mh-e/mh-tool-bar.el
(register-definition-prefixes "mh-tool-bar" '("mh-tool-bar-"))
-;;;***
-;;;### (autoloads nil "mh-utils" "mh-e/mh-utils.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-utils.el
(register-definition-prefixes "mh-utils" '("mh-"))
-;;;***
-;;;### (autoloads nil "mh-xface" "mh-e/mh-xface.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-xface.el
(register-definition-prefixes "mh-xface" '("mh-"))
-;;;***
-;;;### (autoloads nil "mhtml-mode" "textmodes/mhtml-mode.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from textmodes/mhtml-mode.el
(autoload 'mhtml-mode "mhtml-mode" "\
@@ -21816,13 +19939,10 @@ Code inside a <script> element is indented using the rules from
`js-mode'; and code inside a <style> element is indented using
the rules from `css-mode'.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "mhtml-mode" '("mhtml-"))
-;;;***
-;;;### (autoloads nil "midnight" "midnight.el" (0 0 0 0))
;;; Generated autoloads from midnight.el
(defvar midnight-mode nil "\
@@ -21832,28 +19952,25 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `midnight-mode'.")
-
(custom-autoload 'midnight-mode "midnight" nil)
-
(autoload 'midnight-mode "midnight" "\
Non-nil means run `midnight-hook' at midnight.
-This is a minor mode. If called interactively, toggle the `Midnight
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Midnight mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='midnight-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'clean-buffer-list "midnight" "\
Kill old buffers that have not been displayed recently.
The relevant variables are `clean-buffer-list-delay-general',
@@ -21865,19 +19982,15 @@ While processing buffers, this procedure displays messages containing
the current date/time, buffer name, how many seconds ago it was
displayed (can be nil if the buffer was never displayed) and its
lifetime, i.e., its \"age\" when it will be purged." t nil)
-
(autoload 'midnight-delay-set "midnight" "\
Modify `midnight-timer' according to `midnight-delay'.
Sets the first argument SYMB (which must be symbol `midnight-delay')
to its second argument TM.
-\(fn SYMB TM)" nil nil)
-
+(fn SYMB TM)" nil nil)
(register-definition-prefixes "midnight" '("clean-buffer-list-" "midnight-"))
-;;;***
-;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (0 0 0 0))
;;; Generated autoloads from minibuf-eldef.el
(defvar minibuffer-electric-default-mode nil "\
@@ -21887,27 +20000,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `minibuffer-electric-default-mode'.")
-
(custom-autoload 'minibuffer-electric-default-mode "minibuf-eldef" nil)
-
(autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\
Toggle Minibuffer Electric Default mode.
-This is a minor mode. If called interactively, toggle the
-`Minibuffer-Electric-Default mode' mode. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='minibuffer-electric-default-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Minibuffer Electric Default mode is a global minor mode. When
enabled, minibuffer prompts that show a default value only show
the default when it's applicable -- that is, when hitting RET
@@ -21915,13 +20011,25 @@ would yield the default value. If the user modifies the input
such that hitting RET would enter a non-default value, the prompt
is modified to remove the default indication.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Minibuffer-Electric-Default mode' mode. If the prefix argument
+is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='minibuffer-electric-default-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "minibuf-eldef" '("minibuf"))
-;;;***
-;;;### (autoloads nil "misc" "misc.el" (0 0 0 0))
;;; Generated autoloads from misc.el
(autoload 'copy-from-above-command "misc" "\
@@ -21930,39 +20038,43 @@ Copy ARG characters, but not past the end of that line.
If no argument given, copy the entire rest of the line.
The characters copied are inserted in the buffer before point.
-\(fn &optional ARG)" t nil)
+Also see the `duplicate-line' command.
+
+(fn &optional ARG)" t nil)
+(autoload 'duplicate-line "misc" "\
+Duplicate the current line N times.
+Interactively, N is the prefix numeric argument, and defaults to 1.
+Also see the `copy-from-above-command' command.
+(fn &optional N)" t nil)
(autoload 'zap-up-to-char "misc" "\
Kill up to, but not including ARGth occurrence of CHAR.
+When run interactively, the argument INTERACTIVE is non-nil.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found.
Ignores CHAR at point.
+If called interactively, do a case sensitive search if CHAR
+is an upper-case character.
-\(fn ARG CHAR)" t nil)
-
+(fn ARG CHAR &optional INTERACTIVE)" t nil)
(autoload 'mark-beginning-of-buffer "misc" "\
Set mark at the beginning of the buffer." t nil)
-
(autoload 'mark-end-of-buffer "misc" "\
Set mark at the end of the buffer." t nil)
-
(autoload 'upcase-char "misc" "\
Uppercasify ARG chars starting from point. Point doesn't move.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'forward-to-word "misc" "\
Move forward until encountering the beginning of a word.
With argument, do this that many times.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'backward-to-word "misc" "\
Move backward until encountering the end of a word.
With argument, do this that many times.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'butterfly "misc" "\
Use butterflies to flip the desired bit on the drive platter.
Open hands and let the delicate wings flap once. The disturbance
@@ -21970,28 +20082,24 @@ ripples outward, changing the flow of the eddy currents in the
upper atmosphere. These cause momentary pockets of higher-pressure
air to form, which act as lenses that deflect incoming cosmic rays,
focusing them to strike the drive platter and flip the desired bit.
-You can type `M-x butterfly C-M-c' to run it. This is a permuted
+You can type \\`M-x butterfly C-M-c' to run it. This is a permuted
variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'." t nil)
-
(autoload 'list-dynamic-libraries "misc" "\
Display a list of all dynamic libraries known to Emacs.
-\(These are the libraries listed in `dynamic-library-alist'.)
+(These are the libraries listed in `dynamic-library-alist'.)
If optional argument LOADED-ONLY-P (interactively, prefix arg)
is non-nil, only libraries already loaded are listed.
Optional argument BUFFER specifies a buffer to use, instead of
\"*Dynamic Libraries*\".
The return value is always nil.
-\(fn &optional LOADED-ONLY-P BUFFER)" t nil)
-
+(fn &optional LOADED-ONLY-P BUFFER)" t nil)
(register-definition-prefixes "misc" '("list-dynamic-libraries--"))
-;;;***
-;;;### (autoloads nil "misearch" "misearch.el" (0 0 0 0))
;;; Generated autoloads from misearch.el
- (add-hook 'isearch-mode-hook 'multi-isearch-setup)
+ (add-hook 'isearch-mode-hook 'multi-isearch-setup)
(defvar multi-isearch-next-buffer-function nil "\
Function to call to get the next buffer to search.
@@ -22013,30 +20121,23 @@ should return the previous buffer to search.
If the second argument of this function WRAP is non-nil, then it
should return the first buffer in the series; and for the backward
search, it should return the last buffer in the series.")
-
(defvar multi-isearch-next-buffer-current-function nil "\
The currently active function to get the next buffer to search.
Initialized from `multi-isearch-next-buffer-function' when
Isearch starts.")
-
(defvar multi-isearch-current-buffer nil "\
The buffer where the search is currently searching.
The value is nil when the search still is in the initial buffer.")
-
(defvar multi-isearch-buffer-list nil "\
Sequence of buffers visited by multiple buffers Isearch.
This is nil if Isearch is not currently searching more than one buffer.")
-
(defvar multi-isearch-file-list nil "\
Sequence of files visited by multiple file buffers Isearch.")
-
(autoload 'multi-isearch-setup "misearch" "\
Set up isearch to search multiple buffers.
Intended to be added to `isearch-mode-hook'." nil nil)
-
(autoload 'multi-isearch-switch-buffer "misearch" "\
Switch to the next buffer in multi-buffer search." nil nil)
-
(autoload 'multi-isearch-buffers "misearch" "\
Start multi-buffer Isearch on a list of BUFFERS.
This list can contain live buffers or their names.
@@ -22044,8 +20145,7 @@ Interactively read buffer names to search, one by one, ended with RET.
With a prefix argument, ask for a regexp, and search in buffers
whose names match the specified regexp.
-\(fn BUFFERS)" t nil)
-
+(fn BUFFERS)" t nil)
(autoload 'multi-isearch-buffers-regexp "misearch" "\
Start multi-buffer regexp Isearch on a list of BUFFERS.
This list can contain live buffers or their names.
@@ -22053,8 +20153,7 @@ Interactively read buffer names to search, one by one, ended with RET.
With a prefix argument, ask for a regexp, and search in buffers
whose names match the specified regexp.
-\(fn BUFFERS)" t nil)
-
+(fn BUFFERS)" t nil)
(autoload 'multi-isearch-files "misearch" "\
Start multi-buffer Isearch on a list of FILES.
Relative file names in this list are expanded to absolute
@@ -22063,8 +20162,7 @@ Interactively read file names to search, one by one, ended with RET.
With a prefix argument, ask for a wildcard, and search in file buffers
whose file names match the specified wildcard.
-\(fn FILES)" t nil)
-
+(fn FILES)" t nil)
(autoload 'multi-isearch-files-regexp "misearch" "\
Start multi-buffer regexp Isearch on a list of FILES.
Relative file names in this list are expanded to absolute
@@ -22073,82 +20171,61 @@ Interactively read file names to search, one by one, ended with RET.
With a prefix argument, ask for a wildcard, and search in file buffers
whose file names match the specified wildcard.
-\(fn FILES)" t nil)
-
+(fn FILES)" t nil)
(register-definition-prefixes "misearch" '("misearch-unload-function" "multi-isearch-"))
-;;;***
-;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from progmodes/mixal-mode.el
-(push (purecopy '(mixal-mode 0 4)) package--builtin-versions)
+(push (purecopy '(mixal-mode 0 4)) package--builtin-versions)
(autoload 'mixal-mode "mixal-mode" "\
Major mode for the mixal asm language.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "mixal-mode" '("mixal-"))
-;;;***
-;;;### (autoloads nil "mm-archive" "gnus/mm-archive.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-archive.el
(register-definition-prefixes "mm-archive" '("mm-"))
-;;;***
-;;;### (autoloads nil "mm-bodies" "gnus/mm-bodies.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-bodies.el
(register-definition-prefixes "mm-bodies" '("mm-"))
-;;;***
-;;;### (autoloads nil "mm-decode" "gnus/mm-decode.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-decode.el
(register-definition-prefixes "mm-decode" '("mm-"))
-;;;***
-;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-encode.el
(define-obsolete-function-alias 'mm-default-file-encoding #'mm-default-file-type "28.1")
-
(autoload 'mm-default-file-type "mm-encode" "\
Return a default content type for FILE.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(register-definition-prefixes "mm-encode" '("mm-"))
-;;;***
-;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-extern.el
(autoload 'mm-extern-cache-contents "mm-extern" "\
Put the external-body part of HANDLE into its cache.
-\(fn HANDLE)" nil nil)
-
+(fn HANDLE)" nil nil)
(autoload 'mm-inline-external-body "mm-extern" "\
Show the external-body part of HANDLE.
This function replaces the buffer of HANDLE with a buffer contains
the entire message.
If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
-\(fn HANDLE &optional NO-DISPLAY)" nil nil)
-
+(fn HANDLE &optional NO-DISPLAY)" nil nil)
(register-definition-prefixes "mm-extern" '("mm-extern-"))
-;;;***
-;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-partial.el
(autoload 'mm-inline-partial "mm-partial" "\
@@ -22157,38 +20234,29 @@ This function replaces the buffer of HANDLE with a buffer contains
the entire message.
If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
-\(fn HANDLE &optional NO-DISPLAY)" nil nil)
-
+(fn HANDLE &optional NO-DISPLAY)" nil nil)
(register-definition-prefixes "mm-partial" '("mm-partial-find-parts"))
-;;;***
-;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-url.el
(autoload 'mm-url-insert-file-contents "mm-url" "\
Insert file contents of URL.
If `mm-url-use-external' is non-nil, use `mm-url-program'.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'mm-url-insert-file-contents-external "mm-url" "\
Insert file contents of URL using `mm-url-program'.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "mm-url" '("mm-url-"))
-;;;***
-;;;### (autoloads nil "mm-util" "gnus/mm-util.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-util.el
(register-definition-prefixes "mm-util" '("mm-"))
-;;;***
-;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-uu.el
(autoload 'mm-uu-dissect "mm-uu" "\
@@ -22197,31 +20265,24 @@ The optional NOHEADER means there's no header in the buffer.
MIME-TYPE specifies a MIME type and parameters, which defaults to the
value of `mm-uu-text-plain-type'.
-\(fn &optional NOHEADER MIME-TYPE)" nil nil)
-
+(fn &optional NOHEADER MIME-TYPE)" nil nil)
(autoload 'mm-uu-dissect-text-parts "mm-uu" "\
Dissect text parts and put uu handles into HANDLE.
Assume text has been decoded if DECODED is non-nil.
-\(fn HANDLE &optional DECODED)" nil nil)
-
+(fn HANDLE &optional DECODED)" nil nil)
(register-definition-prefixes "mm-uu" '("mm-"))
-;;;***
-;;;### (autoloads nil "mm-view" "gnus/mm-view.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-view.el
(register-definition-prefixes "mm-view" '("mm-"))
-;;;***
-;;;### (autoloads nil "mml" "gnus/mml.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml.el
(autoload 'mml-to-mime "mml" "\
Translate the current buffer from MML to MIME." nil nil)
-
(autoload 'mml-attach-file "mml" "\
Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
@@ -22235,100 +20296,88 @@ specifies how the attachment is intended to be displayed. It can
be either \"inline\" (displayed automatically within the message
body) or \"attachment\" (separate from the body).
+Also see the `mml-attach-file-at-the-end' variable.
+
If given a prefix interactively, no prompting will be done for
the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults
will be computed and used.
-\(fn FILE &optional TYPE DESCRIPTION DISPOSITION)" t nil)
-
+(fn FILE &optional TYPE DESCRIPTION DISPOSITION)" t nil)
(register-definition-prefixes "mml" '("mime-to-mml" "mml-"))
-;;;***
-;;;### (autoloads nil "mml-sec" "gnus/mml-sec.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml-sec.el
(register-definition-prefixes "mml-sec" '("mml-"))
-;;;***
-;;;### (autoloads nil "mml-smime" "gnus/mml-smime.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml-smime.el
(register-definition-prefixes "mml-smime" '("mml-smime-"))
-;;;***
-;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml1991.el
(autoload 'mml1991-encrypt "mml1991" "\
-\(fn CONT &optional SIGN)" nil nil)
-
+(fn CONT &optional SIGN)" nil nil)
(autoload 'mml1991-sign "mml1991" "\
-\(fn CONT)" nil nil)
-
+(fn CONT)" nil nil)
(register-definition-prefixes "mml1991" '("mml1991-"))
-;;;***
-;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml2015.el
(autoload 'mml2015-decrypt "mml2015" "\
-\(fn HANDLE CTL)" nil nil)
-
+(fn HANDLE CTL)" nil nil)
(autoload 'mml2015-decrypt-test "mml2015" "\
-\(fn HANDLE CTL)" nil nil)
-
+(fn HANDLE CTL)" nil nil)
(autoload 'mml2015-verify "mml2015" "\
-\(fn HANDLE CTL)" nil nil)
-
+(fn HANDLE CTL)" nil nil)
(autoload 'mml2015-verify-test "mml2015" "\
-\(fn HANDLE CTL)" nil nil)
-
+(fn HANDLE CTL)" nil nil)
(autoload 'mml2015-encrypt "mml2015" "\
-\(fn CONT &optional SIGN)" nil nil)
-
+(fn CONT &optional SIGN)" nil nil)
(autoload 'mml2015-sign "mml2015" "\
-\(fn CONT)" nil nil)
-
+(fn CONT)" nil nil)
(autoload 'mml2015-self-encrypt "mml2015" nil nil nil)
-
(register-definition-prefixes "mml2015" '("mml2015-"))
-;;;***
-;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/mode.el
+
+(register-definition-prefixes "srecode/mode" '("srecode-"))
+
+
+;;; Generated autoloads from cedet/semantic/decorate/mode.el
+
+(register-definition-prefixes "semantic/decorate/mode" '("define-semantic-decoration-style" "semantic-"))
+
+
;;; Generated autoloads from cedet/mode-local.el
(put 'define-overloadable-function 'doc-string-elt 3)
-
(register-definition-prefixes "mode-local" '("def" "describe-mode-local-bindings" "fetch-overload" "get-mode-local-parent" "make-obsolete-overload" "mode-local-" "setq-mode-local" "with-mode-local" "xref-mode-local-"))
-;;;***
-;;;### (autoloads nil "modula2" "progmodes/modula2.el" (0 0 0 0))
;;; Generated autoloads from progmodes/modula2.el
(defalias 'modula-2-mode 'm2-mode)
-
(autoload 'm2-mode "modula2" "\
This is a mode intended to support program development in Modula-2.
All control constructs of Modula-2 can be reached by typing C-c
@@ -22353,47 +20402,37 @@ followed by the first character of the construct.
`m2-compile-command' holds the command to compile a Modula-2 program.
`m2-link-command' holds the command to link a Modula-2 program.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "modula2" '("m2-" "m3-font-lock-keywords"))
-;;;***
-;;;### (autoloads nil "morse" "play/morse.el" (0 0 0 0))
;;; Generated autoloads from play/morse.el
(autoload 'morse-region "morse" "\
-Convert all text in a given region to morse code.
-
-\(fn BEG END)" t nil)
+Convert plain text in region to Morse code.
+See <https://en.wikipedia.org/wiki/Morse_code>.
+(fn BEG END)" t nil)
(autoload 'unmorse-region "morse" "\
-Convert morse coded text in region to ordinary ASCII text.
-
-\(fn BEG END)" t nil)
+Convert Morse coded text in region to plain text.
+(fn BEG END)" t nil)
(autoload 'nato-region "morse" "\
-Convert all text in a given region to NATO phonetic alphabet.
-
-\(fn BEG END)" t nil)
+Convert plain text in region to NATO spelling alphabet.
+(fn BEG END)" t nil)
(autoload 'denato-region "morse" "\
-Convert NATO phonetic alphabet in region to ordinary ASCII text.
-
-\(fn BEG END)" t nil)
+Convert NATO spelling alphabet text in region to plain text.
+(fn BEG END)" t nil)
(register-definition-prefixes "morse" '("morse-code" "nato-alphabet"))
-;;;***
-;;;### (autoloads nil "mouse-copy" "mouse-copy.el" (0 0 0 0))
;;; Generated autoloads from mouse-copy.el
(register-definition-prefixes "mouse-copy" '("mouse-"))
-;;;***
-;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (0 0 0 0))
;;; Generated autoloads from mouse-drag.el
(autoload 'mouse-drag-throw "mouse-drag" "\
@@ -22418,8 +20457,7 @@ hemisphere you're in.)
To test this function, evaluate:
(global-set-key [down-mouse-2] \\='mouse-drag-throw)
-\(fn START-EVENT)" t nil)
-
+(fn START-EVENT)" t nil)
(autoload 'mouse-drag-drag "mouse-drag" "\
\"Drag\" the page according to a mouse drag.
@@ -22436,33 +20474,29 @@ middle button in Tk text widgets.
To test this function, evaluate:
(global-set-key [down-mouse-2] \\='mouse-drag-drag)
-\(fn START-EVENT)" t nil)
-
+(fn START-EVENT)" t nil)
(register-definition-prefixes "mouse-drag" '("mouse-"))
-;;;***
-;;;### (autoloads nil "mpc" "mpc.el" (0 0 0 0))
;;; Generated autoloads from mpc.el
(autoload 'mpc "mpc" "\
Main entry point for MPC." t nil)
-
(register-definition-prefixes "mpc" '("mpc-" "tag-browser-tagtypes"))
-;;;***
-;;;### (autoloads nil "mpuz" "play/mpuz.el" (0 0 0 0))
;;; Generated autoloads from play/mpuz.el
(autoload 'mpuz "mpuz" "\
Multiplication puzzle with GNU Emacs." t nil)
-
(register-definition-prefixes "mpuz" '("mpuz-"))
-;;;***
-;;;### (autoloads nil "msb" "msb.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/mru-bookmark.el
+
+(register-definition-prefixes "semantic/mru-bookmark" '("global-semantic-mru-bookmark-mode" "semantic-"))
+
+
;;; Generated autoloads from msb.el
(defvar msb-mode nil "\
@@ -22472,50 +20506,41 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `msb-mode'.")
-
(custom-autoload 'msb-mode "msb" nil)
-
(autoload 'msb-mode "msb" "\
Toggle Msb mode.
-This is a minor mode. If called interactively, toggle the `Msb mode'
-mode. If the prefix argument is positive, enable the mode, and if it
-is zero or negative, disable the mode.
+This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
+different buffer menu using the function `msb'.
+
+This is a global minor mode. If called interactively, toggle the
+`Msb mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='msb-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
-different buffer menu using the function `msb'.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "msb" '("mouse-select-buffer" "msb"))
-;;;***
-;;;### (autoloads nil "mspools" "mail/mspools.el" (0 0 0 0))
;;; Generated autoloads from mail/mspools.el
(autoload 'mspools-show "mspools" "\
Show the list of non-empty spool files in the *spools* buffer.
Buffer is not displayed if SHOW is non-nil.
-\(fn &optional NOSHOW)" t nil)
-
+(fn &optional NOSHOW)" t nil)
(register-definition-prefixes "mspools" '("mspools-"))
-;;;***
-;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from international/mule-diag.el
(autoload 'list-character-sets "mule-diag" "\
@@ -22530,8 +20555,7 @@ ISO-2022-based coding systems.
With prefix ARG, the output format gets more cryptic,
but still shows the full information.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'read-charset "mule-diag" "\
Read a character set from the minibuffer, prompting with string PROMPT.
It must be an Emacs character set listed in the variable `charset-list'.
@@ -22542,23 +20566,19 @@ INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
See the documentation of the function `completing-read' for the detailed
meanings of these arguments.
-\(fn PROMPT &optional DEFAULT-VALUE INITIAL-INPUT)" nil nil)
-
+(fn PROMPT &optional DEFAULT-VALUE INITIAL-INPUT)" nil nil)
(autoload 'list-charset-chars "mule-diag" "\
Display a list of characters in character set CHARSET.
-\(fn CHARSET)" t nil)
-
+(fn CHARSET)" t nil)
(autoload 'describe-character-set "mule-diag" "\
Display information about built-in character set CHARSET.
-\(fn CHARSET)" t nil)
-
+(fn CHARSET)" t nil)
(autoload 'describe-coding-system "mule-diag" "\
Display information about CODING-SYSTEM.
-\(fn CODING-SYSTEM)" t nil)
-
+(fn CODING-SYSTEM)" t nil)
(autoload 'describe-current-coding-system-briefly "mule-diag" "\
Display coding systems currently used in a brief format in echo area.
@@ -22581,10 +20601,8 @@ in place of `..':
eol-type of `default-process-coding-system' for read
`default-process-coding-system' for write
eol-type of `default-process-coding-system'" t nil)
-
(autoload 'describe-current-coding-system "mule-diag" "\
Display coding systems currently used, in detail." t nil)
-
(autoload 'list-coding-systems "mule-diag" "\
Display a list of all coding systems.
This shows the mnemonic letter, name, and description of each coding system.
@@ -22592,33 +20610,27 @@ This shows the mnemonic letter, name, and description of each coding system.
With prefix ARG, the output format gets more cryptic,
but still contains full information about each coding system.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'list-coding-categories "mule-diag" "\
Display a list of all coding categories." nil nil)
-
(autoload 'describe-font "mule-diag" "\
Display information about a font whose name is FONTNAME.
-\(fn FONTNAME)" t nil)
-
+(fn FONTNAME)" t nil)
(autoload 'describe-fontset "mule-diag" "\
Display information about FONTSET.
This shows which font is used for which character(s).
-\(fn FONTSET)" t nil)
-
+(fn FONTSET)" t nil)
(autoload 'list-fontsets "mule-diag" "\
Display a list of all fontsets.
This shows the name, size, and style of each fontset.
With prefix arg, also list the fonts contained in each fontset;
see the function `describe-fontset' for the format of the list.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'list-input-methods "mule-diag" "\
Display information about all input methods." t nil)
-
(autoload 'mule-diag "mule-diag" "\
Display diagnosis of the multilingual environment (Mule).
@@ -22626,27 +20638,21 @@ This shows various information related to the current multilingual
environment, including lists of input methods, coding systems,
character sets, and fontsets (if Emacs is running under a window
system which uses fontsets)." t nil)
-
(autoload 'font-show-log "mule-diag" "\
Show log of font listing and opening.
Prefix arg LIMIT says how many fonts to show for each listing.
The default is 20. If LIMIT is negative, do not limit the listing.
-\(fn &optional LIMIT)" t nil)
-
+(fn &optional LIMIT)" t nil)
(register-definition-prefixes "mule-diag" '("charset-history" "describe-font-internal" "insert-section" "list-" "mule--kbd-at" "print-" "sort-listed-character-sets"))
-;;;***
-;;;### (autoloads nil "mule-util" "international/mule-util.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from international/mule-util.el
(autoload 'store-substring "mule-util" "\
Embed OBJ (string or character) at index IDX of STRING.
-\(fn STRING IDX OBJ)" nil nil)
-
+(fn STRING IDX OBJ)" nil nil)
(autoload 'truncate-string-to-width "mule-util" "\
Truncate string STR to end at column END-COLUMN.
The optional 3rd arg START-COLUMN, if non-nil, specifies the starting
@@ -22680,19 +20686,17 @@ If ELLIPSIS-TEXT-PROPERTY is non-nil, a too-long string will not
be truncated, but instead the elided parts will be covered by a
`display' text property showing the ellipsis.
-\(fn STR END-COLUMN &optional START-COLUMN PADDING ELLIPSIS ELLIPSIS-TEXT-PROPERTY)" nil nil)
-
+(fn STR END-COLUMN &optional START-COLUMN PADDING ELLIPSIS ELLIPSIS-TEXT-PROPERTY)" nil nil)
(defsubst nested-alist-p (obj) "\
Return t if OBJ is a nested alist.
Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is
any Lisp object, and BRANCHES is a list of cons cells of the form
-\(KEY-ELEMENT . NESTED-ALIST).
+(KEY-ELEMENT . NESTED-ALIST).
You can use a nested alist to store any Lisp object (ENTRY) for a key
sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ
can be a string, a vector, or a list." (and obj (listp obj) (listp (cdr obj))))
-
(autoload 'set-nested-alist "mule-util" "\
Set ENTRY for KEYSEQ in a nested alist ALIST.
Optional 4th arg LEN non-nil means the first LEN elements in KEYSEQ
@@ -22701,8 +20705,7 @@ Optional 5th argument BRANCHES if non-nil is branches for a keyseq
longer than KEYSEQ.
See the documentation of `nested-alist-p' for more detail.
-\(fn KEYSEQ ENTRY ALIST &optional LEN BRANCHES)" nil nil)
-
+(fn KEYSEQ ENTRY ALIST &optional LEN BRANCHES)" nil nil)
(autoload 'lookup-nested-alist "mule-util" "\
Look up key sequence KEYSEQ in nested alist ALIST. Return the definition.
Optional 3rd argument LEN specifies the length of KEYSEQ.
@@ -22715,45 +20718,37 @@ If ALIST is not deep enough for KEYSEQ, return number which is
Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil
even if ALIST is not deep enough.
-\(fn KEYSEQ ALIST &optional LEN START NIL-FOR-TOO-LONG)" nil nil)
-
+(fn KEYSEQ ALIST &optional LEN START NIL-FOR-TOO-LONG)" nil nil)
(autoload 'coding-system-post-read-conversion "mule-util" "\
Return the value of CODING-SYSTEM's `post-read-conversion' property.
-\(fn CODING-SYSTEM)" nil nil)
-
+(fn CODING-SYSTEM)" nil nil)
(autoload 'coding-system-pre-write-conversion "mule-util" "\
Return the value of CODING-SYSTEM's `pre-write-conversion' property.
-\(fn CODING-SYSTEM)" nil nil)
-
+(fn CODING-SYSTEM)" nil nil)
(autoload 'coding-system-translation-table-for-decode "mule-util" "\
Return the value of CODING-SYSTEM's `decode-translation-table' property.
-\(fn CODING-SYSTEM)" nil nil)
-
+(fn CODING-SYSTEM)" nil nil)
(autoload 'coding-system-translation-table-for-encode "mule-util" "\
Return the value of CODING-SYSTEM's `encode-translation-table' property.
-\(fn CODING-SYSTEM)" nil nil)
-
+(fn CODING-SYSTEM)" nil nil)
(autoload 'with-coding-priority "mule-util" "\
Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list.
CODING-SYSTEMS is a list of coding systems. See `set-coding-system-priority'.
This affects the implicit sorting of lists of coding systems returned by
operations such as `find-coding-systems-region'.
-\(fn CODING-SYSTEMS &rest BODY)" nil t)
-
-(function-put 'with-coding-priority 'lisp-indent-function '1)
-
+(fn CODING-SYSTEMS &rest BODY)" nil t)
+(function-put 'with-coding-priority 'lisp-indent-function 1)
(autoload 'detect-coding-with-language-environment "mule-util" "\
Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
language environment LANG-ENV.
-\(fn FROM TO LANG-ENV)" nil nil)
-
+(fn FROM TO LANG-ENV)" nil nil)
(autoload 'filepos-to-bufferpos "mule-util" "\
Try to return the buffer position corresponding to a particular file position.
The file position is given as a (0-based) BYTE count.
@@ -22768,8 +20763,7 @@ QUALITY can be:
EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation.
-\(fn BYTE &optional QUALITY CODING-SYSTEM)" nil nil)
-
+(fn BYTE &optional QUALITY CODING-SYSTEM)" nil nil)
(autoload 'bufferpos-to-filepos "mule-util" "\
Try to return the file byte corresponding to a particular buffer POSITION.
Value is the file position given as a (0-based) byte count.
@@ -22784,13 +20778,28 @@ QUALITY can be:
EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation.
-\(fn POSITION &optional QUALITY CODING-SYSTEM)" nil nil)
-
+(fn POSITION &optional QUALITY CODING-SYSTEM)" nil nil)
(register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis"))
-;;;***
-;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/multisession.el
+
+(autoload 'define-multisession-variable "multisession" "\
+Make NAME into a multisession variable initialized from INITIAL-VALUE.
+DOC should be a doc string, and ARGS are keywords as applicable to
+`make-multisession'.
+
+(fn NAME INITIAL-VALUE &optional DOC &rest ARGS)" nil t)
+(function-put 'define-multisession-variable 'lisp-indent-function 'defun)
+(autoload 'list-multisession-values "multisession" "\
+List all values in the \"multisession\" database.
+If CHOOSE-STORAGE (interactively, the prefix), query for the
+storage method to list.
+
+(fn &optional CHOOSE-STORAGE)" t nil)
+(register-definition-prefixes "multisession" '("multisession-"))
+
+
;;; Generated autoloads from mwheel.el
(defvar mouse-wheel-mode t "\
@@ -22800,62 +20809,50 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `mouse-wheel-mode'.")
-
(custom-autoload 'mouse-wheel-mode "mwheel" nil)
-
(autoload 'mouse-wheel-mode "mwheel" "\
Toggle mouse wheel support (Mouse Wheel mode).
-This is a minor mode. If called interactively, toggle the
-`Mouse-Wheel mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Mouse-Wheel mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='mouse-wheel-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
-;;;***
-;;;### (autoloads nil "net-utils" "net/net-utils.el" (0 0 0 0))
;;; Generated autoloads from net/net-utils.el
(autoload 'ifconfig "net-utils" "\
Run `ifconfig-program' and display diagnostic output." t nil)
-
(autoload 'iwconfig "net-utils" "\
Run `iwconfig-program' and display diagnostic output." t nil)
-
(autoload 'netstat "net-utils" "\
Run `netstat-program' and display diagnostic output." t nil)
-
(autoload 'arp "net-utils" "\
Run `arp-program' and display diagnostic output." t nil)
-
(autoload 'route "net-utils" "\
Run `route-program' and display diagnostic output." t nil)
-
(autoload 'traceroute "net-utils" "\
Run `traceroute-program' for TARGET.
-\(fn TARGET)" t nil)
-
+(fn TARGET)" t nil)
(autoload 'ping "net-utils" "\
Ping HOST.
If your system's ping continues until interrupted, you can try setting
`ping-program-options'.
-\(fn HOST)" t nil)
-
+(fn HOST)" t nil)
(autoload 'nslookup-host "net-utils" "\
Look up the DNS information for HOST (name or IP address).
Optional argument NAME-SERVER says which server to use for
@@ -22868,8 +20865,7 @@ See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
non-interactive versions of this function more suitable for use
in Lisp code.
-\(fn HOST &optional NAME-SERVER)" t nil)
-
+(fn HOST &optional NAME-SERVER)" t nil)
(autoload 'nslookup-host-ipv4 "net-utils" "\
Return the IPv4 address for HOST (name or IP address).
Optional argument NAME-SERVER says which server to use for DNS
@@ -22881,8 +20877,7 @@ vector of octets.
This command uses `nslookup-program' to look up DNS records.
-\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
-
+(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
(autoload 'nslookup-host-ipv6 "net-utils" "\
Return the IPv6 address for HOST (name or IP address).
Optional argument NAME-SERVER says which server to use for DNS
@@ -22894,11 +20889,9 @@ vector of hextets.
This command uses `nslookup-program' to look up DNS records.
-\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
-
+(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
(autoload 'nslookup "net-utils" "\
Run `nslookup-program'." t nil)
-
(autoload 'dns-lookup-host "net-utils" "\
Look up the DNS information for HOST (name or IP address).
Optional argument NAME-SERVER says which server to use for
@@ -22907,8 +20900,7 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument.
This command uses `dns-lookup-program' for looking up the DNS information.
-\(fn HOST &optional NAME-SERVER)" t nil)
-
+(fn HOST &optional NAME-SERVER)" t nil)
(autoload 'run-dig "net-utils" "\
Look up DNS information for HOST (name or IP address).
Optional argument NAME-SERVER says which server to use for
@@ -22917,46 +20909,37 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument.
This command uses `dig-program' for looking up the DNS information.
-\(fn HOST &optional NAME-SERVER)" t nil)
-
+(fn HOST &optional NAME-SERVER)" t nil)
(autoload 'ftp "net-utils" "\
Run `ftp-program' to connect to HOST.
-\(fn HOST)" t nil)
-
+(fn HOST)" t nil)
(autoload 'finger "net-utils" "\
Finger USER on HOST.
This command uses `finger-X.500-host-regexps'
and `network-connection-service-alist', which see.
-\(fn USER HOST)" t nil)
-
+(fn USER HOST)" t nil)
(autoload 'whois "net-utils" "\
Send SEARCH-STRING to server defined by the `whois-server-name' variable.
If `whois-guess-server' is non-nil, then try to deduce the correct server
from SEARCH-STRING. With argument, prompt for whois server.
The port is deduced from `network-connection-service-alist'.
-\(fn ARG SEARCH-STRING)" t nil)
-
+(fn ARG SEARCH-STRING)" t nil)
(autoload 'whois-reverse-lookup "net-utils" nil t nil)
-
(autoload 'network-connection-to-service "net-utils" "\
Open a network connection to SERVICE on HOST.
This command uses `network-connection-service-alist', which see.
-\(fn HOST SERVICE)" t nil)
-
+(fn HOST SERVICE)" t nil)
(autoload 'network-connection "net-utils" "\
Open a network connection to HOST on PORT.
-\(fn HOST PORT)" t nil)
-
+(fn HOST PORT)" t nil)
(register-definition-prefixes "net-utils" '("arp-program" "dig-program" "dns-lookup-program" "finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig" "iwconfig-program" "net" "nslookup-" "ping-program" "route-program" "run-network-program" "smbclient" "traceroute-program" "whois-"))
-;;;***
-;;;### (autoloads nil "netrc" "net/netrc.el" (0 0 0 0))
;;; Generated autoloads from net/netrc.el
(autoload 'netrc-credentials "netrc" "\
@@ -22964,14 +20947,10 @@ Return a user name/password pair.
Port specifications will be prioritized in the order they are
listed in the PORTS list.
-\(fn MACHINE &rest PORTS)" nil nil)
-
+(fn MACHINE &rest PORTS)" nil nil)
(register-definition-prefixes "netrc" '("netrc-"))
-;;;***
-;;;### (autoloads nil "network-stream" "net/network-stream.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from net/network-stream.el
(autoload 'open-network-stream "network-stream" "\
@@ -23080,23 +21059,17 @@ type (either `gnutls-x509pki' or `gnutls-anon'), and the
remaining elements should be a keyword list accepted by
gnutls-boot (as returned by `gnutls-boot-parameters').
-\(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil)
-
+(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil)
(define-obsolete-function-alias 'open-protocol-stream #'open-network-stream "26.1")
-
(register-definition-prefixes "network-stream" '("network-stream-"))
-;;;***
-;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from net/newst-backend.el
(autoload 'newsticker-running-p "newst-backend" "\
Check whether newsticker is running.
Return t if newsticker is running, nil otherwise. Newsticker is
considered to be running if the newsticker timer list is not empty." nil nil)
-
(autoload 'newsticker-start "newst-backend" "\
Start the newsticker.
Start the timers for display and retrieval. If the newsticker, i.e. the
@@ -23104,36 +21077,24 @@ timers, are running already a warning message is printed unless
DO-NOT-COMPLAIN-IF-RUNNING is not nil.
Run `newsticker-start-hook' if newsticker was not running already.
-\(fn &optional DO-NOT-COMPLAIN-IF-RUNNING)" t nil)
-
+(fn &optional DO-NOT-COMPLAIN-IF-RUNNING)" t nil)
(register-definition-prefixes "newst-backend" '("newsticker-"))
-;;;***
-;;;### (autoloads nil "newst-plainview" "net/newst-plainview.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from net/newst-plainview.el
(autoload 'newsticker-plainview "newst-plainview" "\
Start newsticker plainview." t nil)
-
(register-definition-prefixes "newst-plainview" '("newsticker-"))
-;;;***
-;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from net/newst-reader.el
(autoload 'newsticker-show-news "newst-reader" "\
Start reading news. You may want to bind this to a key." t nil)
-
(register-definition-prefixes "newst-reader" '("newsticker-"))
-;;;***
-;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from net/newst-ticker.el
(autoload 'newsticker-ticker-running-p "newst-ticker" "\
@@ -23141,68 +21102,49 @@ Check whether newsticker's actual ticker is running.
Return t if ticker is running, nil otherwise. Newsticker is
considered to be running if the newsticker timer list is not
empty." nil nil)
-
(autoload 'newsticker-start-ticker "newst-ticker" "\
Start newsticker's ticker (but not the news retrieval).
Start display timer for the actual ticker if wanted and not
running already." t nil)
-
(register-definition-prefixes "newst-ticker" '("newsticker-"))
-;;;***
-;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from net/newst-treeview.el
(autoload 'newsticker-treeview "newst-treeview" "\
Start newsticker treeview." t nil)
-
(register-definition-prefixes "newst-treeview" '("newsticker-"))
-;;;***
-;;;### (autoloads nil "newsticker" "net/newsticker.el" (0 0 0 0))
;;; Generated autoloads from net/newsticker.el
(register-definition-prefixes "newsticker" '("newsticker-version"))
-;;;***
-;;;### (autoloads nil "nnagent" "gnus/nnagent.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnagent.el
(register-definition-prefixes "nnagent" '("nnagent-"))
-;;;***
-;;;### (autoloads nil "nnbabyl" "gnus/nnbabyl.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnbabyl.el
(register-definition-prefixes "nnbabyl" '("nnbabyl-"))
-;;;***
-;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndiary.el
(autoload 'nndiary-generate-nov-databases "nndiary" "\
Generate NOV databases in all nndiary directories.
-\(fn &optional SERVER)" t nil)
-
+(fn &optional SERVER)" t nil)
(register-definition-prefixes "nndiary" '("nndiary-"))
-;;;***
-;;;### (autoloads nil "nndir" "gnus/nndir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndir.el
(register-definition-prefixes "nndir" '("nndir-"))
-;;;***
-;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndoc.el
(autoload 'nndoc-add-type "nndoc" "\
@@ -23212,209 +21154,153 @@ as the last checked definition, if t or `first', add as the
first definition, and if any other symbol, add after that
symbol in the alist.
-\(fn DEFINITION &optional POSITION)" nil nil)
-
+(fn DEFINITION &optional POSITION)" nil nil)
(register-definition-prefixes "nndoc" '("nndoc-"))
-;;;***
-;;;### (autoloads nil "nndraft" "gnus/nndraft.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndraft.el
(register-definition-prefixes "nndraft" '("nndraft-"))
-;;;***
-;;;### (autoloads nil "nneething" "gnus/nneething.el" (0 0 0 0))
;;; Generated autoloads from gnus/nneething.el
(register-definition-prefixes "nneething" '("nneething-"))
-;;;***
-;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnfolder.el
(autoload 'nnfolder-generate-active-file "nnfolder" "\
Look for mbox folders in the nnfolder directory and make them into groups.
This command does not work if you use short group names." t nil)
-
(register-definition-prefixes "nnfolder" '("nnfolder-"))
-;;;***
-;;;### (autoloads nil "nngateway" "gnus/nngateway.el" (0 0 0 0))
;;; Generated autoloads from gnus/nngateway.el
(register-definition-prefixes "nngateway" '("nngateway-"))
-;;;***
-;;;### (autoloads nil "nnheader" "gnus/nnheader.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnheader.el
(register-definition-prefixes "nnheader" '("gnus-" "mail-header-" "make-mail-header" "nnheader-" "nntp-"))
-;;;***
-;;;### (autoloads nil "nnimap" "gnus/nnimap.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnimap.el
(register-definition-prefixes "nnimap" '("nnimap-"))
-;;;***
-;;;### (autoloads nil "nnmail" "gnus/nnmail.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmail.el
(register-definition-prefixes "nnmail" '("nnmail-"))
-;;;***
-;;;### (autoloads nil "nnmaildir" "gnus/nnmaildir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmaildir.el
(register-definition-prefixes "nnmaildir" '("nnmaildir-"))
-;;;***
-;;;### (autoloads nil "nnmairix" "gnus/nnmairix.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmairix.el
(register-definition-prefixes "nnmairix" '("nnmairix-"))
-;;;***
-;;;### (autoloads nil "nnmbox" "gnus/nnmbox.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmbox.el
(register-definition-prefixes "nnmbox" '("nnmbox-"))
-;;;***
-;;;### (autoloads nil "nnmh" "gnus/nnmh.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmh.el
(register-definition-prefixes "nnmh" '("nnmh-"))
-;;;***
-;;;### (autoloads nil "nnml" "gnus/nnml.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnml.el
(autoload 'nnml-generate-nov-databases "nnml" "\
Generate NOV databases in all nnml directories.
-\(fn &optional SERVER)" t nil)
-
+(fn &optional SERVER)" t nil)
(register-definition-prefixes "nnml" '("nnml-"))
-;;;***
-;;;### (autoloads nil "nnnil" "gnus/nnnil.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnnil.el
(register-definition-prefixes "nnnil" '("nnnil-"))
-;;;***
-;;;### (autoloads nil "nnoo" "gnus/nnoo.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnoo.el
(register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-" "noo--defalias"))
-;;;***
-;;;### (autoloads nil "nnregistry" "gnus/nnregistry.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnregistry.el
(register-definition-prefixes "nnregistry" '("nnregistry-"))
-;;;***
-;;;### (autoloads nil "nnrss" "gnus/nnrss.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnrss.el
(register-definition-prefixes "nnrss" '("nnrss-"))
-;;;***
-;;;### (autoloads nil "nnselect" "gnus/nnselect.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnselect.el
(register-definition-prefixes "nnselect" '("gnus-" "ids-by-group" "nnselect-" "numbers-by-group"))
-;;;***
-;;;### (autoloads nil "nnspool" "gnus/nnspool.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnspool.el
(register-definition-prefixes "nnspool" '("news-inews-program" "nnspool-"))
-;;;***
-;;;### (autoloads nil "nntp" "gnus/nntp.el" (0 0 0 0))
;;; Generated autoloads from gnus/nntp.el
(register-definition-prefixes "nntp" '("nntp-"))
-;;;***
-;;;### (autoloads nil "nnvirtual" "gnus/nnvirtual.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnvirtual.el
(register-definition-prefixes "nnvirtual" '("nnvirtual-"))
-;;;***
-;;;### (autoloads nil "nnweb" "gnus/nnweb.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnweb.el
(register-definition-prefixes "nnweb" '("nnweb-"))
-;;;***
-;;;### (autoloads nil "notifications" "notifications.el" (0 0 0 0))
;;; Generated autoloads from notifications.el
(register-definition-prefixes "notifications" '("notifications-"))
-;;;***
-;;;### (autoloads nil "novice" "novice.el" (0 0 0 0))
;;; Generated autoloads from novice.el
(defvar disabled-command-function 'disabled-command-function "\
Function to call to handle disabled commands.
If nil, the feature is disabled, i.e., all commands work normally.")
-
(autoload 'disabled-command-function "novice" "\
-\(fn &optional CMD KEYS)" nil nil)
-
+(fn &optional CMD KEYS)" nil nil)
(autoload 'enable-command "novice" "\
Allow COMMAND to be executed without special confirmation from now on.
COMMAND must be a symbol.
This command alters the user's .emacs file so that this will apply
to future sessions.
-\(fn COMMAND)" t nil)
-
+(fn COMMAND)" t nil)
(autoload 'disable-command "novice" "\
Require special confirmation to execute COMMAND from now on.
COMMAND must be a symbol.
This command alters your init file so that this choice applies to
future sessions.
-\(fn COMMAND)" t nil)
-
+(fn COMMAND)" t nil)
(register-definition-prefixes "novice" '("en/disable-command"))
-;;;***
-;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from textmodes/nroff-mode.el
(autoload 'nroff-mode "nroff-mode" "\
@@ -23424,42 +21310,31 @@ Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'.
Also, try `nroff-electric-mode', for automatically inserting
closing requests for requests that are used in matched pairs.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "nroff-mode" '("nroff-"))
-;;;***
-;;;### (autoloads nil "nsm" "net/nsm.el" (0 0 0 0))
;;; Generated autoloads from net/nsm.el
(register-definition-prefixes "nsm" '("network-security-" "nsm-"))
-;;;***
-;;;### (autoloads nil "ntlm" "net/ntlm.el" (0 0 0 0))
;;; Generated autoloads from net/ntlm.el
-(push (purecopy '(ntlm 2 1 0)) package--builtin-versions)
+(push (purecopy '(ntlm 2 1 0)) package--builtin-versions)
(register-definition-prefixes "ntlm" '("ntlm-"))
-;;;***
-;;;### (autoloads nil "nxml-enc" "nxml/nxml-enc.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-enc.el
(register-definition-prefixes "nxml-enc" '("nxml-"))
-;;;***
-;;;### (autoloads nil "nxml-maint" "nxml/nxml-maint.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-maint.el
(register-definition-prefixes "nxml-maint" '("nxml-insert-target-repertoire-glyph-set"))
-;;;***
-;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-mode.el
(autoload 'nxml-mode "nxml-mode" "\
@@ -23514,359 +21389,271 @@ to nil. For more details, see the function `nxml-forward-balanced-item'.
Many aspects this mode can be customized using
\\[customize-group] nxml RET.
-\(fn)" t nil)
+(fn)" t nil)
(defalias 'xml-mode 'nxml-mode)
-
(register-definition-prefixes "nxml-mode" '("nxml-"))
-;;;***
-;;;### (autoloads nil "nxml-ns" "nxml/nxml-ns.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-ns.el
(register-definition-prefixes "nxml-ns" '("nxml-ns-"))
-;;;***
-;;;### (autoloads nil "nxml-outln" "nxml/nxml-outln.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-outln.el
(register-definition-prefixes "nxml-outln" '("nxml-"))
-;;;***
-;;;### (autoloads nil "nxml-parse" "nxml/nxml-parse.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-parse.el
(register-definition-prefixes "nxml-parse" '("nxml-"))
-;;;***
-;;;### (autoloads nil "nxml-rap" "nxml/nxml-rap.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-rap.el
(register-definition-prefixes "nxml-rap" '("nxml-"))
-;;;***
-;;;### (autoloads nil "nxml-util" "nxml/nxml-util.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-util.el
(register-definition-prefixes "nxml-util" '("nxml-"))
-;;;***
-;;;### (autoloads nil "ob-C" "org/ob-C.el" (0 0 0 0))
;;; Generated autoloads from org/ob-C.el
(register-definition-prefixes "ob-C" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0))
;;; Generated autoloads from org/ob-R.el
(register-definition-prefixes "ob-R" '("ob-" "org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-awk" "org/ob-awk.el" (0 0 0 0))
;;; Generated autoloads from org/ob-awk.el
(register-definition-prefixes "ob-awk" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-calc" "org/ob-calc.el" (0 0 0 0))
;;; Generated autoloads from org/ob-calc.el
(register-definition-prefixes "ob-calc" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-clojure" "org/ob-clojure.el" (0 0 0 0))
;;; Generated autoloads from org/ob-clojure.el
(register-definition-prefixes "ob-clojure" '("ob-clojure-" "org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-comint" "org/ob-comint.el" (0 0 0 0))
;;; Generated autoloads from org/ob-comint.el
(register-definition-prefixes "ob-comint" '("org-babel-comint-"))
-;;;***
-;;;### (autoloads nil "ob-css" "org/ob-css.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-core.el
+
+(register-definition-prefixes "ob-core" '("org-"))
+
+
;;; Generated autoloads from org/ob-css.el
(register-definition-prefixes "ob-css" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-ditaa" "org/ob-ditaa.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ditaa.el
(register-definition-prefixes "ob-ditaa" '("org-"))
-;;;***
-;;;### (autoloads nil "ob-dot" "org/ob-dot.el" (0 0 0 0))
;;; Generated autoloads from org/ob-dot.el
(register-definition-prefixes "ob-dot" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-emacs-lisp" "org/ob-emacs-lisp.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from org/ob-emacs-lisp.el
(register-definition-prefixes "ob-emacs-lisp" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-eshell" "org/ob-eshell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-eshell.el
(register-definition-prefixes "ob-eshell" '("ob-eshell-session-live-p" "org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-eval" "org/ob-eval.el" (0 0 0 0))
;;; Generated autoloads from org/ob-eval.el
(register-definition-prefixes "ob-eval" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-exp" "org/ob-exp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-exp.el
(register-definition-prefixes "ob-exp" '("org-"))
-;;;***
-;;;### (autoloads nil "ob-forth" "org/ob-forth.el" (0 0 0 0))
;;; Generated autoloads from org/ob-forth.el
(register-definition-prefixes "ob-forth" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0))
;;; Generated autoloads from org/ob-fortran.el
(register-definition-prefixes "ob-fortran" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-gnuplot" "org/ob-gnuplot.el" (0 0 0 0))
;;; Generated autoloads from org/ob-gnuplot.el
(register-definition-prefixes "ob-gnuplot" '("*org-babel-gnuplot-" "org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-groovy" "org/ob-groovy.el" (0 0 0 0))
;;; Generated autoloads from org/ob-groovy.el
(register-definition-prefixes "ob-groovy" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-haskell.el
(register-definition-prefixes "ob-haskell" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-java" "org/ob-java.el" (0 0 0 0))
;;; Generated autoloads from org/ob-java.el
(register-definition-prefixes "ob-java" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-js" "org/ob-js.el" (0 0 0 0))
;;; Generated autoloads from org/ob-js.el
(register-definition-prefixes "ob-js" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-julia" "org/ob-julia.el" (0 0 0 0))
;;; Generated autoloads from org/ob-julia.el
(register-definition-prefixes "ob-julia" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0))
;;; Generated autoloads from org/ob-latex.el
(register-definition-prefixes "ob-latex" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-lilypond" "org/ob-lilypond.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lilypond.el
(register-definition-prefixes "ob-lilypond" '("lilypond-mode" "ob-lilypond-header-args" "org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-lisp" "org/ob-lisp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lisp.el
(register-definition-prefixes "ob-lisp" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-lob.el
+
+(register-definition-prefixes "ob-lob" '("org-babel-"))
+
+
;;; Generated autoloads from org/ob-lua.el
(register-definition-prefixes "ob-lua" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0))
;;; Generated autoloads from org/ob-makefile.el
(register-definition-prefixes "ob-makefile" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-maxima" "org/ob-maxima.el" (0 0 0 0))
;;; Generated autoloads from org/ob-maxima.el
(register-definition-prefixes "ob-maxima" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-ocaml" "org/ob-ocaml.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ocaml.el
(register-definition-prefixes "ob-ocaml" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-octave" "org/ob-octave.el" (0 0 0 0))
;;; Generated autoloads from org/ob-octave.el
(register-definition-prefixes "ob-octave" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-org" "org/ob-org.el" (0 0 0 0))
;;; Generated autoloads from org/ob-org.el
(register-definition-prefixes "ob-org" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-perl" "org/ob-perl.el" (0 0 0 0))
;;; Generated autoloads from org/ob-perl.el
(register-definition-prefixes "ob-perl" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-plantuml" "org/ob-plantuml.el" (0 0 0 0))
;;; Generated autoloads from org/ob-plantuml.el
(register-definition-prefixes "ob-plantuml" '("org-"))
-;;;***
-;;;### (autoloads nil "ob-processing" "org/ob-processing.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from org/ob-processing.el
(register-definition-prefixes "ob-processing" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0))
;;; Generated autoloads from org/ob-python.el
(register-definition-prefixes "ob-python" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-ref" "org/ob-ref.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ref.el
(register-definition-prefixes "ob-ref" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-ruby" "org/ob-ruby.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ruby.el
(register-definition-prefixes "ob-ruby" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-sass" "org/ob-sass.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sass.el
(register-definition-prefixes "ob-sass" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-scheme" "org/ob-scheme.el" (0 0 0 0))
;;; Generated autoloads from org/ob-scheme.el
(register-definition-prefixes "ob-scheme" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-screen" "org/ob-screen.el" (0 0 0 0))
;;; Generated autoloads from org/ob-screen.el
(register-definition-prefixes "ob-screen" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-sed" "org/ob-sed.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sed.el
(register-definition-prefixes "ob-sed" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-shell" "org/ob-shell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-shell.el
(register-definition-prefixes "ob-shell" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sql.el
(register-definition-prefixes "ob-sql" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-sqlite" "org/ob-sqlite.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sqlite.el
(register-definition-prefixes "ob-sqlite" '("org-babel-"))
-;;;***
-;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0))
;;; Generated autoloads from org/ob-table.el
(register-definition-prefixes "ob-table" '("org-"))
-;;;***
-;;;### (autoloads nil "oc" "org/oc.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-tangle.el
+
+(register-definition-prefixes "ob-tangle" '("org-babel-"))
+
+
;;; Generated autoloads from org/oc.el
(autoload 'org-cite-insert "oc" "\
@@ -23874,47 +21661,35 @@ Insert a citation at point.
Insertion is done according to the processor set in `org-cite-insert-processor'.
ARG is the prefix argument received when calling interactively the function.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "oc" '("org-cite-"))
-;;;***
-;;;### (autoloads nil "oc-basic" "org/oc-basic.el" (0 0 0 0))
;;; Generated autoloads from org/oc-basic.el
(register-definition-prefixes "oc-basic" '("org-cite-basic-"))
-;;;***
-;;;### (autoloads nil "oc-biblatex" "org/oc-biblatex.el" (0 0 0 0))
;;; Generated autoloads from org/oc-biblatex.el
(register-definition-prefixes "oc-biblatex" '("org-cite-biblatex-"))
-;;;***
-;;;### (autoloads nil "oc-csl" "org/oc-csl.el" (0 0 0 0))
;;; Generated autoloads from org/oc-csl.el
(register-definition-prefixes "oc-csl" '("org-cite-csl-"))
-;;;***
-;;;### (autoloads nil "oc-natbib" "org/oc-natbib.el" (0 0 0 0))
;;; Generated autoloads from org/oc-natbib.el
(register-definition-prefixes "oc-natbib" '("org-cite-natbib-"))
-;;;***
-;;;### (autoloads nil "octave" "progmodes/octave.el" (0 0 0 0))
;;; Generated autoloads from progmodes/octave.el
- (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-maybe-mode))
+ (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-maybe-mode))
(autoload 'octave-maybe-mode "octave" "\
Select `octave-mode' if the current buffer seems to hold Octave code." nil nil)
-
(autoload 'octave-mode "octave" "\
Major mode for editing Octave code.
@@ -23928,8 +21703,7 @@ See Info node `(octave-mode) Using Octave Mode' for more details.
Key bindings:
\\{octave-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'inferior-octave "octave" "\
Run an inferior Octave process, I/O via `inferior-octave-buffer'.
This buffer is put in Inferior Octave mode. See `inferior-octave-mode'.
@@ -23943,103 +21717,89 @@ Additional commands to be executed on startup can be provided either in
the file specified by `inferior-octave-startup-file' or by the default
startup file, `~/.emacs-octave'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(defalias 'run-octave 'inferior-octave)
-
(register-definition-prefixes "octave" '("inferior-octave-" "octave-"))
-;;;***
-;;;### (autoloads nil "ogonek" "international/ogonek.el" (0 0 0 0))
;;; Generated autoloads from international/ogonek.el
(register-definition-prefixes "ogonek" '("ogonek-"))
-;;;***
-;;;### (autoloads nil "ol-bibtex" "org/ol-bibtex.el" (0 0 0 0))
+;;; Generated autoloads from org/ol.el
+
+(register-definition-prefixes "ol" '("org-"))
+
+
+;;; Generated autoloads from org/ol-bbdb.el
+
+(register-definition-prefixes "ol-bbdb" '("org-bbdb-"))
+
+
;;; Generated autoloads from org/ol-bibtex.el
(register-definition-prefixes "ol-bibtex" '("org-"))
-;;;***
-;;;### (autoloads nil "ol-docview" "org/ol-docview.el" (0 0 0 0))
;;; Generated autoloads from org/ol-docview.el
(register-definition-prefixes "ol-docview" '("org-docview-"))
-;;;***
-;;;### (autoloads nil "ol-doi" "org/ol-doi.el" (0 0 0 0))
;;; Generated autoloads from org/ol-doi.el
(register-definition-prefixes "ol-doi" '("org-link-doi-"))
-;;;***
-;;;### (autoloads nil "ol-eshell" "org/ol-eshell.el" (0 0 0 0))
;;; Generated autoloads from org/ol-eshell.el
(register-definition-prefixes "ol-eshell" '("org-eshell-"))
-;;;***
-;;;### (autoloads nil "ol-eww" "org/ol-eww.el" (0 0 0 0))
;;; Generated autoloads from org/ol-eww.el
(register-definition-prefixes "ol-eww" '("org-eww-"))
-;;;***
-;;;### (autoloads nil "ol-gnus" "org/ol-gnus.el" (0 0 0 0))
;;; Generated autoloads from org/ol-gnus.el
(register-definition-prefixes "ol-gnus" '("org-gnus-"))
-;;;***
-;;;### (autoloads nil "ol-info" "org/ol-info.el" (0 0 0 0))
;;; Generated autoloads from org/ol-info.el
(register-definition-prefixes "ol-info" '("org-info-"))
-;;;***
-;;;### (autoloads nil "ol-man" "org/ol-man.el" (0 0 0 0))
+;;; Generated autoloads from org/ol-irc.el
+
+(register-definition-prefixes "ol-irc" '("org-irc-"))
+
+
;;; Generated autoloads from org/ol-man.el
(register-definition-prefixes "ol-man" '("org-man-"))
-;;;***
-;;;### (autoloads nil "ol-mhe" "org/ol-mhe.el" (0 0 0 0))
;;; Generated autoloads from org/ol-mhe.el
(register-definition-prefixes "ol-mhe" '("org-mhe-"))
-;;;***
-;;;### (autoloads nil "ol-rmail" "org/ol-rmail.el" (0 0 0 0))
;;; Generated autoloads from org/ol-rmail.el
(register-definition-prefixes "ol-rmail" '("org-rmail-"))
-;;;***
-;;;### (autoloads nil "ol-w3m" "org/ol-w3m.el" (0 0 0 0))
;;; Generated autoloads from org/ol-w3m.el
(register-definition-prefixes "ol-w3m" '("org-w3m-"))
-;;;***
-;;;### (autoloads nil "opascal" "progmodes/opascal.el" (0 0 0 0))
;;; Generated autoloads from progmodes/opascal.el
(define-obsolete-function-alias 'delphi-mode #'opascal-mode "24.4")
-
(autoload 'opascal-mode "opascal" "\
Major mode for editing OPascal code.
\\<opascal-mode-map>
@@ -24067,21 +21827,17 @@ Coloring:
`opascal-keyword-face' (default `font-lock-keyword-face')
Face used to color OPascal keywords.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "opascal" '("opascal-"))
-;;;***
-;;;### (autoloads nil "org" "org/org.el" (0 0 0 0))
;;; Generated autoloads from org/org.el
-(push (purecopy '(org 9 5 4)) package--builtin-versions)
+(push (purecopy '(org 9 5 4)) package--builtin-versions)
(autoload 'org-babel-do-load-languages "org" "\
Load the languages defined in `org-babel-load-languages'.
-\(fn SYM VALUE)" nil nil)
-
+(fn SYM VALUE)" nil nil)
(autoload 'org-babel-load-file "org" "\
Load Emacs Lisp source code blocks in the Org FILE.
This function exports the source code using `org-babel-tangle'
@@ -24089,8 +21845,7 @@ and then loads the resulting file using `load-file'. With
optional prefix argument COMPILE, the tangled Emacs Lisp file is
byte-compiled before it is loaded.
-\(fn FILE &optional COMPILE)" t nil)
-
+(fn FILE &optional COMPILE)" t nil)
(autoload 'org-version "org" "\
Show the Org version.
Interactively, or when MESSAGE is non-nil, show it in echo area.
@@ -24098,16 +21853,13 @@ With prefix argument, or when HERE is non-nil, insert it at point.
In non-interactive uses, a reduced version string is output unless
FULL is given.
-\(fn &optional HERE FULL MESSAGE)" t nil)
-
+(fn &optional HERE FULL MESSAGE)" t nil)
(autoload 'org-load-modules-maybe "org" "\
Load all extensions listed in `org-modules'.
-\(fn &optional FORCE)" nil nil)
-
+(fn &optional FORCE)" nil nil)
(autoload 'org-clock-persistence-insinuate "org" "\
Set up hooks for clock persistence." nil nil)
-
(autoload 'org-mode "org" "\
Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
@@ -24127,8 +21879,7 @@ The following commands are available:
\\{org-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'org-cycle "org" "\
TAB-action and visibility cycling for Org mode.
@@ -24179,23 +21930,20 @@ there is no headline there, and if the variable `org-cycle-global-at-bob'
is non-nil, this function acts as if called with prefix argument (`\\[universal-argument] TAB',
same as `S-TAB') also when called without prefix argument.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'org-global-cycle "org" "\
Cycle the global visibility. For details see `org-cycle'.
With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'org-run-like-in-org-mode "org" "\
Run a command, pretending that the current buffer is in Org mode.
This will temporarily bind local variables that are typically bound in
Org mode to the values they have in Org mode, and then interactively
call CMD.
-\(fn CMD)" nil nil)
-
+(fn CMD)" nil nil)
(autoload 'org-open-file "org" "\
Open the file at PATH.
First, this expands any special file name abbreviations. Then the
@@ -24218,8 +21966,7 @@ link, please customize `org-link-frame-setup'.
If the file does not exist, throw an error.
-\(fn PATH &optional IN-EMACS LINE SEARCH)" nil nil)
-
+(fn PATH &optional IN-EMACS LINE SEARCH)" nil nil)
(autoload 'org-open-at-point-global "org" "\
Follow a link or a time-stamp like Org mode does.
Also follow links and emails as seen by `thing-at-point'.
@@ -24227,7 +21974,6 @@ This command can be called in any mode to follow an external
link or a time-stamp that has Org mode syntax. Its behavior
is undefined when called on internal links like fuzzy links.
Raise a user error when there is nothing to follow." t nil)
-
(autoload 'org-offer-links-in-entry "org" "\
Offer links in the current entry and return the selected link.
If there is only one link, return it.
@@ -24235,8 +21981,7 @@ If NTH is an integer, return the NTH link found.
If ZERO is a string, check also this string for a link, and if
there is one, return it.
-\(fn BUFFER MARKER &optional NTH ZERO)" nil nil)
-
+(fn BUFFER MARKER &optional NTH ZERO)" nil nil)
(autoload 'org-switchb "org" "\
Switch between Org buffers.
@@ -24244,13 +21989,11 @@ With `\\[universal-argument]' prefix, restrict available buffers to files.
With `\\[universal-argument] \\[universal-argument]' prefix, restrict available buffers to agenda files.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'org-cycle-agenda-files "org" "\
Cycle through the files in `org-agenda-files'.
If the current buffer visits an agenda file, find the next one in the list.
If the current buffer does not, find the first agenda file." t nil)
-
(autoload 'org-submit-bug-report "org" "\
Submit a bug report on Org via mail.
@@ -24259,28 +22002,22 @@ Don't hesitate to report any problems or inaccurate documentation.
If you don't have setup sending mail from (X)Emacs, please copy the
output buffer into your mail program, as it gives us important
information about your Org version and configuration." t nil)
-
(autoload 'org-reload "org" "\
Reload all Org Lisp files.
With prefix arg UNCOMPILED, load the uncompiled versions.
-\(fn &optional UNCOMPILED)" t nil)
-
+(fn &optional UNCOMPILED)" t nil)
(autoload 'org-customize "org" "\
Call the customize function with org as argument." t nil)
-
(register-definition-prefixes "org" '("org-" "turn-on-org-cdlatex"))
-;;;***
-;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (0 0 0 0))
;;; Generated autoloads from org/org-agenda.el
(autoload 'org-toggle-sticky-agenda "org-agenda" "\
Toggle `org-agenda-sticky'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'org-agenda "org-agenda" "\
Dispatch agenda commands to collect entries to the agenda buffer.
Prompts for a command to execute. Any prefix arg will be passed
@@ -24311,12 +22048,11 @@ searches can be pre-defined in this way.
If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
-\(until the next use of `\\[org-agenda]') restricted to the current file.
+(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
-\(if active).
-
-\(fn &optional ARG KEYS RESTRICTION)" t nil)
+(if active).
+(fn &optional ARG KEYS RESTRICTION)" t nil)
(autoload 'org-batch-agenda "org-agenda" "\
Run an agenda command in batch mode and send the result to STDOUT.
If CMD-KEY is a string of length 1, it is used as a key in
@@ -24325,8 +22061,7 @@ longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command.
-\(fn CMD-KEY &rest PARAMETERS)" nil t)
-
+(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-batch-agenda-csv "org-agenda" "\
Run an agenda command in batch mode and send the result to STDOUT.
If CMD-KEY is a string of length 1, it is used as a key in
@@ -24362,18 +22097,15 @@ priority-l The priority letter if any was given
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed
-\(fn CMD-KEY &rest PARAMETERS)" nil t)
-
+(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-store-agenda-views "org-agenda" "\
Store agenda views.
-\(fn &rest PARAMETERS)" t nil)
-
+(fn &rest PARAMETERS)" t nil)
(autoload 'org-batch-store-agenda-views "org-agenda" "\
Run all custom agenda commands that have a file argument.
-\(fn &rest PARAMETERS)" nil t)
-
+(fn &rest PARAMETERS)" nil t)
(autoload 'org-agenda-list "org-agenda" "\
Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
@@ -24389,8 +22121,7 @@ given in `org-agenda-start-on-weekday'.
When WITH-HOUR is non-nil, only include scheduled and deadline
items if they have an hour specification like [h]h:mm.
-\(fn &optional ARG START-DAY SPAN WITH-HOUR)" t nil)
-
+(fn &optional ARG START-DAY SPAN WITH-HOUR)" t nil)
(autoload 'org-search-view "org-agenda" "\
Show all entries that contain a phrase or words or regular expressions.
@@ -24436,8 +22167,7 @@ This command searches the agenda files, and in addition the files
listed in `org-agenda-text-search-extra-files' unless a restriction lock
is active.
-\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil)
-
+(fn &optional TODO-ONLY STRING EDIT-AT)" t nil)
(autoload 'org-todo-list "org-agenda" "\
Show all (not done) TODO entries from all agenda files in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
@@ -24445,22 +22175,19 @@ the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'org-tags-view "org-agenda" "\
Show all headlines for all `org-agenda-files' matching a TAGS criterion.
The prefix arg TODO-ONLY limits the search to TODO entries.
-\(fn &optional TODO-ONLY MATCH)" t nil)
-
+(fn &optional TODO-ONLY MATCH)" t nil)
(autoload 'org-agenda-list-stuck-projects "org-agenda" "\
Create agenda view for projects that are stuck.
Stuck projects are project that have no next actions. For the definitions
of what a project is and how to check if it stuck, customize the variable
`org-stuck-projects'.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'org-diary "org-agenda" "\
Return diary information from org files.
This function can be used in a \"sexp\" diary entry in the Emacs calendar.
@@ -24488,28 +22215,24 @@ The function expects the lisp variables `entry' and `date' to be provided
by the caller, because this is how the calendar works. Don't use this
function from a program - use `org-agenda-get-day-entries' instead.
-\(fn &rest ARGS)" nil nil)
-
+(fn &rest ARGS)" nil nil)
(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\
Do we have a reason to ignore this TODO entry because it has a time stamp?
-\(fn &optional END)" nil nil)
-
+(fn &optional END)" nil nil)
(autoload 'org-agenda-set-restriction-lock "org-agenda" "\
Set restriction lock for agenda to current subtree or file.
When in a restricted subtree, remove it.
The restriction will span over the entire file if TYPE is `file',
-or if type is '(4), or if the cursor is before the first headline
+or if type is \\='(4), or if the cursor is before the first headline
in the file. Otherwise, only apply the restriction to the current
subtree.
-\(fn &optional TYPE)" t nil)
-
+(fn &optional TYPE)" t nil)
(autoload 'org-calendar-goto-agenda "org-agenda" "\
Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'." t nil)
-
(autoload 'org-agenda-to-appt "org-agenda" "\
Activate appointments found in `org-agenda-files'.
@@ -24536,35 +22259,38 @@ belonging to the \"Work\" category.
ARGS are symbols indicating what kind of entries to consider.
By default `org-agenda-to-appt' will use :deadline*, :scheduled*
-\(i.e., deadlines and scheduled items with a hh:mm specification)
+(i.e., deadlines and scheduled items with a hh:mm specification)
and :timestamp entries. See the docstring of `org-diary' for
details and examples.
If an entry has a APPT_WARNTIME property, its value will be used
to override `appt-message-warning-time'.
-\(fn &optional REFRESH FILTER &rest ARGS)" t nil)
-
+(fn &optional REFRESH FILTER &rest ARGS)" t nil)
(register-definition-prefixes "org-agenda" '("org-"))
-;;;***
-;;;### (autoloads nil "org-attach-git" "org/org-attach-git.el" (0
-;;;;;; 0 0 0))
+;;; Generated autoloads from org/org-archive.el
+
+(register-definition-prefixes "org-archive" '("org-a"))
+
+
+;;; Generated autoloads from org/org-attach.el
+
+(register-definition-prefixes "org-attach" '("org-attach-"))
+
+
;;; Generated autoloads from org/org-attach-git.el
(register-definition-prefixes "org-attach-git" '("org-attach-git-"))
-;;;***
-;;;### (autoloads nil "org-capture" "org/org-capture.el" (0 0 0 0))
;;; Generated autoloads from org/org-capture.el
(autoload 'org-capture-string "org-capture" "\
Capture STRING with the template selected by KEYS.
-\(fn STRING &optional KEYS)" t nil)
-
+(fn STRING &optional KEYS)" t nil)
(autoload 'org-capture "org-capture" "\
Capture something.
\\<org-capture-mode-map>
@@ -24594,137 +22320,202 @@ agenda will use the date at point as the default date. Then, a
`C-1' prefix will tell the capture process to use the HH:MM time
of the day at point (if any) or the current HH:MM time.
-\(fn &optional GOTO KEYS)" t nil)
-
+(fn &optional GOTO KEYS)" t nil)
(autoload 'org-capture-import-remember-templates "org-capture" "\
Set `org-capture-templates' to be similar to `org-remember-templates'." t nil)
-
(register-definition-prefixes "org-capture" '("org-capture-"))
-;;;***
-;;;### (autoloads nil "org-crypt" "org/org-crypt.el" (0 0 0 0))
+;;; Generated autoloads from org/org-clock.el
+
+(register-definition-prefixes "org-clock" '("org-"))
+
+
+;;; Generated autoloads from org/org-colview.el
+
+(register-definition-prefixes "org-colview" '("org-"))
+
+
+;;; Generated autoloads from org/org-compat.el
+
+(register-definition-prefixes "org-compat" '("org-"))
+
+
;;; Generated autoloads from org/org-crypt.el
(autoload 'org-encrypt-entry "org-crypt" "\
Encrypt the content of the current headline." t nil)
-
(autoload 'org-decrypt-entry "org-crypt" "\
Decrypt the content of the current headline." t nil)
-
(autoload 'org-encrypt-entries "org-crypt" "\
Encrypt all top-level entries in the current buffer." t nil)
-
(autoload 'org-decrypt-entries "org-crypt" "\
Decrypt all entries in the current buffer." t nil)
-
(autoload 'org-crypt-use-before-save-magic "org-crypt" "\
Add a hook to automatically encrypt entries before a file is saved to disk." nil nil)
-
(register-definition-prefixes "org-crypt" '("org-"))
-;;;***
-;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0))
;;; Generated autoloads from org/org-ctags.el
(register-definition-prefixes "org-ctags" '("org-ctags-"))
-;;;***
-;;;### (autoloads nil "org-entities" "org/org-entities.el" (0 0 0
-;;;;;; 0))
+;;; Generated autoloads from org/org-datetree.el
+
+(register-definition-prefixes "org-datetree" '("org-datetree-"))
+
+
+;;; Generated autoloads from org/org-duration.el
+
+(register-definition-prefixes "org-duration" '("org-duration-"))
+
+
+;;; Generated autoloads from org/org-element.el
+
+(register-definition-prefixes "org-element" '("org-element-"))
+
+
;;; Generated autoloads from org/org-entities.el
(register-definition-prefixes "org-entities" '("org-entit"))
-;;;***
-;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0))
;;; Generated autoloads from org/org-faces.el
(register-definition-prefixes "org-faces" '("org-"))
-;;;***
-;;;### (autoloads nil "org-habit" "org/org-habit.el" (0 0 0 0))
+;;; Generated autoloads from org/org-feed.el
+
+(register-definition-prefixes "org-feed" '("org-feed-"))
+
+
+;;; Generated autoloads from org/org-footnote.el
+
+(register-definition-prefixes "org-footnote" '("org-footnote-"))
+
+
+;;; Generated autoloads from org/org-goto.el
+
+(register-definition-prefixes "org-goto" '("org-goto-"))
+
+
;;; Generated autoloads from org/org-habit.el
(register-definition-prefixes "org-habit" '("org-"))
-;;;***
-;;;### (autoloads nil "org-inlinetask" "org/org-inlinetask.el" (0
-;;;;;; 0 0 0))
+;;; Generated autoloads from org/org-id.el
+
+(register-definition-prefixes "org-id" '("org-id-"))
+
+
+;;; Generated autoloads from org/org-indent.el
+
+(register-definition-prefixes "org-indent" '("org-indent-"))
+
+
;;; Generated autoloads from org/org-inlinetask.el
(register-definition-prefixes "org-inlinetask" '("org-inlinetask-"))
-;;;***
-;;;### (autoloads nil "org-macro" "org/org-macro.el" (0 0 0 0))
+;;; Generated autoloads from org/org-keys.el
+
+(register-definition-prefixes "org-keys" '("org-"))
+
+
+;;; Generated autoloads from org/org-lint.el
+
+(register-definition-prefixes "org-lint" '("org-lint-"))
+
+
+;;; Generated autoloads from org/org-list.el
+
+(register-definition-prefixes "org-list" '("org-"))
+
+
;;; Generated autoloads from org/org-macro.el
(register-definition-prefixes "org-macro" '("org-macro-"))
-;;;***
-;;;### (autoloads nil "org-mouse" "org/org-mouse.el" (0 0 0 0))
+;;; Generated autoloads from org/org-macs.el
+
+(register-definition-prefixes "org-macs" '("org-"))
+
+
+;;; Generated autoloads from org/org-mobile.el
+
+(register-definition-prefixes "org-mobile" '("org-mobile-"))
+
+
;;; Generated autoloads from org/org-mouse.el
(register-definition-prefixes "org-mouse" '("org-mouse-"))
-;;;***
-;;;### (autoloads nil "org-pcomplete" "org/org-pcomplete.el" (0 0
-;;;;;; 0 0))
+;;; Generated autoloads from org/org-num.el
+
+(register-definition-prefixes "org-num" '("org-num-"))
+
+
;;; Generated autoloads from org/org-pcomplete.el
(register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/"))
-;;;***
-;;;### (autoloads nil "org-protocol" "org/org-protocol.el" (0 0 0
-;;;;;; 0))
+;;; Generated autoloads from org/org-plot.el
+
+(register-definition-prefixes "org-plot" '("org-"))
+
+
;;; Generated autoloads from org/org-protocol.el
(register-definition-prefixes "org-protocol" '("org-protocol-"))
-;;;***
-;;;### (autoloads nil "org-src" "org/org-src.el" (0 0 0 0))
+;;; Generated autoloads from org/org-refile.el
+
+(register-definition-prefixes "org-refile" '("org-"))
+
+
;;; Generated autoloads from org/org-src.el
(register-definition-prefixes "org-src" '("org-"))
-;;;***
-;;;### (autoloads nil "org-tempo" "org/org-tempo.el" (0 0 0 0))
+;;; Generated autoloads from org/org-table.el
+
+(register-definition-prefixes "org-table" '("org"))
+
+
;;; Generated autoloads from org/org-tempo.el
(register-definition-prefixes "org-tempo" '("org-tempo-"))
-;;;***
-;;;### (autoloads nil "org-version" "org/org-version.el" (0 0 0 0))
+;;; Generated autoloads from org/org-timer.el
+
+(register-definition-prefixes "org-timer" '("org-timer-"))
+
+
;;; Generated autoloads from org/org-version.el
(autoload 'org-release "org-version" "\
The release version of Org.
Inserted by installing Org mode or when a release is made." nil nil)
-
(autoload 'org-git-version "org-version" "\
The Git version of Org mode.
Inserted by installing Org or when a release is made." nil nil)
-;;;***
-;;;### (autoloads nil "outline" "outline.el" (0 0 0 0))
;;; Generated autoloads from outline.el
+
(put 'outline-regexp 'safe-local-variable 'stringp)
(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
(put 'outline-level 'risky-local-variable t)
-
(autoload 'outline-mode "outline" "\
Set major mode for editing outlines with selective display.
Headings are lines which start with asterisks: one for major headings,
@@ -24748,37 +22539,55 @@ beginning of the line. The longer the match, the deeper the level.
Turning on outline mode calls the value of `text-mode-hook' and then of
`outline-mode-hook', if they are non-nil.
-\(fn)" t nil)
-(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp)
-(put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp)
-
+(fn)" t nil)
(autoload 'outline-minor-mode "outline" "\
Toggle Outline minor mode.
-This is a minor mode. If called interactively, toggle the `Outline
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+See the command `outline-mode' for more information on this mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+This is a minor mode. If called interactively, toggle the
+`Outline minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `outline-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-See the command `outline-mode' for more information on this mode.
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "outline" '("outline-"))
-\(fn &optional ARG)" t nil)
+
+;;; Generated autoloads from org/ox.el
-(register-definition-prefixes "outline" '("outline-"))
+(register-definition-prefixes "ox" '("org-export-"))
+
+
+;;; Generated autoloads from org/ox-ascii.el
+
+(register-definition-prefixes "ox-ascii" '("org-ascii-"))
+
+
+;;; Generated autoloads from org/ox-beamer.el
+
+(register-definition-prefixes "ox-beamer" '("org-beamer-"))
+
+
+;;; Generated autoloads from org/ox-html.el
+
+(register-definition-prefixes "ox-html" '("org-html-"))
+
+
+;;; Generated autoloads from org/ox-icalendar.el
+
+(register-definition-prefixes "ox-icalendar" '("org-icalendar-"))
-;;;***
-;;;### (autoloads nil "ox-koma-letter" "org/ox-koma-letter.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from org/ox-koma-letter.el
(autoload 'org-koma-letter-export-as-latex "ox-koma-letter" "\
@@ -24811,8 +22620,7 @@ Export is done in a buffer named \"*Org KOMA-LETTER Export*\". It
will be displayed if `org-export-show-temporary-export-buffer' is
non-nil.
-\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
-
+(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(autoload 'org-koma-letter-export-to-latex "ox-koma-letter" "\
Export current buffer as a KOMA Scrlttr2 letter (tex).
@@ -24844,8 +22652,7 @@ directory.
Return output file's name.
-\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
-
+(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(autoload 'org-koma-letter-export-to-pdf "ox-koma-letter" "\
Export current buffer as a KOMA Scrlttr2 letter (pdf).
@@ -24874,23 +22681,48 @@ file-local settings.
Return PDF file's name.
-\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
-
+(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(register-definition-prefixes "ox-koma-letter" '("org-koma-letter-"))
-;;;***
-;;;### (autoloads nil "ox-man" "org/ox-man.el" (0 0 0 0))
+;;; Generated autoloads from org/ox-latex.el
+
+(register-definition-prefixes "ox-latex" '("org-latex-"))
+
+
;;; Generated autoloads from org/ox-man.el
(register-definition-prefixes "ox-man" '("org-man-"))
-;;;***
-;;;### (autoloads nil "package" "emacs-lisp/package.el" (0 0 0 0))
+;;; Generated autoloads from org/ox-md.el
+
+(register-definition-prefixes "ox-md" '("org-md-"))
+
+
+;;; Generated autoloads from org/ox-odt.el
+
+(register-definition-prefixes "ox-odt" '("org-odt-"))
+
+
+;;; Generated autoloads from org/ox-org.el
+
+(register-definition-prefixes "ox-org" '("org-org-"))
+
+
+;;; Generated autoloads from org/ox-publish.el
+
+(register-definition-prefixes "ox-publish" '("org-publish-"))
+
+
+;;; Generated autoloads from org/ox-texinfo.el
+
+(register-definition-prefixes "ox-texinfo" '("org-texinfo-"))
+
+
;;; Generated autoloads from emacs-lisp/package.el
-(push (purecopy '(package 1 1 0)) package--builtin-versions)
+(push (purecopy '(package 1 1 0)) package--builtin-versions)
(defvar package-enable-at-startup t "\
Whether to make installed packages available when Emacs starts.
If non-nil, packages are made available before reading the init
@@ -24903,29 +22735,22 @@ with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
call (package-activate-all) in your init-file.")
-
(custom-autoload 'package-enable-at-startup "package" t)
-
(defcustom package-user-dir (locate-user-emacs-file "elpa") "\
Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'." :type 'directory :initialize #'custom-initialize-delay :risky t :version "24.1")
-
(custom-autoload 'package-user-dir "package" t)
-
(defcustom package-directory-list (let (result) (dolist (f load-path) (and (stringp f) (equal (file-name-nondirectory f) "site-lisp") (push (expand-file-name "elpa" f) result))) (nreverse result)) "\
List of additional directories containing Emacs Lisp packages.
Each directory name should be absolute.
These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use." :type '(repeat directory) :initialize #'custom-initialize-delay :risky t :version "24.1")
-
(custom-autoload 'package-directory-list "package" t)
-
(defvar package--activated nil "\
Non-nil if `package-activate-all' has been run.")
-
(autoload 'package-initialize "package" "\
Load Emacs Lisp packages, and activate them.
The variable `package-load-list' controls which packages to load.
@@ -24942,17 +22767,14 @@ superfluous call to `package-initialize' from your init-file. If
you have code which must run before `package-initialize', put
that code in the early init-file.
-\(fn &optional NO-ACTIVATE)" t nil)
-
+(fn &optional NO-ACTIVATE)" t nil)
(defun package-activate-all nil "\
Activate all installed packages.
-The variable `package-load-list' controls which packages to load." (setq package--activated t) (let* ((elc (concat package-quickstart-file "c")) (qs (if (file-readable-p elc) elc (if (file-readable-p package-quickstart-file) package-quickstart-file)))) (if qs (let ((load-source-file-function nil)) (unless (boundp 'package-activated-list) (setq package-activated-list nil)) (load qs nil 'nomessage)) (require 'package) (package--activate-all))))
-
+The variable `package-load-list' controls which packages to load." (setq package--activated t) (let* ((elc (concat package-quickstart-file "c")) (qs (if (file-readable-p elc) elc (if (file-readable-p package-quickstart-file) package-quickstart-file)))) (if (and qs (not (bound-and-true-p package-activated-list))) (let ((load-source-file-function nil)) (unless (boundp 'package-activated-list) (setq package-activated-list nil)) (load qs nil 'nomessage)) (require 'package) (package--activate-all))))
(autoload 'package-import-keyring "package" "\
Import keys from FILE.
-\(fn &optional FILE)" t nil)
-
+(fn &optional FILE)" t nil)
(autoload 'package-refresh-contents "package" "\
Download descriptions of all configured ELPA packages.
For each archive configured in the variable `package-archives',
@@ -24961,8 +22783,15 @@ and make them available for download.
Optional argument ASYNC specifies whether to perform the
downloads in the background.
-\(fn &optional ASYNC)" t nil)
+(fn &optional ASYNC)" t nil)
+(autoload 'package-installed-p "package" "\
+Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed.
+If PACKAGE is a symbol, it is the package name and MIN-VERSION
+should be a version list.
+
+If PACKAGE is a `package-desc' object, MIN-VERSION is ignored.
+(fn PACKAGE &optional MIN-VERSION)" nil nil)
(autoload 'package-install "package" "\
Install the package PKG.
PKG can be a `package-desc' or a symbol naming one of the
@@ -24979,8 +22808,17 @@ non-nil, install the package but do not add it to
If PKG is a `package-desc' and it is already installed, don't try
to install it but still mark it as selected.
-\(fn PKG &optional DONT-SELECT)" t nil)
+(fn PKG &optional DONT-SELECT)" t nil)
+(autoload 'package-update "package" "\
+Update package NAME if a newer version exists.
+
+(fn NAME)" t nil)
+(autoload 'package-update-all "package" "\
+Refresh package list and upgrade all packages.
+If QUERY, ask the user before updating packages. When called
+interactively, QUERY is always true.
+(fn &optional QUERY)" t nil)
(autoload 'package-install-from-buffer "package" "\
Install a package from the current buffer.
The current buffer is assumed to be a single .el or .tar file or
@@ -24992,41 +22830,45 @@ description file is not mandatory, in which case the information
is derived from the main .el file in the directory.
Downloads and installs required packages as needed." t nil)
-
(autoload 'package-install-file "package" "\
Install a package from FILE.
The file can either be a tar file, an Emacs Lisp file, or a
directory.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'package-install-selected-packages "package" "\
Ensure packages in `package-selected-packages' are installed.
If some packages are not installed, propose to install them.
If optional argument NOCONFIRM is non-nil, don't ask for
confirmation to install packages.
-\(fn &optional NOCONFIRM)" t nil)
-
+(fn &optional NOCONFIRM)" t nil)
(autoload 'package-reinstall "package" "\
Reinstall package PKG.
PKG should be either a symbol, the package name, or a `package-desc'
object.
-\(fn PKG)" t nil)
+(fn PKG)" t nil)
+(autoload 'package-recompile "package" "\
+Byte-compile package PKG again.
+PKG should be either a symbol, the package name, or a `package-desc'
+object.
+(fn PKG)" t nil)
+(autoload 'package-recompile-all "package" "\
+Byte-compile all installed packages.
+This is meant to be used only in the case the byte-compiled files
+are invalid due to changed byte-code, macros or the like." t nil)
(autoload 'package-autoremove "package" "\
Remove packages that are no longer needed.
Packages that are no more needed by other packages in
`package-selected-packages' and their dependencies
will be deleted." t nil)
-
(autoload 'describe-package "package" "\
Display the full documentation of PACKAGE (a symbol).
-\(fn PACKAGE)" t nil)
-
+(fn PACKAGE)" t nil)
(autoload 'list-packages "package" "\
Display a list of packages.
This first fetches the updated list of packages before
@@ -25035,29 +22877,22 @@ The list is displayed in a buffer named `*Packages*', and
includes the package's version, availability status, and a
short description.
-\(fn &optional NO-FETCH)" t nil)
-
+(fn &optional NO-FETCH)" t nil)
(defalias 'package-list-packages 'list-packages)
-
(autoload 'package-get-version "package" "\
Return the version number of the package in which this is used.
Assumes it is used from an Elisp file placed inside the top-level directory
of an installed ELPA package.
-The return value is a string (or nil in case we can't find it)." nil nil)
-
+The return value is a string (or nil in case we can't find it).
+It works in more cases if the call is in the file which contains
+the `Version:' header." nil nil)
(function-put 'package-get-version 'pure 't)
-
(defcustom package-quickstart-file (locate-user-emacs-file "package-quickstart.el") "\
Location of the file used to speed up activation of packages at startup." :type 'file :initialize #'custom-initialize-delay :version "27.1")
-
(custom-autoload 'package-quickstart-file "package" t)
-
(register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-"))
-;;;***
-;;;### (autoloads nil "package-x" "emacs-lisp/package-x.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/package-x.el
(autoload 'package-upload-file "package-x" "\
@@ -25070,27 +22905,21 @@ contents list with this information.
If `package-archive-upload-base' does not specify a valid upload
destination, prompt for one. If the directory does not exist, it
is created. The directory need not have any initial contents
-\(i.e., you can use this command to populate an initially empty
+(i.e., you can use this command to populate an initially empty
archive).
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(register-definition-prefixes "package-x" '("package-"))
-;;;***
-;;;### (autoloads nil "page-ext" "textmodes/page-ext.el" (0 0 0 0))
;;; Generated autoloads from textmodes/page-ext.el
(register-definition-prefixes "page-ext" '("pages-"))
-;;;***
-;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from calendar/parse-time.el
-(put 'parse-time-rules 'risky-local-variable t)
+(put 'parse-time-rules 'risky-local-variable t)
(autoload 'parse-time-string "parse-time" "\
Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\",
@@ -25102,13 +22931,10 @@ The values returned are identical to those of `decode-time', but
any unknown values other than DST are returned as nil, and an
unknown DST value is returned as -1.
-\(fn STRING)" nil nil)
-
+(fn STRING)" nil nil)
(register-definition-prefixes "parse-time" '("parse-"))
-;;;***
-;;;### (autoloads nil "pascal" "progmodes/pascal.el" (0 0 0 0))
;;; Generated autoloads from progmodes/pascal.el
(autoload 'pascal-mode "pascal" "\
@@ -25153,37 +22979,26 @@ Variables controlling indentation/edit style:
See also the user variables `pascal-type-keywords', `pascal-start-keywords' and
`pascal-separator-keywords'.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "pascal" '("electric-pascal-" "pascal-"))
-;;;***
-;;;### (autoloads nil "password-cache" "password-cache.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from password-cache.el
(defvar password-cache t "\
Whether to cache passwords.")
-
(custom-autoload 'password-cache "password-cache" t)
-
(defvar password-cache-expiry 16 "\
How many seconds passwords are cached, or nil to disable expiring.
Whether passwords are cached at all is controlled by `password-cache'.")
-
(custom-autoload 'password-cache-expiry "password-cache" t)
-
(autoload 'password-in-cache-p "password-cache" "\
Check if KEY is in the cache.
-\(fn KEY)" nil nil)
-
+(fn KEY)" nil nil)
(register-definition-prefixes "password-cache" '("password-"))
-;;;***
-;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/pcase.el
(autoload 'pcase "pcase" "\
@@ -25226,14 +23041,10 @@ Additional patterns can be defined using `pcase-defmacro'.
See Info node `(elisp) Pattern-Matching Conditional' in the
Emacs Lisp manual for more information and examples.
-\(fn EXP &rest CASES)" nil t)
-
-(function-put 'pcase 'lisp-indent-function '1)
-
+(fn EXP &rest CASES)" nil t)
+(function-put 'pcase 'lisp-indent-function 1)
(put 'pcase 'function-documentation '(pcase--make-docstring))
-
(autoload 'pcase--make-docstring "pcase" nil nil nil)
-
(autoload 'pcase-exhaustive "pcase" "\
The exhaustive version of `pcase' (which see).
If EXP fails to match any of the patterns in CASES, an error is
@@ -25242,22 +23053,17 @@ signaled.
In contrast, `pcase' will return nil if there is no match, but
not signal an error.
-\(fn EXP &rest CASES)" nil t)
-
-(function-put 'pcase-exhaustive 'lisp-indent-function '1)
-
+(fn EXP &rest CASES)" nil t)
+(function-put 'pcase-exhaustive 'lisp-indent-function 1)
(autoload 'pcase-lambda "pcase" "\
Like `lambda' but allow each argument to be a pattern.
I.e. accepts the usual &optional and &rest keywords, but every
formal argument can be any pattern accepted by `pcase' (a mere
variable name being but a special case of it).
-\(fn LAMBDA-LIST &rest BODY)" nil t)
-
-(function-put 'pcase-lambda 'doc-string-elt '2)
-
+(fn LAMBDA-LIST &rest BODY)" nil t)
+(function-put 'pcase-lambda 'doc-string-elt 2)
(function-put 'pcase-lambda 'lisp-indent-function 'defun)
-
(autoload 'pcase-let* "pcase" "\
Like `let*', but supports destructuring BINDINGS using `pcase' patterns.
As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the
@@ -25268,10 +23074,8 @@ Each EXP should match (i.e. be of compatible structure) to its
respective PATTERN; a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil.
-\(fn BINDINGS &rest BODY)" nil t)
-
-(function-put 'pcase-let* 'lisp-indent-function '1)
-
+(fn BINDINGS &rest BODY)" nil t)
+(function-put 'pcase-let* 'lisp-indent-function 1)
(autoload 'pcase-let "pcase" "\
Like `let', but supports destructuring BINDINGS using `pcase' patterns.
BODY should be a list of expressions, and BINDINGS should be a list of
@@ -25284,10 +23088,8 @@ Each EXP should match (i.e. be of compatible structure) to its
respective PATTERN; a mismatch may signal an error or may go
undetected, binding variables to arbitrary values, such as nil.
-\(fn BINDINGS &rest BODY)" nil t)
-
-(function-put 'pcase-let 'lisp-indent-function '1)
-
+(fn BINDINGS &rest BODY)" nil t)
+(function-put 'pcase-let 'lisp-indent-function 1)
(autoload 'pcase-dolist "pcase" "\
Eval BODY once for each set of bindings defined by PATTERN and LIST elements.
PATTERN should be a `pcase' pattern describing the structure of
@@ -25299,23 +23101,20 @@ then evaluates BODY with these bindings in effect. The
destructuring bindings of variables in PATTERN to the subfields
of the elements of LIST is performed as if by `pcase-let'.
-\(fn (PATTERN LIST) BODY...)" nil t)
-
-(function-put 'pcase-dolist 'lisp-indent-function '1)
-
+(fn (PATTERN LIST) BODY...)" nil t)
+(function-put 'pcase-dolist 'lisp-indent-function 1)
(autoload 'pcase-setq "pcase" "\
Assign values to variables by destructuring with `pcase'.
PATTERNS are normal `pcase' patterns, and VALUES are expression.
Evaluation happens sequentially as in `setq' (not in parallel).
-An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)]))
+An example: (pcase-setq \\=`((,a) [(,b)]) \\='((1) [(2)]))
VAL is presumed to match PAT. Failure to match may signal an error or go
undetected, binding variables to arbitrary values, such as nil.
-\(fn PATTERNS VALUE PATTERN VALUES ...)" nil t)
-
+(fn PATTERNS VALUE PATTERN VALUES ...)" nil t)
(autoload 'pcase-defmacro "pcase" "\
Define a new kind of pcase PATTERN, by macro expansion.
Patterns of the form (NAME ...) will be expanded according
@@ -25324,146 +23123,99 @@ to this macro.
By convention, DOC should use \"EXPVAL\" to stand
for the result of evaluating EXP (first arg to `pcase').
-\(fn NAME ARGS [DOC] &rest BODY...)" nil t)
-
-(function-put 'pcase-defmacro 'lisp-indent-function '2)
-
-(function-put 'pcase-defmacro 'doc-string-elt '3)
-
+(fn NAME ARGS [DOC] &rest BODY...)" nil t)
+(function-put 'pcase-defmacro 'lisp-indent-function 2)
+(function-put 'pcase-defmacro 'doc-string-elt 3)
(register-definition-prefixes "pcase" '("pcase-"))
-;;;***
-;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (0 0 0 0))
;;; Generated autoloads from pcmpl-cvs.el
(autoload 'pcomplete/cvs "pcmpl-cvs" "\
Completion rules for the `cvs' command." nil nil)
-
(register-definition-prefixes "pcmpl-cvs" '("pcmpl-cvs-"))
-;;;***
-;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (0 0 0 0))
;;; Generated autoloads from pcmpl-gnu.el
(autoload 'pcomplete/gzip "pcmpl-gnu" "\
Completion for `gzip'." nil nil)
-
(autoload 'pcomplete/bzip2 "pcmpl-gnu" "\
Completion for `bzip2'." nil nil)
-
(autoload 'pcomplete/make "pcmpl-gnu" "\
Completion for GNU `make'." nil nil)
-
(autoload 'pcomplete/tar "pcmpl-gnu" "\
Completion for the GNU tar utility." nil nil)
-
(autoload 'pcomplete/find "pcmpl-gnu" "\
Completion for the GNU find utility." nil nil)
-
(defalias 'pcomplete/gdb 'pcomplete/xargs)
+(register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-" "pcomplete/find"))
-(register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-"))
-
-;;;***
-;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (0 0 0 0))
;;; Generated autoloads from pcmpl-linux.el
(autoload 'pcomplete/kill "pcmpl-linux" "\
Completion for GNU/Linux `kill', using /proc filesystem." nil nil)
-
(autoload 'pcomplete/umount "pcmpl-linux" "\
Completion for GNU/Linux `umount'." nil nil)
-
(autoload 'pcomplete/mount "pcmpl-linux" "\
Completion for GNU/Linux `mount'." nil nil)
-
(register-definition-prefixes "pcmpl-linux" '("pcmpl-linux-" "pcomplete-pare-list"))
-;;;***
-;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (0 0 0 0))
;;; Generated autoloads from pcmpl-rpm.el
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
Completion for the `rpm' command." nil nil)
-
(register-definition-prefixes "pcmpl-rpm" '("pcmpl-rpm-"))
-;;;***
-;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (0 0 0 0))
;;; Generated autoloads from pcmpl-unix.el
(autoload 'pcomplete/cd "pcmpl-unix" "\
Completion for `cd'." nil nil)
-
(defalias 'pcomplete/pushd 'pcomplete/cd)
-
(autoload 'pcomplete/rmdir "pcmpl-unix" "\
Completion for `rmdir'." nil nil)
-
(autoload 'pcomplete/rm "pcmpl-unix" "\
Completion for `rm'." nil nil)
-
(autoload 'pcomplete/xargs "pcmpl-unix" "\
Completion for `xargs'." nil nil)
-
(defalias 'pcomplete/time 'pcomplete/xargs)
-
(autoload 'pcomplete/which "pcmpl-unix" "\
Completion for `which'." nil nil)
-
(autoload 'pcomplete/chown "pcmpl-unix" "\
Completion for the `chown' command." nil nil)
-
(autoload 'pcomplete/chgrp "pcmpl-unix" "\
Completion for the `chgrp' command." nil nil)
-
(autoload 'pcomplete/ssh "pcmpl-unix" "\
Completion rules for the `ssh' command." nil nil)
-
(autoload 'pcomplete/scp "pcmpl-unix" "\
Completion rules for the `scp' command.
Includes files as well as host names followed by a colon." nil nil)
-
(autoload 'pcomplete/telnet "pcmpl-unix" nil nil nil)
-
(autoload 'pcomplete/rsh "pcmpl-unix" "\
Complete `rsh', which, after the user and hostname, is like xargs." nil nil)
-
(register-definition-prefixes "pcmpl-unix" '("pcmpl-" "pcomplete/"))
-;;;***
-;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (0 0 0 0))
;;; Generated autoloads from pcmpl-x.el
(autoload 'pcomplete/tlmgr "pcmpl-x" "\
Completion for the `tlmgr' command." nil nil)
-
(autoload 'pcomplete/ack "pcmpl-x" "\
Completion for the `ack' command.
Start an argument with `-' to complete short options and `--' for
long options." nil nil)
-
(defalias 'pcomplete/ack-grep 'pcomplete/ack)
-
(autoload 'pcomplete/ag "pcmpl-x" "\
Completion for the `ag' command." nil nil)
-
(autoload 'pcomplete/bcc32 "pcmpl-x" "\
Completion function for Borland's C++ compiler." nil nil)
-
(defalias 'pcomplete/bcc 'pcomplete/bcc32)
-
(register-definition-prefixes "pcmpl-x" '("pcmpl-x-"))
-;;;***
-;;;### (autoloads nil "pcomplete" "pcomplete.el" (0 0 0 0))
;;; Generated autoloads from pcomplete.el
(autoload 'pcomplete "pcomplete" "\
@@ -25471,48 +23223,40 @@ Support extensible programmable completion.
To use this function, just bind the TAB key to it, or add it to your
completion functions list (it should occur fairly early in the list).
-\(fn &optional INTERACTIVELY)" t nil)
-
-(make-obsolete 'pcomplete '"use completion-at-point and pcomplete-completions-at-point" '"27.1")
-
+(fn &optional INTERACTIVELY)" t nil)
+(make-obsolete 'pcomplete '"use completion-at-point and pcomplete-completions-at-point" "27.1")
(autoload 'pcomplete-reverse "pcomplete" "\
If cycling completion is in use, cycle backwards." t nil)
-
(autoload 'pcomplete-expand-and-complete "pcomplete" "\
Expand the textual value of the current argument.
This will modify the current buffer." t nil)
-
(autoload 'pcomplete-continue "pcomplete" "\
Complete without reference to any cycling completions." t nil)
-
(autoload 'pcomplete-expand "pcomplete" "\
Expand the textual value of the current argument.
This will modify the current buffer." t nil)
-
(autoload 'pcomplete-help "pcomplete" "\
Display any help information relative to the current argument." t nil)
-
-(make-obsolete 'pcomplete-help '"use completion-help-at-point and pcomplete-completions-at-point" '"27.1")
-
+(make-obsolete 'pcomplete-help '"use completion-help-at-point and pcomplete-completions-at-point" "27.1")
(autoload 'pcomplete-list "pcomplete" "\
Show the list of possible completions for the current argument." t nil)
-
(autoload 'pcomplete-comint-setup "pcomplete" "\
Setup a comint buffer to use pcomplete.
COMPLETEF-SYM should be the symbol where the
dynamic-complete-functions are kept. For comint mode itself,
this is `comint-dynamic-complete-functions'.
-\(fn COMPLETEF-SYM)" nil nil)
-
+(fn COMPLETEF-SYM)" nil nil)
(autoload 'pcomplete-shell-setup "pcomplete" "\
Setup `shell-mode' to use pcomplete." nil nil)
-
(register-definition-prefixes "pcomplete" '("pcomplete-"))
-;;;***
-;;;### (autoloads nil "pcvs" "vc/pcvs.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/pconf.el
+
+(register-definition-prefixes "ede/pconf" '("ede-pconf-create-file-query"))
+
+
;;; Generated autoloads from vc/pcvs.el
(autoload 'cvs-checkout "pcvs" "\
@@ -25522,8 +23266,7 @@ and run `cvs-mode' on it.
With a prefix argument, prompt for cvs FLAGS to use.
-\(fn MODULES DIR FLAGS &optional ROOT)" t nil)
-
+(fn MODULES DIR FLAGS &optional ROOT)" t nil)
(autoload 'cvs-quickdir "pcvs" "\
Open a *cvs* buffer on DIR without running cvs.
With a prefix argument, prompt for a directory to use.
@@ -25532,8 +23275,7 @@ A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
Optional argument NOSHOW if non-nil means not to display the buffer.
FLAGS is ignored.
-\(fn DIR &optional FLAGS NOSHOW)" t nil)
-
+(fn DIR &optional FLAGS NOSHOW)" t nil)
(autoload 'cvs-examine "pcvs" "\
Run a `cvs -n update' in the specified DIRECTORY.
That is, check what needs to be done, but don't change the disc.
@@ -25543,8 +23285,7 @@ A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
prevents reuse of an existing *cvs* buffer.
Optional argument NOSHOW if non-nil means not to display the buffer.
-\(fn DIRECTORY FLAGS &optional NOSHOW)" t nil)
-
+(fn DIRECTORY FLAGS &optional NOSHOW)" t nil)
(autoload 'cvs-update "pcvs" "\
Run a `cvs update' in the current working DIRECTORY.
Feed the output to a *cvs* buffer and run `cvs-mode' on it.
@@ -25554,8 +23295,7 @@ A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
The prefix is also passed to `cvs-flags-query' to select the FLAGS
passed to cvs.
-\(fn DIRECTORY FLAGS)" t nil)
-
+(fn DIRECTORY FLAGS)" t nil)
(autoload 'cvs-status "pcvs" "\
Run a `cvs status' in the current working DIRECTORY.
Feed the output to a *cvs* buffer and run `cvs-mode' on it.
@@ -25564,80 +23304,61 @@ A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
prevents reuse of an existing *cvs* buffer.
Optional argument NOSHOW if non-nil means not to display the buffer.
-\(fn DIRECTORY FLAGS &optional NOSHOW)" t nil)
-
+(fn DIRECTORY FLAGS &optional NOSHOW)" t nil)
(defvar cvs-dired-action 'cvs-quickdir "\
The action to be performed when opening a CVS directory.
Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'.")
-
(custom-autoload 'cvs-dired-action "pcvs" t)
-
(defvar cvs-dired-use-hook '(4) "\
Whether or not opening a CVS directory should run PCL-CVS.
A value of nil means never do it.
`always' means to always do it unless a prefix argument is given to the
command that prompted the opening of the directory.
Anything else means to do it only if the prefix arg is equal to this value.")
-
(custom-autoload 'cvs-dired-use-hook "pcvs" t)
-
(defun cvs-dired-noselect (dir) "\
Run `cvs-examine' if DIR is a CVS administrative directory.
The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp dir) (setq dir (directory-file-name dir)) (when (and (string= "CVS" (file-name-nondirectory dir)) (file-readable-p (expand-file-name "Entries" dir)) cvs-dired-use-hook (if (eq cvs-dired-use-hook 'always) (not current-prefix-arg) (equal current-prefix-arg cvs-dired-use-hook))) (save-excursion (funcall cvs-dired-action (file-name-directory dir) t t)))))
-
(register-definition-prefixes "pcvs" '("cvs-" "defun-cvs-mode"))
-;;;***
-;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-defs.el
(defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\
Global menu used by PCL-CVS.")
-
(register-definition-prefixes "pcvs-defs" '("cvs-"))
-;;;***
-;;;### (autoloads nil "pcvs-info" "vc/pcvs-info.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-info.el
(register-definition-prefixes "pcvs-info" '("cvs-"))
-;;;***
-;;;### (autoloads nil "pcvs-parse" "vc/pcvs-parse.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-parse.el
(register-definition-prefixes "pcvs-parse" '("cvs-"))
-;;;***
-;;;### (autoloads nil "pcvs-util" "vc/pcvs-util.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-util.el
(register-definition-prefixes "pcvs-util" '("cvs-"))
-;;;***
-;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/perl-mode.el
+
(put 'perl-indent-level 'safe-local-variable 'integerp)
(put 'perl-continued-statement-offset 'safe-local-variable 'integerp)
(put 'perl-continued-brace-offset 'safe-local-variable 'integerp)
(put 'perl-brace-offset 'safe-local-variable 'integerp)
(put 'perl-brace-imaginary-offset 'safe-local-variable 'integerp)
(put 'perl-label-offset 'safe-local-variable 'integerp)
-
(autoload 'perl-flymake "perl-mode" "\
Perl backend for Flymake.
Launch `perl-flymake-command' (which see) and pass to its
standard input the contents of the current buffer. The output of
this command is analyzed for error and warning messages.
-\(fn REPORT-FN &rest ARGS)" nil nil)
-
+(fn REPORT-FN &rest ARGS)" nil nil)
(autoload 'perl-mode "perl-mode" "\
Major mode for editing Perl code.
Expression and list commands understand all Perl brackets.
@@ -25686,13 +23407,15 @@ Various indentation styles: K&R BSD BLK GNU LW
Turning on Perl mode runs the normal hook `perl-mode-hook'.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "perl-mode" '("indent-perl-exp" "mark-perl-function" "perl-"))
-;;;***
-;;;### (autoloads nil "picture" "textmodes/picture.el" (0 0 0 0))
+;;; Generated autoloads from pgtk-dnd.el
+
+(register-definition-prefixes "pgtk-dnd" '("pgtk-dnd-"))
+
+
;;; Generated autoloads from textmodes/picture.el
(autoload 'picture-mode "picture" "\
@@ -25765,21 +23488,20 @@ Entry to this mode calls the value of `picture-mode-hook' if non-nil.
Note that Picture mode commands will work outside of Picture mode, but
they are not by default assigned to keys." t nil)
-
(defalias 'edit-picture 'picture-mode)
-
(register-definition-prefixes "picture" '("picture-"))
-;;;***
-;;;### (autoloads nil "pinyin" "language/pinyin.el" (0 0 0 0))
;;; Generated autoloads from language/pinyin.el
(register-definition-prefixes "pinyin" '("pinyin-character-map"))
-;;;***
-;;;### (autoloads nil "pixel-scroll" "pixel-scroll.el" (0 0 0 0))
+;;; Generated autoloads from textmodes/pixel-fill.el
+
+(register-definition-prefixes "pixel-fill" '("pixel-fill-"))
+
+
;;; Generated autoloads from pixel-scroll.el
(defvar pixel-scroll-mode nil "\
@@ -25789,63 +23511,86 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `pixel-scroll-mode'.")
-
(custom-autoload 'pixel-scroll-mode "pixel-scroll" nil)
-
(autoload 'pixel-scroll-mode "pixel-scroll" "\
A minor mode to scroll text pixel-by-pixel.
-This is a minor mode. If called interactively, toggle the
-`Pixel-Scroll mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Pixel-Scroll mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='pixel-scroll-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(defvar pixel-scroll-precision-mode nil "\
+Non-nil if Pixel-Scroll-Precision mode is enabled.
+See the `pixel-scroll-precision-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `pixel-scroll-precision-mode'.")
+(custom-autoload 'pixel-scroll-precision-mode "pixel-scroll" nil)
+(autoload 'pixel-scroll-precision-mode "pixel-scroll" "\
+Toggle pixel scrolling.
+
+When enabled, this minor mode allows to scroll the display
+precisely, according to the turning of the mouse wheel.
+
+This is a global minor mode. If called interactively, toggle the
+`Pixel-Scroll-Precision mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='pixel-scroll-precision-mode)'.
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "pixel-scroll" '("pixel-"))
-;;;***
-;;;### (autoloads nil "plstore" "plstore.el" (0 0 0 0))
;;; Generated autoloads from plstore.el
(autoload 'plstore-open "plstore" "\
Create a plstore instance associated with FILE.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'plstore-mode "plstore" "\
Major mode for editing PLSTORE files.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "plstore" '("plstore-"))
-;;;***
-;;;### (autoloads nil "po" "textmodes/po.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/pmake.el
+
+(register-definition-prefixes "ede/pmake" '("ede-pmake-"))
+
+
;;; Generated autoloads from textmodes/po.el
(autoload 'po-find-file-coding-system "po" "\
Return a (DECODING . ENCODING) pair, according to PO file's charset.
Called through `file-coding-system-alist', before the file is visited for real.
-\(fn ARG-LIST)" nil nil)
-
+(fn ARG-LIST)" nil nil)
(register-definition-prefixes "po" '("po-"))
-;;;***
-;;;### (autoloads nil "pong" "play/pong.el" (0 0 0 0))
;;; Generated autoloads from play/pong.el
(autoload 'pong "pong" "\
@@ -25856,25 +23601,19 @@ Move left and right bats and try to bounce the ball to your opponent.
pong-mode keybindings:\\<pong-mode-map>
\\{pong-mode-map}" t nil)
-
(register-definition-prefixes "pong" '("pong-"))
-;;;***
-;;;### (autoloads nil "pop3" "net/pop3.el" (0 0 0 0))
;;; Generated autoloads from net/pop3.el
(autoload 'pop3-movemail "pop3" "\
Transfer contents of a maildrop to the specified FILE.
Use streaming commands.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(register-definition-prefixes "pop3" '("pop3-"))
-;;;***
-;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/pp.el
(autoload 'pp-to-string "pp" "\
@@ -25882,52 +23621,63 @@ Return a string containing the pretty-printed representation of OBJECT.
OBJECT can be any Lisp object. Quoting characters are used as needed
to make output that `read' can handle, whenever this is possible.
-\(fn OBJECT)" nil nil)
-
+(fn OBJECT)" nil nil)
(autoload 'pp-buffer "pp" "\
Prettify the current buffer with printed representation of a Lisp object." t nil)
-
(autoload 'pp "pp" "\
Output the pretty-printed representation of OBJECT, any Lisp object.
Quoting characters are printed as needed to make output that `read'
can handle, whenever this is possible.
+
+This function does not apply special formatting rules for Emacs
+Lisp code. See `pp-emacs-lisp-code' instead.
+
+By default, this function won't limit the line length of lists
+and vectors. Bind `pp-use-max-width' to a non-nil value to do so.
+
Output stream is STREAM, or value of `standard-output' (which see).
-\(fn OBJECT &optional STREAM)" nil nil)
+(fn OBJECT &optional STREAM)" nil nil)
+(autoload 'pp-display-expression "pp" "\
+Prettify and display EXPRESSION in an appropriate way, depending on length.
+If LISP, format with `pp-emacs-lisp-code'; use `pp' otherwise.
+
+If a temporary buffer is needed for representation, it will be named
+after OUT-BUFFER-NAME.
+(fn EXPRESSION OUT-BUFFER-NAME &optional LISP)" nil nil)
(autoload 'pp-eval-expression "pp" "\
Evaluate EXPRESSION and pretty-print its value.
Also add the value to the front of the list in the variable `values'.
-\(fn EXPRESSION)" t nil)
-
+(fn EXPRESSION)" t nil)
(autoload 'pp-macroexpand-expression "pp" "\
Macroexpand EXPRESSION and pretty-print its value.
-\(fn EXPRESSION)" t nil)
-
+(fn EXPRESSION)" t nil)
(autoload 'pp-eval-last-sexp "pp" "\
Run `pp-eval-expression' on sexp before point.
With ARG, pretty-print output into current buffer.
Ignores leading comment characters.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'pp-macroexpand-last-sexp "pp" "\
Run `pp-macroexpand-expression' on sexp before point.
With ARG, pretty-print output into current buffer.
Ignores leading comment characters.
-\(fn ARG)" t nil)
+(fn ARG)" t nil)
+(autoload 'pp-emacs-lisp-code "pp" "\
+Insert SEXP into the current buffer, formatted as Emacs Lisp code.
+Use the `pp-max-width' variable to control the desired line length.
+(fn SEXP)" nil nil)
(register-definition-prefixes "pp" '("pp-"))
-;;;***
-;;;### (autoloads nil "printing" "printing.el" (0 0 0 0))
;;; Generated autoloads from printing.el
-(push (purecopy '(printing 6 9 3)) package--builtin-versions)
+(push (purecopy '(printing 6 9 3)) package--builtin-versions)
(autoload 'pr-interface "printing" "\
Activate the printing interface buffer.
@@ -25935,8 +23685,7 @@ If BUFFER is nil, the current buffer is used for printing.
For more information, type \\[pr-interface-help].
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload 'pr-ps-directory-preview "printing" "\
Preview directory using ghostview.
@@ -25954,8 +23703,7 @@ file name.
See also documentation for `pr-list-directory'.
-\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
-
+(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
(autoload 'pr-ps-directory-using-ghostscript "printing" "\
Print directory using PostScript through ghostscript.
@@ -25973,8 +23721,7 @@ file name.
See also documentation for `pr-list-directory'.
-\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
-
+(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
(autoload 'pr-ps-directory-print "printing" "\
Print directory using PostScript printer.
@@ -25992,8 +23739,7 @@ file name.
See also documentation for `pr-list-directory'.
-\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
-
+(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
(autoload 'pr-ps-directory-ps-print "printing" "\
Print directory using PostScript printer or through ghostscript.
@@ -26013,8 +23759,7 @@ file name.
See also documentation for `pr-list-directory'.
-\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
-
+(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
(autoload 'pr-ps-buffer-preview "printing" "\
Preview buffer using ghostview.
@@ -26027,8 +23772,7 @@ argument FILENAME is treated as follows: if it's nil, save the image in a
temporary file. If FILENAME is a string, save the PostScript image in a file
with that name. If FILENAME is t, prompts for a file name.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-buffer-using-ghostscript "printing" "\
Print buffer using PostScript through ghostscript.
@@ -26041,8 +23785,7 @@ argument FILENAME is treated as follows: if it's nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
that name. If FILENAME is t, prompts for a file name.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-buffer-print "printing" "\
Print buffer using PostScript printer.
@@ -26055,8 +23798,7 @@ argument FILENAME is treated as follows: if it's nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
that name. If FILENAME is t, prompts for a file name.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-buffer-ps-print "printing" "\
Print buffer using PostScript printer or through ghostscript.
@@ -26071,64 +23813,55 @@ argument FILENAME is treated as follows: if it's nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
that name. If FILENAME is t, prompts for a file name.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-region-preview "printing" "\
Preview region using ghostview.
See also `pr-ps-buffer-preview'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-region-using-ghostscript "printing" "\
Print region using PostScript through ghostscript.
See also `pr-ps-buffer-using-ghostscript'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-region-print "printing" "\
Print region using PostScript printer.
See also `pr-ps-buffer-print'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-region-ps-print "printing" "\
Print region using PostScript printer or through ghostscript.
See also `pr-ps-buffer-ps-print'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-mode-preview "printing" "\
Preview major mode using ghostview.
See also `pr-ps-buffer-preview'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-mode-using-ghostscript "printing" "\
Print major mode using PostScript through ghostscript.
See also `pr-ps-buffer-using-ghostscript'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-mode-print "printing" "\
Print major mode using PostScript printer.
See also `pr-ps-buffer-print'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-ps-mode-ps-print "printing" "\
Print major mode using PostScript or through ghostscript.
See also `pr-ps-buffer-ps-print'.
-\(fn N-UP &optional FILENAME)" t nil)
-
+(fn N-UP &optional FILENAME)" t nil)
(autoload 'pr-printify-directory "printing" "\
Replace nonprinting characters in directory with printable representations.
The printable representations use ^ (for ASCII control characters) or hex.
@@ -26142,18 +23875,15 @@ prompts for FILE(name)-REGEXP.
See also documentation for `pr-list-directory'.
-\(fn &optional DIR FILE-REGEXP)" t nil)
-
+(fn &optional DIR FILE-REGEXP)" t nil)
(autoload 'pr-printify-buffer "printing" "\
Replace nonprinting characters in buffer with printable representations.
The printable representations use ^ (for ASCII control characters) or hex.
The characters tab, linefeed, space, return and formfeed are not affected." t nil)
-
(autoload 'pr-printify-region "printing" "\
Replace nonprinting characters in region with printable representations.
The printable representations use ^ (for ASCII control characters) or hex.
The characters tab, linefeed, space, return and formfeed are not affected." t nil)
-
(autoload 'pr-txt-directory "printing" "\
Print directory using text printer.
@@ -26165,17 +23895,13 @@ prompts for FILE(name)-REGEXP.
See also documentation for `pr-list-directory'.
-\(fn &optional DIR FILE-REGEXP)" t nil)
-
+(fn &optional DIR FILE-REGEXP)" t nil)
(autoload 'pr-txt-buffer "printing" "\
Print buffer using text printer." t nil)
-
(autoload 'pr-txt-region "printing" "\
Print region using text printer." t nil)
-
(autoload 'pr-txt-mode "printing" "\
Print major mode using text printer." t nil)
-
(autoload 'pr-despool-preview "printing" "\
Preview spooled PostScript.
@@ -26187,8 +23913,7 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
save the image in a temporary file. If FILENAME is a string, save the
PostScript image in a file with that name.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'pr-despool-using-ghostscript "printing" "\
Print spooled PostScript using ghostscript.
@@ -26200,8 +23925,7 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'pr-despool-print "printing" "\
Send the spooled PostScript to the printer.
@@ -26213,8 +23937,7 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'pr-despool-ps-print "printing" "\
Send the spooled PostScript to the printer or use ghostscript to print it.
@@ -26226,33 +23949,27 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'pr-ps-file-preview "printing" "\
Preview PostScript file FILENAME.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'pr-ps-file-up-preview "printing" "\
Preview PostScript file FILENAME.
-\(fn N-UP IFILENAME &optional OFILENAME)" t nil)
-
+(fn N-UP IFILENAME &optional OFILENAME)" t nil)
(autoload 'pr-ps-file-using-ghostscript "printing" "\
Print PostScript file FILENAME using ghostscript.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'pr-ps-file-print "printing" "\
Print PostScript file FILENAME.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'pr-ps-file-ps-print "printing" "\
Send PostScript file FILENAME to printer or use ghostscript to print it.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'pr-ps-file-up-ps-print "printing" "\
Process a PostScript file IFILENAME and send it to printer.
@@ -26269,11 +23986,9 @@ nil, send the image to the printer. If OFILENAME is a string, save the
PostScript image in a file with that name. If OFILENAME is t, prompts for a
file name.
-\(fn N-UP IFILENAME &optional OFILENAME)" t nil)
-
+(fn N-UP IFILENAME &optional OFILENAME)" t nil)
(autoload 'pr-toggle-file-duplex "printing" "\
Toggle duplex for PostScript file." t nil)
-
(autoload 'pr-toggle-file-tumble "printing" "\
Toggle tumble for PostScript file.
@@ -26281,22 +23996,16 @@ If tumble is off, produces a printing suitable for binding on the left or
right.
If tumble is on, produces a printing suitable for binding at the top or
bottom." t nil)
-
(autoload 'pr-toggle-file-landscape "printing" "\
Toggle landscape for PostScript file." t nil)
-
(autoload 'pr-toggle-ghostscript "printing" "\
Toggle printing using ghostscript." t nil)
-
(autoload 'pr-toggle-faces "printing" "\
Toggle printing with faces." t nil)
-
(autoload 'pr-toggle-spool "printing" "\
Toggle spooling." t nil)
-
(autoload 'pr-toggle-duplex "printing" "\
Toggle duplex." t nil)
-
(autoload 'pr-toggle-tumble "printing" "\
Toggle tumble.
@@ -26304,73 +24013,54 @@ If tumble is off, produces a printing suitable for binding on the left or
right.
If tumble is on, produces a printing suitable for binding at the top or
bottom." t nil)
-
(autoload 'pr-toggle-landscape "printing" "\
Toggle landscape." t nil)
-
(autoload 'pr-toggle-upside-down "printing" "\
Toggle upside-down." t nil)
-
(autoload 'pr-toggle-line "printing" "\
Toggle line number." t nil)
-
(autoload 'pr-toggle-zebra "printing" "\
Toggle zebra stripes." t nil)
-
(autoload 'pr-toggle-header "printing" "\
Toggle printing header." t nil)
-
(autoload 'pr-toggle-header-frame "printing" "\
Toggle printing header frame." t nil)
-
(autoload 'pr-toggle-lock "printing" "\
Toggle menu lock." t nil)
-
(autoload 'pr-toggle-region "printing" "\
Toggle whether the region is automagically detected." t nil)
-
(autoload 'pr-toggle-mode "printing" "\
Toggle auto mode." t nil)
-
(autoload 'pr-customize "printing" "\
Customization of the `printing' group.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'lpr-customize "printing" "\
Customization of the `lpr' group.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'pr-help "printing" "\
Help for the printing package.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'pr-ps-name "printing" "\
Interactively select a PostScript printer." t nil)
-
(autoload 'pr-txt-name "printing" "\
Interactively select a text printer." t nil)
-
(autoload 'pr-ps-utility "printing" "\
Interactively select a PostScript utility." t nil)
-
(autoload 'pr-show-ps-setup "printing" "\
Show current ps-print settings.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'pr-show-pr-setup "printing" "\
Show current printing settings.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'pr-show-lpr-setup "printing" "\
Show current lpr settings.
-\(fn &rest IGNORE)" t nil)
-
+(fn &rest IGNORE)" t nil)
(autoload 'pr-ps-fast-fire "printing" "\
Fast fire function for PostScript printing.
@@ -26432,8 +24122,7 @@ zero and the argument SELECT is treated as follows:
Note that this command always behaves as if `pr-auto-region' and `pr-auto-mode'
are both set to t.
-\(fn N-UP &optional SELECT)" t nil)
-
+(fn N-UP &optional SELECT)" t nil)
(autoload 'pr-txt-fast-fire "printing" "\
Fast fire function for text printing.
@@ -26458,33 +24147,31 @@ Noninteractively, the argument SELECT-PRINTER is treated as follows:
Note that this command always behaves as if `pr-auto-region' and `pr-auto-mode'
are both set to t.
-\(fn &optional SELECT-PRINTER)" t nil)
-
+(fn &optional SELECT-PRINTER)" t nil)
(register-definition-prefixes "printing" '("lpr-setup" "pr-"))
-;;;***
-;;;### (autoloads nil "proced" "proced.el" (0 0 0 0))
;;; Generated autoloads from proced.el
(autoload 'proced "proced" "\
Generate a listing of UNIX system processes.
\\<proced-mode-map>
-If invoked with optional ARG, do not select the window displaying
-the process information.
+If invoked with optional non-negative ARG, do not select the
+window displaying the process information.
+
+If `proced-show-remote-processes' is non-nil or the command is
+invoked with a negative ARG `\\[universal-argument] \\[negative-argument]', and `default-directory'
+points to a remote host, the system processes of that host are shown.
This function runs the normal hook `proced-post-display-hook'.
See `proced-mode' for a description of features available in
Proced buffers.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "proced" '("proced-"))
-;;;***
-;;;### (autoloads nil "profiler" "profiler.el" (0 0 0 0))
;;; Generated autoloads from profiler.el
(autoload 'profiler-start "profiler" "\
@@ -26497,31 +24184,80 @@ If MODE is `mem' or `cpu+mem', start profiler that samples CPU
if SIGPROF is not supported, or is unreliable, or is not sampling
at a high enough frequency.
-\(fn MODE)" t nil)
-
+(fn MODE)" t nil)
(autoload 'profiler-find-profile "profiler" "\
Open profile FILENAME.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'profiler-find-profile-other-window "profiler" "\
Open profile FILENAME.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'profiler-find-profile-other-frame "profiler" "\
Open profile FILENAME.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(register-definition-prefixes "profiler" '("profiler-"))
-;;;***
-;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/proj.el
+
+(register-definition-prefixes "ede/proj" '("ede-proj-"))
+
+
+;;; Generated autoloads from cedet/ede/proj-archive.el
+
+(register-definition-prefixes "ede/proj-archive" '("ede-"))
+
+
+;;; Generated autoloads from cedet/ede/proj-aux.el
+
+(register-definition-prefixes "ede/proj-aux" '("ede-"))
+
+
+;;; Generated autoloads from cedet/ede/proj-comp.el
+
+(register-definition-prefixes "ede/proj-comp" '("ede-" "proj-comp-insert-variable-once"))
+
+
+;;; Generated autoloads from cedet/ede/proj-elisp.el
+
+(register-definition-prefixes "ede/proj-elisp" '("ede-"))
+
+
+;;; Generated autoloads from cedet/ede/proj-info.el
+
+(register-definition-prefixes "ede/proj-info" '("ede-"))
+
+
+;;; Generated autoloads from cedet/ede/proj-misc.el
+
+(register-definition-prefixes "ede/proj-misc" '("ede-"))
+
+
+;;; Generated autoloads from cedet/ede/proj-obj.el
+
+(register-definition-prefixes "ede/proj-obj" '("ede-"))
+
+
+;;; Generated autoloads from cedet/ede/proj-prog.el
+
+(register-definition-prefixes "ede/proj-prog" '("ede-proj-target-makefile-program"))
+
+
+;;; Generated autoloads from cedet/ede/proj-scheme.el
+
+(register-definition-prefixes "ede/proj-scheme" '("ede-proj-target-scheme"))
+
+
+;;; Generated autoloads from cedet/ede/proj-shared.el
+
+(register-definition-prefixes "ede/proj-shared" '("ede-"))
+
+
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 8 1)) package--builtin-versions)
+(push (purecopy '(project 0 8 1)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -26539,12 +24275,10 @@ ignored (per `project-ignores').
See the doc string of `project-find-functions' for the general form
of the project instance object.
-\(fn &optional MAYBE-PROMPT DIRECTORY)" nil nil)
-
+(fn &optional MAYBE-PROMPT DIRECTORY)" nil nil)
(defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "!" 'project-shell-command) (define-key map "&" 'project-async-shell-command) (define-key map "f" 'project-find-file) (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-find-dir) (define-key map "D" 'project-dired) (define-key map "v" 'project-vc-dir) (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) (define-key map "x" 'project-execute-extended-command) map) "\
Keymap for project commands.")
(define-key ctl-x-map "p" project-prefix-map)
-
(autoload 'project-other-window-command "project" "\
Run project command, displaying resultant buffer in another window.
@@ -26553,7 +24287,6 @@ The following commands are available:
\\{project-prefix-map}
\\{project-other-window-map}" t nil)
(define-key ctl-x-4-map "p" #'project-other-window-command)
-
(autoload 'project-other-frame-command "project" "\
Run project command, displaying resultant buffer in another frame.
@@ -26562,16 +24295,13 @@ The following commands are available:
\\{project-prefix-map}
\\{project-other-frame-map}" t nil)
(define-key ctl-x-5-map "p" #'project-other-frame-command)
-
(autoload 'project-other-tab-command "project" "\
Run project command, displaying resultant buffer in a new tab.
The following commands are available:
\\{project-prefix-map}" t nil)
-
(when (bound-and-true-p tab-prefix-map) (define-key tab-prefix-map "p" #'project-other-tab-command))
-
(autoload 'project-find-regexp "project" "\
Find all matches for REGEXP in the current project's roots.
With \\[universal-argument] prefix, you can specify the directory
@@ -26581,68 +24311,66 @@ e.g. entering `ch' is equivalent to `*.[ch]'. As whitespace
triggers completion when entering a pattern, including it
requires quoting, e.g. `\\[quoted-insert]<space>'.
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(autoload 'project-or-external-find-regexp "project" "\
Find all matches for REGEXP in the project roots or external roots.
With \\[universal-argument] prefix, you can specify the file name
pattern to search for.
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(autoload 'project-find-file "project" "\
Visit a file (with completion) in the current project.
The filename at point (determined by `thing-at-point'), if any,
-is available as part of \"future history\"." t nil)
+is available as part of \"future history\".
+If INCLUDE-ALL is non-nil, or with prefix argument when called
+interactively, include all files under the project root, except
+for VCS directories listed in `vc-directory-exclusion-list'.
+
+(fn &optional INCLUDE-ALL)" t nil)
(autoload 'project-or-external-find-file "project" "\
Visit a file (with completion) in the current project or external roots.
The filename at point (determined by `thing-at-point'), if any,
-is available as part of \"future history\"." t nil)
+is available as part of \"future history\".
+
+If INCLUDE-ALL is non-nil, or with prefix argument when called
+interactively, include all files under the project root, except
+for VCS directories listed in `vc-directory-exclusion-list'.
+(fn &optional INCLUDE-ALL)" t nil)
(autoload 'project-find-dir "project" "\
Start Dired in a directory inside the current project." t nil)
-
(autoload 'project-dired "project" "\
Start Dired in the current project's root." t nil)
-
(autoload 'project-vc-dir "project" "\
Run VC-Dir in the current project's root." t nil)
-
(autoload 'project-shell "project" "\
Start an inferior shell in the current project's root directory.
If a buffer already exists for running a shell in the project's root,
switch to it. Otherwise, create a new shell buffer.
With \\[universal-argument] prefix arg, create a new inferior shell buffer even
if one already exists." t nil)
-
(autoload 'project-eshell "project" "\
Start Eshell in the current project's root directory.
If a buffer already exists for running Eshell in the project's root,
switch to it. Otherwise, create a new Eshell buffer.
With \\[universal-argument] prefix arg, create a new Eshell buffer even
if one already exists." t nil)
-
(autoload 'project-async-shell-command "project" "\
Run `async-shell-command' in the current project's root directory." t nil)
-
(function-put 'project-async-shell-command 'interactive-only 'async-shell-command)
-
(autoload 'project-shell-command "project" "\
Run `shell-command' in the current project's root directory." t nil)
-
(function-put 'project-shell-command 'interactive-only 'shell-command)
-
(autoload 'project-search "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
To continue searching for the next match, use the
command \\[fileloop-continue].
-\(fn REGEXP)" t nil)
-
+(fn REGEXP)" t nil)
(autoload 'project-query-replace-regexp "project" "\
Query-replace REGEXP in all the files of the project.
Stops when a match is found and prompts for whether to replace it.
@@ -26653,13 +24381,10 @@ type \\[help-command] at that time.
If you exit the `query-replace', you can later continue the
`query-replace' loop using the command \\[fileloop-continue].
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'project-compile "project" "\
Run `compile' in the project root." t nil)
-
(function-put 'project-compile 'interactive-only 'compile)
-
(autoload 'project-switch-to-buffer "project" "\
Display buffer BUFFER-OR-NAME in the selected window.
When called interactively, prompts for a buffer belonging to the
@@ -26667,8 +24392,7 @@ current project. Two buffers belong to the same project if their
project instances, as reported by `project-current' in each
buffer, are identical.
-\(fn BUFFER-OR-NAME)" t nil)
-
+(fn BUFFER-OR-NAME)" t nil)
(autoload 'project-display-buffer "project" "\
Display BUFFER-OR-NAME in some window, without selecting it.
When called interactively, prompts for a buffer belonging to the
@@ -26679,8 +24403,7 @@ buffer, are identical.
This function uses `display-buffer' as a subroutine, which see
for how it is determined where the buffer will be displayed.
-\(fn BUFFER-OR-NAME)" t nil)
-
+(fn BUFFER-OR-NAME)" t nil)
(autoload 'project-display-buffer-other-frame "project" "\
Display BUFFER-OR-NAME preferably in another frame.
When called interactively, prompts for a buffer belonging to the
@@ -26692,8 +24415,7 @@ This function uses `display-buffer-other-frame' as a subroutine,
which see for how it is determined where the buffer will be
displayed.
-\(fn BUFFER-OR-NAME)" t nil)
-
+(fn BUFFER-OR-NAME)" t nil)
(autoload 'project-kill-buffers "project" "\
Kill the buffers belonging to the current project.
Two buffers belong to the same project if their project
@@ -26704,30 +24426,26 @@ is non-nil, the command will not ask the user for confirmation.
NO-CONFIRM is always nil when the command is invoked
interactively.
-\(fn &optional NO-CONFIRM)" t nil)
+Also see the `project-kill-buffers-display-buffer-list' variable.
+(fn &optional NO-CONFIRM)" t nil)
(autoload 'project-remember-project "project" "\
Add project PR to the front of the project list.
Save the result in `project-list-file' if the list of projects
has changed, and NO-WRITE is nil.
-\(fn PR &optional NO-WRITE)" nil nil)
-
+(fn PR &optional NO-WRITE)" nil nil)
(autoload 'project-forget-project "project" "\
Remove directory PROJECT-ROOT from the project list.
PROJECT-ROOT is the root directory of a known project listed in
the project list.
-\(fn PROJECT-ROOT)" t nil)
-
+(fn PROJECT-ROOT)" t nil)
(autoload 'project-known-project-roots "project" "\
Return the list of root directories of all known projects." nil nil)
-
(autoload 'project-execute-extended-command "project" "\
Execute an extended command in project root." t nil)
-
(function-put 'project-execute-extended-command 'interactive-only 'command-execute)
-
(autoload 'project-switch-project "project" "\
\"Switch\" to another project by running an Emacs command.
The available commands are presented as a dispatch menu
@@ -26736,13 +24454,15 @@ made from `project-switch-commands'.
When called in a program, it will use the project corresponding
to directory DIR.
-\(fn DIR)" t nil)
-
+(fn DIR)" t nil)
(register-definition-prefixes "project" '("project-"))
-;;;***
-;;;### (autoloads nil "prolog" "progmodes/prolog.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/project-am.el
+
+(register-definition-prefixes "ede/project-am" '("project-am-"))
+
+
;;; Generated autoloads from progmodes/prolog.el
(autoload 'prolog-mode "prolog" "\
@@ -26759,48 +24479,37 @@ To find out what version of Prolog mode you are running, enter
Commands:
\\{prolog-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'mercury-mode "prolog" "\
Major mode for editing Mercury programs.
Actually this is just customized `prolog-mode'.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'run-prolog "prolog" "\
Run an inferior Prolog process, input and output via buffer *prolog*.
With prefix argument ARG, restart the Prolog process if running before.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "prolog" '("mercury-mode-map" "prolog-"))
-;;;***
-;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (0 0 0 0))
;;; Generated autoloads from ps-bdf.el
(defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\
List of directories to search for `BDF' font files.
The default value is (\"/usr/local/share/emacs/fonts/bdf\").")
-
(custom-autoload 'bdf-directory-list "ps-bdf" t)
-
(register-definition-prefixes "ps-bdf" '("bdf-"))
-;;;***
-;;;### (autoloads nil "ps-def" "ps-def.el" (0 0 0 0))
;;; Generated autoloads from ps-def.el
(register-definition-prefixes "ps-def" '("ps-"))
-;;;***
-;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ps-mode.el
-(push (purecopy '(ps-mode 1 1 9)) package--builtin-versions)
+(push (purecopy '(ps-mode 1 1 9)) package--builtin-versions)
(autoload 'ps-mode "ps-mode" "\
Major mode for editing PostScript with GNU Emacs.
@@ -26839,29 +24548,27 @@ point to the corresponding spot in the PostScript window, if input
to the interpreter was sent from that window.
Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "ps-mode" '("ps-"))
-;;;***
-;;;### (autoloads nil "ps-print" "ps-print.el" (0 0 0 0))
+;;; Generated autoloads from ps-mule.el
+
+(register-definition-prefixes "ps-mule" '("ps-mule-"))
+
+
;;; Generated autoloads from ps-print.el
-(push (purecopy '(ps-print 7 3 5)) package--builtin-versions)
+(push (purecopy '(ps-print 7 3 5)) package--builtin-versions)
(defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\
List associating a symbolic paper type to its width, height and doc media.
See `ps-paper-type'.")
-
(custom-autoload 'ps-page-dimensions-database "ps-print" t)
-
(defvar ps-paper-type 'letter "\
Specify the size of paper to format for.
Should be one of the paper types defined in `ps-page-dimensions-database', for
example `letter', `legal' or `a4'.")
-
(custom-autoload 'ps-paper-type "ps-print" t)
-
(defvar ps-print-color-p (fboundp 'x-color-values) "\
Specify how buffer's text color is printed.
@@ -26875,12 +24582,9 @@ Valid values are:
See also `ps-black-white-faces'.
Any other value is treated as t.")
-
(custom-autoload 'ps-print-color-p "ps-print" t)
-
(autoload 'ps-print-customize "ps-print" "\
Customization of ps-print group." t nil)
-
(autoload 'ps-print-buffer "ps-print" "\
Generate and print a PostScript image of the buffer.
@@ -26892,37 +24596,32 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'ps-print-buffer-with-faces "ps-print" "\
Generate and print a PostScript image of the buffer.
Like `ps-print-buffer', but includes font, color, and underline information in
the generated image. This command works only if you are using a window system,
so it has a way to determine color values.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'ps-print-region "ps-print" "\
Generate and print a PostScript image of the region.
Like `ps-print-buffer', but prints just the current region.
-\(fn FROM TO &optional FILENAME)" t nil)
-
+(fn FROM TO &optional FILENAME)" t nil)
(autoload 'ps-print-region-with-faces "ps-print" "\
Generate and print a PostScript image of the region.
Like `ps-print-region', but includes font, color, and underline information in
the generated image. This command works only if you are using a window system,
so it has a way to determine color values.
-\(fn FROM TO &optional FILENAME)" t nil)
-
+(fn FROM TO &optional FILENAME)" t nil)
(autoload 'ps-spool-buffer "ps-print" "\
Generate and spool a PostScript image of the buffer.
Like `ps-print-buffer' except that the PostScript image is saved in a local
buffer to be sent to the printer later.
Use the command `ps-despool' to send the spooled images to the printer." t nil)
-
(autoload 'ps-spool-buffer-with-faces "ps-print" "\
Generate and spool a PostScript image of the buffer.
Like the command `ps-spool-buffer', but includes font, color, and underline
@@ -26930,15 +24629,13 @@ information in the generated image. This command works only if you are using
a window system, so it has a way to determine color values.
Use the command `ps-despool' to send the spooled images to the printer." t nil)
-
(autoload 'ps-spool-region "ps-print" "\
Generate a PostScript image of the region and spool locally.
Like `ps-spool-buffer', but spools just the current region.
Use the command `ps-despool' to send the spooled images to the printer.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'ps-spool-region-with-faces "ps-print" "\
Generate a PostScript image of the region and spool locally.
Like `ps-spool-region', but includes font, color, and underline information in
@@ -26947,8 +24644,7 @@ so it has a way to determine color values.
Use the command `ps-despool' to send the spooled images to the printer.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'ps-despool "ps-print" "\
Send the spooled PostScript to the printer.
@@ -26960,29 +24656,24 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name.
-\(fn &optional FILENAME)" t nil)
-
+(fn &optional FILENAME)" t nil)
(autoload 'ps-line-lengths "ps-print" "\
Display the correspondence between a line length and a font size.
Done using the current ps-print setup.
Try: pr -t file | awk \\='{printf \"%3d %s
\", length($0), $0}\\=' | sort -r | head" t nil)
-
(autoload 'ps-nb-pages-buffer "ps-print" "\
Display number of pages to print this buffer, for various font heights.
The table depends on the current ps-print setup.
-\(fn NB-LINES)" t nil)
-
+(fn NB-LINES)" t nil)
(autoload 'ps-nb-pages-region "ps-print" "\
Display number of pages to print the region, for various font heights.
The table depends on the current ps-print setup.
-\(fn NB-LINES)" t nil)
-
+(fn NB-LINES)" t nil)
(autoload 'ps-setup "ps-print" "\
Return the current PostScript-generation setup." nil nil)
-
(autoload 'ps-extend-face-list "ps-print" "\
Extend face in ALIST-SYM.
@@ -26996,8 +24687,7 @@ The elements in FACE-EXTENSION-LIST are like those for `ps-extend-face'.
See `ps-extend-face' for documentation.
-\(fn FACE-EXTENSION-LIST &optional MERGE-P ALIST-SYM)" nil nil)
-
+(fn FACE-EXTENSION-LIST &optional MERGE-P ALIST-SYM)" nil nil)
(autoload 'ps-extend-face "ps-print" "\
Extend face in ALIST-SYM.
@@ -27028,56 +24718,43 @@ EXTENSION is one of the following symbols:
If EXTENSION is any other symbol, it is ignored.
-\(fn FACE-EXTENSION &optional MERGE-P ALIST-SYM)" nil nil)
-
+(fn FACE-EXTENSION &optional MERGE-P ALIST-SYM)" nil nil)
(register-definition-prefixes "ps-print" '("ps-"))
-;;;***
-;;;### (autoloads nil "ps-samp" "ps-samp.el" (0 0 0 0))
;;; Generated autoloads from ps-samp.el
(register-definition-prefixes "ps-samp" '("ps-"))
-;;;***
-;;;### (autoloads nil "pulse" "cedet/pulse.el" (0 0 0 0))
;;; Generated autoloads from cedet/pulse.el
-(push (purecopy '(pulse 1 0)) package--builtin-versions)
+(push (purecopy '(pulse 1 0)) package--builtin-versions)
(autoload 'pulse-momentary-highlight-one-line "pulse" "\
Highlight the line around POINT, unhighlighting before next command.
If POINT is nil or missing, the current point is used instead.
Optional argument FACE specifies the face to do the highlighting.
-\(fn &optional POINT FACE)" nil nil)
-
+(fn &optional POINT FACE)" nil nil)
(autoload 'pulse-momentary-highlight-region "pulse" "\
Highlight between START and END, unhighlighting before next command.
Optional argument FACE specifies the face to do the highlighting.
-\(fn START END &optional FACE)" nil nil)
-
+(fn START END &optional FACE)" nil nil)
(register-definition-prefixes "pulse" '("pulse-"))
-;;;***
-;;;### (autoloads nil "puny" "net/puny.el" (0 0 0 0))
;;; Generated autoloads from net/puny.el
(register-definition-prefixes "puny" '("puny-"))
-;;;***
-;;;### (autoloads nil "python" "progmodes/python.el" (0 0 0 0))
;;; Generated autoloads from progmodes/python.el
-(push (purecopy '(python 0 28)) package--builtin-versions)
+(push (purecopy '(python 0 28)) package--builtin-versions)
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode))
-
(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode))
-
(autoload 'run-python "python" "\
Run an inferior Python process.
@@ -27096,20 +24773,21 @@ Runs the hook `inferior-python-mode-hook' after
`comint-mode-hook' is run. (Type \\[describe-mode] in the
process buffer for a list of commands.)
-\(fn &optional CMD DEDICATED SHOW)" t nil)
-
+(fn &optional CMD DEDICATED SHOW)" t nil)
(autoload 'python-mode "python" "\
Major mode for editing Python files.
\\{python-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "python" '("inferior-python-mode" "python-" "run-python-internal"))
-;;;***
-;;;### (autoloads nil "qp" "mail/qp.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/wisent/python.el
+
+(register-definition-prefixes "semantic/wisent/python" '("semantic-" "wisent-python-"))
+
+
;;; Generated autoloads from mail/qp.el
(autoload 'quoted-printable-decode-region "qp" "\
@@ -27124,18 +24802,14 @@ The CODING-SYSTEM argument is a historical hangover and is deprecated.
QP encodes raw bytes and should be decoded into raw bytes. Decoding
them into characters should be done separately.
-\(fn FROM TO &optional CODING-SYSTEM)" t nil)
-
+(fn FROM TO &optional CODING-SYSTEM)" t nil)
(register-definition-prefixes "qp" '("quoted-printable-"))
-;;;***
-;;;### (autoloads nil "quail" "international/quail.el" (0 0 0 0))
;;; Generated autoloads from international/quail.el
(autoload 'quail-title "quail" "\
Return the title of the current Quail package." nil nil)
-
(autoload 'quail-use-package "quail" "\
Start using Quail package PACKAGE-NAME.
The remaining arguments are LIBRARIES to be loaded before using the package.
@@ -27143,8 +24817,7 @@ The remaining arguments are LIBRARIES to be loaded before using the package.
This activates input method defined by PACKAGE-NAME by running
`quail-activate', which see.
-\(fn PACKAGE-NAME &rest LIBRARIES)" nil nil)
-
+(fn PACKAGE-NAME &rest LIBRARIES)" nil nil)
(autoload 'quail-define-package "quail" "\
Define NAME as a new Quail package for input LANGUAGE.
TITLE is a string to be displayed at mode-line to indicate this package.
@@ -27163,8 +24836,8 @@ If it is nil, the current key is shown.
DOCSTRING is the documentation string of this package. The command
`describe-input-method' shows this string while replacing the form
-\\=\\<VAR> in the string by the value of VAR. That value should be a
-string. For instance, the form \\=\\<quail-translation-docstring> is
+\\=\\=\\=\\<VAR> in the string by the value of VAR. That value should be a
+string. For instance, the form \\=\\=\\=\\<quail-translation-docstring> is
replaced by a description about how to select a translation from a
list of candidates.
@@ -27225,8 +24898,7 @@ If SIMPLE is non-nil, then we do not alter the meanings of
commands such as \\[forward-char], \\[backward-char], \\[next-line], \\[previous-line] and \\[indent-for-tab-command]; they are treated as
non-Quail commands.
-\(fn NAME LANGUAGE TITLE &optional GUIDANCE DOCSTRING TRANSLATION-KEYS FORGET-LAST-SELECTION DETERMINISTIC KBD-TRANSLATE SHOW-LAYOUT CREATE-DECODE-MAP MAXIMUM-SHORTEST OVERLAY-PLIST UPDATE-TRANSLATION-FUNCTION CONVERSION-KEYS SIMPLE)" nil nil)
-
+(fn NAME LANGUAGE TITLE &optional GUIDANCE DOCSTRING TRANSLATION-KEYS FORGET-LAST-SELECTION DETERMINISTIC KBD-TRANSLATE SHOW-LAYOUT CREATE-DECODE-MAP MAXIMUM-SHORTEST OVERLAY-PLIST UPDATE-TRANSLATION-FUNCTION CONVERSION-KEYS SIMPLE)" nil nil)
(autoload 'quail-set-keyboard-layout "quail" "\
Set the current keyboard layout to the same as keyboard KBD-TYPE.
@@ -27236,16 +24908,14 @@ standard layout defined in `quail-keyboard-layout-standard'. This
function tells Quail system the layout of your keyboard so that what
you type is correctly handled.
-\(fn KBD-TYPE)" t nil)
-
+(fn KBD-TYPE)" t nil)
(autoload 'quail-show-keyboard-layout "quail" "\
Show the physical layout of the keyboard type KEYBOARD-TYPE.
The variable `quail-keyboard-layout-type' holds the currently selected
keyboard type.
-\(fn &optional KEYBOARD-TYPE)" t nil)
-
+(fn &optional KEYBOARD-TYPE)" t nil)
(autoload 'quail-define-rules "quail" "\
Define translation rules of the current Quail package.
Each argument is a list of KEY and TRANSLATION.
@@ -27279,8 +24949,7 @@ the following annotation types are supported.
no-decode-map --- the value non-nil means that decoding map is not
generated for the following translations.
-\(fn &rest RULES)" nil t)
-
+(fn &rest RULES)" nil t)
(autoload 'quail-install-map "quail" "\
Install the Quail map MAP in the current Quail package.
@@ -27289,8 +24958,7 @@ which to install MAP.
The installed map can be referred by the function `quail-map'.
-\(fn MAP &optional NAME)" nil nil)
-
+(fn MAP &optional NAME)" nil nil)
(autoload 'quail-install-decode-map "quail" "\
Install the Quail decode map DECODE-MAP in the current Quail package.
@@ -27299,8 +24967,7 @@ which to install MAP.
The installed decode map can be referred by the function `quail-decode-map'.
-\(fn DECODE-MAP &optional NAME)" nil nil)
-
+(fn DECODE-MAP &optional NAME)" nil nil)
(autoload 'quail-defrule "quail" "\
Add one translation rule, KEY to TRANSLATION, in the current Quail package.
KEY is a string meaning a sequence of keystrokes to be translated.
@@ -27326,8 +24993,7 @@ current Quail package.
Optional 4th argument APPEND, if non-nil, appends TRANSLATION
to the current translations for KEY instead of replacing them.
-\(fn KEY TRANSLATION &optional NAME APPEND)" nil nil)
-
+(fn KEY TRANSLATION &optional NAME APPEND)" nil nil)
(autoload 'quail-defrule-internal "quail" "\
Define KEY as TRANS in a Quail map MAP.
@@ -27339,8 +25005,7 @@ Optional 5th arg DECODE-MAP is a Quail decode map.
Optional 6th arg PROPS is a property list annotating TRANS. See the
function `quail-define-rules' for the detail.
-\(fn KEY TRANS MAP &optional APPEND DECODE-MAP PROPS)" nil nil)
-
+(fn KEY TRANS MAP &optional APPEND DECODE-MAP PROPS)" nil nil)
(autoload 'quail-update-leim-list-file "quail" "\
Update entries for Quail packages in `LEIM' list file in directory DIRNAME.
DIRNAME is a directory containing Emacs input methods;
@@ -27354,120 +25019,10 @@ When called from a program, the remaining arguments are additional
directory names to search for Quail packages under `quail' subdirectory
of each directory.
-\(fn DIRNAME &rest DIRNAMES)" t nil)
-
+(fn DIRNAME &rest DIRNAMES)" t nil)
(register-definition-prefixes "quail" '("quail-"))
-;;;***
-
-;;;### (autoloads nil "quail/ethiopic" "leim/quail/ethiopic.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from leim/quail/ethiopic.el
-
-(register-definition-prefixes "quail/ethiopic" '("ethio-select-a-translation"))
-
-;;;***
-;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from leim/quail/hangul.el
-
-(autoload 'hangul-input-method-activate "quail/hangul" "\
-Activate Hangul input method INPUT-METHOD.
-FUNC is a function to handle input key.
-HELP-TEXT is a text set in `hangul-input-method-help-text'.
-
-\(fn INPUT-METHOD FUNC HELP-TEXT &rest ARGS)" nil nil)
-
-(register-definition-prefixes "quail/hangul" '("alphabetp" "hangul" "notzerop"))
-
-;;;***
-
-;;;### (autoloads nil "quail/indian" "leim/quail/indian.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from leim/quail/indian.el
-
-(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u" "inscript-" "quail-"))
-
-;;;***
-
-;;;### (autoloads nil "quail/ipa" "leim/quail/ipa.el" (0 0 0 0))
-;;; Generated autoloads from leim/quail/ipa.el
-
-(register-definition-prefixes "quail/ipa" '("ipa-x-sampa-"))
-
-;;;***
-
-;;;### (autoloads nil "quail/japanese" "leim/quail/japanese.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from leim/quail/japanese.el
-
-(register-definition-prefixes "quail/japanese" '("quail-japanese-"))
-
-;;;***
-
-;;;### (autoloads nil "quail/lao" "leim/quail/lao.el" (0 0 0 0))
-;;; Generated autoloads from leim/quail/lao.el
-
-(register-definition-prefixes "quail/lao" '("lao-" "quail-lao-update-translation"))
-
-;;;***
-
-;;;### (autoloads nil "quail/lrt" "leim/quail/lrt.el" (0 0 0 0))
-;;; Generated autoloads from leim/quail/lrt.el
-
-(register-definition-prefixes "quail/lrt" '("quail-lrt-update-translation"))
-
-;;;***
-
-;;;### (autoloads nil "quail/sisheng" "leim/quail/sisheng.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from leim/quail/sisheng.el
-
-(register-definition-prefixes "quail/sisheng" '("quail-make-sisheng-rules" "sisheng-"))
-
-;;;***
-
-;;;### (autoloads nil "quail/thai" "leim/quail/thai.el" (0 0 0 0))
-;;; Generated autoloads from leim/quail/thai.el
-
-(register-definition-prefixes "quail/thai" '("thai-generate-quail-map"))
-
-;;;***
-
-;;;### (autoloads nil "quail/tibetan" "leim/quail/tibetan.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from leim/quail/tibetan.el
-
-(register-definition-prefixes "quail/tibetan" '("quail-tib" "tibetan-"))
-
-;;;***
-
-;;;### (autoloads nil "quail/uni-input" "leim/quail/uni-input.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from leim/quail/uni-input.el
-
-(autoload 'ucs-input-activate "quail/uni-input" "\
-Activate UCS input method.
-With ARG, activate UCS input method if and only if ARG is positive.
-
-While this input method is active, the variable
-`input-method-function' is bound to the function `ucs-input-method'.
-
-\(fn &optional ARG)" nil nil)
-
-(register-definition-prefixes "quail/uni-input" '("ucs-input-"))
-
-;;;***
-
-;;;### (autoloads nil "quail/viqr" "leim/quail/viqr.el" (0 0 0 0))
-;;; Generated autoloads from leim/quail/viqr.el
-
-(register-definition-prefixes "quail/viqr" '("viet-quail-define-rules"))
-
-;;;***
-
-;;;### (autoloads nil "quickurl" "net/quickurl.el" (0 0 0 0))
;;; Generated autoloads from net/quickurl.el
(defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'write-file-functions (lambda () (quickurl-read) nil) nil t))\n;; End:\n" "\
@@ -27480,7 +25035,6 @@ To make use of this do something like:
(setq quickurl-postfix quickurl-reread-hook-postfix)
in your init file (after loading/requiring quickurl).")
-
(autoload 'quickurl "quickurl" "\
Insert a URL based on LOOKUP.
@@ -27488,21 +25042,18 @@ If not supplied LOOKUP is taken to be the word at point in the current
buffer, this default action can be modified via
`quickurl-grab-lookup-function'.
-\(fn &optional LOOKUP)" t nil)
-
+(fn &optional LOOKUP)" t nil)
(autoload 'quickurl-ask "quickurl" "\
Insert a URL, with `completing-read' prompt, based on LOOKUP.
-\(fn LOOKUP)" t nil)
-
+(fn LOOKUP)" t nil)
(autoload 'quickurl-add-url "quickurl" "\
Allow the user to interactively add a new URL associated with WORD.
See `quickurl-grab-url' for details on how the default word/URL combination
is decided.
-\(fn WORD URL COMMENT)" t nil)
-
+(fn WORD URL COMMENT)" t nil)
(autoload 'quickurl-browse-url "quickurl" "\
Browse the URL associated with LOOKUP.
@@ -27510,16 +25061,13 @@ If not supplied LOOKUP is taken to be the word at point in the
current buffer, this default action can be modified via
`quickurl-grab-lookup-function'.
-\(fn &optional LOOKUP)" t nil)
-
+(fn &optional LOOKUP)" t nil)
(autoload 'quickurl-browse-url-ask "quickurl" "\
Browse the URL, with `completing-read' prompt, associated with LOOKUP.
-\(fn LOOKUP)" t nil)
-
+(fn LOOKUP)" t nil)
(autoload 'quickurl-edit-urls "quickurl" "\
Pull `quickurl-url-file' into a buffer for hand editing." t nil)
-
(autoload 'quickurl-list-mode "quickurl" "\
A mode for browsing the quickurl URL list.
@@ -27527,24 +25075,22 @@ The key bindings for `quickurl-list-mode' are:
\\{quickurl-list-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'quickurl-list "quickurl" "\
Display `quickurl-list' as a formatted list using `quickurl-list-mode'." t nil)
-
(register-definition-prefixes "quickurl" '("quickurl-"))
-;;;***
-;;;### (autoloads nil "radix-tree" "emacs-lisp/radix-tree.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/radix-tree.el
(register-definition-prefixes "radix-tree" '("radix-tree-"))
-;;;***
-;;;### (autoloads nil "rcirc" "net/rcirc.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/range.el
+
+(register-definition-prefixes "range" '("range-"))
+
+
;;; Generated autoloads from net/rcirc.el
(autoload 'rcirc "rcirc" "\
@@ -27554,19 +25100,16 @@ Do not connect to a server if it is already connected.
If ARG is non-nil, instead prompt for connection parameters.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(defalias 'irc 'rcirc)
-
(autoload 'rcirc-connect "rcirc" "\
Connect to SERVER.
The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
-ENCRYPTION, SERVER-ALIAS are interpreted as in
+ENCRYPTION, CERTFP, SERVER-ALIAS are interpreted as in
`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
that are joined after authentication.
-\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS)" nil nil)
-
+(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION CERTFP SERVER-ALIAS)" nil nil)
(defvar rcirc-track-minor-mode nil "\
Non-nil if Rcirc-Track minor mode is enabled.
See the `rcirc-track-minor-mode' command
@@ -27574,38 +25117,32 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `rcirc-track-minor-mode'.")
-
(custom-autoload 'rcirc-track-minor-mode "rcirc" nil)
-
(autoload 'rcirc-track-minor-mode "rcirc" "\
Global minor mode for tracking activity in rcirc buffers.
-This is a minor mode. If called interactively, toggle the
-`Rcirc-Track minor mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Rcirc-Track minor mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='rcirc-track-minor-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-"))
-;;;***
-;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/re-builder.el
(defalias 'regexp-builder 're-builder)
-
(autoload 're-builder "re-builder" "\
Construct a regexp interactively.
This command makes the current buffer the \"target\" buffer of
@@ -27619,14 +25156,17 @@ Case-sensitivity can be toggled with \\[reb-toggle-case]. The
regexp builder supports three different forms of input which can
be set with \\[reb-change-syntax]. More options and details are
provided in the Commentary section of this library." t nil)
-
(register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-"))
-;;;***
-;;;### (autoloads nil "recentf" "recentf.el" (0 0 0 0))
;;; Generated autoloads from recentf.el
+(autoload 'recentf-open "recentf" "\
+Prompt for FILE in `recentf-list' and visit it.
+Enable `recentf-mode' if it isn't already.
+
+(fn FILE)" t nil)
+(defalias 'recentf 'recentf-open)
(defvar recentf-mode nil "\
Non-nil if Recentf mode is enabled.
See the `recentf-mode' command
@@ -27634,25 +25174,16 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `recentf-mode'.")
-
(custom-autoload 'recentf-mode "recentf" nil)
-
(autoload 'recentf-mode "recentf" "\
-Toggle \"Open Recent\" menu (Recentf mode).
-
-This is a minor mode. If called interactively, toggle the `Recentf
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+Toggle keeping track of opened files (Recentf mode).
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+This mode maintains a list of recently opened files and makes it
+easy to visit them. The recent files list is automatically saved
+across Emacs sessions.
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='recentf-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+You can use `recentf-open' or `recentf-open-files' to visit
+files.
When Recentf mode is enabled, a \"Open Recent\" submenu is
displayed in the \"File\" menu, containing a list of files that
@@ -27663,15 +25194,26 @@ to a file, and killing a buffer is counted as \"operating\" on
the file. If instead you want to prioritize files that appear in
buffers you switch to a lot, you can say something like the following:
- (add-hook 'buffer-list-update-hook 'recentf-track-opened-file)
+ (add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file)
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Recentf mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='recentf-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "recentf" '("recentf-"))
-;;;***
-;;;### (autoloads nil "rect" "rect.el" (0 0 0 0))
;;; Generated autoloads from rect.el
(autoload 'delete-rectangle "rect" "\
@@ -27684,8 +25226,7 @@ When called from a program the rectangle's corners are START and END.
With a prefix (or a FILL) argument, also fill lines where nothing has
to be deleted.
-\(fn START END &optional FILL)" t nil)
-
+(fn START END &optional FILL)" t nil)
(autoload 'delete-extract-rectangle "rect" "\
Delete the contents of the rectangle with corners at START and END.
Return it as a list of strings, one for each line of the rectangle.
@@ -27694,14 +25235,12 @@ When called from a program the rectangle's corners are START and END.
With an optional FILL argument, also fill lines where nothing has to be
deleted.
-\(fn START END &optional FILL)" nil nil)
-
+(fn START END &optional FILL)" nil nil)
(autoload 'extract-rectangle "rect" "\
Return the contents of the rectangle with corners at START and END.
Return it as a list of strings, one for each line of the rectangle.
-\(fn START END)" nil nil)
-
+(fn START END)" nil nil)
(autoload 'kill-rectangle "rect" "\
Delete the region-rectangle and save it as the last killed one.
@@ -27714,19 +25253,16 @@ deleted.
If the buffer is read-only, Emacs will beep and refrain from deleting
the rectangle, but put it in `killed-rectangle' anyway. This means that
you can use this command to copy text from a read-only buffer.
-\(If the variable `kill-read-only-ok' is non-nil, then this won't
+(If the variable `kill-read-only-ok' is non-nil, then this won't
even beep.)
-\(fn START END &optional FILL)" t nil)
-
+(fn START END &optional FILL)" t nil)
(autoload 'copy-rectangle-as-kill "rect" "\
Copy the region-rectangle and save it as the last killed one.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'yank-rectangle "rect" "\
Yank the last killed rectangle with upper left corner at point." t nil)
-
(autoload 'insert-rectangle "rect" "\
Insert text of RECTANGLE with upper left corner at point.
RECTANGLE's first line is inserted at point, its second
@@ -27735,8 +25271,7 @@ RECTANGLE should be a list of strings.
After this command, the mark is at the upper left corner
and point is at the lower right corner.
-\(fn RECTANGLE)" nil nil)
-
+(fn RECTANGLE)" nil nil)
(autoload 'open-rectangle "rect" "\
Blank out the region-rectangle, shifting text right.
@@ -27747,10 +25282,8 @@ When called from a program the rectangle's corners are START and END.
With a prefix (or a FILL) argument, fill with blanks even if there is
no text on the right side of the rectangle.
-\(fn START END &optional FILL)" t nil)
-
+(fn START END &optional FILL)" t nil)
(defalias 'close-rectangle 'delete-whitespace-rectangle)
-
(autoload 'delete-whitespace-rectangle "rect" "\
Delete all whitespace following a specified column in each line.
The left edge of the rectangle specifies the position in each line
@@ -27760,8 +25293,7 @@ rectangle, all contiguous whitespace starting at that column is deleted.
When called from a program the rectangle's corners are START and END.
With a prefix (or a FILL) argument, also fill too short lines.
-\(fn START END &optional FILL)" t nil)
-
+(fn START END &optional FILL)" t nil)
(autoload 'string-rectangle "rect" "\
Replace rectangle contents with STRING on each line.
The length of STRING need not be the same as the rectangle width.
@@ -27772,10 +25304,8 @@ the minibuffer.
Called from a program, takes three args; START, END and STRING.
-\(fn START END STRING)" t nil)
-
+(fn START END STRING)" t nil)
(defalias 'replace-rectangle 'string-rectangle)
-
(autoload 'string-insert-rectangle "rect" "\
Insert STRING on each line of region-rectangle, shifting text right.
@@ -27783,8 +25313,7 @@ When called from a program, the rectangle's corners are START and END.
The left edge of the rectangle specifies the column for insertion.
This command does not delete or overwrite any existing text.
-\(fn START END STRING)" t nil)
-
+(fn START END STRING)" t nil)
(autoload 'clear-rectangle "rect" "\
Blank out the region-rectangle.
The text previously in the region is overwritten with blanks.
@@ -27793,8 +25322,7 @@ When called from a program the rectangle's corners are START and END.
With a prefix (or a FILL) argument, also fill with blanks the parts of the
rectangle which were empty.
-\(fn START END &optional FILL)" t nil)
-
+(fn START END &optional FILL)" t nil)
(autoload 'rectangle-number-lines "rect" "\
Insert numbers in front of the region-rectangle.
@@ -27803,68 +25331,46 @@ counting. FORMAT, if non-nil, should be a format string to pass
to `format' along with the line count. When called interactively
with a prefix argument, prompt for START-AT and FORMAT.
-\(fn START END START-AT &optional FORMAT)" t nil)
-
+(fn START END START-AT &optional FORMAT)" t nil)
(autoload 'rectangle-mark-mode "rect" "\
Toggle the region as rectangular.
+Activates the region if it's inactive and Transient Mark mode is
+on. Only lasts until the region is next deactivated.
+
This is a minor mode. If called interactively, toggle the
`Rectangle-Mark mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `rectangle-mark-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-Activates the region if it's inactive and Transient Mark mode is
-on. Only lasts until the region is next deactivated.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-"))
-;;;***
-;;;### (autoloads nil "refbib" "textmodes/refbib.el" (0 0 0 0))
;;; Generated autoloads from textmodes/refbib.el
(register-definition-prefixes "refbib" '("r2b-"))
-;;;***
-;;;### (autoloads nil "refer" "textmodes/refer.el" (0 0 0 0))
;;; Generated autoloads from textmodes/refer.el
(register-definition-prefixes "refer" '("refer-"))
-;;;***
-;;;### (autoloads nil "refill" "textmodes/refill.el" (0 0 0 0))
;;; Generated autoloads from textmodes/refill.el
(autoload 'refill-mode "refill" "\
Toggle automatic refilling (Refill mode).
-This is a minor mode. If called interactively, toggle the `Refill
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `refill-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Refill mode is a buffer-local minor mode. When enabled, the
current paragraph is refilled as you edit. Self-inserting
characters only cause refilling if they would cause
@@ -27872,39 +25378,40 @@ auto-filling.
For true \"word wrap\" behavior, use `visual-line-mode' instead.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Refill mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `refill-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "refill" '("refill-"))
-;;;***
-;;;### (autoloads nil "reftex" "textmodes/reftex.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/analyze/refs.el
+
+(register-definition-prefixes "semantic/analyze/refs" '("semantic-"))
+
+
;;; Generated autoloads from textmodes/reftex.el
+
(autoload 'reftex-citation "reftex-cite" nil t)
(autoload 'reftex-all-document-files "reftex-parse")
(autoload 'reftex-isearch-minor-mode "reftex-global" nil t)
(autoload 'reftex-index-phrases-mode "reftex-index" nil t)
-
(autoload 'turn-on-reftex "reftex" "\
Turn on RefTeX mode." nil nil)
-
(autoload 'reftex-mode "reftex" "\
Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX.
-This is a minor mode. If called interactively, toggle the `Reftex
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `reftex-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
\\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing
capabilities is available with `\\[reftex-toc]'.
@@ -27933,30 +25440,81 @@ on the menu bar.
------------------------------------------------------------------------------
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Reftex mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `reftex-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'reftex-reset-scanning-information "reftex" "\
Reset the symbols containing information from buffer scanning.
This enforces rescanning the buffer on next use." nil nil)
-
(register-definition-prefixes "reftex" '("reftex-"))
-;;;***
-;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (0
-;;;;;; 0 0 0))
+;;; Generated autoloads from textmodes/reftex-auc.el
+
+(register-definition-prefixes "reftex-auc" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-cite.el
+
+(register-definition-prefixes "reftex-cite" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-dcr.el
+
+(register-definition-prefixes "reftex-dcr" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-global.el
+
+(register-definition-prefixes "reftex-global" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-index.el
+
+(register-definition-prefixes "reftex-index" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-parse.el
+
+(register-definition-prefixes "reftex-parse" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-ref.el
+
+(register-definition-prefixes "reftex-ref" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-sel.el
+
+(register-definition-prefixes "reftex-sel" '("reftex-"))
+
+
+;;; Generated autoloads from textmodes/reftex-toc.el
+
+(register-definition-prefixes "reftex-toc" '("reftex-"))
+
+
;;; Generated autoloads from textmodes/reftex-vars.el
+
(put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(put 'reftex-level-indent 'safe-local-variable 'integerp)
(put 'reftex-guess-label-type 'safe-local-variable (lambda (x) (memq x '(nil t))))
-
(register-definition-prefixes "reftex-vars" '("reftex-"))
-;;;***
-;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/regexp-opt.el
(autoload 'regexp-opt "regexp-opt" "\
@@ -28006,34 +25564,26 @@ usually more efficient than that of a simplified version:
(mapconcat \\='regexp-quote strings \"\\\\|\")
(cdr parens))))
-\(fn STRINGS &optional PAREN)" nil nil)
-
+(fn STRINGS &optional PAREN)" nil nil)
(autoload 'regexp-opt-depth "regexp-opt" "\
Return the depth of REGEXP.
This means the number of non-shy regexp grouping constructs
-\(parenthesized expressions) in REGEXP.
-
-\(fn REGEXP)" nil nil)
+(parenthesized expressions) in REGEXP.
+(fn REGEXP)" nil nil)
(register-definition-prefixes "regexp-opt" '("regexp-opt-"))
-;;;***
-;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/regi.el
(register-definition-prefixes "regi" '("regi-"))
-;;;***
-;;;### (autoloads nil "registry" "registry.el" (0 0 0 0))
;;; Generated autoloads from registry.el
(register-definition-prefixes "registry" '("registry-"))
-;;;***
-;;;### (autoloads nil "remember" "textmodes/remember.el" (0 0 0 0))
;;; Generated autoloads from textmodes/remember.el
(autoload 'remember "remember" "\
@@ -28043,20 +25593,16 @@ or nil to bring up a blank `remember-buffer'.
With a prefix or a visible region, use the region as INITIAL.
-\(fn &optional INITIAL)" t nil)
-
+(fn &optional INITIAL)" t nil)
(autoload 'remember-other-frame "remember" "\
Call `remember' in another frame.
-\(fn &optional INITIAL)" t nil)
-
+(fn &optional INITIAL)" t nil)
(autoload 'remember-clipboard "remember" "\
Remember the contents of the current clipboard.
Most useful for remembering things from other applications." t nil)
-
(autoload 'remember-diary-extract-entries "remember" "\
Extract diary entries from the region based on `remember-diary-regexp'." nil nil)
-
(autoload 'remember-notes "remember" "\
Return the notes buffer, creating it if needed, and maybe switch to it.
This buffer is for notes that you want to preserve across Emacs sessions.
@@ -28078,13 +25624,10 @@ Set `initial-buffer-choice' to `remember-notes' to visit your notes buffer
when Emacs starts. Set `remember-notes-buffer-name' to \"*scratch*\"
to turn the *scratch* buffer into your notes buffer.
-\(fn &optional SWITCH-TO)" t nil)
-
+(fn &optional SWITCH-TO)" t nil)
(register-definition-prefixes "remember" '("remember-"))
-;;;***
-;;;### (autoloads nil "repeat" "repeat.el" (0 0 0 0))
;;; Generated autoloads from repeat.el
(autoload 'repeat "repeat" "\
@@ -28102,13 +25645,11 @@ sequence. This behavior can be modified by the global variable
\"most recently executed command\" shall be read as \"most
recently executed command not bound to an input event\".
-\(fn REPEAT-ARG)" t nil)
-
+(fn REPEAT-ARG)" t nil)
(defvar repeat-map nil "\
The value of the repeating transient map for the next command.
A command called from the map can set it again to the same map when
the map can't be set on the command symbol property `repeat-map'.")
-
(defvar repeat-mode nil "\
Non-nil if Repeat mode is enabled.
See the `repeat-mode' command
@@ -28116,36 +25657,32 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `repeat-mode'.")
-
(custom-autoload 'repeat-mode "repeat" nil)
-
(autoload 'repeat-mode "repeat" "\
Toggle Repeat mode.
+
When Repeat mode is enabled, and the command symbol has the property named
`repeat-map', this map is activated temporarily for the next command.
See `describe-repeat-maps' for a list of all repeatable commands.
-This is a minor mode. If called interactively, toggle the `Repeat
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Repeat mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='repeat-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "repeat" '("describe-repeat-maps" "repeat-"))
-;;;***
-;;;### (autoloads nil "reporter" "mail/reporter.el" (0 0 0 0))
;;; Generated autoloads from mail/reporter.el
(autoload 'reporter-submit-bug-report "reporter" "\
@@ -28169,16 +25706,13 @@ is non-nil.
This function does not send a message; it uses the given information
to initialize a message, which the user can then edit and finally send
-\(or decline to send). The variable `mail-user-agent' controls which
+(or decline to send). The variable `mail-user-agent' controls which
mail-sending package is used for editing and sending the message.
-\(fn ADDRESS PKGNAME VARLIST &optional PRE-HOOKS POST-HOOKS SALUTATION)" nil nil)
-
+(fn ADDRESS PKGNAME VARLIST &optional PRE-HOOKS POST-HOOKS SALUTATION)" nil nil)
(register-definition-prefixes "reporter" '("reporter-"))
-;;;***
-;;;### (autoloads nil "reposition" "reposition.el" (0 0 0 0))
;;; Generated autoloads from reposition.el
(autoload 'reposition-window "reposition" "\
@@ -28202,39 +25736,35 @@ first comment line visible (if point is in a comment).
If INTERACTIVE is non-nil, as it is interactively,
report errors as appropriate for this kind of usage.
-\(fn &optional ARG INTERACTIVE)" t nil)
-
+(fn &optional ARG INTERACTIVE)" t nil)
(register-definition-prefixes "reposition" '("repos-count-screen-lines"))
-;;;***
-;;;### (autoloads nil "reveal" "reveal.el" (0 0 0 0))
;;; Generated autoloads from reveal.el
(autoload 'reveal-mode "reveal" "\
Toggle uncloaking of invisible text near point (Reveal mode).
-This is a minor mode. If called interactively, toggle the `Reveal
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `reveal-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Reveal mode is a buffer-local minor mode. When enabled, it
reveals invisible text around point.
Also see the `reveal-auto-hide' variable.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Reveal mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `reveal-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(defvar global-reveal-mode nil "\
Non-nil if Global Reveal mode is enabled.
See the `global-reveal-mode' command
@@ -28242,101 +25772,78 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-reveal-mode'.")
-
(custom-autoload 'global-reveal-mode "reveal" nil)
-
(autoload 'global-reveal-mode "reveal" "\
Toggle Reveal mode in all buffers (Global Reveal mode).
+
Reveal mode renders invisible text around point visible again.
-This is a minor mode. If called interactively, toggle the `Global
-Reveal mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Global Reveal mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-reveal-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "reveal" '("reveal-"))
-;;;***
-;;;### (autoloads nil "rfc1843" "international/rfc1843.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from international/rfc1843.el
(register-definition-prefixes "rfc1843" '("rfc1843-"))
-;;;***
-;;;### (autoloads nil "rfc2045" "mail/rfc2045.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2045.el
(register-definition-prefixes "rfc2045" '("rfc2045-encode-string"))
-;;;***
-;;;### (autoloads nil "rfc2047" "mail/rfc2047.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2047.el
(register-definition-prefixes "rfc2047" '("rfc2047-"))
-;;;***
-;;;### (autoloads nil "rfc2104" "net/rfc2104.el" (0 0 0 0))
;;; Generated autoloads from net/rfc2104.el
(register-definition-prefixes "rfc2104" '("rfc2104-"))
-;;;***
-;;;### (autoloads nil "rfc2231" "mail/rfc2231.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2231.el
(register-definition-prefixes "rfc2231" '("rfc2231-"))
-;;;***
-;;;### (autoloads nil "rfc6068" "mail/rfc6068.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc6068.el
(register-definition-prefixes "rfc6068" '("rfc6068-"))
-;;;***
-;;;### (autoloads nil "rfc822" "mail/rfc822.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc822.el
(register-definition-prefixes "rfc822" '("rfc822-"))
-;;;***
-;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/ring.el
(autoload 'ring-p "ring" "\
Return t if X is a ring; nil otherwise.
-\(fn X)" nil nil)
-
+(fn X)" nil nil)
(autoload 'make-ring "ring" "\
Make a ring that can contain SIZE elements.
-\(fn SIZE)" nil nil)
-
+(fn SIZE)" nil nil)
(register-definition-prefixes "ring" '("ring-"))
-;;;***
-;;;### (autoloads nil "rlogin" "net/rlogin.el" (0 0 0 0))
;;; Generated autoloads from net/rlogin.el
(autoload 'rlogin "rlogin" "\
@@ -28347,7 +25854,7 @@ other arguments for `rlogin'.
Input is sent line-at-a-time to the remote connection.
Communication with the remote host is recorded in a buffer `*rlogin-HOST*'
-\(or `*rlogin-USER@HOST*' if the remote username differs).
+(or `*rlogin-USER@HOST*' if the remote username differs).
If a prefix argument is given and the buffer `*rlogin-HOST*' already exists,
a new buffer with a different connection will be made.
@@ -28376,32 +25883,24 @@ If you wish to change directory tracking styles during a session, use the
function `rlogin-directory-tracking-mode' rather than simply setting the
variable.
-\(fn INPUT-ARGS &optional BUFFER)" t nil)
-
+(fn INPUT-ARGS &optional BUFFER)" t nil)
(register-definition-prefixes "rlogin" '("rlogin-"))
-;;;***
-;;;### (autoloads nil "rmail" "mail/rmail.el" (0 0 0 0))
;;; Generated autoloads from mail/rmail.el
(defvar rmail-file-name (purecopy "~/RMAIL") "\
Name of user's primary mail file.")
-
(custom-autoload 'rmail-file-name "rmail" t)
-
(defcustom rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/"))) "\
Name of directory used by system mailer for delivering new mail.
Its name should end with a slash." :initialize #'custom-initialize-delay :type 'directory :group 'rmail)
-
(custom-autoload 'rmail-spool-directory "rmail" t)
-
(autoload 'rmail-movemail-variant-p "rmail" "\
Return t if the current movemail variant is any of VARIANTS.
Currently known variants are `emacs' and `mailutils'.
-\(fn &rest VARIANTS)" nil nil)
-
+(fn &rest VARIANTS)" nil nil)
(defvar rmail-user-mail-address-regexp nil "\
Regexp matching user mail addresses.
If non-nil, this variable is used to identify the correspondent
@@ -28415,80 +25914,59 @@ sent by you under different user names.
Then it should be a regexp matching your mail addresses.
Setting this variable has an effect only before reading a mail.")
-
(custom-autoload 'rmail-user-mail-address-regexp "rmail" t)
-
-(define-obsolete-variable-alias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names "24.1")
-
+(define-obsolete-variable-alias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names "\
+24.1")
(defvar rmail-default-dont-reply-to-names nil "\
Regexp specifying part of the default value of `mail-dont-reply-to-names'.
This is used when the user does not set `mail-dont-reply-to-names'
explicitly.")
-
-(make-obsolete-variable 'rmail-default-dont-reply-to-names 'mail-dont-reply-to-names "24.1")
-
+(make-obsolete-variable 'rmail-default-dont-reply-to-names 'mail-dont-reply-to-names "\
+24.1")
(defvar rmail-ignored-headers (purecopy (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:" "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:" "\\|^x-mailer:\\|^delivered-to:\\|^lines:" "\\|^content-transfer-encoding:\\|^x-coding-system:" "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" "\\|^precedence:\\|^mime-version:" "\\|^list-owner:\\|^list-help:\\|^list-post:\\|^list-subscribe:" "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" "\\|^content-length:\\|^nntp-posting-date:\\|^user-agent" "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:" "\\|^mbox-line:\\|^cancel-lock:" "\\|^DomainKey-Signature:\\|^dkim-signature:" "\\|^ARC-.*:" "\\|^Received-SPF:" "\\|^Authentication-Results:" "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" "\\|^x-.*:")) "\
Regexp to match header fields that Rmail should normally hide.
-\(See also `rmail-nonignored-headers', which overrides this regexp.)
+(See also `rmail-nonignored-headers', which overrides this regexp.)
This variable is used for reformatting the message header,
which normally happens once for each message,
when you view the message for the first time in Rmail.
To make a change in this variable take effect
for a message that you have already viewed,
go to that message and type \\[rmail-toggle-header] twice.")
-
(custom-autoload 'rmail-ignored-headers "rmail" t)
-
(defvar rmail-displayed-headers nil "\
Regexp to match Header fields that Rmail should display.
If nil, display all header fields except those matched by
`rmail-ignored-headers'.")
-
(custom-autoload 'rmail-displayed-headers "rmail" t)
-
(defvar rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:") "\
Headers that should be stripped when retrying a failed message.")
-
(custom-autoload 'rmail-retry-ignored-headers "rmail" t)
-
(defvar rmail-highlighted-headers (purecopy "^From:\\|^Subject:") "\
Regexp to match Header fields that Rmail should normally highlight.
A value of nil means don't highlight. Uses the face `rmail-highlight'.")
-
(custom-autoload 'rmail-highlighted-headers "rmail" t)
-
(defvar rmail-primary-inbox-list nil "\
List of files that are inboxes for your primary mail file `rmail-file-name'.
If this is nil, uses the environment variable MAIL. If that is
unset, uses a file named by the function `user-login-name' in the
directory `rmail-spool-directory' (whose value depends on the
operating system). For example, \"/var/mail/USER\".")
-
(custom-autoload 'rmail-primary-inbox-list "rmail" t)
-
(defvar rmail-secondary-file-directory (purecopy "~/") "\
Directory for additional secondary Rmail files.")
-
(custom-autoload 'rmail-secondary-file-directory "rmail" t)
-
(defvar rmail-secondary-file-regexp (purecopy "\\.xmail\\'") "\
Regexp for which files are secondary Rmail files.")
-
(custom-autoload 'rmail-secondary-file-regexp "rmail" t)
-
(defvar rmail-mode-hook nil "\
List of functions to call when Rmail is invoked.")
-
(defvar rmail-show-message-hook nil "\
List of functions to call when Rmail displays a message.")
-
(custom-autoload 'rmail-show-message-hook "rmail" t)
-
(defvar rmail-file-coding-system nil "\
Coding system used in RMAIL file.
This is set to nil by default.")
-
(defvar rmail-insert-mime-forwarded-message-function nil "\
Function to insert a message in MIME format so it can be forwarded.
This function is called if `rmail-enable-mime' and
@@ -28496,7 +25974,6 @@ This function is called if `rmail-enable-mime' and
It is called with one argument FORWARD-BUFFER, which is a
buffer containing the message to forward. The current buffer
is the outgoing mail buffer.")
-
(autoload 'rmail "rmail" "\
Read and edit incoming mail.
Moves messages into file named by `rmail-file-name' and edits that
@@ -28510,8 +25987,7 @@ have a chance to specify a file name with the minibuffer.
If `rmail-display-summary' is non-nil, make a summary for this RMAIL file.
-\(fn &optional FILE-NAME-ARG)" t nil)
-
+(fn &optional FILE-NAME-ARG)" t nil)
(autoload 'rmail-mode "rmail" "\
Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files.
All normal editing commands are turned off.
@@ -28562,33 +26038,107 @@ Instead, these commands are available:
\\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s).
\\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s).
\\[rmail-toggle-header] Toggle display of complete header." t nil)
-
(autoload 'rmail-input "rmail" "\
Run Rmail on file FILENAME.
-\(fn FILENAME)" t nil)
-
+(fn FILENAME)" t nil)
(autoload 'rmail-set-remote-password "rmail" "\
Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
-\(fn PASSWORD)" t nil)
-
+(fn PASSWORD)" t nil)
(register-definition-prefixes "rmail" '("mail-" "rmail-"))
-;;;***
-;;;### (autoloads nil "rmail-spam-filter" "mail/rmail-spam-filter.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmail-spam-filter.el
(register-definition-prefixes "rmail-spam-filter" '("rmail-" "rsf-"))
-;;;***
-;;;### (autoloads nil "rmailout" "mail/rmailout.el" (0 0 0 0))
+;;; Generated autoloads from mail/rmailedit.el
+
+(autoload 'rmail-edit-current-message "rmailedit" "\
+Edit the contents of this message." t nil)
+(register-definition-prefixes "rmailedit" '("rmail-"))
+
+
+;;; Generated autoloads from mail/rmailkwd.el
+
+(autoload 'rmail-add-label "rmailkwd" "\
+Add LABEL to labels associated with current RMAIL message.
+Completes (see `rmail-read-label') over known labels when reading.
+LABEL may be a symbol or string. Only one label is allowed.
+
+(fn LABEL)" t nil)
+(autoload 'rmail-kill-label "rmailkwd" "\
+Remove LABEL from labels associated with current RMAIL message.
+Completes (see `rmail-read-label') over known labels when reading.
+LABEL may be a symbol or string. Only one label is allowed.
+
+(fn LABEL)" t nil)
+(autoload 'rmail-read-label "rmailkwd" "\
+Read a label with completion, prompting with PROMPT.
+Completions are chosen from `rmail-label-obarray'. The default
+is `rmail-last-label', if that is non-nil. Updates `rmail-last-label'
+according to the choice made, and returns a symbol.
+
+(fn PROMPT)" nil nil)
+(autoload 'rmail-previous-labeled-message "rmailkwd" "\
+Show previous message with one of the labels LABELS.
+LABELS should be a comma-separated list of label names.
+If LABELS is empty, the last set of labels specified is used.
+With prefix argument N moves backward N messages with these labels.
+
+(fn N LABELS)" t nil)
+(autoload 'rmail-next-labeled-message "rmailkwd" "\
+Show next message with one of the labels LABELS.
+LABELS should be a comma-separated list of label names.
+If LABELS is empty, the last set of labels specified is used.
+With prefix argument N moves forward N messages with these labels.
+
+(fn N LABELS)" t nil)
+(register-definition-prefixes "rmailkwd" '("rmail-"))
+
+
+;;; Generated autoloads from mail/rmailmm.el
+
+(autoload 'rmail-mime "rmailmm" "\
+Toggle the display of a MIME message.
+
+The actual behavior depends on the value of `rmail-enable-mime'.
+
+If `rmail-enable-mime' is non-nil (the default), this command toggles
+the display of a MIME message between decoded presentation form and
+raw data. With optional prefix argument ARG, it toggles the display only
+of the MIME entity at point, if there is one. The optional argument
+STATE forces a particular display state, rather than toggling.
+`raw' forces raw mode, any other non-nil value forces decoded mode.
+
+If `rmail-enable-mime' is nil, this creates a temporary \"*RMAIL*\"
+buffer holding a decoded copy of the message. Inline content-types
+are handled according to `rmail-mime-media-type-handlers-alist'.
+By default, this displays text and multipart messages, and offers to
+download attachments as specified by `rmail-mime-attachment-dirs-alist'.
+The arguments ARG and STATE have no effect in this case.
+
+(fn &optional ARG STATE)" t nil)
+(register-definition-prefixes "rmailmm" '("rmail-"))
+
+
+;;; Generated autoloads from mail/rmailmsc.el
+
+(autoload 'set-rmail-inbox-list "rmailmsc" "\
+Set the inbox list of the current RMAIL file to FILE-NAME.
+You can specify one file name, or several names separated by commas.
+If FILE-NAME is empty, remove any existing inbox list.
+
+This applies only to the current session.
+
+(fn FILE-NAME)" t nil)
+
+
;;; Generated autoloads from mail/rmailout.el
-(put 'rmail-output-file-alist 'risky-local-variable t)
+(put 'rmail-output-file-alist 'risky-local-variable t)
(autoload 'rmail-output "rmailout" "\
Append this message to mail file FILE-NAME.
Writes mbox format, unless FILE-NAME exists and is Babyl format, in which
@@ -28624,8 +26174,7 @@ message (if writing a file directly).
Set the optional fourth argument NOT-RMAIL non-nil if you call this
from a non-Rmail buffer. In this case, COUNT is ignored.
-\(fn FILE-NAME &optional COUNT NOATTRIBUTE NOT-RMAIL)" t nil)
-
+(fn FILE-NAME &optional COUNT NOATTRIBUTE NOT-RMAIL)" t nil)
(autoload 'rmail-output-as-seen "rmailout" "\
Append this message to mbox file named FILE-NAME.
The details are as for `rmail-output', except that:
@@ -28637,8 +26186,7 @@ Note that if NOT-RMAIL is non-nil, there is no difference between this
function and `rmail-output'. This argument may be removed in future,
so you should call `rmail-output' directly in that case.
-\(fn FILE-NAME &optional COUNT NOATTRIBUTE NOT-RMAIL)" t nil)
-
+(fn FILE-NAME &optional COUNT NOATTRIBUTE NOT-RMAIL)" t nil)
(autoload 'rmail-output-body-to-file "rmailout" "\
Write this message body to the file FILE-NAME.
Interactively, the default file name comes from either the message
@@ -28651,162 +26199,164 @@ Note that this overwrites FILE-NAME (after confirmation), rather
than appending to it. Deletes the message after writing if
`rmail-delete-after-output' is non-nil.
-\(fn FILE-NAME)" t nil)
-
+(fn FILE-NAME)" t nil)
(register-definition-prefixes "rmailout" '("rmail-"))
-;;;***
-
-;;;### (autoloads nil "rmc" "emacs-lisp/rmc.el" (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/rmc.el
-
-(autoload 'read-multiple-choice "rmc" "\
-Ask user to select an entry from CHOICES, promting with PROMPT.
-This function allows to ask the user a multiple-choice question.
-
-CHOICES should be a list of the form (KEY NAME [DESCRIPTION]).
-KEY is a character the user should type to select the entry.
-NAME is a short name for the entry to be displayed while prompting
-\(if there's no room, it might be shortened).
-DESCRIPTION is an optional longer description of the entry; it will
-be displayed in a help buffer if the user requests more help. This
-help description has a fixed format in columns. For greater
-flexibility, instead of passing a DESCRIPTION, the caller can pass
-the optional argument HELP-STRING. This argument is a string that
-should contain a more detailed description of all of the possible
-choices. `read-multiple-choice' will display that description in a
-help buffer if the user requests that.
-
-This function translates user input into responses by consulting
-the bindings in `query-replace-map'; see the documentation of
-that variable for more information. The relevant bindings for the
-purposes of this function are `recenter', `scroll-up', `scroll-down',
-and `edit'.
-If the user types the `recenter', `scroll-up', or `scroll-down'
-responses, the function performs the requested window recentering or
-scrolling, and then asks the question again. If the user enters `edit',
-the function starts a recursive edit. When the user exit the recursive
-edit, the multiple-choice prompt gains focus again.
-
-When `use-dialog-box' is t (the default), and the command using this
-function was invoked via the mouse, this function pops up a GUI dialog
-to collect the user input, but only if Emacs is capable of using GUI
-dialogs. Otherwise, the function will always use text-mode dialogs.
-
-The return value is the matching entry from the CHOICES list.
-
-Usage example:
-
-\(read-multiple-choice \"Continue connecting?\"
- \\='((?a \"always\")
- (?s \"session only\")
- (?n \"no\")))
-
-\(fn PROMPT CHOICES &optional HELP-STRING)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (0 0 0 0))
+
+;;; Generated autoloads from mail/rmailsort.el
+
+(autoload 'rmail-sort-by-date "rmailsort" "\
+Sort messages of current Rmail buffer by \"Date\" header.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+(fn REVERSE)" t nil)
+(autoload 'rmail-sort-by-subject "rmailsort" "\
+Sort messages of current Rmail buffer by \"Subject\" header.
+Ignores any \"Re: \" prefix. If prefix argument REVERSE is
+non-nil, sorts in reverse order.
+
+(fn REVERSE)" t nil)
+(autoload 'rmail-sort-by-author "rmailsort" "\
+Sort messages of current Rmail buffer by author.
+This uses either the \"From\" or \"Sender\" header, downcased.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+(fn REVERSE)" t nil)
+(autoload 'rmail-sort-by-recipient "rmailsort" "\
+Sort messages of current Rmail buffer by recipient.
+This uses either the \"To\" or \"Apparently-To\" header, downcased.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+(fn REVERSE)" t nil)
+(autoload 'rmail-sort-by-correspondent "rmailsort" "\
+Sort messages of current Rmail buffer by other correspondent.
+This uses either the \"From\", \"Sender\", \"To\", or
+\"Apparently-To\" header, downcased. Uses the first header not
+excluded by `mail-dont-reply-to-names'. If prefix argument
+REVERSE is non-nil, sorts in reverse order.
+
+(fn REVERSE)" t nil)
+(autoload 'rmail-sort-by-lines "rmailsort" "\
+Sort messages of current Rmail buffer by the number of lines.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+(fn REVERSE)" t nil)
+(autoload 'rmail-sort-by-labels "rmailsort" "\
+Sort messages of current Rmail buffer by labels.
+LABELS is a comma-separated list of labels. The order of these
+labels specifies the order of messages: messages with the first
+label come first, messages with the second label come second, and
+so on. Messages that have none of these labels come last.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+(fn REVERSE LABELS)" t nil)
+(register-definition-prefixes "rmailsort" '("rmail-"))
+
+
+;;; Generated autoloads from mail/rmailsum.el
+
+(autoload 'rmail-summary "rmailsum" "\
+Display a summary of all messages, one line per message." t nil)
+(autoload 'rmail-summary-by-labels "rmailsum" "\
+Display a summary of all messages with one or more LABELS.
+LABELS should be a string containing the desired labels, separated by commas.
+
+(fn LABELS)" t nil)
+(autoload 'rmail-summary-by-recipients "rmailsum" "\
+Display a summary of all messages with the given RECIPIENTS.
+Normally checks the To, From and Cc fields of headers;
+but if PRIMARY-ONLY is non-nil (prefix arg given),
+ only look in the To and From fields.
+RECIPIENTS is a regular expression.
+
+(fn RECIPIENTS &optional PRIMARY-ONLY)" t nil)
+(autoload 'rmail-summary-by-regexp "rmailsum" "\
+Display a summary of all messages according to regexp REGEXP.
+If the regular expression is found in the header of the message
+(including in the date and other lines, as well as the subject line),
+Emacs will list the message in the summary.
+
+(fn REGEXP)" t nil)
+(autoload 'rmail-summary-by-topic "rmailsum" "\
+Display a summary of all messages with the given SUBJECT.
+Normally checks just the Subject field of headers; but with prefix
+argument WHOLE-MESSAGE is non-nil, looks in the whole message.
+SUBJECT is a regular expression.
+
+(fn SUBJECT &optional WHOLE-MESSAGE)" t nil)
+(autoload 'rmail-summary-by-senders "rmailsum" "\
+Display a summary of all messages whose \"From\" field matches SENDERS.
+SENDERS is a regular expression. The default for SENDERS matches the
+sender of the current message.
+
+(fn SENDERS)" t nil)
+(register-definition-prefixes "rmailsum" '("rmail-"))
+
+
;;; Generated autoloads from nxml/rng-cmpct.el
(autoload 'rng-c-load-schema "rng-cmpct" "\
Load a schema in RELAX NG compact syntax from FILENAME.
Return a pattern.
-\(fn FILENAME)" nil nil)
-
+(fn FILENAME)" nil nil)
(register-definition-prefixes "rng-cmpct" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-dt" "nxml/rng-dt.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-dt.el
(register-definition-prefixes "rng-dt" '("rng-dt-"))
-;;;***
-;;;### (autoloads nil "rng-loc" "nxml/rng-loc.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-loc.el
(register-definition-prefixes "rng-loc" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-maint" "nxml/rng-maint.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-maint.el
(register-definition-prefixes "rng-maint" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-match" "nxml/rng-match.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-match.el
(register-definition-prefixes "rng-match" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-nxml.el
(autoload 'rng-nxml-mode-init "rng-nxml" "\
Initialize `nxml-mode' to take advantage of `rng-validate-mode'.
This is typically called from `nxml-mode-hook'.
Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil)
-
(register-definition-prefixes "rng-nxml" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-parse" "nxml/rng-parse.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-parse.el
(register-definition-prefixes "rng-parse" '("rng-parse-"))
-;;;***
-;;;### (autoloads nil "rng-pttrn" "nxml/rng-pttrn.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-pttrn.el
(register-definition-prefixes "rng-pttrn" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-uri" "nxml/rng-uri.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-uri.el
(register-definition-prefixes "rng-uri" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-util" "nxml/rng-util.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-util.el
(register-definition-prefixes "rng-util" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-valid.el
(autoload 'rng-validate-mode "rng-valid" "\
Minor mode performing continual validation against a RELAX NG schema.
-This is a minor mode. If called interactively, toggle the
-`Rng-Validate mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `rng-validate-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Checks whether the buffer is a well-formed XML 1.0 document,
conforming to the XML Namespaces Recommendation and valid against a
RELAX NG schema. The mode-line indicates whether it is or not. Any
@@ -28827,17 +26377,27 @@ conventionally have a suffix of `.rnc'). The variable
`rng-schema-locating-files' specifies files containing rules
to use for finding the schema.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Rng-Validate mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `rng-validate-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "rng-valid" '("rng-"))
-;;;***
-;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-xsd.el
-(put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile #'rng-xsd-compile)
-
+(put 'http://www.w3.org/2001/XMLSchema-datatypes 'rng-dt-compile #'rng-xsd-compile)
(autoload 'rng-xsd-compile "rng-xsd" "\
Provide W3C XML Schema as a RELAX NG datatypes library.
NAME is a symbol giving the local name of the datatype. PARAMS is a
@@ -28856,13 +26416,10 @@ The object returned can be any convenient non-nil value, provided
that, if two strings represent the same value, the returned objects
must be equal.
-\(fn NAME PARAMS)" nil nil)
-
+(fn NAME PARAMS)" nil nil)
(register-definition-prefixes "rng-xsd" '("rng-xsd-" "xsd-duration-reference-dates"))
-;;;***
-;;;### (autoloads nil "robin" "international/robin.el" (0 0 0 0))
;;; Generated autoloads from international/robin.el
(autoload 'robin-define-package "robin" "\
@@ -28876,8 +26433,7 @@ OUTPUT is either a character or a string. RULES are not evaluated.
If there already exists a robin package whose name is NAME, the new
one replaces the old one.
-\(fn NAME DOCSTRING &rest RULES)" nil t)
-
+(fn NAME DOCSTRING &rest RULES)" nil t)
(autoload 'robin-modify-package "robin" "\
Change a rule in an already defined robin package.
@@ -28885,18 +26441,14 @@ NAME is the string specifying a robin package.
INPUT is a string that specifies the input pattern.
OUTPUT is either a character or a string to be generated.
-\(fn NAME INPUT OUTPUT)" nil nil)
-
+(fn NAME INPUT OUTPUT)" nil nil)
(autoload 'robin-use-package "robin" "\
Start using robin package NAME, which is a string.
-\(fn NAME)" nil nil)
-
+(fn NAME)" nil nil)
(register-definition-prefixes "robin" '("robin-"))
-;;;***
-;;;### (autoloads nil "rot13" "rot13.el" (0 0 0 0))
;;; Generated autoloads from rot13.el
(autoload 'rot13 "rot13" "\
@@ -28905,18 +26457,15 @@ If OBJECT is a buffer, encrypt the region between START and END.
If OBJECT is a string, encrypt it in its entirety, ignoring START
and END, and return the encrypted string.
-\(fn OBJECT &optional START END)" nil nil)
-
+(fn OBJECT &optional START END)" nil nil)
(autoload 'rot13-string "rot13" "\
Return ROT13 encryption of STRING.
-\(fn STRING)" nil nil)
-
+(fn STRING)" nil nil)
(autoload 'rot13-region "rot13" "\
ROT13 encrypt the region between START and END in current buffer.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'rot13-other-window "rot13" "\
Display current buffer in ROT13 in another window.
The text itself is not modified, only the way it is displayed is affected.
@@ -28926,18 +26475,14 @@ is not deleted, any buffer displayed in it will become instantly encoded
in ROT13.
See also `toggle-rot13-mode'." t nil)
-
(autoload 'toggle-rot13-mode "rot13" "\
Toggle the use of ROT13 encoding for the current window." t nil)
-
(register-definition-prefixes "rot13" '("rot13-"))
-;;;***
-;;;### (autoloads nil "rst" "textmodes/rst.el" (0 0 0 0))
;;; Generated autoloads from textmodes/rst.el
- (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
+ (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
(autoload 'rst-mode "rst" "\
Major mode for editing reStructuredText documents.
\\<rst-mode-map>
@@ -28948,91 +26493,75 @@ highlighting.
\\{rst-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'rst-minor-mode "rst" "\
Toggle ReST minor mode.
-This is a minor mode. If called interactively, toggle the `Rst minor
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+When ReST minor mode is enabled, the ReST mode keybindings
+are installed on top of the major mode bindings. Use this
+for modes derived from Text mode, like Mail mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+This is a minor mode. If called interactively, toggle the `Rst
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `rst-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-When ReST minor mode is enabled, the ReST mode keybindings
-are installed on top of the major mode bindings. Use this
-for modes derived from Text mode, like Mail mode.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "rst" '("rst-"))
-;;;***
-;;;### (autoloads nil "rtree" "rtree.el" (0 0 0 0))
;;; Generated autoloads from rtree.el
(register-definition-prefixes "rtree" '("rtree-"))
-;;;***
-;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/ruby-mode.el
-(push (purecopy '(ruby-mode 1 2)) package--builtin-versions)
+(push (purecopy '(ruby-mode 1 2)) package--builtin-versions)
(autoload 'ruby-mode "ruby-mode" "\
Major mode for editing Ruby code.
-\(fn)" t nil)
-
+(fn)" t nil)
(add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\.\\(?:" "rbw?\\|ru\\|rake\\|thor" "\\|jbuilder\\|rabl\\|gemspec\\|podspec" "\\)" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" "\\|Puppet\\|Berks\\|Brew" "\\|Vagrant\\|Guard\\|Pod\\)file" "\\)\\'")) 'ruby-mode))
-
(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode)))
-
(register-definition-prefixes "ruby-mode" '("ruby-"))
-;;;***
-;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (0 0 0 0))
;;; Generated autoloads from ruler-mode.el
(defvar-local ruler-mode nil "\
Non-nil if Ruler mode is enabled.
Use the command `ruler-mode' to change this variable.")
-
(autoload 'ruler-mode "ruler-mode" "\
Toggle display of ruler in header line (Ruler mode).
This is a minor mode. If called interactively, toggle the `Ruler
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `ruler-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "ruler-mode" '("ruler-"))
-;;;***
-;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/rx.el
(autoload 'rx-to-string "rx" "\
@@ -29044,8 +26573,7 @@ group.
For extending the `rx' notation in FORM, use `rx-define' or `rx-let-eval'.
-\(fn FORM &optional NO-GROUP)" nil nil)
-
+(fn FORM &optional NO-GROUP)" nil nil)
(autoload 'rx "rx" "\
Translate regular expressions REGEXPS in sexp form to a regexp string.
Each argument is one of the forms below; RX is a subform, and RX... stands
@@ -29055,34 +26583,34 @@ See `rx-to-string' for the corresponding function.
STRING Match a literal string.
CHAR Match a literal character.
-\(seq RX...) Match the RXs in sequence. Alias: :, sequence, and.
-\(or RX...) Match one of the RXs. Alias: |.
-
-\(zero-or-more RX...) Match RXs zero or more times. Alias: 0+.
-\(one-or-more RX...) Match RXs one or more times. Alias: 1+.
-\(zero-or-one RX...) Match RXs or the empty string. Alias: opt, optional.
-\(* RX...) Match RXs zero or more times; greedy.
-\(+ RX...) Match RXs one or more times; greedy.
-\(? RX...) Match RXs or the empty string; greedy.
-\(*? RX...) Match RXs zero or more times; non-greedy.
-\(+? RX...) Match RXs one or more times; non-greedy.
-\(?? RX...) Match RXs or the empty string; non-greedy.
-\(= N RX...) Match RXs exactly N times.
-\(>= N RX...) Match RXs N or more times.
-\(** N M RX...) Match RXs N to M times. Alias: repeat.
-\(minimal-match RX) Match RX, with zero-or-more, one-or-more, zero-or-one
+(seq RX...) Match the RXs in sequence. Alias: :, sequence, and.
+(or RX...) Match one of the RXs. Alias: |.
+
+(zero-or-more RX...) Match RXs zero or more times. Alias: 0+.
+(one-or-more RX...) Match RXs one or more times. Alias: 1+.
+(zero-or-one RX...) Match RXs or the empty string. Alias: opt, optional.
+(* RX...) Match RXs zero or more times; greedy.
+(+ RX...) Match RXs one or more times; greedy.
+(? RX...) Match RXs or the empty string; greedy.
+(*? RX...) Match RXs zero or more times; non-greedy.
+(+? RX...) Match RXs one or more times; non-greedy.
+(?? RX...) Match RXs or the empty string; non-greedy.
+(= N RX...) Match RXs exactly N times.
+(>= N RX...) Match RXs N or more times.
+(** N M RX...) Match RXs N to M times. Alias: repeat.
+(minimal-match RX) Match RX, with zero-or-more, one-or-more, zero-or-one
and aliases using non-greedy matching.
-\(maximal-match RX) Match RX, with zero-or-more, one-or-more, zero-or-one
+(maximal-match RX) Match RX, with zero-or-more, one-or-more, zero-or-one
and aliases using greedy matching, which is the default.
-\(any SET...) Match a character from one of the SETs. Each SET is a
+(any SET...) Match a character from one of the SETs. Each SET is a
character, a string, a range as string \"A-Z\" or cons
(?A . ?Z), or a character class (see below). Alias: in, char.
-\(not CHARSPEC) Match one character not matched by CHARSPEC. CHARSPEC
+(not CHARSPEC) Match one character not matched by CHARSPEC. CHARSPEC
can be a character, single-char string, (any ...), (or ...),
(intersection ...), (syntax ...), (category ...),
or a character class.
-\(intersection CHARSET...) Match all CHARSETs.
+(intersection CHARSET...) Match all CHARSETs.
CHARSET is (any...), (not...), (or...) or (intersection...),
a character or a single-char string.
not-newline Match any character except a newline. Alias: nonl.
@@ -29107,13 +26635,13 @@ CHARCLASS Match a character from a character class. One of:
ascii ASCII characters (codes 0-127).
nonascii Non-ASCII characters (but not raw bytes).
-\(syntax SYNTAX) Match a character with syntax SYNTAX, being one of:
+(syntax SYNTAX) Match a character with syntax SYNTAX, being one of:
whitespace, punctuation, word, symbol, open-parenthesis,
close-parenthesis, expression-prefix, string-quote,
paired-delimiter, escape, character-quote, comment-start,
comment-end, string-delimiter, comment-delimiter
-\(category CAT) Match a character in category CAT, being one of:
+(category CAT) Match a character in category CAT, being one of:
space-for-indent, base, consonant, base-vowel,
upper-diacritical-mark, lower-diacritical-mark, tone-mark, symbol,
digit, vowel-modifying-diacritical-mark, vowel-sign,
@@ -29142,24 +26670,23 @@ Zero-width assertions: these all match the empty string in specific places.
symbol-start At the beginning of a symbol.
symbol-end At the end of a symbol.
-\(group RX...) Match RXs and define a capture group. Alias: submatch.
-\(group-n N RX...) Match RXs and define capture group N. Alias: submatch-n.
-\(backref N) Match the text that capture group N matched.
+(group RX...) Match RXs and define a capture group. Alias: submatch.
+(group-n N RX...) Match RXs and define capture group N. Alias: submatch-n.
+(backref N) Match the text that capture group N matched.
-\(literal EXPR) Match the literal string from evaluating EXPR at run time.
-\(regexp EXPR) Match the string regexp from evaluating EXPR at run time.
-\(eval EXPR) Match the rx sexp from evaluating EXPR at macro-expansion
+(literal EXPR) Match the literal string from evaluating EXPR at run time.
+(regexp EXPR) Match the string regexp from evaluating EXPR at run time.
+(eval EXPR) Match the rx sexp from evaluating EXPR at macro-expansion
(compile) time.
Additional constructs can be defined using `rx-define' and `rx-let',
which see.
-\(fn REGEXPS...)" nil t)
-
+(fn REGEXPS...)" nil t)
(autoload 'rx-let-eval "rx" "\
Evaluate BODY with local BINDINGS for `rx-to-string'.
BINDINGS, after evaluation, is a list of definitions each on the form
-\(NAME [(ARGS...)] RX), in effect for calls to `rx-to-string'
+(NAME [(ARGS...)] RX), in effect for calls to `rx-to-string'
in BODY.
For bindings without an ARGS list, NAME is defined as an alias
@@ -29175,14 +26702,12 @@ For extensions when using the `rx' macro, use `rx-let'.
To make global rx extensions, use `rx-define'.
For more details, see Info node `(elisp) Extending Rx'.
-\(fn BINDINGS BODY...)" nil t)
-
-(function-put 'rx-let-eval 'lisp-indent-function '1)
-
+(fn BINDINGS BODY...)" nil t)
+(function-put 'rx-let-eval 'lisp-indent-function 1)
(autoload 'rx-let "rx" "\
Evaluate BODY with local BINDINGS for `rx'.
BINDINGS is an unevaluated list of bindings each on the form
-\(NAME [(ARGS...)] RX).
+(NAME [(ARGS...)] RX).
They are bound lexically and are available in `rx' expressions in
BODY only.
@@ -29199,10 +26724,8 @@ For local extensions to `rx-to-string', use `rx-let-eval'.
To make global rx extensions, use `rx-define'.
For more details, see Info node `(elisp) Extending Rx'.
-\(fn BINDINGS BODY...)" nil t)
-
-(function-put 'rx-let 'lisp-indent-function '1)
-
+(fn BINDINGS BODY...)" nil t)
+(function-put 'rx-let 'lisp-indent-function 1)
(autoload 'rx-define "rx" "\
Define NAME as a global `rx' definition.
If the ARGS list is omitted, define NAME as an alias for the `rx'
@@ -29219,65 +26742,58 @@ To make local rx extensions, use `rx-let' for `rx',
`rx-let-eval' for `rx-to-string'.
For more details, see Info node `(elisp) Extending Rx'.
-\(fn NAME [(ARGS...)] RX)" nil t)
-
+(fn NAME [(ARGS...)] RX)" nil t)
(function-put 'rx-define 'lisp-indent-function 'defun)
-
-(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.\nREGEXPS are interpreted as in `rx'. The pattern matches any\nstring that is a match for REGEXPS, as if by `string-match'.\n\nIn addition to the usual `rx' syntax, REGEXPS can contain the\nfollowing constructs:\n\n (let REF RX...) binds the symbol REF to a submatch that matches\n the regular expressions RX. REF is bound in\n CODE to the string of the submatch or nil, but\n can also be used in `backref'.\n (backref REF) matches whatever the submatch REF matched.\n REF can be a number, as usual, or a name\n introduced by a previous (let REF ...)\n construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) `(and (pred stringp) ,(pcase (length rx--pcase-vars) (0 `(pred (string-match ,regexp))) (1 `(app (lambda (s) (if (string-match ,regexp s) (match-string 1 s) 0)) (and ,(car rx--pcase-vars) (pred (not numberp))))) (nvars `(app (lambda (s) (and (string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b)) (mapcar (lambda (i) `(match-string ,i s)) (number-sequence 1 nvars))))) ,(list '\` (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) (reverse rx--pcase-vars)))))))))))
-
+(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.
+REGEXPS are interpreted as in `rx'. The pattern matches any
+string that is a match for REGEXPS, as if by `string-match'.
+
+In addition to the usual `rx' syntax, REGEXPS can contain the
+following constructs:
+
+ (let REF RX...) binds the symbol REF to a submatch that matches
+ the regular expressions RX. REF is bound in
+ CODE to the string of the submatch or nil, but
+ can also be used in `backref'.
+ (backref REF) matches whatever the submatch REF matched.
+ REF can be a number, as usual, or a name
+ introduced by a previous (let REF ...)
+ construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) `(and (pred stringp) ,(pcase (length rx--pcase-vars) (0 `(pred (string-match ,regexp))) (1 `(app (lambda (s) (if (string-match ,regexp s) (match-string 1 s) 0)) (and ,(car rx--pcase-vars) (pred (not numberp))))) (nvars `(app (lambda (s) (and (string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b)) (mapcar (lambda (i) `(match-string ,i s)) (number-sequence 1 nvars))))) ,(list '\` (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) (reverse rx--pcase-vars)))))))))))
(define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil)
-
(define-symbol-prop 'rx 'pcase-macroexpander #'rx--pcase-macroexpander)
-
(register-definition-prefixes "rx" '("rx-"))
-;;;***
-;;;### (autoloads nil "sasl" "net/sasl.el" (0 0 0 0))
;;; Generated autoloads from net/sasl.el
(register-definition-prefixes "sasl" '("sasl-"))
-;;;***
-;;;### (autoloads nil "sasl-cram" "net/sasl-cram.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-cram.el
(register-definition-prefixes "sasl-cram" '("sasl-cram-md5-"))
-;;;***
-;;;### (autoloads nil "sasl-digest" "net/sasl-digest.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-digest.el
(register-definition-prefixes "sasl-digest" '("sasl-digest-md5-"))
-;;;***
-;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-ntlm.el
(register-definition-prefixes "sasl-ntlm" '("sasl-ntlm-"))
-;;;***
-;;;### (autoloads nil "sasl-scram-rfc" "net/sasl-scram-rfc.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from net/sasl-scram-rfc.el
(register-definition-prefixes "sasl-scram-rfc" '("sasl-scram-"))
-;;;***
-;;;### (autoloads nil "sasl-scram-sha256" "net/sasl-scram-sha256.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from net/sasl-scram-sha256.el
(register-definition-prefixes "sasl-scram-sha256" '("sasl-scram-sha"))
-;;;***
-;;;### (autoloads nil "savehist" "savehist.el" (0 0 0 0))
;;; Generated autoloads from savehist.el
(defvar savehist-mode nil "\
@@ -29287,26 +26803,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `savehist-mode'.")
-
(custom-autoload 'savehist-mode "savehist" nil)
-
(autoload 'savehist-mode "savehist" "\
Toggle saving of minibuffer history (Savehist mode).
-This is a minor mode. If called interactively, toggle the `Savehist
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='savehist-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When Savehist mode is enabled, minibuffer history is saved
to `savehist-file' periodically and when exiting Emacs. When
Savehist mode is enabled for the first time in an Emacs session,
@@ -29333,13 +26833,24 @@ This mode should normally be turned on from your Emacs init file.
Calling it at any other time replaces your current minibuffer
histories, which is probably undesirable.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Savehist mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='savehist-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "savehist" '("savehist-"))
-;;;***
-;;;### (autoloads nil "saveplace" "saveplace.el" (0 0 0 0))
;;; Generated autoloads from saveplace.el
(defvar save-place-mode nil "\
@@ -29349,62 +26860,64 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `save-place-mode'.")
-
(custom-autoload 'save-place-mode "saveplace" nil)
-
(autoload 'save-place-mode "saveplace" "\
Non-nil means automatically save place in each file.
+
This means when you visit a file, point goes to the last place
where it was when you previously visited the same file.
-This is a minor mode. If called interactively, toggle the `Save-Place
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+This is a global minor mode. If called interactively, toggle the
+`Save-Place mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='save-place-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'save-place-local-mode "saveplace" "\
Toggle whether to save your place in this file between sessions.
+
If this mode is enabled, point is recorded when you kill the buffer
or exit Emacs. Visiting this file again will go to that position,
even in a later Emacs session.
+To save places automatically in all files, put this in your init
+file:
+
+(save-place-mode 1)
+
This is a minor mode. If called interactively, toggle the
-`Save-Place-Local mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
+`Save-Place-Local mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `save-place-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-To save places automatically in all files, put this in your init
-file:
-
-\(save-place-mode 1)
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "saveplace" '("load-save-place-alist-from-file" "save-place"))
-\(fn &optional ARG)" t nil)
+
+;;; Generated autoloads from cedet/semantic/sb.el
-(register-definition-prefixes "saveplace" '("load-save-place-alist-from-file" "save-place"))
+(register-definition-prefixes "semantic/sb" '("semantic-sb-"))
-;;;***
-;;;### (autoloads nil "scheme" "progmodes/scheme.el" (0 0 0 0))
;;; Generated autoloads from progmodes/scheme.el
(autoload 'scheme-mode "scheme" "\
@@ -29425,8 +26938,7 @@ Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
\\{scheme-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'dsssl-mode "scheme" "\
Major mode for editing DSSSL code.
Editing commands are similar to those of `lisp-mode'.
@@ -29439,13 +26951,20 @@ Entering this mode runs the hooks `scheme-mode-hook' and then
`dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
that variable's value is a string.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "scheme" '("dsssl-" "scheme-"))
-;;;***
-;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/bovine/scm.el
+
+(register-definition-prefixes "semantic/bovine/scm" '("semantic-"))
+
+
+;;; Generated autoloads from cedet/semantic/scope.el
+
+(register-definition-prefixes "semantic/scope" '("semantic-"))
+
+
;;; Generated autoloads from gnus/score-mode.el
(autoload 'gnus-score-mode "score-mode" "\
@@ -29454,13 +26973,10 @@ This mode is an extended emacs-lisp mode.
\\{gnus-score-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "score-mode" '("gnus-score-" "score-mode-"))
-;;;***
-;;;### (autoloads nil "scroll-all" "scroll-all.el" (0 0 0 0))
;;; Generated autoloads from scroll-all.el
(defvar scroll-all-mode nil "\
@@ -29470,89 +26986,82 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `scroll-all-mode'.")
-
(custom-autoload 'scroll-all-mode "scroll-all" nil)
-
(autoload 'scroll-all-mode "scroll-all" "\
Toggle shared scrolling in same-frame windows (Scroll-All mode).
-This is a minor mode. If called interactively, toggle the `Scroll-All
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+When Scroll-All mode is enabled, scrolling commands invoked in
+one window apply to all visible windows in the same frame.
+
+This is a global minor mode. If called interactively, toggle the
+`Scroll-All mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='scroll-all-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-When Scroll-All mode is enabled, scrolling commands invoked in
-one window apply to all visible windows in the same frame.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "scroll-all" '("scroll-all-"))
-;;;***
-;;;### (autoloads nil "scroll-bar" "scroll-bar.el" (0 0 0 0))
;;; Generated autoloads from scroll-bar.el
(register-definition-prefixes "scroll-bar" '("get-scroll-bar-mode" "horizontal-scroll-bar" "previous-scroll-bar-mode" "scroll-bar-" "set-scroll-bar-mode" "toggle-"))
-;;;***
-;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (0 0 0 0))
;;; Generated autoloads from scroll-lock.el
(autoload 'scroll-lock-mode "scroll-lock" "\
Buffer-local minor mode for pager-like scrolling.
-This is a minor mode. If called interactively, toggle the
-`Scroll-Lock mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `scroll-lock-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When enabled, keys that normally move point by line or paragraph
will scroll the buffer by the respective amount of lines instead
and point will be kept vertically fixed relative to window
boundaries during scrolling.
-Note that the default key binding to Scroll_Lock will not work on
+Note that the default key binding to `scroll' will not work on
MS-Windows systems if `w32-scroll-lock-modifier' is non-nil.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Scroll-Lock mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `scroll-lock-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "scroll-lock" '("scroll-lock-"))
-;;;***
-;;;### (autoloads nil "secrets" "net/secrets.el" (0 0 0 0))
;;; Generated autoloads from net/secrets.el
+
(when (featurep 'dbusbind)
(autoload 'secrets-show-secrets "secrets" nil t))
-
(register-definition-prefixes "secrets" '("secrets-"))
-;;;***
-;;;### (autoloads nil "semantic" "cedet/semantic.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/semantic.el
+
+(register-definition-prefixes "srecode/semantic" '("srecode-semantic-"))
+
+
;;; Generated autoloads from cedet/semantic.el
-(push (purecopy '(semantic 2 2)) package--builtin-versions)
+(push (purecopy '(semantic 2 2)) package--builtin-versions)
(defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\
List of auxiliary Semantic minor modes enabled by `semantic-mode'.
The possible elements of this list include the following:
@@ -29575,9 +27084,7 @@ The following modes are more targeted at people who want to see
`global-semantic-show-unmatched-syntax-mode' - Highlight unmatched lexical
syntax tokens.
`global-semantic-show-parser-state-mode' - Display the parser cache state.")
-
(custom-autoload 'semantic-default-submodes "semantic" t)
-
(defvar semantic-mode nil "\
Non-nil if Semantic mode is enabled.
See the `semantic-mode' command
@@ -29585,26 +27092,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `semantic-mode'.")
-
(custom-autoload 'semantic-mode "semantic" nil)
-
(autoload 'semantic-mode "semantic" "\
Toggle parser features (Semantic mode).
-This is a minor mode. If called interactively, toggle the `Semantic
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='semantic-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
In Semantic mode, Emacs parses the buffers you visit for their
semantic content. This information is used by a variety of
auxiliary minor modes, listed in `semantic-default-submodes';
@@ -29613,199 +27104,29 @@ Semantic mode.
\\{semantic-mode-map}
-\(fn &optional ARG)" t nil)
-
-(register-definition-prefixes "semantic" '("bovinate" "semantic-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/analyze/debug" "cedet/semantic/analyze/debug.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/analyze/debug.el
-
-(register-definition-prefixes "semantic/analyze/debug" '("semantic-analyze"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/analyze/fcn" "cedet/semantic/analyze/fcn.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/analyze/fcn.el
-
-(register-definition-prefixes "semantic/analyze/fcn" '("semantic-analyze-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/bovine/debug" "cedet/semantic/bovine/debug.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine/debug.el
-
-(register-definition-prefixes "semantic/bovine/debug" '("semantic-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/bovine/grammar" "cedet/semantic/bovine/grammar.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine/grammar.el
-
-(autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\
-Major mode for editing Bovine grammars.
-
-\(fn)" t nil)
-
-(register-definition-prefixes "semantic/bovine/grammar" '("bovine-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/chart" "cedet/semantic/chart.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/chart.el
-
-(register-definition-prefixes "semantic/chart" '("semantic-chart-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/db-debug" "cedet/semantic/db-debug.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-debug.el
-
-(register-definition-prefixes "semantic/db-debug" '("semanticdb-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/db-ebrowse" "cedet/semantic/db-ebrowse.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-ebrowse.el
-
-(register-definition-prefixes "semantic/db-ebrowse" '("c++-mode" "semanticdb-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/db-el" "cedet/semantic/db-el.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-el.el
-
-(register-definition-prefixes "semantic/db-el" '("emacs-lisp-mode" "semanticdb-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/db-javascript" "cedet/semantic/db-javascript.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-javascript.el
-
-(register-definition-prefixes "semantic/db-javascript" '("javascript-mode" "semanticdb-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/db-ref" "cedet/semantic/db-ref.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-ref.el
-
-(register-definition-prefixes "semantic/db-ref" '("semanticdb-ref-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/decorate" "cedet/semantic/decorate.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/decorate.el
-
-(register-definition-prefixes "semantic/decorate" '("semantic-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/ede-grammar" "cedet/semantic/ede-grammar.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/ede-grammar.el
-
-(register-definition-prefixes "semantic/ede-grammar" '("semantic-ede-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/fw" "cedet/semantic/fw.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from cedet/semantic/fw.el
-
-(register-definition-prefixes "semantic/fw" '("semantic"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/grammar" "cedet/semantic/grammar.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/grammar.el
-
-(register-definition-prefixes "semantic/grammar" '("semantic-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/java" "cedet/semantic/java.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from cedet/semantic/java.el
-
-(register-definition-prefixes "semantic/java" '("semantic-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/sb" "cedet/semantic/sb.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from cedet/semantic/sb.el
-
-(register-definition-prefixes "semantic/sb" '("semantic-sb-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/symref/filter" "cedet/semantic/symref/filter.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/symref/filter.el
-
-(register-definition-prefixes "semantic/symref/filter" '("semantic-symref-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/util" "cedet/semantic/util.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from cedet/semantic/util.el
-
-(register-definition-prefixes "semantic/util" '("semantic-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/wisent" "cedet/semantic/wisent.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/wisent.el
-
-(register-definition-prefixes "semantic/wisent" '("define-wisent-lexer" "wisent-"))
-
-;;;***
-
-;;;### (autoloads nil "semantic/wisent/comp" "cedet/semantic/wisent/comp.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/wisent/comp.el
-
-(register-definition-prefixes "semantic/wisent/comp" '("wisent-"))
+This is a global minor mode. If called interactively, toggle the
+`Semantic mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-;;;***
-
-;;;### (autoloads nil "semantic/wisent/grammar" "cedet/semantic/wisent/grammar.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/wisent/grammar.el
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
-(autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\
-Major mode for editing Wisent grammars.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='semantic-mode)'.
-\(fn)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-(register-definition-prefixes "semantic/wisent/grammar" '("wisent-"))
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "semantic" '("bovinate" "semantic-"))
-;;;***
-;;;### (autoloads nil "semantic/wisent/wisent" "cedet/semantic/wisent/wisent.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/wisent/wisent.el
+;;; Generated autoloads from cedet/semantic/senator.el
-(register-definition-prefixes "semantic/wisent/wisent" '("$action" "$nterm" "$region" "wisent-"))
+(register-definition-prefixes "semantic/senator" '("semantic-up-reference" "senator-"))
-;;;***
-;;;### (autoloads nil "sendmail" "mail/sendmail.el" (0 0 0 0))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'angles "\
@@ -29820,9 +27141,7 @@ If `angles', they look like:
Otherwise, most addresses look like `angles', but they look like
`parens' if `angles' would need quoting and `parens' would not.")
-
(custom-autoload 'mail-from-style "sendmail" t)
-
(defvar mail-specify-envelope-from nil "\
If non-nil, specify the envelope-from address when sending mail.
The value used to specify it is whatever is found in
@@ -29832,24 +27151,18 @@ On most systems, specifying the envelope-from address is a
privileged operation. This variable affects sendmail and
smtpmail -- if you use feedmail to send mail, see instead the
variable `feedmail-deduce-envelope-from'.")
-
(custom-autoload 'mail-specify-envelope-from "sendmail" t)
-
(defvar mail-self-blind nil "\
Non-nil means insert Bcc to self in messages to be sent.
This is done when the message is initialized,
so you can remove or alter the Bcc field to override the default.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead.")
-
(custom-autoload 'mail-self-blind "sendmail" t)
-
(defvar mail-interactive t "\
Non-nil means when sending a message wait for and display errors.
Otherwise, let mailer send back a message to report errors.")
-
(custom-autoload 'mail-interactive "sendmail" t)
-
(defvar send-mail-function (if (and (boundp 'smtpmail-smtp-server) smtpmail-smtp-server) #'smtpmail-send-it #'sendmail-query-once) "\
Function to call to send the current buffer as mail.
The headers should be delimited by a line which is
@@ -29857,65 +27170,48 @@ not a valid RFC 822 (or later) header or continuation line,
that matches the variable `mail-header-separator'.
This is used by the default mail-sending commands. See also
`message-send-mail-function' for use with the Message package.")
-
(custom-autoload 'send-mail-function "sendmail" t)
-
(defvar mail-header-separator (purecopy "--text follows this line--") "\
Line used to separate headers from text in messages being composed.")
-
(custom-autoload 'mail-header-separator "sendmail" t)
-
(defvar mail-archive-file-name nil "\
Name of file to write all outgoing messages in, or nil for none.
This is normally an mbox file, but for backwards compatibility may also
be a Babyl file.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead.")
-
(custom-autoload 'mail-archive-file-name "sendmail" t)
-
(defvar mail-default-reply-to nil "\
Address to insert as default Reply-To field of outgoing messages.
If nil, it will be initialized from the REPLYTO environment variable
when you first send mail.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead.")
-
(custom-autoload 'mail-default-reply-to "sendmail" t)
-
(defvar mail-personal-alias-file (purecopy "~/.mailrc") "\
If non-nil, the name of the user's personal mail alias file.
This file typically should be in same format as the `.mailrc' file used by
the `Mail' or `mailx' program.
This file need not actually exist.")
-
(custom-autoload 'mail-personal-alias-file "sendmail" t)
-
(defvar mail-setup-hook nil "\
Normal hook, run each time a new outgoing message is initialized.")
-
(custom-autoload 'mail-setup-hook "sendmail" t)
-
(defvar mail-aliases t "\
Alist of mail address aliases,
or t meaning should be initialized from your mail aliases file.
-\(The file's name is normally `~/.mailrc', but `mail-personal-alias-file'
+(The file's name is normally `~/.mailrc', but `mail-personal-alias-file'
can specify a different file name.)
The alias definitions in the file have this form:
alias ALIAS MEANING")
-
(defvar mail-yank-prefix "> " "\
Prefix insert on lines of yanked message being replied to.
If this is nil, use indentation, as specified by `mail-indentation-spaces'.")
-
(custom-autoload 'mail-yank-prefix "sendmail" t)
-
(defvar mail-indentation-spaces 3 "\
Number of spaces to insert at the beginning of each cited line.
Used by `mail-yank-original' via `mail-indent-citation'.")
-
(custom-autoload 'mail-indentation-spaces "sendmail" t)
-
(defvar mail-citation-hook nil "\
Hook for modifying a citation just inserted in the mail buffer.
Each hook function can find the citation between (point) and (mark t),
@@ -29926,17 +27222,13 @@ in the cited portion of the message.
If this hook is entirely empty (nil), a default action is taken
instead of no action.")
-
(custom-autoload 'mail-citation-hook "sendmail" t)
-
(defvar mail-citation-prefix-regexp (purecopy "\\([ \11]*\\(\\w\\|[_.]\\)+>+\\|[ \11]*[>|]\\)+") "\
Regular expression to match a citation prefix plus whitespace.
It should match whatever sort of citation prefixes you want to handle,
with whitespace before and after; it should also match just whitespace.
The default value matches citations like `foo-bar>' plus whitespace.")
-
(custom-autoload 'mail-citation-prefix-regexp "sendmail" t)
-
(defvar mail-signature t "\
Text inserted at end of mail buffer when a message is initialized.
If nil, no signature is inserted.
@@ -29946,43 +27238,32 @@ If a string, that string is inserted.
which is the standard way to delimit a signature in a message.)
Otherwise, it should be an expression; it is evaluated
and should insert whatever you want to insert.")
-
(custom-autoload 'mail-signature "sendmail" t)
-
(defvar mail-signature-file (purecopy "~/.signature") "\
File containing the text inserted at end of mail buffer.")
-
(custom-autoload 'mail-signature-file "sendmail" t)
-
(defvar mail-default-directory (purecopy "~/") "\
Value of `default-directory' for Mail mode buffers.
This directory is used for auto-save files of Mail mode buffers.
Note that Message mode does not use this variable; it auto-saves
in `message-auto-save-directory'.")
-
(custom-autoload 'mail-default-directory "sendmail" t)
-
(defvar mail-default-headers nil "\
A string containing header lines, to be inserted in outgoing messages.
It can contain newlines, and should end in one. It is inserted
before you edit the message, so you can edit or delete the lines.
If you are using `message-mode' to compose messages, customize the
variable `message-default-mail-headers' instead.")
-
(custom-autoload 'mail-default-headers "sendmail" t)
-
(autoload 'sendmail-query-once "sendmail" "\
Query for `send-mail-function' and send mail with it.
This also saves the value of `send-mail-function' via Customize." nil nil)
-
(define-mail-user-agent 'sendmail-user-agent #'sendmail-user-agent-compose #'mail-send-and-exit)
-
(autoload 'sendmail-user-agent-compose "sendmail" "\
-\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" nil nil)
-
+(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" nil nil)
(autoload 'mail-mode "sendmail" "\
Major mode for editing mail to be sent.
Like Text Mode but with these additional commands:
@@ -30005,22 +27286,18 @@ Here are commands that move to a header field (and create it if there isn't):
Turning on Mail mode runs the normal hooks `text-mode-hook' and
`mail-mode-hook' (in that order).
-\(fn)" t nil)
-
+(fn)" t nil)
(defvar mail-mailing-lists nil "\
List of mailing list addresses the user is subscribed to.
The variable is used to trigger insertion of the \"Mail-Followup-To\"
header when sending a message to a mailing list.")
-
(custom-autoload 'mail-mailing-lists "sendmail" t)
-
(defvar sendmail-coding-system nil "\
Coding system for encoding the outgoing mail.
This has higher priority than the default `buffer-file-coding-system'
and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
See also the function `select-message-coding-system'.")
-
(defvar default-sendmail-coding-system 'utf-8 "\
Default coding system for encoding the outgoing mail.
This variable is used only when `sendmail-coding-system' is nil.
@@ -30030,7 +27307,6 @@ User should not set this variable manually,
instead use `sendmail-coding-system' to get a constant encoding
of outgoing mails regardless of the current language environment.
See also the function `select-message-coding-system'.")
-
(autoload 'mail "sendmail" "\
Edit a message to be sent. Prefix arg means resume editing (don't erase).
When this function returns, the buffer `*mail*' is selected.
@@ -30079,154 +27355,28 @@ The seventh argument ACTIONS is a list of actions to take
when the message is sent, we apply FUNCTION to ARGS.
This is how Rmail arranges to mark messages `answered'.
-\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER ACTIONS RETURN-ACTION)" t nil)
-
+(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER ACTIONS RETURN-ACTION)" t nil)
(autoload 'mail-other-window "sendmail" "\
Like `mail' command, but display mail buffer in another window.
-\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
-
+(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
(autoload 'mail-other-frame "sendmail" "\
Like `mail' command, but display mail buffer in another frame.
-\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
-
+(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
(register-definition-prefixes "sendmail" '("mail-" "sendmail-"))
-;;;***
-;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/seq.el
-(push (purecopy '(seq 2 23)) package--builtin-versions)
-
-(autoload 'seq-subseq "seq" "\
-Return the sequence of elements of SEQUENCE from START to END.
-END is exclusive.
-
-If END is omitted, it defaults to the length of the sequence. If
-START or END is negative, it counts from the end. Signal an
-error if START or END are outside of the sequence (i.e too large
-if positive or too small if negative).
-
-\(fn SEQUENCE START &optional END)" nil nil)
-
-(autoload 'seq-take "seq" "\
-Take the first N elements of SEQUENCE and return the result.
-The result is a sequence of the same type as SEQUENCE.
-
-If N is a negative integer or zero, an empty sequence is
-returned.
-
-\(fn SEQUENCE N)" nil nil)
-
-(autoload 'seq-sort-by "seq" "\
-Sort SEQUENCE using PRED as a comparison function.
-Elements of SEQUENCE are transformed by FUNCTION before being
-sorted. FUNCTION must be a function of one argument.
-
-\(fn FUNCTION PRED SEQUENCE)" nil nil)
-
-(autoload 'seq-filter "seq" "\
-Return a list of all elements for which (PRED element) is non-nil in SEQUENCE.
-\(fn PRED SEQUENCE)" nil nil)
-
-(autoload 'seq-remove "seq" "\
-Return a list of all the elements for which (PRED element) is nil in SEQUENCE.
-
-\(fn PRED SEQUENCE)" nil nil)
-
-(autoload 'seq-reduce "seq" "\
-Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
-
-Return the result of calling FUNCTION with INITIAL-VALUE and the
-first element of SEQUENCE, then calling FUNCTION with that result
-and the second element of SEQUENCE, then with that result and the
-third element of SEQUENCE, etc. FUNCTION will be called with
-INITIAL-VALUE (and then the accumulated value) as the first
-argument, and the elements from SEQUENCE as the second argument.
-
-If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called.
-
-\(fn FUNCTION SEQUENCE INITIAL-VALUE)" nil nil)
-
-(autoload 'seq-every-p "seq" "\
-Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE.
-
-\(fn PRED SEQUENCE)" nil nil)
-
-(autoload 'seq-some "seq" "\
-Return non-nil if PRED is satisfied for at least one element of SEQUENCE.
-If so, return the first non-nil value returned by PRED.
-
-\(fn PRED SEQUENCE)" nil nil)
-
-(autoload 'seq-find "seq" "\
-Return the first element for which (PRED element) is non-nil in SEQUENCE.
-If no element is found, return DEFAULT.
-
-Note that `seq-find' has an ambiguity if the found element is
-identical to DEFAULT, as it cannot be known if an element was
-found or not.
-
-\(fn PRED SEQUENCE &optional DEFAULT)" nil nil)
-
-(autoload 'seq-position "seq" "\
-Return the index of the first element in SEQUENCE that is equal to ELT.
-Equality is defined by TESTFN if non-nil or by `equal' if nil.
-
-\(fn SEQUENCE ELT &optional TESTFN)" nil nil)
-
-(autoload 'seq-uniq "seq" "\
-Return a list of the elements of SEQUENCE with duplicates removed.
-TESTFN is used to compare elements, or `equal' if TESTFN is nil.
-
-\(fn SEQUENCE &optional TESTFN)" nil nil)
-
-(autoload 'seq-union "seq" "\
-Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2.
-Equality is defined by TESTFN if non-nil or by `equal' if nil.
-
-\(fn SEQUENCE1 SEQUENCE2 &optional TESTFN)" nil nil)
-
-(autoload 'seq-intersection "seq" "\
-Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
-Equality is defined by TESTFN if non-nil or by `equal' if nil.
-
-\(fn SEQUENCE1 SEQUENCE2 &optional TESTFN)" nil nil)
-
-(autoload 'seq-group-by "seq" "\
-Apply FUNCTION to each element of SEQUENCE.
-Separate the elements of SEQUENCE into an alist using the results as
-keys. Keys are compared using `equal'.
-
-\(fn FUNCTION SEQUENCE)" nil nil)
-
-(autoload 'seq-max "seq" "\
-Return the largest element of SEQUENCE.
-SEQUENCE must be a sequence of numbers or markers.
-
-\(fn SEQUENCE)" nil nil)
-
-(autoload 'seq-random-elt "seq" "\
-Return a random element from SEQUENCE.
-Signal an error if SEQUENCE is empty.
-
-\(fn SEQUENCE)" nil nil)
-
-(register-definition-prefixes "seq" '("seq-"))
+(push (purecopy '(seq 2 23)) package--builtin-versions)
-;;;***
-;;;### (autoloads nil "server" "server.el" (0 0 0 0))
;;; Generated autoloads from server.el
(put 'server-host 'risky-local-variable t)
-
(put 'server-port 'risky-local-variable t)
-
(put 'server-auth-dir 'risky-local-variable t)
-
(autoload 'server-start "server" "\
Allow this Emacs process to be a server for client processes.
This starts a server communications subprocess through which client
@@ -30247,15 +27397,13 @@ To force-start a server, do \\[server-force-delete] and then
To check from a Lisp program whether a server is running, use
the `server-process' variable.
-\(fn &optional LEAVE-DEAD INHIBIT-PROMPT)" t nil)
-
+(fn &optional LEAVE-DEAD INHIBIT-PROMPT)" t nil)
(autoload 'server-force-delete "server" "\
Unconditionally delete connection file for server NAME.
If server is running, it is first stopped.
NAME defaults to `server-name'. With argument, ask for NAME.
-\(fn &optional NAME)" t nil)
-
+(fn &optional NAME)" t nil)
(defvar server-mode nil "\
Non-nil if Server mode is enabled.
See the `server-mode' command
@@ -30263,32 +27411,29 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `server-mode'.")
-
(custom-autoload 'server-mode "server" nil)
-
(autoload 'server-mode "server" "\
Toggle Server mode.
-This is a minor mode. If called interactively, toggle the `Server
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+Server mode runs a process that accepts commands from the
+`emacsclient' program. See Info node `Emacs server' and
+`server-start' for details.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+This is a global minor mode. If called interactively, toggle the
+`Server mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='server-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-Server mode runs a process that accepts commands from the
-`emacsclient' program. See Info node `Emacs server' and
-`server-start' for details.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'server-save-buffers-kill-terminal "server" "\
Offer to save each buffer, then kill the current client.
With ARG non-nil, silently save all file-visiting buffers, then kill.
@@ -30296,13 +27441,32 @@ With ARG non-nil, silently save all file-visiting buffers, then kill.
If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved.
-\(fn ARG)" nil nil)
+(fn ARG)" nil nil)
+(autoload 'server-stop-automatically "server" "\
+Automatically stop server as specified by ARG.
+If ARG is the symbol `empty', stop the server when it has no
+remaining clients, no remaining unsaved file-visiting buffers,
+and no running processes with a `query-on-exit' flag.
+
+If ARG is the symbol `delete-frame', ask the user when the last
+frame is deleted whether each unsaved file-visiting buffer must
+be saved and each running process with a `query-on-exit' flag
+can be stopped, and if so, stop the server itself.
+
+If ARG is the symbol `kill-terminal', ask the user when the
+terminal is killed with \\[save-buffers-kill-terminal] whether each unsaved file-visiting
+buffer must be saved and each running process with a `query-on-exit'
+flag can be stopped, and if so, stop the server itself.
+
+Any other value of ARG will cause this function to signal an error.
+
+This function is meant to be called from the user init file.
+
+(fn ARG)" nil nil)
(register-definition-prefixes "server" '("server-"))
-;;;***
-;;;### (autoloads nil "ses" "ses.el" (0 0 0 0))
;;; Generated autoloads from ses.el
(autoload 'ses-mode "ses" "\
@@ -30319,7 +27483,7 @@ contents of another cell. For example, you can sum a range of
cells with `(+ A1 A2 A3)'. There are specialized functions like
`ses+' (addition for ranges with empty cells), `ses-average' (for
performing calculations on cells), and `ses-range' and `ses-select'
-\(for extracting ranges of cells).
+(for extracting ranges of cells).
Each cell also has a print function that controls how it is
displayed.
@@ -30341,13 +27505,9 @@ part):
These are active only in the minibuffer, when entering or editing a
formula:
\\{ses-mode-edit-map}" t nil)
-
(register-definition-prefixes "ses" '("ses"))
-;;;***
-;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload 'sgml-mode "sgml-mode" "\
@@ -30369,8 +27529,7 @@ Do \\[describe-variable] sgml- SPC to see available variables.
Do \\[describe-key] on the following bindings to discover what they do.
\\{sgml-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'html-mode "sgml-mode" "\
Major mode based on SGML mode for editing HTML documents.
This allows inserting skeleton constructs used in hypertext documents with
@@ -30409,17 +27568,13 @@ To work around that, do:
\\{html-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "sgml-mode" '("html-" "sgml-"))
-;;;***
-;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/sh-script.el
-(put 'sh-shell 'safe-local-variable 'symbolp)
+(put 'sh-shell 'safe-local-variable 'symbolp)
(autoload 'sh-mode "sh-script" "\
Major mode for editing shell scripts.
This mode works for many shells, since they all have roughly the same syntax,
@@ -30472,15 +27627,11 @@ indicate what shell it is use `sh-alias-alist' to translate.
If your shell gives error messages with line numbers, you can use \\[executable-interpret]
with your script for an edit-interpret-debug cycle.
-\(fn)" t nil)
-
+(fn)" t nil)
(defalias 'shell-script-mode 'sh-mode)
-
(register-definition-prefixes "sh-script" '("sh-"))
-;;;***
-;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/shadow.el
(autoload 'list-load-path-shadows "shadow" "\
@@ -30498,11 +27649,11 @@ the earlier.
For example, suppose `load-path' is set to
-\(\"/usr/share/emacs/site-lisp\" \"/usr/share/emacs/24.3/lisp\")
+(\"/usr/share/emacs/site-lisp\" \"/usr/share/emacs/24.3/lisp\")
and that each of these directories contains a file called XXX.el. Then
XXX.el in the site-lisp directory is referred to by all of:
-\(require \\='XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc.
+(require \\='XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc.
The first XXX.el file prevents Emacs from seeing the second (unless
the second is loaded explicitly via `load-file').
@@ -30518,20 +27669,17 @@ Emacs version).
This function performs these checks and flags all possible
shadowings. Because a .el file may exist without a corresponding .elc
-\(or vice-versa), these suffixes are essentially ignored. A file
+(or vice-versa), these suffixes are essentially ignored. A file
XXX.elc in an early directory (that does not contain XXX.el) is
considered to shadow a later file XXX.el, and vice-versa.
Shadowings are located by calling the (non-interactive) companion
function, `load-path-shadows-find'.
-\(fn &optional STRINGP)" t nil)
-
+(fn &optional STRINGP)" t nil)
(register-definition-prefixes "shadow" '("load-path-shadows-"))
-;;;***
-;;;### (autoloads nil "shadowfile" "shadowfile.el" (0 0 0 0))
;;; Generated autoloads from shadowfile.el
(autoload 'shadow-define-cluster "shadowfile" "\
@@ -30542,14 +27690,12 @@ defined by a name, the network address of a primary host (the one we copy
files to), and a regular expression that matches the hostnames of all the
sites in the cluster.
-\(fn NAME)" t nil)
-
+(fn NAME)" t nil)
(autoload 'shadow-define-literal-group "shadowfile" "\
Declare a single file to be shared between sites.
It may have different filenames on each site. When this file is edited, the
new version will be copied to each of the other locations. Sites can be
specific hostnames, or names of clusters (see `shadow-define-cluster')." t nil)
-
(autoload 'shadow-define-regexp-group "shadowfile" "\
Make each of a group of files be shared between hosts.
Prompts for regular expression; files matching this are shared between a list
@@ -30557,15 +27703,16 @@ of sites, which are also prompted for. The filenames must be identical on all
hosts (if they aren't, use `shadow-define-literal-group' instead of this
function). Each site can be either a hostname or the name of a cluster (see
`shadow-define-cluster')." t nil)
-
(autoload 'shadow-initialize "shadowfile" "\
Set up file shadowing." t nil)
-
(register-definition-prefixes "shadowfile" '("shadow"))
-;;;***
-;;;### (autoloads nil "shell" "shell.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/shell.el
+
+(register-definition-prefixes "ede/shell" '("ede-shell-run-command"))
+
+
;;; Generated autoloads from shell.el
(defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\
@@ -30574,16 +27721,13 @@ don't handle the backslash as a quote character. For shells that
match this regexp, Emacs will write out the command history when the
shell finishes, and won't remove backslashes when it unquotes shell
arguments.")
-
(custom-autoload 'shell-dumb-shell-regexp "shell" t)
-
(autoload 'split-string-shell-command "shell" "\
Split STRING (a shell command) into a list of strings.
General shell syntax, like single and double quoting, as well as
backslash quoting, is respected.
-\(fn STRING)" nil nil)
-
+(fn STRING)" nil nil)
(autoload 'shell "shell" "\
Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
Interactively, a prefix arg means to prompt for BUFFER.
@@ -30595,6 +27739,8 @@ If BUFFER exists and shell process is running, just switch to BUFFER.
Program used comes from variable `explicit-shell-file-name',
or (if that is nil) from the ESHELL environment variable,
or (if that is nil) from `shell-file-name'.
+Non-interactively, it can also be specified via the FILE-NAME arg.
+
If a file `~/.emacs_SHELLNAME' exists, or `~/.emacs.d/init_SHELLNAME.sh',
it is given as initial input (but this may be lost, due to a timing
error, if the shell discards input when it starts up).
@@ -30616,103 +27762,149 @@ Otherwise, one argument `-i' is passed to the shell.
Make the shell buffer the current buffer, and return it.
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the shell buffer for a list of commands.)
+(fn &optional BUFFER FILE-NAME)" t nil)
(register-definition-prefixes "shell" '("dirs" "explicit-" "shell-"))
-;;;***
-;;;### (autoloads nil "shortdoc" "emacs-lisp/shortdoc.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emacs-lisp/shortdoc.el
+(defvar shortdoc--groups nil)
+(defmacro define-short-documentation-group (group &rest functions) "\
+Add GROUP to the list of defined documentation groups.
+FUNCTIONS is a list of elements on the form:
+
+ (FUNC
+ :no-manual BOOL
+ :args ARGS
+ :eval EVAL
+ :no-eval EXAMPLE-FORM
+ :no-value EXAMPLE-FORM
+ :no-eval* EXAMPLE-FORM
+ :result RESULT-FORM
+ :result-string RESULT-STRING
+ :eg-result RESULT-FORM
+ :eg-result-string RESULT-STRING)
+
+FUNC is the function being documented.
+
+NO-MANUAL should be non-nil if FUNC isn't documented in the
+manual.
+
+ARGS is optional list of function FUNC's arguments. FUNC's
+signature is displayed automatically if ARGS is not present.
+Specifying ARGS might be useful where you don't want to document
+some of the uncommon arguments a function might have.
+
+While the `:no-manual' and `:args' property can be used for
+any (FUNC ..) form, all of the other properties shown above
+cannot be used simultaneously in such a form.
+
+Here are some common forms with examples of properties that go
+together:
+
+1. Document a form or string, and its evaluated return value.
+ (FUNC
+ :eval EVAL)
+
+If EVAL is a string, it will be inserted as is, and then that
+string will be `read' and evaluated.
+
+2. Document a form or string, but manually document its evaluation
+ result. The provided form will not be evaluated.
+
+ (FUNC
+ :no-eval EXAMPLE-FORM
+ :result RESULT-FORM) ;Use `:result-string' if value is in string form
+
+Using `:no-value' is the same as using `:no-eval'.
+
+Use `:no-eval*' instead of `:no-eval' where the successful
+execution of the documented form depends on some conditions.
+
+3. Document a form or string EXAMPLE-FORM. Also manually
+ document an example result. This result could be unrelated to
+ the documented form.
+
+ (FUNC
+ :no-eval EXAMPLE-FORM
+ :eg-result RESULT-FORM) ;Use `:eg-result-string' if value is in string form
+
+A FUNC form can have any number of `:no-eval' (or `:no-value'),
+`:no-eval*', `:result', `:result-string', `:eg-result' and
+`:eg-result-string' properties." (declare (indent defun)) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups)))
(autoload 'shortdoc-display-group "shortdoc" "\
Pop to a buffer with short documentation summary for functions in GROUP.
If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
+If SAME-WINDOW, don't pop to a new window.
-\(fn GROUP &optional FUNCTION)" t nil)
-
-(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "overlay" "process" "regexp" "sequence" "shortdoc-" "string" "text-properties" "vector"))
+(fn GROUP &optional FUNCTION SAME-WINDOW)" t nil)
+(defalias 'shortdoc #'shortdoc-display-group)
+(register-definition-prefixes "shortdoc" '("alist" "buffer" "file" "hash-table" "keymaps" "list" "number" "overlay" "process" "regexp" "sequence" "shortdoc-" "string" "text-properties" "vector"))
-;;;***
-;;;### (autoloads nil "shr" "net/shr.el" (0 0 0 0))
;;; Generated autoloads from net/shr.el
(autoload 'shr-render-region "shr" "\
Display the HTML rendering of the region between BEGIN and END.
-\(fn BEGIN END &optional BUFFER)" t nil)
-
+(fn BEGIN END &optional BUFFER)" t nil)
(autoload 'shr-insert-document "shr" "\
Render the parsed document DOM into the current buffer.
DOM should be a parse tree as generated by
`libxml-parse-html-region' or similar.
-\(fn DOM)" nil nil)
-
+(fn DOM)" nil nil)
(register-definition-prefixes "shr" '("shr-"))
-;;;***
-;;;### (autoloads nil "shr-color" "net/shr-color.el" (0 0 0 0))
;;; Generated autoloads from net/shr-color.el
(register-definition-prefixes "shr-color" '("shr-color-"))
-;;;***
-;;;### (autoloads nil "sieve" "net/sieve.el" (0 0 0 0))
;;; Generated autoloads from net/sieve.el
(autoload 'sieve-manage "sieve" "\
-\(fn SERVER &optional PORT)" t nil)
-
+(fn SERVER &optional PORT)" t nil)
(autoload 'sieve-upload "sieve" "\
-\(fn &optional NAME)" t nil)
-
+(fn &optional NAME)" t nil)
(autoload 'sieve-upload-and-bury "sieve" "\
-\(fn &optional NAME)" t nil)
-
+(fn &optional NAME)" t nil)
(autoload 'sieve-upload-and-kill "sieve" "\
-\(fn &optional NAME)" t nil)
-
+(fn &optional NAME)" t nil)
(register-definition-prefixes "sieve" '("sieve-"))
-;;;***
-;;;### (autoloads nil "sieve-manage" "net/sieve-manage.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from net/sieve-manage.el
(register-definition-prefixes "sieve-manage" '("sieve-"))
-;;;***
-;;;### (autoloads nil "sieve-mode" "net/sieve-mode.el" (0 0 0 0))
;;; Generated autoloads from net/sieve-mode.el
(autoload 'sieve-mode "sieve-mode" "\
Major mode for editing Sieve code.
Turning on Sieve mode runs `sieve-mode-hook'.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "sieve-mode" '("sieve-"))
-;;;***
-;;;### (autoloads nil "simula" "progmodes/simula.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/simple.el
+
+(register-definition-prefixes "ede/simple" '("ede-simple-"))
+
+
;;; Generated autoloads from progmodes/simula.el
(autoload 'simula-mode "simula" "\
@@ -30753,27 +27945,27 @@ Variables controlling indentation style:
Turning on SIMULA mode calls the value of the variable simula-mode-hook
with no arguments, if that value is non-nil.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "simula" '("simula-"))
-;;;***
-;;;### (autoloads nil "skeleton" "skeleton.el" (0 0 0 0))
+;;; Generated autoloads from leim/quail/sisheng.el
+
+(register-definition-prefixes "quail/sisheng" '("quail-make-sisheng-rules" "sisheng-"))
+
+
;;; Generated autoloads from skeleton.el
(defvar skeleton-filter-function 'identity "\
Function for transforming a skeleton proxy's aliases' variable value.")
-
(autoload 'define-skeleton "skeleton" "\
Define a user-configurable COMMAND that enters a statement skeleton.
DOCUMENTATION is that of the command.
SKELETON is as defined under `skeleton-insert'.
-\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t)
-
-(function-put 'define-skeleton 'doc-string-elt '2)
-
+(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t)
+(function-put 'define-skeleton 'doc-string-elt 2)
+(function-put 'define-skeleton 'lisp-indent-function 'defun)
(autoload 'skeleton-proxy-new "skeleton" "\
Insert SKELETON.
Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
@@ -30785,13 +27977,12 @@ This command can also be an abbrev expansion (3rd and 4th columns in
Optional second argument STR may also be a string which will be the value
of `str' whereas the skeleton's interactor is then ignored.
-\(fn SKELETON &optional STR ARG)" nil nil)
-
+(fn SKELETON &optional STR ARG)" nil nil)
(autoload 'skeleton-insert "skeleton" "\
Insert the complex statement skeleton SKELETON describes very concisely.
With optional second argument REGIONS, wrap first interesting point
-\(`_') in skeleton around next REGIONS words, if REGIONS is positive.
+(`_') in skeleton around next REGIONS words, if REGIONS is positive.
If REGIONS is negative, wrap REGIONS preceding interregions into first
REGIONS interesting positions (successive `_'s) in skeleton.
@@ -30858,8 +28049,7 @@ available:
input initial input (string or cons with index) while reading str
v1, v2 local variables for memorizing anything you want
-\(fn SKELETON &optional REGIONS STR)" nil nil)
-
+(fn SKELETON &optional REGIONS STR)" nil nil)
(autoload 'skeleton-pair-insert-maybe "skeleton" "\
Insert the character you type ARG times.
@@ -30875,13 +28065,10 @@ the defaults are used. These are (), [], {}, <> and (grave
accent, apostrophe) for the paired ones, and the same character
twice for the others.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "skeleton" '("skeleton-"))
-;;;***
-;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (0 0 0 0))
;;; Generated autoloads from vc/smerge-mode.el
(autoload 'smerge-refine-regions "smerge-mode" "\
@@ -30899,92 +28086,74 @@ If non-nil, PREPROC is called with no argument in a buffer that contains
a copy of a region, just before preparing it to for `diff'. It can be
used to replace chars to try and eliminate some spurious differences.
-\(fn BEG1 END1 BEG2 END2 PROPS-C &optional PREPROC PROPS-R PROPS-A)" nil nil)
-
+(fn BEG1 END1 BEG2 END2 PROPS-C &optional PREPROC PROPS-R PROPS-A)" nil nil)
(autoload 'smerge-ediff "smerge-mode" "\
Invoke ediff to resolve the conflicts.
NAME-UPPER, NAME-LOWER, and NAME-BASE, if non-nil, are used for the
buffer names.
-\(fn &optional NAME-UPPER NAME-LOWER NAME-BASE)" t nil)
-
+(fn &optional NAME-UPPER NAME-LOWER NAME-BASE)" t nil)
(autoload 'smerge-mode "smerge-mode" "\
Minor mode to simplify editing output from the diff3 program.
-This is a minor mode. If called interactively, toggle the `SMerge
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+\\{smerge-mode-map}
+
+This is a minor mode. If called interactively, toggle the
+`SMerge mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `smerge-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\\{smerge-mode-map}
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'smerge-start-session "smerge-mode" "\
Turn on `smerge-mode' and move point to first conflict marker.
If no conflict maker is found, turn off `smerge-mode'.
-\(fn &optional INTERACTIVELY)" t nil)
-
+(fn &optional INTERACTIVELY)" t nil)
(register-definition-prefixes "smerge-mode" '("smerge-"))
-;;;***
-;;;### (autoloads nil "smie" "emacs-lisp/smie.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/smie.el
(register-definition-prefixes "smie" '("smie-"))
-;;;***
-;;;### (autoloads nil "smiley" "gnus/smiley.el" (0 0 0 0))
;;; Generated autoloads from gnus/smiley.el
(autoload 'smiley-region "smiley" "\
Replace in the region `smiley-regexp-alist' matches with corresponding images.
A list of images is returned.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'smiley-buffer "smiley" "\
Run `smiley-region' at the BUFFER, specified in the argument or
interactively. If there's no argument, do it at the current buffer.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(register-definition-prefixes "smiley" '("gnus-smiley-file-types" "smiley-"))
-;;;***
-;;;### (autoloads nil "smime" "gnus/smime.el" (0 0 0 0))
;;; Generated autoloads from gnus/smime.el
(register-definition-prefixes "smime" '("smime"))
-;;;***
-;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (0 0 0 0))
;;; Generated autoloads from mail/smtpmail.el
(autoload 'smtpmail-send-it "smtpmail" nil nil nil)
-
(autoload 'smtpmail-send-queued-mail "smtpmail" "\
Send mail that was queued as a result of setting `smtpmail-queue-mail'." t nil)
-
(register-definition-prefixes "smtpmail" '("smtpmail-"))
-;;;***
-;;;### (autoloads nil "snake" "play/snake.el" (0 0 0 0))
;;; Generated autoloads from play/snake.el
(autoload 'snake "snake" "\
@@ -31002,12 +28171,9 @@ Snake mode keybindings:
\\[snake-move-right] Makes the snake move right
\\[snake-move-up] Makes the snake move up
\\[snake-move-down] Makes the snake move down" t nil)
-
(register-definition-prefixes "snake" '("snake-"))
-;;;***
-;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (0 0 0 0))
;;; Generated autoloads from net/snmp-mode.el
(autoload 'snmp-mode "snmp-mode" "\
@@ -31019,7 +28185,6 @@ Delete converts tabs to spaces as it moves back.
\\{snmp-mode-map}
Turning on `snmp-mode' runs the hooks in `snmp-common-mode-hook', then
`snmp-mode-hook'." t nil)
-
(autoload 'snmpv2-mode "snmp-mode" "\
Major mode for editing SNMPv2 MIBs.
Expression and list commands understand all C brackets.
@@ -31029,46 +28194,40 @@ Delete converts tabs to spaces as it moves back.
\\{snmp-mode-map}
Turning on `snmp-mode' runs the hooks in `snmp-common-mode-hook',
then `snmpv2-mode-hook'." t nil)
-
(register-definition-prefixes "snmp-mode" '("snmp"))
-;;;***
-;;;### (autoloads nil "so-long" "so-long.el" (0 0 0 0))
;;; Generated autoloads from so-long.el
-(push (purecopy '(so-long 1 1 2)) package--builtin-versions)
+(push (purecopy '(so-long 1 1 2)) package--builtin-versions)
(autoload 'so-long-commentary "so-long" "\
View the `so-long' library's documentation in `outline-mode'." t nil)
-
(autoload 'so-long-customize "so-long" "\
Open the customization group `so-long'." t nil)
-
(autoload 'so-long-minor-mode "so-long" "\
This is the minor mode equivalent of `so-long-mode'.
-This is a minor mode. If called interactively, toggle the `So-Long
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `so-long-minor-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Any active minor modes listed in `so-long-minor-modes' are disabled for the
current buffer, and buffer-local values are assigned to variables in accordance
with `so-long-variable-overrides'.
This minor mode is a standard `so-long-action' option.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`So-Long minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `so-long-minor-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'so-long-mode "so-long" "\
This major mode is the default `so-long-action' option.
@@ -31096,8 +28255,7 @@ Use \\[so-long-commentary] for more information.
Use \\[so-long-customize] to open the customization group `so-long' to
configure the behavior.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'so-long "so-long" "\
Invoke `so-long-action' and run `so-long-hook'.
@@ -31113,13 +28271,11 @@ With a prefix argument, select the action to use interactively.
If an action was already active in the buffer, it will be reverted before
invoking the new action.
-\(fn &optional ACTION)" t nil)
-
+(fn &optional ACTION)" t nil)
(autoload 'so-long-enable "so-long" "\
Enable the `so-long' library's functionality.
Equivalent to calling (global-so-long-mode 1)" t nil)
-
(defvar global-so-long-mode nil "\
Non-nil if Global So-Long mode is enabled.
See the `global-so-long-mode' command
@@ -31127,26 +28283,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-so-long-mode'.")
-
(custom-autoload 'global-so-long-mode "so-long" nil)
-
(autoload 'global-so-long-mode "so-long" "\
Toggle automated performance mitigations for files with long lines.
-This is a minor mode. If called interactively, toggle the `Global
-So-Long mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='global-so-long-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Many Emacs modes struggle with buffers which contain excessively long lines,
and may consequently cause unacceptable performance issues.
@@ -31162,36 +28302,40 @@ Use \\[so-long-commentary] for more information.
Use \\[so-long-customize] to open the customization group `so-long' to
configure the behavior.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Global So-Long mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='global-so-long-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "so-long" '("so-long-" "turn-o"))
-;;;***
-;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0))
;;; Generated autoloads from net/soap-client.el
-(push (purecopy '(soap-client 3 2 0)) package--builtin-versions)
+(push (purecopy '(soap-client 3 2 1)) package--builtin-versions)
(register-definition-prefixes "soap-client" '("soap-"))
-;;;***
-;;;### (autoloads nil "soap-inspect" "net/soap-inspect.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from net/soap-inspect.el
(register-definition-prefixes "soap-inspect" '("soap-"))
-;;;***
-;;;### (autoloads nil "socks" "net/socks.el" (0 0 0 0))
;;; Generated autoloads from net/socks.el
(register-definition-prefixes "socks" '("socks-"))
-;;;***
-;;;### (autoloads nil "solar" "calendar/solar.el" (0 0 0 0))
;;; Generated autoloads from calendar/solar.el
(autoload 'sunrise-sunset "solar" "\
@@ -31202,13 +28346,10 @@ longitude, latitude, time zone, and date, and always use standard time.
This function is suitable for execution in an init file.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "solar" '("calendar-" "diary-sunrise-sunset" "solar-"))
-;;;***
-;;;### (autoloads nil "solitaire" "play/solitaire.el" (0 0 0 0))
;;; Generated autoloads from play/solitaire.el
(autoload 'solitaire "solitaire" "\
@@ -31220,7 +28361,7 @@ Move around the board using the cursor keys.
Move stones using \\[solitaire-move] followed by a direction key.
Undo moves using \\[solitaire-undo].
Check for possible moves using \\[solitaire-do-check].
-\(The variable `solitaire-auto-eval' controls whether to automatically
+(The variable `solitaire-auto-eval' controls whether to automatically
check after each move or undo.)
What is Solitaire?
@@ -31279,16 +28420,18 @@ Pick your favorite shortcuts:
\\{solitaire-mode-map}
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(register-definition-prefixes "solitaire" '("solitaire-"))
-;;;***
-;;;### (autoloads nil "sort" "sort.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/sort.el
+
+(register-definition-prefixes "semantic/sort" '("semantic-"))
+
+
;;; Generated autoloads from sort.el
-(put 'sort-fold-case 'safe-local-variable 'booleanp)
+(put 'sort-fold-case 'safe-local-variable 'booleanp)
(autoload 'sort-subr "sort" "\
General text sorting routine to divide buffer into records and sort them.
@@ -31333,8 +28476,7 @@ the keys are numbers, with `compare-buffer-substrings' if the
keys are cons cells (the car and cdr of each cons cell are taken
as start and end positions), and with `string<' otherwise.
-\(fn REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN PREDICATE)" nil nil)
-
+(fn REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN PREDICATE)" nil nil)
(autoload 'sort-lines "sort" "\
Sort lines in region alphabetically; REVERSE non-nil means descending order.
Interactively, REVERSE is the prefix argument, and BEG and END are the region.
@@ -31343,8 +28485,7 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
-\(fn REVERSE BEG END)" t nil)
-
+(fn REVERSE BEG END)" t nil)
(autoload 'sort-paragraphs "sort" "\
Sort paragraphs in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
@@ -31352,8 +28493,7 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
-\(fn REVERSE BEG END)" t nil)
-
+(fn REVERSE BEG END)" t nil)
(autoload 'sort-pages "sort" "\
Sort pages in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
@@ -31361,9 +28501,8 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
-\(fn REVERSE BEG END)" t nil)
+(fn REVERSE BEG END)" t nil)
(put 'sort-numeric-base 'safe-local-variable 'integerp)
-
(autoload 'sort-numeric-fields "sort" "\
Sort lines in region numerically by the ARGth field of each line.
Fields are separated by whitespace and numbered from 1 up.
@@ -31374,8 +28513,7 @@ With a negative arg, sorts by the ARGth field counted from the right.
Called from a program, there are three arguments:
FIELD, BEG and END. BEG and END specify region to sort.
-\(fn FIELD BEG END)" t nil)
-
+(fn FIELD BEG END)" t nil)
(autoload 'sort-fields "sort" "\
Sort lines in region lexicographically by the ARGth field of each line.
Fields are separated by whitespace and numbered from 1 up.
@@ -31385,8 +28523,7 @@ FIELD, BEG and END. BEG and END specify region to sort.
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
-\(fn FIELD BEG END)" t nil)
-
+(fn FIELD BEG END)" t nil)
(autoload 'sort-regexp-fields "sort" "\
Sort the text in the region lexicographically.
If called interactively, prompt for two regular expressions,
@@ -31413,8 +28550,7 @@ For example: to sort lines in the region by the first word on each line
starting with the letter \"f\",
RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\<f\\\\w*\\\\>\"
-\(fn REVERSE RECORD-REGEXP KEY-REGEXP BEG END)" t nil)
-
+(fn REVERSE RECORD-REGEXP KEY-REGEXP BEG END)" t nil)
(autoload 'sort-columns "sort" "\
Sort lines in region alphabetically by a certain range of columns.
For the purpose of this command, the region BEG...END includes
@@ -31430,8 +28566,7 @@ and it doesn't know how to handle that. Also, when possible,
it uses the `sort' utility program, which doesn't understand tabs.
Use \\[untabify] to convert tabs to spaces before sorting.
-\(fn REVERSE &optional BEG END)" t nil)
-
+(fn REVERSE &optional BEG END)" t nil)
(autoload 'reverse-region "sort" "\
Reverse the order of lines in a region.
When called from Lisp, takes two point or marker arguments, BEG and END.
@@ -31440,8 +28575,7 @@ to be reversed is the line starting after BEG.
If END is not at the end of a line, the last line to be reversed
is the one that ends before END.
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'delete-duplicate-lines "sort" "\
Delete all but one copy of any identical lines in the region.
Non-interactively, arguments BEG and END delimit the region.
@@ -31461,20 +28595,20 @@ If the argument KEEP-BLANKS is non-nil (interactively, with a
Returns the number of deleted lines. Interactively, or if INTERACTIVE
is non-nil, it also prints a message describing the number of deletions.
-\(fn BEG END &optional REVERSE ADJACENT KEEP-BLANKS INTERACTIVE)" t nil)
-
+(fn BEG END &optional REVERSE ADJACENT KEEP-BLANKS INTERACTIVE)" t nil)
(register-definition-prefixes "sort" '("sort-"))
-;;;***
-;;;### (autoloads nil "soundex" "soundex.el" (0 0 0 0))
;;; Generated autoloads from soundex.el
(register-definition-prefixes "soundex" '("soundex"))
-;;;***
-;;;### (autoloads nil "spam" "gnus/spam.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/source.el
+
+(register-definition-prefixes "ede/source" '("ede-source"))
+
+
;;; Generated autoloads from gnus/spam.el
(autoload 'spam-initialize "spam" "\
@@ -31484,14 +28618,10 @@ can call `spam-initialize' before you set spam-use-* variables on
explicitly, and matters only if you need the extra headers
installed through `spam-necessary-extra-headers'.
-\(fn &rest SYMBOLS)" t nil)
-
-(register-definition-prefixes "spam" '("spam-"))
+(fn &rest SYMBOLS)" t nil)
+(register-definition-prefixes "spam" '(":keymap" "spam-"))
-;;;***
-;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from gnus/spam-report.el
(autoload 'spam-report-process-queue "spam-report" "\
@@ -31501,55 +28631,48 @@ If FILE is given, use it instead of `spam-report-requests-file'.
If KEEP is t, leave old requests in the file. If KEEP is the
symbol `ask', query before flushing the queue file.
-\(fn &optional FILE KEEP)" t nil)
-
+(fn &optional FILE KEEP)" t nil)
(autoload 'spam-report-url-ping-mm-url "spam-report" "\
Ping a host through HTTP, addressing a specific GET resource.
Use the external program specified in `mm-url-program' to connect
to server.
-\(fn HOST REPORT)" nil nil)
-
+(fn HOST REPORT)" nil nil)
(autoload 'spam-report-url-to-file "spam-report" "\
Collect spam report requests in `spam-report-requests-file'.
Customize `spam-report-url-ping-function' to use this function.
-\(fn HOST REPORT)" nil nil)
-
+(fn HOST REPORT)" nil nil)
(autoload 'spam-report-agentize "spam-report" "\
Add spam-report support to the Agent.
Spam reports will be queued with \\[spam-report-url-to-file] when
the Agent is unplugged, and will be submitted in a batch when the
Agent is plugged." t nil)
-
(autoload 'spam-report-deagentize "spam-report" "\
Remove spam-report support from the Agent.
Spam reports will be queued with the method used when
\\[spam-report-agentize] was run." t nil)
-
(register-definition-prefixes "spam-report" '("spam-report-"))
-;;;***
-;;;### (autoloads nil "spam-stat" "gnus/spam-stat.el" (0 0 0 0))
;;; Generated autoloads from gnus/spam-stat.el
(register-definition-prefixes "spam-stat" '("spam-stat" "with-spam-stat-max-buffer-size"))
-;;;***
-;;;### (autoloads nil "spam-wash" "gnus/spam-wash.el" (0 0 0 0))
;;; Generated autoloads from gnus/spam-wash.el
(register-definition-prefixes "spam-wash" '("spam-"))
-;;;***
-;;;### (autoloads nil "speedbar" "speedbar.el" (0 0 0 0))
+;;; Generated autoloads from cedet/ede/speedbar.el
+
+(register-definition-prefixes "ede/speedbar" '("ede-"))
+
+
;;; Generated autoloads from speedbar.el
(defalias 'speedbar 'speedbar-frame-mode)
-
(autoload 'speedbar-frame-mode "speedbar" "\
Enable or disable speedbar. Positive ARG means turn on, negative turn off.
A nil ARG means toggle. Once the speedbar frame is activated, a buffer in
@@ -31558,34 +28681,26 @@ supported at a time.
`speedbar-before-popup-hook' is called before popping up the speedbar frame.
`speedbar-before-delete-hook' is called before the frame is deleted.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'speedbar-get-focus "speedbar" "\
Change frame focus to or from the speedbar frame.
If the selected frame is not speedbar, then speedbar frame is
selected. If the speedbar frame is active, then select the attached frame." t nil)
-
(register-definition-prefixes "speedbar" '("speedbar-"))
-;;;***
-;;;### (autoloads nil "spook" "play/spook.el" (0 0 0 0))
;;; Generated autoloads from play/spook.el
(autoload 'spook "spook" "\
Add that special touch of class to your outgoing mail." t nil)
-
(autoload 'snarf-spooks "spook" "\
Return a vector containing the lines from `spook-phrases-file'." nil nil)
-
(register-definition-prefixes "spook" '("spook-phrase"))
-;;;***
-;;;### (autoloads nil "sql" "progmodes/sql.el" (0 0 0 0))
;;; Generated autoloads from progmodes/sql.el
-(push (purecopy '(sql 3 6)) package--builtin-versions)
+(push (purecopy '(sql 3 6)) package--builtin-versions)
(autoload 'sql-add-product-keywords "sql" "\
Add highlighting KEYWORDS for SQL PRODUCT.
@@ -31605,8 +28720,7 @@ For example:
adds a fontification pattern to fontify identifiers ending in
`_t' as data types.
-\(fn PRODUCT KEYWORDS &optional APPEND)" nil nil)
-
+(fn PRODUCT KEYWORDS &optional APPEND)" nil nil)
(autoload 'sql-mode "sql" "\
Major mode to edit SQL.
@@ -31631,12 +28745,11 @@ Note that SQL doesn't have an escape character unless you specify
one. If you specify backslash as escape character in SQL, you
must tell Emacs. Here's how to do that in your init file:
-\(add-hook \\='sql-mode-hook
+(add-hook \\='sql-mode-hook
(lambda ()
(modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'sql-connect "sql" "\
Connect to an interactive session using CONNECTION settings.
@@ -31646,8 +28759,7 @@ their settings.
The user will not be prompted for any login parameters if a value
is specified in the connection settings.
-\(fn CONNECTION &optional BUF-NAME)" t nil)
-
+(fn CONNECTION &optional BUF-NAME)" t nil)
(autoload 'sql-product-interactive "sql" "\
Run PRODUCT interpreter as an inferior process.
@@ -31659,10 +28771,9 @@ To specify the SQL product, prefix the call with
the call to \\[sql-product-interactive] with
\\[universal-argument] \\[universal-argument].
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional PRODUCT NEW-NAME)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional PRODUCT NEW-NAME)" t nil)
(autoload 'sql-oracle "sql" "\
Run sqlplus by Oracle as an inferior process.
@@ -31690,10 +28801,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-sybase "sql" "\
Run isql by Sybase as an inferior process.
@@ -31721,10 +28831,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-informix "sql" "\
Run dbaccess by Informix as an inferior process.
@@ -31750,10 +28859,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-sqlite "sql" "\
Run sqlite as an inferior process.
@@ -31783,10 +28891,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-mysql "sql" "\
Run mysql by TcX as an inferior process.
@@ -31816,10 +28923,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-mariadb "sql" "\
Run mysql by MariaDB as an inferior process.
@@ -31849,10 +28955,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-solid "sql" "\
Run solsql by Solid as an inferior process.
@@ -31879,10 +28984,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-ingres "sql" "\
Run sql by Ingres as an inferior process.
@@ -31908,10 +29012,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-ms "sql" "\
Run osql by Microsoft as an inferior process.
@@ -31939,10 +29042,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-postgres "sql" "\
Run psql by Postgres as an inferior process.
@@ -31972,12 +29074,11 @@ The default comes from `process-coding-system-alist' and
your might try undecided-dos as a coding system. If this doesn't help,
Try to set `comint-output-filter-functions' like this:
-\(add-hook \\='comint-output-filter-functions #\\='comint-strip-ctrl-m \\='append)
+(add-hook \\='comint-output-filter-functions #\\='comint-strip-ctrl-m \\='append)
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-interbase "sql" "\
Run isql by Interbase as an inferior process.
@@ -32004,10 +29105,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-db2 "sql" "\
Run db2 by IBM as an inferior process.
@@ -32038,10 +29138,9 @@ in the SQL buffer, after you start the process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-linter "sql" "\
Run inl by RELEX as an inferior process.
@@ -32069,115 +29168,83 @@ before \\[sql-linter]. Once session has started,
\\[sql-rename-buffer] can be called separately to rename the
buffer.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
-
-\(fn &optional BUFFER)" t nil)
+(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+(fn &optional BUFFER)" t nil)
(autoload 'sql-vertica "sql" "\
Run vsql as an inferior process.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(register-definition-prefixes "sql" '("sql-"))
-;;;***
-;;;### (autoloads nil "srecode" "cedet/srecode.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode.el
-(push (purecopy '(srecode 1 2)) package--builtin-versions)
+;;; Generated autoloads from sqlite.el
-(register-definition-prefixes "srecode" '("srecode-version"))
+(register-definition-prefixes "sqlite" '("with-sqlite-transaction"))
-;;;***
-;;;### (autoloads nil "srecode/args" "cedet/srecode/args.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from cedet/srecode/args.el
+;;; Generated autoloads from sqlite-mode.el
-(register-definition-prefixes "srecode/args" '("srecode-"))
+(autoload 'sqlite-mode-open-file "sqlite-mode" "\
+Browse the contents of an sqlite file.
-;;;***
-
-;;;### (autoloads nil "srecode/ctxt" "cedet/srecode/ctxt.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from cedet/srecode/ctxt.el
-
-(register-definition-prefixes "srecode/ctxt" '("srecode-"))
+(fn FILE)" t nil)
+(register-definition-prefixes "sqlite-mode" '("sqlite-"))
-;;;***
-;;;### (autoloads nil "srecode/dictionary" "cedet/srecode/dictionary.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/dictionary.el
-
-(register-definition-prefixes "srecode/dictionary" '("srecode-"))
-
-;;;***
-
-;;;### (autoloads nil "srecode/extract" "cedet/srecode/extract.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/extract.el
-
-(register-definition-prefixes "srecode/extract" '("srecode-extract"))
-
-;;;***
-
-;;;### (autoloads nil "srecode/fields" "cedet/srecode/fields.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/fields.el
+;;; Generated autoloads from cedet/ede/srecode.el
-(register-definition-prefixes "srecode/fields" '("srecode-"))
+(register-definition-prefixes "ede/srecode" '("ede-srecode-"))
-;;;***
-;;;### (autoloads nil "srecode/filters" "cedet/srecode/filters.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/filters.el
+;;; Generated autoloads from cedet/srecode.el
-(register-definition-prefixes "srecode/filters" '("srecode-comment-prefix"))
+(push (purecopy '(srecode 1 2)) package--builtin-versions)
+(register-definition-prefixes "srecode" '("srecode-version"))
-;;;***
-;;;### (autoloads nil "srecode/find" "cedet/srecode/find.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from cedet/srecode/find.el
+;;; Generated autoloads from cedet/srecode/srt.el
-(register-definition-prefixes "srecode/find" '("srecode-"))
+(register-definition-prefixes "srecode/srt" '("srecode-read-"))
-;;;***
-;;;### (autoloads nil "srecode/semantic" "cedet/srecode/semantic.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/semantic.el
-
-(register-definition-prefixes "srecode/semantic" '("srecode-semantic-"))
-
-;;;***
-
-;;;### (autoloads nil "srecode/srt-mode" "cedet/srecode/srt-mode.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/srt-mode.el
(autoload 'srecode-template-mode "srecode/srt-mode" "\
Major-mode for writing SRecode macros.
-\(fn)" t nil)
-
+(fn)" t nil)
(defalias 'srt-mode #'srecode-template-mode)
-
(register-definition-prefixes "srecode/srt-mode" '("semantic-" "srecode-"))
-;;;***
-;;;### (autoloads nil "srecode/table" "cedet/srecode/table.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from cedet/srecode/table.el
+;;; Generated autoloads from textmodes/string-edit.el
-(register-definition-prefixes "srecode/table" '("object-sort-list" "srecode-"))
+(autoload 'string-edit "string-edit" "\
+Switch to a new buffer to edit STRING.
+When the user finishes editing (with \\<string-edit-mode-map>\\[string-edit-done]), SUCCESS-CALLBACK
+is called with the resulting string.
+
+If the user aborts (with \\<string-edit-mode-map>\\[string-edit-abort]), ABORT-CALLBACK (if any) is
+called with no parameters.
+
+PROMPT will be inserted at the start of the buffer, but won't be
+included in the resulting string. If PROMPT is nil, no help text
+will be inserted.
+
+(fn PROMPT STRING SUCCESS-CALLBACK &key ABORT-CALLBACK)" nil nil)
+(autoload 'read-string-from-buffer "string-edit" "\
+Switch to a new buffer to edit STRING in a recursive edit.
+The user finishes editing with \\<string-edit-mode-map>\\[string-edit-done], or aborts with \\<string-edit-mode-map>\\[string-edit-abort]).
+
+PROMPT will be inserted at the start of the buffer, but won't be
+included in the resulting string. If nil, no prompt will be
+inserted in the buffer.
+
+(fn PROMPT STRING)" nil nil)
+(register-definition-prefixes "string-edit" '("string-edit-"))
-;;;***
-;;;### (autoloads nil "strokes" "strokes.el" (0 0 0 0))
;;; Generated autoloads from strokes.el
(autoload 'strokes-global-set-stroke "strokes" "\
@@ -32189,8 +29256,7 @@ documentation for the `strokes-define-stroke' function.
See also `strokes-global-set-stroke-string'.
-\(fn STROKE COMMAND)" t nil)
-
+(fn STROKE COMMAND)" t nil)
(autoload 'strokes-read-stroke "strokes" "\
Read a simple stroke (interactively) and return the stroke.
Optional PROMPT in minibuffer displays before and during stroke reading.
@@ -32199,8 +29265,7 @@ entered in the strokes buffer if the variable
`strokes-use-strokes-buffer' is non-nil.
Optional EVENT is acceptable as the starting event of the stroke.
-\(fn &optional PROMPT EVENT)" nil nil)
-
+(fn &optional PROMPT EVENT)" nil nil)
(autoload 'strokes-read-complex-stroke "strokes" "\
Read a complex stroke (interactively) and return the stroke.
Optional PROMPT in minibuffer displays before and during stroke reading.
@@ -32209,39 +29274,32 @@ is implemented by allowing the user to paint with button 1 or button 2 and
then complete the stroke with button 3.
Optional EVENT is acceptable as the starting event of the stroke.
-\(fn &optional PROMPT EVENT)" nil nil)
-
+(fn &optional PROMPT EVENT)" nil nil)
(autoload 'strokes-do-stroke "strokes" "\
Read a simple stroke from the user and then execute its command.
This must be bound to a mouse event.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'strokes-do-complex-stroke "strokes" "\
Read a complex stroke from the user and then execute its command.
This must be bound to a mouse event.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'strokes-describe-stroke "strokes" "\
Displays the command which STROKE maps to, reading STROKE interactively.
-\(fn STROKE)" t nil)
-
+(fn STROKE)" t nil)
(autoload 'strokes-help "strokes" "\
Get instruction on using the Strokes package." t nil)
-
(autoload 'strokes-load-user-strokes "strokes" "\
Load user-defined strokes from file named by `strokes-file'." t nil)
-
(autoload 'strokes-list-strokes "strokes" "\
Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP.
With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes chronologically
by command name.
If STROKES-MAP is not given, `strokes-global-map' will be used instead.
-\(fn &optional CHRONOLOGICAL STROKES-MAP)" t nil)
-
+(fn &optional CHRONOLOGICAL STROKES-MAP)" t nil)
(defvar strokes-mode nil "\
Non-nil if Strokes mode is enabled.
See the `strokes-mode' command
@@ -32249,26 +29307,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `strokes-mode'.")
-
(custom-autoload 'strokes-mode "strokes" nil)
-
(autoload 'strokes-mode "strokes" "\
Toggle Strokes mode, a global minor mode.
-This is a minor mode. If called interactively, toggle the `Strokes
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='strokes-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
\\<strokes-mode-map>
Strokes are pictographic mouse gestures which invoke commands.
Strokes are invoked with \\[strokes-do-stroke]. You can define
@@ -32282,120 +29324,90 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
\\{strokes-mode-map}
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Strokes mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='strokes-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'strokes-decode-buffer "strokes" "\
Decode stroke strings in BUFFER and display their corresponding glyphs.
Optional BUFFER defaults to the current buffer.
Optional FORCE non-nil will ignore the buffer's read-only status.
-\(fn &optional BUFFER FORCE)" t nil)
-
+(fn &optional BUFFER FORCE)" t nil)
(autoload 'strokes-compose-complex-stroke "strokes" "\
Read a complex stroke and insert its glyph into the current buffer." t nil)
-
(register-definition-prefixes "strokes" '("strokes-"))
-;;;***
-;;;### (autoloads nil "studly" "play/studly.el" (0 0 0 0))
;;; Generated autoloads from play/studly.el
(autoload 'studlify-region "studly" "\
Studlify-case the region.
-\(fn BEGIN END)" t nil)
-
+(fn BEGIN END)" t nil)
(autoload 'studlify-word "studly" "\
Studlify-case the current word, or COUNT words if given an argument.
-\(fn COUNT)" t nil)
-
+(fn COUNT)" t nil)
(autoload 'studlify-buffer "studly" "\
Studlify-case the current buffer." t nil)
-;;;***
-;;;### (autoloads nil "subr-x" "emacs-lisp/subr-x.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/subr-x.el
-(autoload 'if-let "subr-x" "\
-Bind variables according to SPEC and evaluate THEN or ELSE.
-Evaluate each binding in turn, as in `let*', stopping if a
-binding value is nil. If all are non-nil return the value of
-THEN, otherwise the last form in ELSE.
-
-Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
-SYMBOL to the value of VALUEFORM. An element can additionally be
-of the form (VALUEFORM), which is evaluated and checked for nil;
-i.e. SYMBOL can be omitted if only the test result is of
-interest. It can also be of the form SYMBOL, then the binding of
-SYMBOL is checked for nil.
-
-As a special case, interprets a SPEC of the form (SYMBOL SOMETHING)
-like ((SYMBOL SOMETHING)). This exists for backward compatibility
-with an old syntax that accepted only one binding.
-
-\(fn SPEC THEN &rest ELSE)" nil t)
-
-(function-put 'if-let 'lisp-indent-function '2)
-
-(autoload 'when-let "subr-x" "\
-Bind variables according to SPEC and conditionally evaluate BODY.
-Evaluate each binding in turn, stopping if a binding value is nil.
-If all are non-nil, return the value of the last form in BODY.
-
-The variable list SPEC is the same as in `if-let'.
-
-\(fn SPEC &rest BODY)" nil t)
-
-(function-put 'when-let 'lisp-indent-function '1)
-
(autoload 'string-truncate-left "subr-x" "\
Truncate STRING to LENGTH, replacing initial surplus with \"...\".
-\(fn STRING LENGTH)" nil nil)
-
+(fn STRING LENGTH)" nil nil)
(autoload 'string-clean-whitespace "subr-x" "\
Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed.
-\(fn STRING)" nil nil)
+(fn STRING)" nil nil)
+(autoload 'string-pixel-width "subr-x" "\
+Return the width of STRING in pixels.
-(autoload 'string-lines "subr-x" "\
-Split STRING into a list of lines.
-If OMIT-NULLS, empty lines will be removed from the results.
+(fn STRING)" nil nil)
+(autoload 'string-glyph-split "subr-x" "\
+Split STRING into a list of strings representing separate glyphs.
+This takes into account combining characters and grapheme clusters.
-\(fn STRING &optional OMIT-NULLS)" nil nil)
+(fn STRING)" nil nil)
+(autoload 'add-display-text-property "subr-x" "\
+Add display property PROP with VALUE to the text from START to END.
+If any text in the region has a non-nil `display' property, those
+properties are retained.
-(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "named-let" "replace-region-contents" "string-" "thread-" "when-let*"))
+If OBJECT is non-nil, it should be a string or a buffer. If nil,
+this defaults to the current buffer.
+
+(fn START END PROP VALUE &optional OBJECT)" nil nil)
+(autoload 'read-process-name "subr-x" "\
+Query the user for a process and return the process object.
+
+(fn PROMPT)" nil nil)
+(register-definition-prefixes "subr-x" '("hash-table-" "internal--thread-argument" "named-let" "replace-region-contents" "string-" "thread-" "with-buffer-unmodified-if-unchanged"))
-;;;***
-;;;### (autoloads nil "subword" "progmodes/subword.el" (0 0 0 0))
;;; Generated autoloads from progmodes/subword.el
(define-obsolete-function-alias 'capitalized-words-mode 'subword-mode "25.1")
-
(autoload 'subword-mode "subword" "\
Toggle subword movement and editing (Subword mode).
-This is a minor mode. If called interactively, toggle the `Subword
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `subword-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Subword mode is a buffer-local minor mode. Enabling it changes
the definition of a word so that word-based commands stop inside
symbols with mixed uppercase and lowercase letters,
@@ -32414,10 +29426,22 @@ called a `subword'. Here are some examples:
This mode changes the definition of a word so that word commands
treat nomenclature boundaries as word boundaries.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Subword mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-(put 'global-subword-mode 'globalized-minor-mode t)
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `subword-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(put 'global-subword-mode 'globalized-minor-mode t)
(defvar global-subword-mode nil "\
Non-nil if Global Subword mode is enabled.
See the `global-subword-mode' command
@@ -32425,9 +29449,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-subword-mode'.")
-
(custom-autoload 'global-subword-mode "subword" nil)
-
(autoload 'global-subword-mode "subword" "\
Toggle Subword mode in all buffers.
With prefix ARG, enable Global Subword mode if ARG is positive;
@@ -32438,29 +29460,14 @@ Enable the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
Subword mode is enabled in all buffers where `(lambda nil
-\(subword-mode 1))' would do it.
+(subword-mode 1))' would do it.
See `subword-mode' for more information on Subword mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'superword-mode "subword" "\
Toggle superword movement and editing (Superword mode).
-This is a minor mode. If called interactively, toggle the `Superword
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `superword-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Superword mode is a buffer-local minor mode. Enabling it changes
the definition of words such that characters which have symbol
syntax are treated as parts of words: e.g., in `superword-mode',
@@ -32468,10 +29475,22 @@ syntax are treated as parts of words: e.g., in `superword-mode',
\\{superword-mode-map}
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Superword mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
-(put 'global-superword-mode 'globalized-minor-mode t)
+To check whether the minor mode is enabled in the current buffer,
+evaluate `superword-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
+(put 'global-superword-mode 'globalized-minor-mode t)
(defvar global-superword-mode nil "\
Non-nil if Global Superword mode is enabled.
See the `global-superword-mode' command
@@ -32479,9 +29498,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-superword-mode'.")
-
(custom-autoload 'global-superword-mode "subword" nil)
-
(autoload 'global-superword-mode "subword" "\
Toggle Superword mode in all buffers.
With prefix ARG, enable Global Superword mode if ARG is positive;
@@ -32492,17 +29509,14 @@ Enable the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
Superword mode is enabled in all buffers where `(lambda nil
-\(superword-mode 1))' would do it.
+(superword-mode 1))' would do it.
See `superword-mode' for more information on Superword mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "subword" '("subword-" "superword-mode-map"))
-;;;***
-;;;### (autoloads nil "supercite" "mail/supercite.el" (0 0 0 0))
;;; Generated autoloads from mail/supercite.el
(autoload 'sc-cite-original "supercite" "\
@@ -32529,20 +29543,20 @@ original message but it does require a few things:
The region need not be active (and typically isn't when this
function is called). Also, the hook `sc-pre-hook' is run before,
and `sc-post-hook' is run after the guts of this function." nil nil)
-
(register-definition-prefixes "supercite" '("sc-"))
-;;;***
-;;;### (autoloads nil "svg" "svg.el" (0 0 0 0))
;;; Generated autoloads from svg.el
-(push (purecopy '(svg 1 1)) package--builtin-versions)
+(push (purecopy '(svg 1 1)) package--builtin-versions)
(register-definition-prefixes "svg" '("svg-"))
-;;;***
-;;;### (autoloads nil "t-mouse" "t-mouse.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/symref.el
+
+(register-definition-prefixes "semantic/symref" '("semantic-symref-"))
+
+
;;; Generated autoloads from t-mouse.el
(defvar gpm-mouse-mode t "\
@@ -32552,26 +29566,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `gpm-mouse-mode'.")
-
(custom-autoload 'gpm-mouse-mode "t-mouse" nil)
-
(autoload 'gpm-mouse-mode "t-mouse" "\
Toggle mouse support in GNU/Linux consoles (GPM Mouse mode).
-This is a minor mode. If called interactively, toggle the `Gpm-Mouse
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='gpm-mouse-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
This allows the use of the mouse when operating on a GNU/Linux console,
in the same way as you can use the mouse under X11.
It relies on the `gpm' daemon being activated.
@@ -32580,38 +29578,46 @@ Note that when `gpm-mouse-mode' is enabled, you cannot use the
mouse to transfer text between Emacs and other programs which use
GPM. This is due to limitations in GPM and the Linux kernel.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Gpm-Mouse mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='gpm-mouse-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(register-definition-prefixes "t-mouse" '("gpm-mouse-"))
-;;;***
-;;;### (autoloads nil "tab-line" "tab-line.el" (0 0 0 0))
;;; Generated autoloads from tab-line.el
(autoload 'tab-line-mode "tab-line" "\
Toggle display of tab line in the windows displaying the current buffer.
-This is a minor mode. If called interactively, toggle the `Tab-Line
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Tab-Line mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `tab-line-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(defvar-local tab-line-exclude nil)
-
(put 'global-tab-line-mode 'globalized-minor-mode t)
-
(defvar global-tab-line-mode nil "\
Non-nil if Global Tab-Line mode is enabled.
See the `global-tab-line-mode' command
@@ -32619,9 +29625,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-tab-line-mode'.")
-
(custom-autoload 'global-tab-line-mode "tab-line" nil)
-
(autoload 'global-tab-line-mode "tab-line" "\
Toggle Tab-Line mode in all buffers.
With prefix ARG, enable Global Tab-Line mode if ARG is positive;
@@ -32636,13 +29640,10 @@ would do it.
See `tab-line-mode' for more information on Tab-Line mode.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "tab-line" '("tab-line-"))
-;;;***
-;;;### (autoloads nil "tabify" "tabify.el" (0 0 0 0))
;;; Generated autoloads from tabify.el
(autoload 'untabify "tabify" "\
@@ -32654,8 +29655,7 @@ Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
The variable `tab-width' controls the spacing of tab stops.
-\(fn START END &optional ARG)" t nil)
-
+(fn START END &optional ARG)" t nil)
(autoload 'tabify "tabify" "\
Convert multiple spaces in region to tabs when possible.
A group of spaces is partially replaced by tabs
@@ -32667,15 +29667,39 @@ Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
The variable `tab-width' controls the spacing of tab stops.
-\(fn START END &optional ARG)" t nil)
-
+(fn START END &optional ARG)" t nil)
(register-definition-prefixes "tabify" '("tabify-regexp"))
-;;;***
-;;;### (autoloads nil "table" "textmodes/table.el" (0 0 0 0))
;;; Generated autoloads from textmodes/table.el
+(autoload 'table-fixed-width-mode "table" "\
+Cell width is fixed when this is non-nil.
+
+Normally it should be nil for allowing automatic cell width expansion
+that widens a cell when it is necessary. When non-nil, typing in a
+cell does not automatically expand the cell width. A word that is too
+long to fit in a cell is chopped into multiple lines. The chopped
+location is indicated by `table-word-continuation-char'. This
+variable's value can be toggled by \\[table-fixed-width-mode] at
+run-time.
+
+This is a minor mode. If called interactively, toggle the
+`Table-Fixed-Width mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `table-fixed-width-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'table-insert "table" "\
Insert an editable text table.
Insert a table of specified number of COLUMNS and ROWS. Optional
@@ -32797,8 +29821,7 @@ Inside a table cell has a special keymap.
\\{table-cell-map}
-\(fn COLUMNS ROWS &optional CELL-WIDTH CELL-HEIGHT)" t nil)
-
+(fn COLUMNS ROWS &optional CELL-WIDTH CELL-HEIGHT)" t nil)
(autoload 'table-insert-row "table" "\
Insert N table row(s).
When point is in a table the newly inserted row(s) are placed above
@@ -32806,8 +29829,7 @@ the current row. When point is outside of the table it must be below
the table within the table width range, then the newly created row(s)
are appended at the bottom of the table.
-\(fn N)" t nil)
-
+(fn N)" t nil)
(autoload 'table-insert-column "table" "\
Insert N table column(s).
When point is in a table the newly inserted column(s) are placed left
@@ -32815,14 +29837,12 @@ of the current column. When point is outside of the table it must be
right side of the table within the table height range, then the newly
created column(s) are appended at the right of the table.
-\(fn N)" t nil)
-
+(fn N)" t nil)
(autoload 'table-insert-row-column "table" "\
Insert row(s) or column(s).
See `table-insert-row' and `table-insert-column'.
-\(fn ROW-COLUMN N)" t nil)
-
+(fn ROW-COLUMN N)" t nil)
(autoload 'table-recognize "table" "\
Recognize all tables within the current buffer and activate them.
Scans the entire buffer and recognizes valid table cells. If the
@@ -32830,10 +29850,8 @@ optional numeric prefix argument ARG is negative the tables in the
buffer become inactive, meaning the tables become plain text and loses
all the table specific features.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'table-unrecognize "table" nil t nil)
-
(autoload 'table-recognize-region "table" "\
Recognize all tables within region.
BEG and END specify the region to work on. If the optional numeric
@@ -32841,23 +29859,19 @@ prefix argument ARG is negative the tables in the region become
inactive, meaning the tables become plain text and lose all the table
specific features.
-\(fn BEG END &optional ARG)" t nil)
-
+(fn BEG END &optional ARG)" t nil)
(autoload 'table-unrecognize-region "table" "\
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'table-recognize-table "table" "\
Recognize a table at point.
If the optional numeric prefix argument ARG is negative the table
becomes inactive, meaning the table becomes plain text and loses all
the table specific features.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'table-unrecognize-table "table" nil t nil)
-
(autoload 'table-recognize-cell "table" "\
Recognize a table cell that contains current point.
Probe the cell dimension and prepare the cell information. The
@@ -32866,10 +29880,8 @@ must not be specified. When the optional numeric prefix argument ARG
is negative the cell becomes inactive, meaning that the cell becomes
plain text and loses all the table specific features.
-\(fn &optional FORCE NO-COPY ARG)" t nil)
-
+(fn &optional FORCE NO-COPY ARG)" t nil)
(autoload 'table-unrecognize-cell "table" nil t nil)
-
(autoload 'table-heighten-cell "table" "\
Heighten the current cell by N lines by expanding the cell vertically.
Heightening is done by adding blank lines at the bottom of the current
@@ -32878,8 +29890,7 @@ heightened in order to keep the rectangular table structure. The
optional argument NO-COPY is internal use only and must not be
specified.
-\(fn N &optional NO-COPY NO-UPDATE)" t nil)
-
+(fn N &optional NO-COPY NO-UPDATE)" t nil)
(autoload 'table-shorten-cell "table" "\
Shorten the current cell by N lines by shrinking the cell vertically.
Shortening is done by removing blank lines from the bottom of the cell
@@ -32889,22 +29900,19 @@ is applicable to all the cells aligned horizontally with the current
one because they are also shortened in order to keep the rectangular
table structure.
-\(fn N)" t nil)
-
+(fn N)" t nil)
(autoload 'table-widen-cell "table" "\
Widen the current cell by N columns and expand the cell horizontally.
Some other cells in the same table are widen as well to keep the
table's rectangle structure.
-\(fn N &optional NO-COPY NO-UPDATE)" t nil)
-
+(fn N &optional NO-COPY NO-UPDATE)" t nil)
(autoload 'table-narrow-cell "table" "\
Narrow the current cell by N columns and shrink the cell horizontally.
Some other cells in the same table are narrowed as well to keep the
table's rectangle structure.
-\(fn N)" t nil)
-
+(fn N)" t nil)
(autoload 'table-forward-cell "table" "\
Move point forward to the beginning of the next cell.
With argument ARG, do it ARG times;
@@ -32944,43 +29952,36 @@ You can actually try how it works in this buffer. Press
| |6 | | | |6 | | +--+--+--+--+ +--+--+--+--+ +--+-----+--+
+--+--+--+ +--+--+--+
-\(fn &optional ARG NO-RECOGNIZE UNRECOGNIZE)" t nil)
-
+(fn &optional ARG NO-RECOGNIZE UNRECOGNIZE)" t nil)
(autoload 'table-backward-cell "table" "\
Move backward to the beginning of the previous cell.
With argument ARG, do it ARG times;
a negative argument ARG = -N means move forward N cells.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'table-span-cell "table" "\
Span current cell into adjacent cell in DIRECTION.
DIRECTION is one of symbols; right, left, above or below.
-\(fn DIRECTION)" t nil)
-
+(fn DIRECTION)" t nil)
(autoload 'table-split-cell-vertically "table" "\
Split current cell vertically.
Creates a cell above and a cell below the current point location." t nil)
-
(autoload 'table-split-cell-horizontally "table" "\
Split current cell horizontally.
Creates a cell on the left and a cell on the right of the current
point location." t nil)
-
(autoload 'table-split-cell "table" "\
Split current cell in ORIENTATION.
ORIENTATION is a symbol either horizontally or vertically.
-\(fn ORIENTATION)" t nil)
-
+(fn ORIENTATION)" t nil)
(autoload 'table-justify "table" "\
Justify contents of a cell, a row of cells or a column of cells.
WHAT is a symbol `cell', `row' or `column'. JUSTIFY is a symbol
`left', `center', `right', `top', `middle', `bottom' or `none'.
-\(fn WHAT JUSTIFY)" t nil)
-
+(fn WHAT JUSTIFY)" t nil)
(autoload 'table-justify-cell "table" "\
Justify cell contents.
JUSTIFY is a symbol `left', `center' or `right' for horizontal, or `top',
@@ -32988,48 +29989,19 @@ JUSTIFY is a symbol `left', `center' or `right' for horizontal, or `top',
non-nil the justify operation is limited to the current paragraph,
otherwise the entire cell contents is justified.
-\(fn JUSTIFY &optional PARAGRAPH)" t nil)
-
+(fn JUSTIFY &optional PARAGRAPH)" t nil)
(autoload 'table-justify-row "table" "\
Justify cells of a row.
JUSTIFY is a symbol `left', `center' or `right' for horizontal,
or `top', `middle', `bottom' or `none' for vertical.
-\(fn JUSTIFY)" t nil)
-
+(fn JUSTIFY)" t nil)
(autoload 'table-justify-column "table" "\
Justify cells of a column.
JUSTIFY is a symbol `left', `center' or `right' for horizontal,
or `top', `middle', `bottom' or `none' for vertical.
-\(fn JUSTIFY)" t nil)
-
-(autoload 'table-fixed-width-mode "table" "\
-Cell width is fixed when this is non-nil.
-Normally it should be nil for allowing automatic cell width expansion
-that widens a cell when it is necessary. When non-nil, typing in a
-cell does not automatically expand the cell width. A word that is too
-long to fit in a cell is chopped into multiple lines. The chopped
-location is indicated by `table-word-continuation-char'. This
-variable's value can be toggled by \\[table-fixed-width-mode] at
-run-time.
-
-This is a minor mode. If called interactively, toggle the
-`Table-Fixed-Width mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `table-fixed-width-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
-
+(fn JUSTIFY)" t nil)
(autoload 'table-query-dimension "table" "\
Return the dimension of the current cell and the current table.
The result is a list (cw ch tw th c r cells) where cw is the cell
@@ -33042,8 +30014,7 @@ the number tends to be larger than it appears for the tables with
non-uniform cell structure (heavily spanned and split). When optional
WHERE is provided the cell and table at that location is reported.
-\(fn &optional WHERE)" t nil)
-
+(fn &optional WHERE)" t nil)
(autoload 'table-generate-source "table" "\
Generate source of the current table in the specified language.
LANGUAGE is a symbol that specifies the language to describe the
@@ -33071,8 +30042,7 @@ CALS (DocBook DTD):
URL `https://www.oasis-open.org/html/a502.htm'
URL `https://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751'
-\(fn LANGUAGE &optional DEST-BUFFER CAPTION)" t nil)
-
+(fn LANGUAGE &optional DEST-BUFFER CAPTION)" t nil)
(autoload 'table-insert-sequence "table" "\
Travel cells forward while inserting a specified sequence string in each cell.
STR is the base string from which the sequence starts. When STR is an
@@ -33108,24 +30078,21 @@ Example:
(table-forward-cell 1)
(table-insert-sequence \"64\" 0 1 2 \\='left))
-\(fn STR N INCREMENT INTERVAL JUSTIFY)" t nil)
-
+(fn STR N INCREMENT INTERVAL JUSTIFY)" t nil)
(autoload 'table-delete-row "table" "\
Delete N row(s) of cells.
Delete N rows of cells from current row. The current row is the row
contains the current cell where point is located. Each row must
consists from cells of same height.
-\(fn N)" t nil)
-
+(fn N)" t nil)
(autoload 'table-delete-column "table" "\
Delete N column(s) of cells.
Delete N columns of cells from current column. The current column is
the column contains the current cell where point is located. Each
column must consists from cells of same width.
-\(fn N)" t nil)
-
+(fn N)" t nil)
(autoload 'table-capture "table" "\
Convert plain text into a table by capturing the text in the region.
Create a table with the text in region as cell contents. BEG and END
@@ -33237,41 +30204,56 @@ By applying `table-release', which does the opposite process, the
contents become once again plain text. `table-release' works as
companion command to `table-capture' this way.
-\(fn BEG END &optional COL-DELIM-REGEXP ROW-DELIM-REGEXP JUSTIFY MIN-CELL-WIDTH COLUMNS)" t nil)
-
+(fn BEG END &optional COL-DELIM-REGEXP ROW-DELIM-REGEXP JUSTIFY MIN-CELL-WIDTH COLUMNS)" t nil)
(autoload 'table-release "table" "\
Convert a table into plain text by removing the frame from a table.
Remove the frame from a table and deactivate the table. This command
converts a table into plain text without frames. It is a companion to
`table-capture' which does the opposite process." t nil)
-
(register-definition-prefixes "table" '("*table--" "table-"))
-;;;***
-;;;### (autoloads nil "tabulated-list" "emacs-lisp/tabulated-list.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/table.el
+
+(register-definition-prefixes "srecode/table" '("object-sort-list" "srecode-"))
+
+
;;; Generated autoloads from emacs-lisp/tabulated-list.el
+
(push (purecopy '(tabulated-list 1 0)) package--builtin-versions)
-;;;***
-;;;### (autoloads nil "talk" "talk.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/tag.el
+
+(register-definition-prefixes "semantic/tag" '("semantic-"))
+
+
+;;; Generated autoloads from cedet/semantic/tag-file.el
+
+(register-definition-prefixes "semantic/tag-file" '("semantic-prototype-file"))
+
+
+;;; Generated autoloads from cedet/semantic/tag-ls.el
+
+(register-definition-prefixes "semantic/tag-ls" '("semantic-"))
+
+
+;;; Generated autoloads from cedet/semantic/tag-write.el
+
+(register-definition-prefixes "semantic/tag-write" '("semantic-tag-write-"))
+
+
;;; Generated autoloads from talk.el
(autoload 'talk-connect "talk" "\
Connect to display DISPLAY for the Emacs talk group.
-\(fn DISPLAY)" t nil)
-
+(fn DISPLAY)" t nil)
(autoload 'talk "talk" "\
Connect to the Emacs talk group from the current X display or tty frame." t nil)
-
(register-definition-prefixes "talk" '("talk-"))
-;;;***
-;;;### (autoloads nil "tar-mode" "tar-mode.el" (0 0 0 0))
;;; Generated autoloads from tar-mode.el
(autoload 'tar-mode "tar-mode" "\
@@ -33290,13 +30272,10 @@ inside of a tar archive without extracting it and re-archiving it.
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\\{tar-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "tar-mode" '("tar-"))
-;;;***
-;;;### (autoloads nil "tcl" "progmodes/tcl.el" (0 0 0 0))
;;; Generated autoloads from progmodes/tcl.el
(autoload 'tcl-mode "tcl" "\
@@ -33327,34 +30306,26 @@ Turning on Tcl mode runs `tcl-mode-hook'. Read the documentation for
`tcl-mode-hook' to see what kinds of interesting hook functions
already exist.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'inferior-tcl "tcl" "\
Run inferior Tcl process.
Prefix arg means enter program name interactively.
See documentation for function `inferior-tcl-mode' for more information.
-\(fn CMD)" t nil)
-
+(fn CMD)" t nil)
(autoload 'tcl-help-on-word "tcl" "\
Get help on Tcl command. Default is word at point.
Prefix argument means invert sense of `tcl-use-smart-word-finder'.
-\(fn COMMAND &optional ARG)" t nil)
-
+(fn COMMAND &optional ARG)" t nil)
(register-definition-prefixes "tcl" '("inferior-tcl-" "run-tcl" "switch-to-tcl" "tcl-"))
-;;;***
-;;;### (autoloads nil "tcover-ses" "emacs-lisp/tcover-ses.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/tcover-ses.el
(register-definition-prefixes "tcover-ses" '("ses-exercise"))
-;;;***
-;;;### (autoloads nil "telnet" "net/telnet.el" (0 0 0 0))
;;; Generated autoloads from net/telnet.el
(autoload 'telnet "telnet" "\
@@ -33368,27 +30339,26 @@ is controlled by the contents of the global variable `telnet-host-properties',
falling back on the value of the global variable `telnet-program'.
Normally input is edited in Emacs and sent a line at a time.
-\(fn HOST &optional PORT)" t nil)
-
+(fn HOST &optional PORT)" t nil)
(autoload 'rsh "telnet" "\
Open a network login connection to host named HOST (a string).
Communication with HOST is recorded in a buffer `*rsh-HOST*'.
Normally input is edited in Emacs and sent a line at a time.
-\(fn HOST)" t nil)
-
+(fn HOST)" t nil)
(register-definition-prefixes "telnet" '("send-process-next-char" "telnet-"))
-;;;***
-;;;### (autoloads nil "tempo" "tempo.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/template.el
+
+(register-definition-prefixes "srecode/template" '("semantic-tag-components"))
+
+
;;; Generated autoloads from tempo.el
(register-definition-prefixes "tempo" '("tempo-"))
-;;;***
-;;;### (autoloads nil "term" "term.el" (0 0 0 0))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
@@ -33398,8 +30368,7 @@ If there is already a running process in that buffer, it is not restarted.
Optional third arg STARTFILE is the name of a file to send the contents of to
the process. Any more args are arguments to PROGRAM.
-\(fn NAME PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
-
+(fn NAME PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
(autoload 'term "term" "\
Start a terminal-emulator in a new buffer.
The buffer is in Term mode; see `term-mode' for the
@@ -33407,15 +30376,13 @@ commands to use in that buffer.
\\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer.
-\(fn PROGRAM)" t nil)
-
+(fn PROGRAM)" t nil)
(autoload 'ansi-term "term" "\
Start a terminal-emulator in a new buffer.
This is almost the same as `term' apart from always creating a new buffer,
-and `C-x' being marked as a `term-escape-char'.
-
-\(fn PROGRAM &optional NEW-BUFFER-NAME)" t nil)
+and \\`C-x' being marked as a `term-escape-char'.
+(fn PROGRAM &optional NEW-BUFFER-NAME)" t nil)
(autoload 'serial-term "term" "\
Start a terminal-emulator for a serial port in a new buffer.
PORT is the path or name of the serial port. For example, this
@@ -33435,30 +30402,22 @@ use in that buffer.
\\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer.
-\(fn PORT SPEED &optional LINE-MODE)" t nil)
-
+(fn PORT SPEED &optional LINE-MODE)" t nil)
(register-definition-prefixes "term" '("ansi-term-color-vector" "serial-" "term-"))
-;;;***
-;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/testcover.el
(autoload 'testcover-start "testcover" "\
Use Edebug to instrument for coverage all macros and functions in FILENAME.
If BYTE-COMPILE is non-nil, byte compile each function after instrumenting.
-\(fn FILENAME &optional BYTE-COMPILE)" t nil)
-
+(fn FILENAME &optional BYTE-COMPILE)" t nil)
(autoload 'testcover-this-defun "testcover" "\
Start coverage on function under point." t nil)
-
(register-definition-prefixes "testcover" '("testcover-"))
-;;;***
-;;;### (autoloads nil "tetris" "play/tetris.el" (0 0 0 0))
;;; Generated autoloads from play/tetris.el
(autoload 'tetris "tetris" "\
@@ -33477,103 +30436,74 @@ as to form complete rows.
\\[tetris-rotate-prev] Rotate the shape clockwise
\\[tetris-rotate-next] Rotate the shape anticlockwise
\\[tetris-move-bottom] Drop the shape to the bottom of the playing area" t nil)
-
(register-definition-prefixes "tetris" '("tetris-"))
-;;;***
-;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (0 0 0 0))
;;; Generated autoloads from textmodes/tex-mode.el
(defvar tex-shell-file-name nil "\
If non-nil, the shell file name to run in the subshell used to run TeX.")
-
(custom-autoload 'tex-shell-file-name "tex-mode" t)
-
(defvar tex-directory (purecopy ".") "\
Directory in which temporary files are written.
You can make this `/tmp' if your TEXINPUTS has no relative directories in it
and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are
`\\input' commands with relative directories.")
-
(custom-autoload 'tex-directory "tex-mode" t)
-
(defvar tex-first-line-header-regexp nil "\
Regexp for matching a first line which `tex-region' should include.
If this is non-nil, it should be a regular expression string;
if it matches the first line of the file,
`tex-region' always includes the first line in the TeX run.")
-
(custom-autoload 'tex-first-line-header-regexp "tex-mode" t)
-
(defvar tex-main-file nil "\
The main TeX source file which includes this buffer's file.
The command `tex-file' runs TeX on the file specified by `tex-main-file'
if the variable is non-nil.")
-
(custom-autoload 'tex-main-file "tex-mode" t)
-
(defvar tex-offer-save t "\
If non-nil, ask about saving modified buffers before \\[tex-file] is run.")
-
(custom-autoload 'tex-offer-save "tex-mode" t)
-
(defvar tex-run-command (purecopy "tex") "\
Command used to run TeX subjob.
TeX Mode sets `tex-command' to this string.
See the documentation of that variable.")
-
(custom-autoload 'tex-run-command "tex-mode" t)
-
(defvar latex-run-command (purecopy "latex") "\
Command used to run LaTeX subjob.
LaTeX Mode sets `tex-command' to this string.
See the documentation of that variable.")
-
(custom-autoload 'latex-run-command "tex-mode" t)
-
(defvar slitex-run-command (purecopy "slitex") "\
Command used to run SliTeX subjob.
SliTeX Mode sets `tex-command' to this string.
See the documentation of that variable.")
-
(custom-autoload 'slitex-run-command "tex-mode" t)
-
(defvar tex-start-options (purecopy "") "\
TeX options to use when starting TeX.
These immediately precede the commands in `tex-start-commands'
and the input file name, with no separating space and are not shell-quoted.
If nil, TeX runs with no options. See the documentation of `tex-command'.")
-
(custom-autoload 'tex-start-options "tex-mode" t)
-
(defvar tex-start-commands (purecopy "\\nonstopmode\\input") "\
TeX commands to use when starting TeX.
They are shell-quoted and precede the input file name, with a separating space.
If nil, no commands are used. See the documentation of `tex-command'.")
-
(custom-autoload 'tex-start-commands "tex-mode" t)
-
(defvar latex-block-names nil "\
User defined LaTeX block names.
Combined with `latex-standard-block-names' for minibuffer completion.")
-
(custom-autoload 'latex-block-names "tex-mode" t)
-
(defvar tex-bibtex-command (purecopy "bibtex") "\
Command used by `tex-bibtex-file' to gather bibliographic data.
If this string contains an asterisk (`*'), that is replaced by the file name;
otherwise, the file name, preceded by blank, is added at the end.")
-
(custom-autoload 'tex-bibtex-command "tex-mode" t)
-
(defvar tex-dvi-print-command (purecopy "lpr -d") "\
Command used by \\[tex-print] to print a .dvi file.
If this string contains an asterisk (`*'), that is replaced by the file name;
otherwise, the file name, preceded by blank, is added at the end.")
-
(custom-autoload 'tex-dvi-print-command "tex-mode" t)
-
(defvar tex-alt-dvi-print-command (purecopy "lpr -d") "\
Command used by \\[tex-print] with a prefix arg to print a .dvi file.
If this string contains an asterisk (`*'), that is replaced by the file name;
@@ -33588,9 +30518,7 @@ for example,
would tell \\[tex-print] with a prefix argument to ask you which printer to
use.")
-
(custom-autoload 'tex-alt-dvi-print-command "tex-mode" t)
-
(defvar tex-dvi-view-command `(cond ((eq window-system 'x) ,(purecopy "xdvi")) ((eq window-system 'w32) ,(purecopy "yap")) (t ,(purecopy "dvi2tty * | cat -s"))) "\
Command used by \\[tex-view] to display a `.dvi' file.
If it is a string, that specifies the command directly.
@@ -33598,33 +30526,23 @@ If this string contains an asterisk (`*'), that is replaced by the file name;
otherwise, the file name, preceded by a space, is added at the end.
If the value is a form, it is evaluated to get the command to use.")
-
(custom-autoload 'tex-dvi-view-command "tex-mode" t)
-
(defvar tex-show-queue-command (purecopy "lpq") "\
Command used by \\[tex-show-print-queue] to show the print queue.
Should show the queue(s) that \\[tex-print] puts jobs on.")
-
(custom-autoload 'tex-show-queue-command "tex-mode" t)
-
(defvar tex-default-mode #'latex-mode "\
Mode to enter for a new file that might be either TeX or LaTeX.
This variable is used when it can't be determined whether the file
is plain TeX or LaTeX or what because the file contains no commands.
Normally set to either `plain-tex-mode' or `latex-mode'.")
-
(custom-autoload 'tex-default-mode "tex-mode" t)
-
(defvar tex-open-quote (purecopy "``") "\
String inserted by typing \\[tex-insert-quote] to open a quotation.")
-
(custom-autoload 'tex-open-quote "tex-mode" t)
-
(defvar tex-close-quote (purecopy "''") "\
String inserted by typing \\[tex-insert-quote] to close a quotation.")
-
(custom-autoload 'tex-close-quote "tex-mode" t)
-
(autoload 'tex-mode "tex-mode" "\
Major mode for editing files of input for TeX, LaTeX, or SliTeX.
This is the shared parent mode of several submodes.
@@ -33634,14 +30552,10 @@ this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
such as if there are no commands in the file, the value of `tex-default-mode'
says which mode to use.
-\(fn)" t nil)
-
+(fn)" t nil)
(defalias 'TeX-mode #'tex-mode)
-
(defalias 'plain-TeX-mode #'plain-tex-mode)
-
(defalias 'LaTeX-mode #'latex-mode)
-
(autoload 'plain-tex-mode "tex-mode" "\
Major mode for editing files of input for plain TeX.
Makes $ and } display the characters they match.
@@ -33683,8 +30597,7 @@ Entering Plain-tex mode runs the hook `text-mode-hook', then the hook
`tex-mode-hook', and finally the hook `plain-tex-mode-hook'. When the
special subshell is initiated, the hook `tex-shell-hook' is run.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'latex-mode "tex-mode" "\
Major mode for editing files of input for LaTeX.
Makes $ and } display the characters they match.
@@ -33726,8 +30639,7 @@ Entering Latex mode runs the hook `text-mode-hook', then
`tex-mode-hook', and finally `latex-mode-hook'. When the special
subshell is initiated, `tex-shell-hook' is run.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'slitex-mode "tex-mode" "\
Major mode for editing files of input for SliTeX.
Makes $ and } display the characters they match.
@@ -33770,20 +30682,25 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
`slitex-mode-hook'. When the special subshell is initiated, the hook
`tex-shell-hook' is run.
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'tex-start-shell "tex-mode" nil nil nil)
-
(autoload 'doctex-mode "tex-mode" "\
Major mode to edit DocTeX files.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "tex-mode" '("doctex-font-lock-" "latex-" "plain-tex-mode-map" "tex-"))
-;;;***
-;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (0 0 0 0))
+;;; Generated autoloads from cedet/srecode/texi.el
+
+(register-definition-prefixes "srecode/texi" '("semantic-insert-foreign-tag" "srecode-texi-"))
+
+
+;;; Generated autoloads from cedet/semantic/texi.el
+
+(register-definition-prefixes "semantic/texi" '("semantic-"))
+
+
;;; Generated autoloads from textmodes/texinfmt.el
(autoload 'texinfo-format-buffer "texinfmt" "\
@@ -33795,16 +30712,14 @@ Non-nil argument (prefix, if interactive) means don't make tag table
and don't split the file if large. You can use `Info-tagify' and
`Info-split' to do these manually.
-\(fn &optional NOSPLIT)" t nil)
-
+(fn &optional NOSPLIT)" t nil)
(autoload 'texinfo-format-region "texinfmt" "\
Convert the current region of the Texinfo file to Info format.
This lets you see what that part of the file will look like in Info.
The command is bound to \\[texinfo-format-region]. The text that is
converted to Info is stored in a temporary buffer.
-\(fn REGION-BEGINNING REGION-END)" t nil)
-
+(fn REGION-BEGINNING REGION-END)" t nil)
(autoload 'texi2info "texinfmt" "\
Convert the current buffer (written in Texinfo code) into an Info file.
The Info file output is generated in a buffer visiting the Info file
@@ -33818,25 +30733,18 @@ Texinfo source buffer is not changed.
Non-nil argument (prefix, if interactive) means don't split the file
if large. You can use `Info-split' to do this manually.
-\(fn &optional NOSPLIT)" t nil)
-
+(fn &optional NOSPLIT)" t nil)
(register-definition-prefixes "texinfmt" '("batch-texinfo-format" "texinf"))
-;;;***
-;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (0 0 0 0))
;;; Generated autoloads from textmodes/texinfo.el
(defvar texinfo-open-quote (purecopy "``") "\
String inserted by typing \\[texinfo-insert-quote] to open a quotation.")
-
(custom-autoload 'texinfo-open-quote "texinfo" t)
-
(defvar texinfo-close-quote (purecopy "''") "\
String inserted by typing \\[texinfo-insert-quote] to close a quotation.")
-
(custom-autoload 'texinfo-close-quote "texinfo" t)
-
(autoload 'texinfo-mode "texinfo" "\
Major mode for editing Texinfo files.
@@ -33904,22 +30812,63 @@ be the first node in the file.
Entering Texinfo mode calls the value of `text-mode-hook', and then the
value of `texinfo-mode-hook'.
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "texinfo" '("texinfo-"))
-;;;***
-;;;### (autoloads nil "text-property-search" "emacs-lisp/text-property-search.el"
-;;;;;; (0 0 0 0))
+;;; Generated autoloads from textmodes/texnfo-upd.el
+
+(register-definition-prefixes "texnfo-upd" '("texinfo-"))
+
+
;;; Generated autoloads from emacs-lisp/text-property-search.el
(register-definition-prefixes "text-property-search" '("text-property-"))
-;;;***
-;;;### (autoloads nil "thai-util" "language/thai-util.el" (0 0 0
-;;;;;; 0))
+;;; Generated autoloads from international/textsec.el
+
+(register-definition-prefixes "textsec" '("textsec-"))
+
+
+;;; Generated autoloads from international/textsec-check.el
+
+(autoload 'textsec-suspicious-p "textsec-check" "\
+Say whether OBJECT is suspicious for use as TYPE.
+If OBJECT is suspicious, return a string explaining the reason
+for considering it suspicious, otherwise return nil.
+
+Available values of TYPE and corresponding OBJECTs are:
+
+ `url' -- a URL; OBJECT should be a URL string.
+
+ `link' -- an HTML link; OBJECT should be a cons cell
+ of the form (URL . LINK-TEXT).
+
+ `domain' -- a Web domain; OBJECT should be a string.
+
+ `local-address' -- the local part of an email address; OBJECT
+ should be a string.
+ `name' -- the \"display name\" part of an email address;
+ OBJECT should be a string.
+
+`email-address' -- a full email address; OBJECT should be a string.
+
+ `email-address-header' -- a raw email address header in RFC 2822 format;
+ OBJECT should be a string.
+
+If the user option `textsec-check' is nil, these checks are
+disabled, and this function always returns nil.
+
+(fn OBJECT TYPE)" nil nil)
+(register-definition-prefixes "textsec-check" '("textsec-check"))
+
+
+;;; Generated autoloads from leim/quail/thai.el
+
+(register-definition-prefixes "quail/thai" '("thai-generate-quail-map"))
+
+
;;; Generated autoloads from language/thai-util.el
(autoload 'thai-compose-region "thai-util" "\
@@ -33927,49 +30876,39 @@ Compose Thai characters in the region.
When called from a program, expects two arguments,
positions (integers or markers) specifying the region.
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'thai-compose-string "thai-util" "\
Compose Thai characters in STRING and return the resulting string.
-\(fn STRING)" nil nil)
-
+(fn STRING)" nil nil)
(autoload 'thai-compose-buffer "thai-util" "\
Compose Thai characters in the current buffer." t nil)
-
(autoload 'thai-composition-function "thai-util" "\
-\(fn GSTRING DIRECTION)" nil nil)
-
+(fn GSTRING DIRECTION)" nil nil)
(register-definition-prefixes "thai-util" '("exit-thai-language-environment-internal" "setup-thai-language-environment-internal" "thai-"))
-;;;***
-;;;### (autoloads nil "thai-word" "language/thai-word.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from language/thai-word.el
(register-definition-prefixes "thai-word" '("thai-"))
-;;;***
-;;;### (autoloads nil "thingatpt" "thingatpt.el" (0 0 0 0))
;;; Generated autoloads from thingatpt.el
(autoload 'forward-thing "thingatpt" "\
Move forward to the end of the Nth next THING.
THING should be a symbol specifying a type of syntactic entity.
-Possibilities include `symbol', `list', `sexp', `defun',
+Possibilities include `symbol', `list', `sexp', `defun', `number',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'.
-\(fn THING &optional N)" nil nil)
-
+(fn THING &optional N)" nil nil)
(autoload 'bounds-of-thing-at-point "thingatpt" "\
Determine the start and end buffer locations for the THING at point.
THING should be a symbol specifying a type of syntactic entity.
-Possibilities include `symbol', `list', `sexp', `defun',
+Possibilities include `symbol', `list', `sexp', `defun', `number',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'.
@@ -33979,8 +30918,7 @@ valid THING.
Return a cons cell (START . END) giving the start and end
positions of the thing found.
-\(fn THING)" nil nil)
-
+(fn THING)" nil nil)
(autoload 'thing-at-point "thingatpt" "\
Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
@@ -33994,45 +30932,36 @@ strip text properties from the return value.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING.
-\(fn THING &optional NO-PROPERTIES)" nil nil)
-
+(fn THING &optional NO-PROPERTIES)" nil nil)
(autoload 'bounds-of-thing-at-mouse "thingatpt" "\
Determine start and end locations for THING at mouse click given by EVENT.
Like `bounds-of-thing-at-point', but tries to use the position in EVENT
where the mouse button is clicked to find the thing nearby.
-\(fn EVENT THING)" nil nil)
-
+(fn EVENT THING)" nil nil)
(autoload 'thing-at-mouse "thingatpt" "\
Return the THING at mouse click specified by EVENT.
Like `thing-at-point', but tries to use the position in EVENT
where the mouse button is clicked to find the thing nearby.
-\(fn EVENT THING &optional NO-PROPERTIES)" nil nil)
-
+(fn EVENT THING &optional NO-PROPERTIES)" nil nil)
(autoload 'sexp-at-point "thingatpt" "\
Return the sexp at point, or nil if none is found." nil nil)
-
(autoload 'symbol-at-point "thingatpt" "\
Return the symbol at point, or nil if none is found." nil nil)
-
(autoload 'number-at-point "thingatpt" "\
Return the number at point, or nil if none is found.
Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers
like \"0xBEEF09\" or \"#xBEEF09\", are recognized." nil nil)
-
(autoload 'list-at-point "thingatpt" "\
Return the Lisp list at point, or nil if none is found.
If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are
treated as white space.
-\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil)
-
+(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil)
(register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point"))
-;;;***
-;;;### (autoloads nil "thread" "thread.el" (0 0 0 0))
;;; Generated autoloads from thread.el
(autoload 'thread-handle-event "thread" "\
@@ -34040,132 +30969,108 @@ Handle thread events, propagated by `thread-signal'.
An EVENT has the format
(thread-event THREAD ERROR-SYMBOL DATA)
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'list-threads "thread" "\
Display a list of threads." t nil)
(put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.")
-
(register-definition-prefixes "thread" '("thread-list-"))
-;;;***
-;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0))
;;; Generated autoloads from thumbs.el
(autoload 'thumbs-find-thumb "thumbs" "\
Display the thumbnail for IMG.
-\(fn IMG)" t nil)
-
+(fn IMG)" t nil)
(autoload 'thumbs-show-from-dir "thumbs" "\
Make a preview buffer for all images in DIR.
Optional argument REG to select file matching a regexp,
and SAME-WINDOW to show thumbs in the same window.
-\(fn DIR &optional REG SAME-WINDOW)" t nil)
-
+(fn DIR &optional REG SAME-WINDOW)" t nil)
(autoload 'thumbs-dired-show-marked "thumbs" "\
In dired, make a thumbs buffer with marked files." t nil)
-
(autoload 'thumbs-dired-show "thumbs" "\
In dired, make a thumbs buffer with all files in current directory." t nil)
-
(defalias 'thumbs 'thumbs-show-from-dir)
-
(autoload 'thumbs-dired-setroot "thumbs" "\
In dired, call the setroot program on the image at point." t nil)
-
(register-definition-prefixes "thumbs" '("thumbs-"))
-;;;***
-;;;### (autoloads nil "thunk" "emacs-lisp/thunk.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/thunk.el
-(push (purecopy '(thunk 1 0)) package--builtin-versions)
+(push (purecopy '(thunk 1 0)) package--builtin-versions)
(register-definition-prefixes "thunk" '("thunk-"))
-;;;***
-;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from language/tibet-util.el
(autoload 'tibetan-char-p "tibet-util" "\
Check if char CH is Tibetan character.
Returns non-nil if CH is Tibetan. Otherwise, returns nil.
-\(fn CH)" nil nil)
-
+(fn CH)" nil nil)
(autoload 'tibetan-tibetan-to-transcription "tibet-util" "\
Transcribe Tibetan string STR and return the corresponding Roman string.
-\(fn STR)" nil nil)
-
+(fn STR)" nil nil)
(autoload 'tibetan-transcription-to-tibetan "tibet-util" "\
Convert Tibetan Roman string STR to Tibetan character string.
The returned string has no composition information.
-\(fn STR)" nil nil)
-
+(fn STR)" nil nil)
(autoload 'tibetan-compose-string "tibet-util" "\
Compose Tibetan string STR.
-\(fn STR)" nil nil)
-
+(fn STR)" nil nil)
(autoload 'tibetan-compose-region "tibet-util" "\
Compose Tibetan text the region BEG and END.
-\(fn BEG END)" t nil)
-
+(fn BEG END)" t nil)
(autoload 'tibetan-decompose-region "tibet-util" "\
Decompose Tibetan text in the region FROM and TO.
This is different from `decompose-region' because precomposed
Tibetan characters are decomposed into normal Tibetan character
sequences.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'tibetan-decompose-string "tibet-util" "\
Decompose Tibetan string STR.
This is different from `decompose-string' because precomposed
Tibetan characters are decomposed into normal Tibetan character
sequences.
-\(fn STR)" nil nil)
-
+(fn STR)" nil nil)
(autoload 'tibetan-decompose-buffer "tibet-util" "\
Decomposes Tibetan characters in the buffer into their components.
See also the documentation of the function `tibetan-decompose-region'." t nil)
-
(autoload 'tibetan-compose-buffer "tibet-util" "\
Composes Tibetan character components in the buffer.
See also docstring of the function `tibetan-compose-region'." t nil)
-
(autoload 'tibetan-post-read-conversion "tibet-util" "\
-\(fn LEN)" nil nil)
-
+(fn LEN)" nil nil)
(autoload 'tibetan-pre-write-conversion "tibet-util" "\
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(autoload 'tibetan-pre-write-canonicalize-for-unicode "tibet-util" "\
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(register-definition-prefixes "tibet-util" '("tibetan-"))
-;;;***
-;;;### (autoloads nil "tildify" "textmodes/tildify.el" (0 0 0 0))
+;;; Generated autoloads from leim/quail/tibetan.el
+
+(register-definition-prefixes "quail/tibetan" '("quail-tib" "tibetan-"))
+
+
;;; Generated autoloads from textmodes/tildify.el
-(push (purecopy '(tildify 4 6 1)) package--builtin-versions)
+(push (purecopy '(tildify 4 6 1)) package--builtin-versions)
(autoload 'tildify-region "tildify" "\
Add hard spaces in the region between BEG and END.
See variables `tildify-pattern', `tildify-space-string', and
@@ -34175,8 +31080,7 @@ This function performs no refilling of the changed text.
If DONT-ASK is set, or called interactively with prefix argument, user
won't be prompted for confirmation of each substitution.
-\(fn BEG END &optional DONT-ASK)" t nil)
-
+(fn BEG END &optional DONT-ASK)" t nil)
(autoload 'tildify-buffer "tildify" "\
Add hard spaces in the current buffer.
See variables `tildify-pattern', `tildify-space-string', and
@@ -34186,8 +31090,7 @@ This function performs no refilling of the changed text.
If DONT-ASK is set, or called interactively with prefix argument, user
won't be prompted for confirmation of each substitution.
-\(fn &optional DONT-ASK)" t nil)
-
+(fn &optional DONT-ASK)" t nil)
(autoload 'tildify-space "tildify" "\
Convert space before point into a hard space if the context is right.
@@ -34209,24 +31112,9 @@ Otherwise, if
remove the hard space and leave only the space character.
This function is meant to be used as a `post-self-insert-hook'." t nil)
-
(autoload 'tildify-mode "tildify" "\
Adds electric behavior to space character.
-This is a minor mode. If called interactively, toggle the `Tildify
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `tildify-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When space is inserted into a buffer in a position where hard space is required
instead (determined by `tildify-space-pattern' and `tildify-space-predicates'),
that space character is replaced by a hard space specified by
@@ -34236,28 +31124,36 @@ When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space
representation for current major mode, the `tildify-space-string' buffer-local
variable will be set to the representation.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Tildify mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `tildify-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "tildify" '("tildify-"))
-;;;***
-;;;### (autoloads nil "time" "time.el" (0 0 0 0))
;;; Generated autoloads from time.el
(defvar display-time-day-and-date nil "\
Non-nil means \\[display-time] should display day and date as well as time.")
-
(custom-autoload 'display-time-day-and-date "time" t)
(put 'display-time-string 'risky-local-variable t)
-
(autoload 'display-time "time" "\
Enable display of time, load level, and mail flag in mode lines.
This display updates automatically every minute.
If `display-time-day-and-date' is non-nil, the current day and date
are displayed as well.
This runs the normal hook `display-time-hook' after each update." t nil)
-
(defvar display-time-mode nil "\
Non-nil if Display-Time mode is enabled.
See the `display-time-mode' command
@@ -34265,41 +31161,36 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `display-time-mode'.")
-
(custom-autoload 'display-time-mode "time" nil)
-
(autoload 'display-time-mode "time" "\
Toggle display of time, load level, and mail flag in mode lines.
-This is a minor mode. If called interactively, toggle the
-`Display-Time mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='display-time-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When Display Time mode is enabled, it updates every minute (you
can control the number of seconds between updates by customizing
`display-time-interval'). If `display-time-day-and-date' is
non-nil, the current day and date are displayed as well. This
runs the normal hook `display-time-hook' after each update.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Display-Time mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-(define-obsolete-function-alias 'display-time-world #'world-clock "28.1")
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='display-time-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
+(define-obsolete-function-alias 'display-time-world #'world-clock "28.1")
(autoload 'world-clock "time" "\
Display a world clock buffer with times in various time zones.
The variable `world-clock-list' specifies which time zones to use.
To turn off the world time display, go to the window and type `\\[quit-window]'." t nil)
-
(autoload 'emacs-uptime "time" "\
Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
@@ -34307,21 +31198,16 @@ For example, the Unix uptime command format is \"%D, %z%2h:%.2m\".
If the optional argument HERE is non-nil, insert string at
point.
-\(fn &optional FORMAT HERE)" t nil)
-
+(fn &optional FORMAT HERE)" t nil)
(autoload 'emacs-init-time "time" "\
Return a string giving the duration of the Emacs initialization.
FORMAT is a string to format the result, using `format'. If nil,
the default format \"%f seconds\" is used.
-\(fn &optional FORMAT)" t nil)
-
+(fn &optional FORMAT)" t nil)
(register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "time--display-world-list" "world-clock-" "zoneinfo-style-world-list"))
-;;;***
-;;;### (autoloads nil "time-date" "calendar/time-date.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/time-date.el
(autoload 'date-to-time "time-date" "\
@@ -34329,61 +31215,49 @@ Parse a string DATE that represents a date-time and return a time value.
DATE should be in one of the forms recognized by `parse-time-string'.
If DATE lacks timezone information, GMT is assumed.
-\(fn DATE)" nil nil)
-
+(fn DATE)" nil nil)
(defalias 'time-to-seconds 'float-time)
-
(defalias 'seconds-to-time 'time-convert)
-
(autoload 'days-to-time "time-date" "\
Convert DAYS into a time value.
-\(fn DAYS)" nil nil)
-
+(fn DAYS)" nil nil)
(autoload 'time-since "time-date" "\
Return the time elapsed since TIME.
TIME should be either a time value or a date-time string.
-\(fn TIME)" nil nil)
-
+(fn TIME)" nil nil)
(define-obsolete-function-alias 'subtract-time 'time-subtract "26.1")
-
(autoload 'date-to-day "time-date" "\
Return the absolute date of DATE, a date-time string.
The absolute date is the number of days elapsed since the imaginary
Gregorian date Sunday, December 31, 1 BC.
-\(fn DATE)" nil nil)
-
+(fn DATE)" nil nil)
(autoload 'days-between "time-date" "\
Return the number of days between DATE1 and DATE2.
DATE1 and DATE2 should be date-time strings.
-\(fn DATE1 DATE2)" nil nil)
-
+(fn DATE1 DATE2)" nil nil)
(autoload 'date-leap-year-p "time-date" "\
Return t if YEAR is a leap year.
-\(fn YEAR)" nil nil)
-
+(fn YEAR)" nil nil)
(autoload 'time-to-day-in-year "time-date" "\
Return the day number within the year corresponding to TIME.
-\(fn TIME)" nil nil)
-
+(fn TIME)" nil nil)
(autoload 'time-to-days "time-date" "\
The absolute date corresponding to TIME, a time value.
The absolute date is the number of days elapsed since the imaginary
Gregorian date Sunday, December 31, 1 BC.
-\(fn TIME)" nil nil)
-
+(fn TIME)" nil nil)
(autoload 'safe-date-to-time "time-date" "\
Parse a string DATE that represents a date-time and return a time value.
If DATE is malformed, return a time value of zeros.
-\(fn DATE)" nil nil)
-
+(fn DATE)" nil nil)
(autoload 'format-seconds "time-date" "\
Use format control STRING to format the number SECONDS.
The valid format specifiers are:
@@ -34410,34 +31284,33 @@ The \"%z\" specifier does not print anything. When it is used, specifiers
must be given in order of decreasing size. To the left of \"%z\", nothing
is output until the first non-zero unit is encountered.
-\(fn STRING SECONDS)" nil nil)
+The \"%x\" specifier does not print anything. When it is used,
+specifiers must be given in order of decreasing size. To the
+right of \"%x\", trailing zero units are not output.
+(fn STRING SECONDS)" nil nil)
(autoload 'seconds-to-string "time-date" "\
Convert the time interval in seconds to a short string.
-\(fn DELAY)" nil nil)
-
+(fn DELAY)" nil nil)
(register-definition-prefixes "time-date" '("date-" "decoded-time-" "encode-time-value" "seconds-to-string" "time-" "with-decoded-time-value"))
-;;;***
-;;;### (autoloads nil "time-stamp" "time-stamp.el" (0 0 0 0))
;;; Generated autoloads from time-stamp.el
+
(put 'time-stamp-format 'safe-local-variable 'stringp)
(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p)
-
(autoload 'time-stamp-zone-type-p "time-stamp" "\
Return non-nil if ZONE is of the correct type for a timezone rule.
Valid ZONE values are described in the documentation of `format-time-string'.
-\(fn ZONE)" nil nil)
+(fn ZONE)" nil nil)
(put 'time-stamp-line-limit 'safe-local-variable 'integerp)
(put 'time-stamp-start 'safe-local-variable 'stringp)
(put 'time-stamp-end 'safe-local-variable 'stringp)
(put 'time-stamp-inserts-lines 'safe-local-variable 'symbolp)
(put 'time-stamp-count 'safe-local-variable 'integerp)
(put 'time-stamp-pattern 'safe-local-variable 'stringp)
-
(autoload 'time-stamp "time-stamp" "\
Update any time stamp string(s) in the buffer.
This function looks for a time stamp template and updates it with
@@ -34470,19 +31343,14 @@ You can set `time-stamp-pattern' in a file's local variables list
to customize the information in the time stamp and where it is written.
The time stamp is updated only if `time-stamp-active' is non-nil." t nil)
-
(autoload 'time-stamp-toggle-active "time-stamp" "\
Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
With ARG, turn time stamping on if and only if ARG is positive.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(register-definition-prefixes "time-stamp" '("time-stamp-"))
-;;;***
-;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/timeclock.el
(defvar timeclock-mode-line-display nil "\
@@ -34492,9 +31360,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `timeclock-mode-line-display'.")
-
(custom-autoload 'timeclock-mode-line-display "timeclock" nil)
-
(autoload 'timeclock-mode-line-display "timeclock" "\
Toggle display of the amount of time left today in the mode line.
If `timeclock-use-display-time' is non-nil (the default), then
@@ -34508,13 +31374,12 @@ display (non-nil means on).
If using a customized `timeclock-workday' value, this should be
set before switching this mode on.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'timeclock-in "timeclock" "\
Clock in, recording the current time moment in the timelog.
With a numeric prefix ARG, record the fact that today has only that
many hours in it to be worked. If ARG is a non-numeric prefix argument
-\(non-nil, but not a number), 0 is assumed (working on a holiday or
+(non-nil, but not a number), 0 is assumed (working on a holiday or
weekend). *If not called interactively, ARG should be the number of
_seconds_ worked today*. This feature only has effect the first time
this function is called within a day.
@@ -34524,8 +31389,7 @@ FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
interactively -- call the function `timeclock-get-project-function' to
discover the name of the project.
-\(fn &optional ARG PROJECT FIND-PROJECT)" t nil)
-
+(fn &optional ARG PROJECT FIND-PROJECT)" t nil)
(autoload 'timeclock-out "timeclock" "\
Clock out, recording the current time moment in the timelog.
If a prefix ARG is given, the user has completed the project that was
@@ -34536,16 +31400,14 @@ FIND-REASON is non-nil -- or the user calls `timeclock-out'
interactively -- call the function `timeclock-get-reason-function' to
discover the reason.
-\(fn &optional ARG REASON FIND-REASON)" t nil)
-
+(fn &optional ARG REASON FIND-REASON)" t nil)
(autoload 'timeclock-status-string "timeclock" "\
Report the overall timeclock status at the present moment.
If SHOW-SECONDS is non-nil, display second resolution.
If TODAY-ONLY is non-nil, the display will be relative only to time
worked today, ignoring the time worked on previous days.
-\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
-
+(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
(autoload 'timeclock-change "timeclock" "\
Change to working on a different project.
This clocks out of the current project, then clocks in on a new one.
@@ -34553,16 +31415,13 @@ With a prefix ARG, consider the previous project as finished at the
time of changeover. PROJECT is the name of the last project you were
working on.
-\(fn &optional ARG PROJECT)" t nil)
-
+(fn &optional ARG PROJECT)" t nil)
(autoload 'timeclock-query-out "timeclock" "\
Ask the user whether to clock out.
This is a useful function for adding to `kill-emacs-query-functions'." nil nil)
-
(autoload 'timeclock-reread-log "timeclock" "\
Re-read the timeclock, to account for external changes.
Returns the new value of `timeclock-discrepancy'." t nil)
-
(autoload 'timeclock-workday-remaining-string "timeclock" "\
Return a string representing the amount of time left today.
Display second resolution if SHOW-SECONDS is non-nil. If TODAY-ONLY
@@ -34570,15 +31429,13 @@ is non-nil, the display will be relative only to time worked today.
See `timeclock-relative' for more information about the meaning of
\"relative to today\".
-\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
-
+(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
(autoload 'timeclock-workday-elapsed-string "timeclock" "\
Return a string representing the amount of time worked today.
Display seconds resolution if SHOW-SECONDS is non-nil. If RELATIVE is
non-nil, the amount returned will be relative to past time worked.
-\(fn &optional SHOW-SECONDS)" t nil)
-
+(fn &optional SHOW-SECONDS)" t nil)
(autoload 'timeclock-when-to-leave-string "timeclock" "\
Return a string representing the end of today's workday.
This string is relative to the value of `timeclock-workday'. If
@@ -34586,35 +31443,25 @@ SHOW-SECONDS is non-nil, the value printed/returned will include
seconds. If TODAY-ONLY is non-nil, the value returned will be
relative only to the time worked today, and not to past time.
-\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
-
+(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
(register-definition-prefixes "timeclock" '("timeclock-"))
-;;;***
-;;;### (autoloads nil "timer-list" "emacs-lisp/timer-list.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/timer-list.el
(autoload 'list-timers "timer-list" "\
List all timers in a buffer.
-\(fn &optional IGNORE-AUTO NONCONFIRM)" t nil)
+(fn &optional IGNORE-AUTO NONCONFIRM)" t nil)
(put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
-
(register-definition-prefixes "timer-list" '("timer-list-"))
-;;;***
-;;;### (autoloads nil "timezone" "timezone.el" (0 0 0 0))
;;; Generated autoloads from timezone.el
(register-definition-prefixes "timezone" '("timezone-"))
-;;;***
-;;;### (autoloads nil "titdic-cnv" "international/titdic-cnv.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from international/titdic-cnv.el
(autoload 'titdic-convert "titdic-cnv" "\
@@ -34622,8 +31469,7 @@ Convert a TIT dictionary of FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved.
-\(fn FILENAME &optional DIRNAME)" t nil)
-
+(fn FILENAME &optional DIRNAME)" t nil)
(autoload 'batch-titdic-convert "titdic-cnv" "\
Run `titdic-convert' on the files remaining on the command line.
Use this from the command line, with `-batch';
@@ -34632,16 +31478,13 @@ For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
-\(fn &optional FORCE)" nil nil)
-
+(fn &optional FORCE)" nil nil)
(register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter"))
-;;;***
-;;;### (autoloads nil "tmm" "tmm.el" (0 0 0 0))
;;; Generated autoloads from tmm.el
- (define-key global-map "\M-`" 'tmm-menubar)
+ (define-key global-map "\M-`" 'tmm-menubar)
(autoload 'tmm-menubar "tmm" "\
Text-mode emulation of looking and choosing from a menubar.
See the documentation for `tmm-prompt'.
@@ -34652,16 +31495,14 @@ Note that \\[menu-bar-open] by default drops down TTY menus; if you want it
to invoke `tmm-menubar' instead, customize the variable
`tty-menu-open-use-tmm' to a non-nil value.
-\(fn &optional X-POSITION)" t nil)
-
+(fn &optional X-POSITION)" t nil)
(autoload 'tmm-menubar-mouse "tmm" "\
Text-mode emulation of looking and choosing from a menubar.
This command is used when you click the mouse in the menubar
on a console which has no window system but does have a mouse.
See the documentation for `tmm-prompt'.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'tmm-prompt "tmm" "\
Text-mode emulation of calling the bindings in keymap.
Creates a text-mode menu of possible choices. You can access the elements
@@ -34677,14 +31518,10 @@ Its value should be an event that has a binding in MENU.
NO-EXECUTE, if non-nil, means to return the command the user selects
instead of executing it.
-\(fn MENU &optional IN-POPUP DEFAULT-ITEM NO-EXECUTE)" nil nil)
-
+(fn MENU &optional IN-POPUP DEFAULT-ITEM NO-EXECUTE)" nil nil)
(register-definition-prefixes "tmm" '("tmm-"))
-;;;***
-;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from calendar/todo-mode.el
(autoload 'todo-show "todo-mode" "\
@@ -34724,42 +31561,35 @@ by default. The done items are hidden, but typing
items. With non-nil user option `todo-show-with-done' both todo
and done items are always shown on visiting a category.
-\(fn &optional SOLICIT-FILE INTERACTIVE)" t nil)
-
+(fn &optional SOLICIT-FILE INTERACTIVE)" t nil)
(autoload 'todo-mode "todo-mode" "\
Major mode for displaying, navigating and editing todo lists.
\\{todo-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'todo-archive-mode "todo-mode" "\
Major mode for archived todo categories.
\\{todo-archive-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(autoload 'todo-filtered-items-mode "todo-mode" "\
Mode for displaying and reprioritizing top priority Todo.
\\{todo-filtered-items-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "todo-mode" '("todo-"))
-;;;***
-;;;### (autoloads nil "tool-bar" "tool-bar.el" (0 0 0 0))
;;; Generated autoloads from tool-bar.el
(autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\
Toggle tool bar on or off, based on the status of the current frame.
See `tool-bar-mode' for more information.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'tool-bar-add-item "tool-bar" "\
Add an item to the tool bar.
ICON names the image, DEF is the key definition and KEY is a symbol
@@ -34775,8 +31605,7 @@ ICON.xbm, using `find-image'.
Use this function only to make bindings in the global value of `tool-bar-map'.
To define items in any other map, use `tool-bar-local-item'.
-\(fn ICON DEF KEY &rest PROPS)" nil nil)
-
+(fn ICON DEF KEY &rest PROPS)" nil nil)
(autoload 'tool-bar-local-item "tool-bar" "\
Add an item to the tool bar in map MAP.
ICON names the image, DEF is the key definition and KEY is a symbol
@@ -34789,8 +31618,7 @@ function will first try to use low-color/ICON.xpm if `display-color-cells'
is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
ICON.xbm, using `find-image'.
-\(fn ICON DEF KEY MAP &rest PROPS)" nil nil)
-
+(fn ICON DEF KEY MAP &rest PROPS)" nil nil)
(autoload 'tool-bar-add-item-from-menu "tool-bar" "\
Define tool bar binding for COMMAND in keymap MAP using the given ICON.
This makes a binding for COMMAND in `tool-bar-map', copying its
@@ -34804,8 +31632,7 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
Use this function only to make bindings in the global value of `tool-bar-map'.
To define items in any other map, use `tool-bar-local-item-from-menu'.
-\(fn COMMAND ICON &optional MAP &rest PROPS)" nil nil)
-
+(fn COMMAND ICON &optional MAP &rest PROPS)" nil nil)
(autoload 'tool-bar-local-item-from-menu "tool-bar" "\
Define local tool bar binding for COMMAND using the given ICON.
This makes a binding for COMMAND in IN-MAP, copying its binding from
@@ -34817,20 +31644,15 @@ properties to add to the binding.
FROM-MAP must contain appropriate binding for `[menu-bar]' which
holds a keymap.
-\(fn COMMAND ICON IN-MAP &optional FROM-MAP &rest PROPS)" nil nil)
-
-(register-definition-prefixes "tool-bar" '("tool-bar-"))
+(fn COMMAND ICON IN-MAP &optional FROM-MAP &rest PROPS)" nil nil)
+(register-definition-prefixes "tool-bar" '("toggle-tool-bar-mode-from-frame" "tool-bar-"))
-;;;***
-;;;### (autoloads nil "tooltip" "tooltip.el" (0 0 0 0))
;;; Generated autoloads from tooltip.el
(register-definition-prefixes "tooltip" '("tooltip-"))
-;;;***
-;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/tq.el
(autoload 'tq-create "tq" "\
@@ -34839,26 +31661,20 @@ PROCESS should be a subprocess capable of sending and receiving
streams of bytes. It may be a local process, or it may be connected
to a tcp server on another machine.
-\(fn PROCESS)" nil nil)
-
+(fn PROCESS)" nil nil)
(register-definition-prefixes "tq" '("tq-"))
-;;;***
-;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/trace.el
(defvar trace-buffer "*trace-output*" "\
Trace output will by default go to that buffer.")
-
(custom-autoload 'trace-buffer "trace" t)
-
(autoload 'trace-values "trace" "\
Helper function to get internal values.
You can call this function to add internal values in the trace buffer.
-\(fn &rest VALUES)" nil nil)
-
+(fn &rest VALUES)" nil nil)
(autoload 'trace-function-foreground "trace" "\
Trace calls to function FUNCTION.
With a prefix argument, also prompt for the trace buffer (default
@@ -34879,220 +31695,155 @@ stuff - use `trace-function-background' instead.
To stop tracing a function, use `untrace-function' or `untrace-all'.
-\(fn FUNCTION &optional BUFFER CONTEXT)" t nil)
-
+(fn FUNCTION &optional BUFFER CONTEXT)" t nil)
(autoload 'trace-function-background "trace" "\
Trace calls to function FUNCTION, quietly.
This is like `trace-function-foreground', but without popping up
the output buffer or changing the window configuration.
-\(fn FUNCTION &optional BUFFER CONTEXT)" t nil)
-
+(fn FUNCTION &optional BUFFER CONTEXT)" t nil)
(defalias 'trace-function 'trace-function-foreground)
-
(register-definition-prefixes "trace" '("inhibit-trace" "trace-" "untrace-"))
-;;;***
-;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp.el
+
(when (featurep 'tramp-compat)
(load "tramp-compat" 'noerror 'nomessage))
-
(defvar tramp-mode t "\
Whether Tramp is enabled.
If it is set to nil, all remote file names are used literally.")
-
(custom-autoload 'tramp-mode "tramp" t)
-
(defconst tramp-initial-file-name-regexp "\\`/[^/:]+:[^/:]*:" "\
Value for `tramp-file-name-regexp' for autoload.
It must match the initial `tramp-syntax' settings.")
-
(defvar tramp-file-name-regexp tramp-initial-file-name-regexp "\
Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file
names. When calling `tramp-register-file-name-handlers', the
initial value is overwritten by the car of `tramp-file-name-structure'.")
-
(defvar tramp-ignored-file-name-regexp nil "\
Regular expression matching file names that are not under Tramp's control.")
-
(custom-autoload 'tramp-ignored-file-name-regexp "tramp" t)
-
(defconst tramp-autoload-file-name-regexp (concat "\\`/" (if (memq system-type '(cygwin windows-nt)) "\\(-\\|[^/|:]\\{2,\\}\\)" "[^/|:]+") ":") "\
Regular expression matching file names handled by Tramp autoload.
It must match the initial `tramp-syntax' settings. It should not
match file names at root of the underlying local file system,
like \"/sys\" or \"/C:\".")
-
(defun tramp-autoload-file-name-handler (operation &rest args) "\
Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (when (bound-and-true-p tramp-archive-autoload) (load "tramp-archive" 'noerror 'nomessage)) (load "tramp" 'noerror 'nomessage))) (apply operation args))
-
(defun tramp-register-autoload-file-name-handlers nil "\
Add Tramp file name handlers to `file-name-handler-alist' during autoload." (unless (rassq #'tramp-file-name-handler file-name-handler-alist) (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t)))
(tramp-register-autoload-file-name-handlers)
-
(defun tramp-unload-file-name-handlers nil "\
Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh file-name-handler-alist) (when (and (symbolp (cdr fnh)) (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) (setq file-name-handler-alist (delq fnh file-name-handler-alist)))))
-
(defun tramp-unload-tramp nil "\
Discard Tramp from loading remote files." (interactive) (ignore-errors (unload-feature 'tramp 'force)))
-
(register-definition-prefixes "tramp" '("tramp-" "with-"))
-;;;***
-;;;### (autoloads nil "tramp-adb" "net/tramp-adb.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-adb.el
(register-definition-prefixes "tramp-adb" '("tramp-"))
-;;;***
-;;;### (autoloads nil "tramp-archive" "net/tramp-archive.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from net/tramp-archive.el
(defvar tramp-archive-enabled (featurep 'dbusbind) "\
Non-nil when file archive support is available.")
-
-(defconst tramp-archive-suffixes '("7z" "apk" "ar" "cab" "CAB" "cpio" "deb" "depot" "exe" "iso" "jar" "lzh" "LZH" "msu" "MSU" "mtree" "odb" "odf" "odg" "odp" "ods" "odt" "pax" "rar" "rpm" "shar" "tar" "tbz" "tgz" "tlz" "txz" "tzst" "warc" "xar" "xpi" "xps" "zip" "ZIP") "\
+(defconst tramp-archive-suffixes '("7z" "apk" "ar" "cab" "CAB" "cpio" "crate" "deb" "depot" "epub" "exe" "iso" "jar" "lzh" "LZH" "msu" "MSU" "mtree" "odb" "odf" "odg" "odp" "ods" "odt" "pax" "rar" "rpm" "shar" "tar" "tbz" "tgz" "tlz" "txz" "tzst" "warc" "xar" "xpi" "xps" "zip" "ZIP") "\
List of suffixes which indicate a file archive.
It must be supported by libarchive(3).")
-
(defconst tramp-archive-compression-suffixes '("bz2" "gz" "lrz" "lz" "lz4" "lzma" "lzo" "uu" "xz" "Z" "zst") "\
List of suffixes which indicate a compressed file.
It must be supported by libarchive(3).")
-
(defmacro tramp-archive-autoload-file-name-regexp nil "\
Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'"))
-
(defun tramp-archive-autoload-file-name-handler (operation &rest args) "\
Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) (let ((default-directory temporary-file-directory) (tramp-archive-autoload tramp-archive-enabled)) (apply #'tramp-autoload-file-name-handler operation args)))
-
(defun tramp-register-archive-file-name-handler nil "\
Add archive file name handler to `file-name-handler-alist'." (when (and tramp-archive-enabled (not (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t)))
-
(add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
-
(add-hook 'tramp-archive-unload-hook (lambda nil (remove-hook 'after-init-hook #'tramp-register-archive-file-name-handler)))
-
(register-definition-prefixes "tramp-archive" '("tramp-" "with-parsed-tramp-archive-file-name"))
-;;;***
-;;;### (autoloads nil "tramp-cache" "net/tramp-cache.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-cache.el
(register-definition-prefixes "tramp-cache" '("tramp-"))
-;;;***
-;;;### (autoloads nil "tramp-cmds" "net/tramp-cmds.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-cmds.el
(register-definition-prefixes "tramp-cmds" '("tramp-"))
-;;;***
-;;;### (autoloads nil "tramp-compat" "net/tramp-compat.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from net/tramp-compat.el
(register-definition-prefixes "tramp-compat" '("tramp-"))
-;;;***
-;;;### (autoloads nil "tramp-crypt" "net/tramp-crypt.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-crypt.el
(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
-;;;***
-;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-ftp.el
(register-definition-prefixes "tramp-ftp" '("tramp-"))
-;;;***
-;;;### (autoloads nil "tramp-fuse" "net/tramp-fuse.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-fuse.el
(register-definition-prefixes "tramp-fuse" '("tramp-fuse-"))
-;;;***
-;;;### (autoloads nil "tramp-gvfs" "net/tramp-gvfs.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-gvfs.el
(register-definition-prefixes "tramp-gvfs" '("tramp-" "with-tramp-dbus-"))
-;;;***
-;;;### (autoloads nil "tramp-integration" "net/tramp-integration.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from net/tramp-integration.el
(register-definition-prefixes "tramp-integration" '("tramp-"))
-;;;***
-;;;### (autoloads nil "tramp-rclone" "net/tramp-rclone.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from net/tramp-rclone.el
(register-definition-prefixes "tramp-rclone" '("tramp-rclone-"))
-;;;***
-;;;### (autoloads nil "tramp-sh" "net/tramp-sh.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-sh.el
(register-definition-prefixes "tramp-sh" '("tramp-"))
-;;;***
-;;;### (autoloads nil "tramp-smb" "net/tramp-smb.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-smb.el
(register-definition-prefixes "tramp-smb" '("tramp-smb-"))
-;;;***
-;;;### (autoloads nil "tramp-sshfs" "net/tramp-sshfs.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-sshfs.el
(register-definition-prefixes "tramp-sshfs" '("tramp-sshfs-"))
-;;;***
-;;;### (autoloads nil "tramp-sudoedit" "net/tramp-sudoedit.el" (0
-;;;;;; 0 0 0))
;;; Generated autoloads from net/tramp-sudoedit.el
(register-definition-prefixes "tramp-sudoedit" '("tramp-sudoedit-"))
-;;;***
-;;;### (autoloads nil "tramp-uu" "net/tramp-uu.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-uu.el
(register-definition-prefixes "tramp-uu" '("tramp-uu"))
-;;;***
-;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 5 3)) package--builtin-versions)
+(push (purecopy '(tramp 2 6 0 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
-;;;***
-;;;### (autoloads nil "transient" "transient.el" (0 0 0 0))
;;; Generated autoloads from transient.el
(autoload 'transient-insert-suffix "transient" "\
@@ -35105,10 +31856,8 @@ LOC is a command, a key vector, a key description (a string
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
-\(fn PREFIX LOC SUFFIX)" nil nil)
-
+(fn PREFIX LOC SUFFIX)" nil nil)
(function-put 'transient-insert-suffix 'lisp-indent-function 'defun)
-
(autoload 'transient-append-suffix "transient" "\
Insert a SUFFIX into PREFIX after LOC.
PREFIX is a prefix command, a symbol.
@@ -35119,10 +31868,8 @@ LOC is a command, a key vector, a key description (a string
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
-\(fn PREFIX LOC SUFFIX)" nil nil)
-
+(fn PREFIX LOC SUFFIX)" nil nil)
(function-put 'transient-append-suffix 'lisp-indent-function 'defun)
-
(autoload 'transient-replace-suffix "transient" "\
Replace the suffix at LOC in PREFIX with SUFFIX.
PREFIX is a prefix command, a symbol.
@@ -35133,10 +31880,8 @@ LOC is a command, a key vector, a key description (a string
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
-\(fn PREFIX LOC SUFFIX)" nil nil)
-
+(fn PREFIX LOC SUFFIX)" nil nil)
(function-put 'transient-replace-suffix 'lisp-indent-function 'defun)
-
(autoload 'transient-remove-suffix "transient" "\
Remove the suffix or group at LOC in PREFIX.
PREFIX is a prefix command, a symbol.
@@ -35145,22 +31890,16 @@ LOC is a command, a key vector, a key description (a string
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
-\(fn PREFIX LOC)" nil nil)
-
+(fn PREFIX LOC)" nil nil)
(function-put 'transient-remove-suffix 'lisp-indent-function 'defun)
-
(register-definition-prefixes "transient" '("magit--fit-window-to-buffer" "transient-"))
-;;;***
-;;;### (autoloads nil "tree-widget" "tree-widget.el" (0 0 0 0))
;;; Generated autoloads from tree-widget.el
(register-definition-prefixes "tree-widget" '("tree-widget-"))
-;;;***
-;;;### (autoloads nil "tutorial" "tutorial.el" (0 0 0 0))
;;; Generated autoloads from tutorial.el
(autoload 'help-with-tutorial "tutorial" "\
@@ -35180,31 +31919,24 @@ When the tutorial buffer is killed the content and the point
position in the buffer is saved so that the tutorial may be
resumed later.
-\(fn &optional ARG DONT-ASK-FOR-REVERT)" t nil)
-
+(fn &optional ARG DONT-ASK-FOR-REVERT)" t nil)
(register-definition-prefixes "tutorial" '("get-lang-string" "lang-strings" "tutorial--"))
-;;;***
-;;;### (autoloads nil "tv-util" "language/tv-util.el" (0 0 0 0))
;;; Generated autoloads from language/tv-util.el
(autoload 'tai-viet-composition-function "tv-util" "\
-\(fn FROM TO FONT-OBJECT STRING DIRECTION)" nil nil)
-
+(fn FROM TO FONT-OBJECT STRING DIRECTION)" nil nil)
(register-definition-prefixes "tv-util" '("tai-viet-"))
-;;;***
-;;;### (autoloads nil "two-column" "textmodes/two-column.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from textmodes/two-column.el
+
(autoload '2C-command "two-column" () t 'keymap)
(global-set-key "\C-x6" #'2C-command)
(global-set-key [f2] #'2C-command)
-
(autoload '2C-two-columns "two-column" "\
Split current window vertically for two-column editing.
\\<global-map>When called the first time, associates a buffer with the current
@@ -35213,17 +31945,15 @@ for details.). It runs `2C-other-buffer-hook' in the new buffer.
When called again, restores the screen layout with the current buffer
first and the associated buffer to its right.
-\(fn &optional BUFFER)" t nil)
-
+(fn &optional BUFFER)" t nil)
(autoload '2C-associate-buffer "two-column" "\
Associate another BUFFER with this one in two-column minor mode.
Can also be used to associate a just previously visited file, by
accepting the proposed default buffer.
-\(See \\[describe-mode] .)
-
-\(fn BUFFER)" t nil)
+(See \\[describe-mode] .)
+(fn BUFFER)" t nil)
(autoload '2C-split "two-column" "\
Split a two-column text at point, into two buffers in two-column minor mode.
Point becomes the local value of `2C-window-width'. Only lines that
@@ -35240,15 +31970,12 @@ First column's text sSs Second column's text
/ \\
5 character Separator You type M-5 \\[2C-split] with the point here.
-\(See \\[describe-mode] .)
-
-\(fn ARG)" t nil)
+(See \\[describe-mode] .)
+(fn ARG)" t nil)
(register-definition-prefixes "two-column" '("2C-"))
-;;;***
-;;;### (autoloads nil "type-break" "type-break.el" (0 0 0 0))
;;; Generated autoloads from type-break.el
(defvar type-break-mode nil "\
@@ -35258,26 +31985,11 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `type-break-mode'.")
-
(custom-autoload 'type-break-mode "type-break" nil)
-
(autoload 'type-break-mode "type-break" "\
Enable or disable typing-break mode.
-This is a minor mode, but it is global to all buffers by default.
-
-This is a minor mode. If called interactively, toggle the `Type-Break
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='type-break-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+This is a minor mode, but it is global to all buffers by default.
When this mode is enabled, the user is encouraged to take typing breaks at
appropriate intervals; either after a specified amount of time or when the
@@ -35346,8 +32058,21 @@ across Emacs sessions. This provides recovery of the break status between
sessions and after a crash. Manual changes to the file may result in
problems.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Type-Break mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='type-break-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'type-break "type-break" "\
Take a typing break.
@@ -35356,12 +32081,10 @@ During the break, a demo selected from the functions listed in
After the typing break is finished, the next break is scheduled
as per the function `type-break-schedule'." t nil)
-
(autoload 'type-break-statistics "type-break" "\
Print statistics about typing breaks in a temporary buffer.
This includes the last time a typing break was taken, when the next one is
scheduled, the keystroke thresholds and the current keystroke count, etc." t nil)
-
(autoload 'type-break-guesstimate-keystroke-threshold "type-break" "\
Guess values for the minimum/maximum keystroke threshold for typing breaks.
@@ -35384,97 +32107,33 @@ fraction of the maximum threshold to which to set the minimum threshold.
FRAC should be the inverse of the fractional value; for example, a value of
2 would mean to use one half, a value of 4 would mean to use one quarter, etc.
-\(fn WPM &optional WORDLEN FRAC)" t nil)
-
+(fn WPM &optional WORDLEN FRAC)" t nil)
(register-definition-prefixes "type-break" '("timep" "type-break-"))
-;;;***
-
-;;;### (autoloads nil "uce" "mail/uce.el" (0 0 0 0))
-;;; Generated autoloads from mail/uce.el
-
-(autoload 'uce-reply-to-uce "uce" "\
-Compose a reply to unsolicited commercial email (UCE).
-Sets up a reply buffer addressed to: the sender, his postmaster,
-his abuse@ address, and the postmaster of the mail relay used.
-You might need to set `uce-mail-reader' before using this.
-
-\(fn &optional IGNORED)" t nil)
-
-(register-definition-prefixes "uce" '("uce-"))
-
-;;;***
-;;;### (autoloads nil "ucs-normalize" "international/ucs-normalize.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from international/ucs-normalize.el
-(autoload 'ucs-normalize-NFD-region "ucs-normalize" "\
-Normalize the current region by the Unicode NFD.
-
-\(fn FROM TO)" t nil)
-
-(autoload 'ucs-normalize-NFD-string "ucs-normalize" "\
-Normalize the string STR by the Unicode NFD.
-
-\(fn STR)" nil nil)
-
-(autoload 'ucs-normalize-NFC-region "ucs-normalize" "\
-Normalize the current region by the Unicode NFC.
-
-\(fn FROM TO)" t nil)
-
-(autoload 'ucs-normalize-NFC-string "ucs-normalize" "\
-Normalize the string STR by the Unicode NFC.
-
-\(fn STR)" nil nil)
-
-(autoload 'ucs-normalize-NFKD-region "ucs-normalize" "\
-Normalize the current region by the Unicode NFKD.
-
-\(fn FROM TO)" t nil)
-
-(autoload 'ucs-normalize-NFKD-string "ucs-normalize" "\
-Normalize the string STR by the Unicode NFKD.
-
-\(fn STR)" nil nil)
-
-(autoload 'ucs-normalize-NFKC-region "ucs-normalize" "\
-Normalize the current region by the Unicode NFKC.
-
-\(fn FROM TO)" t nil)
-
-(autoload 'ucs-normalize-NFKC-string "ucs-normalize" "\
-Normalize the string STR by the Unicode NFKC.
-
-\(fn STR)" nil nil)
-
-(autoload 'ucs-normalize-HFS-NFD-region "ucs-normalize" "\
-Normalize the current region by the Unicode NFD and Mac OS's HFS Plus.
-
-\(fn FROM TO)" t nil)
-
-(autoload 'ucs-normalize-HFS-NFD-string "ucs-normalize" "\
-Normalize the string STR by the Unicode NFD and Mac OS's HFS Plus.
-
-\(fn STR)" nil nil)
-
-(autoload 'ucs-normalize-HFS-NFC-region "ucs-normalize" "\
-Normalize the current region by the Unicode NFC and Mac OS's HFS Plus.
+(autoload 'string-glyph-compose "ucs-normalize" "\
+Compose STRING according to the Unicode NFC.
+This returns a new string obtained by canonical decomposition
+of STRING (see `ucs-normalize-NFC-string') followed by canonical
+composition, a.k.a. the \"Unicode Normalization Form C\" of STRING.
+For instance:
-\(fn FROM TO)" t nil)
+ (string-glyph-compose \"Å\") => \"Å\"
-(autoload 'ucs-normalize-HFS-NFC-string "ucs-normalize" "\
-Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus.
+(fn STRING)" nil nil)
+(autoload 'string-glyph-decompose "ucs-normalize" "\
+Decompose STRING according to the Unicode NFD.
+This returns a new string that is the canonical decomposition of STRING,
+a.k.a. the \"Unicode Normalization Form D\" of STRING. For instance:
-\(fn STR)" nil nil)
+ (ucs-normalize-NFD-string \"Å\") => \"Å\"
+(fn STRING)" nil nil)
(register-definition-prefixes "ucs-normalize" '("ucs-normalize-" "utf-8-hfs"))
-;;;***
-;;;### (autoloads nil "underline" "textmodes/underline.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from textmodes/underline.el
(autoload 'underline-region "underline" "\
@@ -35483,18 +32142,33 @@ Works by overstriking underscores.
Called from program, takes two arguments START and END
which specify the range to operate on.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'ununderline-region "underline" "\
Remove all underlining (overstruck underscores) in the region.
Called from program, takes two arguments START and END
which specify the range to operate on.
-\(fn START END)" t nil)
+(fn START END)" t nil)
+
+
+;;; Generated autoloads from mail/undigest.el
+
+(register-definition-prefixes "undigest" '("rmail-"))
+
+
+;;; Generated autoloads from leim/quail/uni-input.el
+
+(autoload 'ucs-input-activate "quail/uni-input" "\
+Activate UCS input method.
+With ARG, activate UCS input method if and only if ARG is positive.
+
+While this input method is active, the variable
+`input-method-function' is bound to the function `ucs-input-method'.
+
+(fn &optional ARG)" nil nil)
+(register-definition-prefixes "quail/uni-input" '("ucs-input-"))
-;;;***
-;;;### (autoloads nil "unrmail" "mail/unrmail.el" (0 0 0 0))
;;; Generated autoloads from mail/unrmail.el
(autoload 'batch-unrmail "unrmail" "\
@@ -35503,18 +32177,14 @@ Specify the input Rmail Babyl file names as command line arguments.
For each Rmail file, the corresponding output file name
is made by adding `.mail' at the end.
For example, invoke `emacs -batch -f batch-unrmail RMAIL'." nil nil)
-
(autoload 'unrmail "unrmail" "\
Convert old-style Rmail Babyl file FILE to mbox format file TO-FILE.
The variable `unrmail-mbox-format' controls which mbox format to use.
-\(fn FILE TO-FILE)" t nil)
-
+(fn FILE TO-FILE)" t nil)
(register-definition-prefixes "unrmail" '("unrmail-mbox-format"))
-;;;***
-;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/unsafep.el
(autoload 'unsafep "unsafep" "\
@@ -35522,13 +32192,10 @@ Return nil if evaluating FORM couldn't possibly do any harm.
Otherwise result is a reason why FORM is unsafe.
VARS is a list of symbols with local bindings like `unsafep-vars'.
-\(fn FORM &optional VARS)" nil nil)
-
+(fn FORM &optional VARS)" nil nil)
(register-definition-prefixes "unsafep" '("safe-functions" "unsafep-"))
-;;;***
-;;;### (autoloads nil "url" "url/url.el" (0 0 0 0))
;;; Generated autoloads from url/url.el
(autoload 'url-retrieve "url" "\
@@ -35544,9 +32211,9 @@ STATUS is a plist representing what happened during the request,
with most recent events first, or an empty list if no events have
occurred. Each pair is one of:
-\(:redirect REDIRECTED-TO) - the request was redirected to this URL.
+(:redirect REDIRECTED-TO) - the request was redirected to this URL.
-\(:error (error type . DATA)) - an error occurred. TYPE is a
+(:error (error type . DATA)) - an error occurred. TYPE is a
symbol that says something about where the error occurred, and
DATA is a list (possibly nil) that describes the error further.
@@ -35565,8 +32232,7 @@ the server.
If URL is a multibyte string, it will be encoded as utf-8 and
URL-encoded before it's used.
-\(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
-
+(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
(autoload 'url-retrieve-synchronously "url" "\
Retrieve URL synchronously.
Return the buffer containing the data, or nil if there are no data
@@ -35578,20 +32244,15 @@ If INHIBIT-COOKIES is non-nil, refuse to store cookies. If
TIMEOUT is passed, it should be a number that says (in seconds)
how long to wait for a response before giving up.
-\(fn URL &optional SILENT INHIBIT-COOKIES TIMEOUT)" nil nil)
-
+(fn URL &optional SILENT INHIBIT-COOKIES TIMEOUT)" nil nil)
(register-definition-prefixes "url" '("url-"))
-;;;***
-;;;### (autoloads nil "url-about" "url/url-about.el" (0 0 0 0))
;;; Generated autoloads from url/url-about.el
(register-definition-prefixes "url-about" '("url-"))
-;;;***
-;;;### (autoloads nil "url-auth" "url/url-auth.el" (0 0 0 0))
;;; Generated autoloads from url/url-auth.el
(autoload 'url-get-authentication "url-auth" "\
@@ -35613,8 +32274,7 @@ TYPE is the type of authentication to be returned. This is either a string
PROMPT is boolean - specifies whether to ask the user for a username/password
if one cannot be found in the cache
-\(fn URL REALM TYPE PROMPT &optional ARGS)" nil nil)
-
+(fn URL REALM TYPE PROMPT &optional ARGS)" nil nil)
(autoload 'url-register-auth-scheme "url-auth" "\
Register an HTTP authentication method.
@@ -35627,63 +32287,49 @@ RATING a rating between 1 and 10 of the strength of the authentication.
This is used when asking for the best authentication for a specific
URL. The item with the highest rating is returned.
-\(fn TYPE &optional FUNCTION RATING)" nil nil)
-
+(fn TYPE &optional FUNCTION RATING)" nil nil)
(register-definition-prefixes "url-auth" '("url-"))
-;;;***
-;;;### (autoloads nil "url-cache" "url/url-cache.el" (0 0 0 0))
;;; Generated autoloads from url/url-cache.el
(autoload 'url-store-in-cache "url-cache" "\
Store buffer BUFF in the cache.
-\(fn &optional BUFF)" nil nil)
-
+(fn &optional BUFF)" nil nil)
(autoload 'url-is-cached "url-cache" "\
Return non-nil if the URL is cached.
The actual return value is the last modification time of the cache file.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'url-cache-extract "url-cache" "\
Extract FNAM from the local disk cache.
-\(fn FNAM)" nil nil)
-
+(fn FNAM)" nil nil)
(register-definition-prefixes "url-cache" '("url-"))
-;;;***
-;;;### (autoloads nil "url-cid" "url/url-cid.el" (0 0 0 0))
;;; Generated autoloads from url/url-cid.el
(autoload 'url-cid "url-cid" "\
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-cid" '("url-cid-gnus"))
-;;;***
-;;;### (autoloads nil "url-cookie" "url/url-cookie.el" (0 0 0 0))
;;; Generated autoloads from url/url-cookie.el
(register-definition-prefixes "url-cookie" '("url-cookie"))
-;;;***
-;;;### (autoloads nil "url-dav" "url/url-dav.el" (0 0 0 0))
;;; Generated autoloads from url/url-dav.el
(autoload 'url-dav-supported-p "url-dav" "\
Return WebDAV protocol version supported by URL.
Returns nil if WebDAV is not supported.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'url-dav-request "url-dav" "\
Perform WebDAV operation METHOD on URL. Return the parsed responses.
Automatically creates an XML request body if TAG is non-nil.
@@ -35700,72 +32346,54 @@ NAMESPACES is an assoc list of (NAMESPACE . EXPANSION), and these are
added to the <TAG> element. The DAV=DAV: namespace is automatically
added to this list, so most requests can just pass in nil.
-\(fn URL METHOD TAG BODY &optional DEPTH HEADERS NAMESPACES)" nil nil)
-
+(fn URL METHOD TAG BODY &optional DEPTH HEADERS NAMESPACES)" nil nil)
(autoload 'url-dav-vc-registered "url-dav" "\
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-dav" '("url-dav-"))
-;;;***
-;;;### (autoloads nil "url-dired" "url/url-dired.el" (0 0 0 0))
;;; Generated autoloads from url/url-dired.el
(register-definition-prefixes "url-dired" '("url-"))
-;;;***
-;;;### (autoloads nil "url-domsuf" "url/url-domsuf.el" (0 0 0 0))
;;; Generated autoloads from url/url-domsuf.el
(register-definition-prefixes "url-domsuf" '("url-domsuf-"))
-;;;***
-;;;### (autoloads nil "url-expand" "url/url-expand.el" (0 0 0 0))
;;; Generated autoloads from url/url-expand.el
(register-definition-prefixes "url-expand" '("url-"))
-;;;***
-;;;### (autoloads nil "url-file" "url/url-file.el" (0 0 0 0))
;;; Generated autoloads from url/url-file.el
(autoload 'url-file "url-file" "\
Handle file: and ftp: URLs.
-\(fn URL CALLBACK CBARGS)" nil nil)
+(fn URL CALLBACK CBARGS)" nil nil)
+(register-definition-prefixes "url-file" '("url-"))
-(register-definition-prefixes "url-file" '("url-file-"))
-
-;;;***
-;;;### (autoloads nil "url-ftp" "url/url-ftp.el" (0 0 0 0))
;;; Generated autoloads from url/url-ftp.el
(register-definition-prefixes "url-ftp" '("url-ftp"))
-;;;***
-;;;### (autoloads nil "url-future" "url/url-future.el" (0 0 0 0))
;;; Generated autoloads from url/url-future.el
(register-definition-prefixes "url-future" '("url-future-"))
-;;;***
-;;;### (autoloads nil "url-gw" "url/url-gw.el" (0 0 0 0))
;;; Generated autoloads from url/url-gw.el
(autoload 'url-gateway-nslookup-host "url-gw" "\
Attempt to resolve the given HOST using nslookup if possible.
-\(fn HOST)" t nil)
-
+(fn HOST)" t nil)
(autoload 'url-open-stream "url-gw" "\
Open a stream to HOST, possibly via a gateway.
Args per `open-network-stream'.
@@ -35775,14 +32403,10 @@ Might do a non-blocking connection; use `process-status' to check.
Optional arg GATEWAY-METHOD specifies the gateway to be used,
overriding the value of `url-gateway-method'.
-\(fn NAME BUFFER HOST SERVICE &optional GATEWAY-METHOD)" nil nil)
-
+(fn NAME BUFFER HOST SERVICE &optional GATEWAY-METHOD)" nil nil)
(register-definition-prefixes "url-gw" '("url-"))
-;;;***
-;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from url/url-handlers.el
(defvar url-handler-mode nil "\
@@ -35792,43 +32416,40 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `url-handler-mode'.")
-
(custom-autoload 'url-handler-mode "url-handlers" nil)
-
(autoload 'url-handler-mode "url-handlers" "\
Handle URLs as if they were file names throughout Emacs.
+
After switching on this minor mode, Emacs file primitives handle
URLs. For instance:
-This is a minor mode. If called interactively, toggle the
-`Url-Handler mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='url-handler-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
(file-exists-p \"https://www.gnu.org/\")
=> t
and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at
that URL in a buffer.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Url-Handler mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='url-handler-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'url-file-handler "url-handlers" "\
Function called from the `file-name-handler-alist' routines.
OPERATION is what needs to be done (`file-exists-p', etc.).
ARGS are the arguments that would have been passed to OPERATION.
-\(fn OPERATION &rest ARGS)" nil nil)
-
+(fn OPERATION &rest ARGS)" nil nil)
(autoload 'url-copy-file "url-handlers" "\
Copy URL to NEWNAME. Both arguments must be strings.
Signal a `file-already-exists' error if file NEWNAME already
@@ -35836,72 +32457,56 @@ exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied
and non-nil. An integer as third argument means request
confirmation if NEWNAME already exists.
-\(fn URL NEWNAME &optional OK-IF-ALREADY-EXISTS &rest IGNORED)" nil nil)
-
+(fn URL NEWNAME &optional OK-IF-ALREADY-EXISTS &rest IGNORED)" nil nil)
(autoload 'url-file-local-copy "url-handlers" "\
Copy URL into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
accessible.
-\(fn URL &rest IGNORED)" nil nil)
-
+(fn URL &rest IGNORED)" nil nil)
(autoload 'url-insert-buffer-contents "url-handlers" "\
Insert the contents of BUFFER into current buffer.
This is like `url-insert', but also decodes the current buffer as
if it had been inserted from a file named URL.
-\(fn BUFFER URL &optional VISIT BEG END REPLACE)" nil nil)
-
+(fn BUFFER URL &optional VISIT BEG END REPLACE)" nil nil)
(autoload 'url-insert-file-contents "url-handlers" "\
-\(fn URL &optional VISIT BEG END REPLACE)" nil nil)
-
+(fn URL &optional VISIT BEG END REPLACE)" nil nil)
(register-definition-prefixes "url-handlers" '("url-"))
-;;;***
-;;;### (autoloads nil "url-history" "url/url-history.el" (0 0 0 0))
;;; Generated autoloads from url/url-history.el
(register-definition-prefixes "url-history" '("url-"))
-;;;***
-;;;### (autoloads nil "url-http" "url/url-http.el" (0 0 0 0))
;;; Generated autoloads from url/url-http.el
- (autoload 'url-default-expander "url-expand")
+ (autoload 'url-default-expander "url-expand")
(defalias 'url-https-expand-file-name 'url-default-expander)
(autoload 'url-https "url-http")
(autoload 'url-https-file-exists-p "url-http")
(autoload 'url-https-file-readable-p "url-http")
(autoload 'url-https-file-attributes "url-http")
-
(register-definition-prefixes "url-http" '("url-h"))
-;;;***
-;;;### (autoloads nil "url-imap" "url/url-imap.el" (0 0 0 0))
;;; Generated autoloads from url/url-imap.el
(register-definition-prefixes "url-imap" '("url-imap"))
-;;;***
-;;;### (autoloads nil "url-irc" "url/url-irc.el" (0 0 0 0))
;;; Generated autoloads from url/url-irc.el
(autoload 'url-irc "url-irc" "\
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-irc" '("url-irc-"))
-;;;***
-;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (0 0 0 0))
;;; Generated autoloads from url/url-ldap.el
(autoload 'url-ldap "url-ldap" "\
@@ -35910,101 +32515,76 @@ The return value is a buffer displaying the search results in HTML.
URL can be a URL string, or a URL record of the type returned by
`url-generic-parse-url'.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-ldap" '("url-ldap-"))
-;;;***
-;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (0 0 0 0))
;;; Generated autoloads from url/url-mailto.el
(autoload 'url-mail "url-mailto" "\
-\(fn &rest ARGS)" t nil)
-
+(fn &rest ARGS)" t nil)
(autoload 'url-mailto "url-mailto" "\
Handle the mailto: URL syntax.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-mailto" '("url-mail-goto-field"))
-;;;***
-;;;### (autoloads nil "url-methods" "url/url-methods.el" (0 0 0 0))
;;; Generated autoloads from url/url-methods.el
(register-definition-prefixes "url-methods" '("url-scheme-"))
-;;;***
-;;;### (autoloads nil "url-misc" "url/url-misc.el" (0 0 0 0))
;;; Generated autoloads from url/url-misc.el
(autoload 'url-man "url-misc" "\
Fetch a Unix manual page URL.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'url-info "url-misc" "\
Fetch a GNU Info URL.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'url-generic-emulator-loader "url-misc" "\
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(defalias 'url-rlogin 'url-generic-emulator-loader)
-
(defalias 'url-telnet 'url-generic-emulator-loader)
-
(defalias 'url-tn3270 'url-generic-emulator-loader)
-
(autoload 'url-data "url-misc" "\
Fetch a data URL (RFC 2397).
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-misc" '("url-do-terminal-emulator"))
-;;;***
-;;;### (autoloads nil "url-news" "url/url-news.el" (0 0 0 0))
;;; Generated autoloads from url/url-news.el
(autoload 'url-news "url-news" "\
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'url-snews "url-news" "\
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-news" '("url-news-"))
-;;;***
-;;;### (autoloads nil "url-nfs" "url/url-nfs.el" (0 0 0 0))
;;; Generated autoloads from url/url-nfs.el
(register-definition-prefixes "url-nfs" '("url-nfs"))
-;;;***
-;;;### (autoloads nil "url-parse" "url/url-parse.el" (0 0 0 0))
;;; Generated autoloads from url/url-parse.el
(autoload 'url-recreate-url "url-parse" "\
Recreate a URL string from the parsed URLOBJ.
-\(fn URLOBJ)" nil nil)
-
+(fn URLOBJ)" nil nil)
(autoload 'url-generic-parse-url "url-parse" "\
Return an URL-struct of the parts of URL.
The CL-style struct contains the following fields:
@@ -36044,30 +32624,22 @@ parses to
ATTRIBUTES = nil
FULLNESS = t
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-parse" '("url-"))
-;;;***
-;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (0 0 0 0))
;;; Generated autoloads from url/url-privacy.el
(autoload 'url-setup-privacy-info "url-privacy" "\
Setup variables that expose info about you and your system." t nil)
-
(register-definition-prefixes "url-privacy" '("url-device-type"))
-;;;***
-;;;### (autoloads nil "url-proxy" "url/url-proxy.el" (0 0 0 0))
;;; Generated autoloads from url/url-proxy.el
(register-definition-prefixes "url-proxy" '("url-"))
-;;;***
-;;;### (autoloads nil "url-queue" "url/url-queue.el" (0 0 0 0))
;;; Generated autoloads from url/url-queue.el
(autoload 'url-queue-retrieve "url-queue" "\
@@ -36077,33 +32649,25 @@ but with limits on the degree of parallelism. The variable
`url-queue-parallel-processes' sets the number of concurrent processes.
The variable `url-queue-timeout' sets a timeout.
-\(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
-
+(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
(register-definition-prefixes "url-queue" '("url-queue"))
-;;;***
-;;;### (autoloads nil "url-tramp" "url/url-tramp.el" (0 0 0 0))
;;; Generated autoloads from url/url-tramp.el
(defvar url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet") "\
List of URL protocols for which the work is handled by Tramp.
They must also be covered by `url-handler-regexp'.")
-
(custom-autoload 'url-tramp-protocols "url-tramp" t)
-
(autoload 'url-tramp-file-handler "url-tramp" "\
Function called from the `file-name-handler-alist' routines.
OPERATION is what needs to be done. ARGS are the arguments that
would have been passed to OPERATION.
-\(fn OPERATION &rest ARGS)" nil nil)
-
+(fn OPERATION &rest ARGS)" nil nil)
(register-definition-prefixes "url-tramp" '("url-tramp-convert-"))
-;;;***
-;;;### (autoloads nil "url-util" "url/url-util.el" (0 0 0 0))
;;; Generated autoloads from url/url-util.el
(defvar url-debug nil "\
@@ -36113,19 +32677,15 @@ Debug messages are logged to the *URL-DEBUG* buffer.
If t, all messages will be logged.
If a number, all messages will be logged, as well shown via `message'.
If a list, it is a list of the types of messages to be logged.")
-
(custom-autoload 'url-debug "url-util" t)
-
(autoload 'url-debug "url-util" "\
-\(fn TAG &rest ARGS)" nil nil)
-
+(fn TAG &rest ARGS)" nil nil)
(autoload 'url-parse-args "url-util" "\
-\(fn STR &optional NODOWNCASE)" nil nil)
-
+(fn STR &optional NODOWNCASE)" nil nil)
(autoload 'url-insert-entities-in-string "url-util" "\
Convert HTML markup-start characters to entity references in STRING.
Also replaces the \" character, so that the result may be safely used as
@@ -36136,62 +32696,50 @@ conversion. Replaces these characters as follows:
> ==> &gt;
\" ==> &quot;
-\(fn STRING)" nil nil)
-
+(fn STRING)" nil nil)
(autoload 'url-normalize-url "url-util" "\
Return a \"normalized\" version of URL.
Strips out default port numbers, etc.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'url-lazy-message "url-util" "\
Just like `message', but is a no-op if called more than once a second.
Will not do anything if `url-show-status' is nil.
-\(fn &rest ARGS)" nil nil)
-
+(fn &rest ARGS)" nil nil)
(autoload 'url-get-normalized-date "url-util" "\
Return a date string that most HTTP servers can understand.
-\(fn &optional SPECIFIED-TIME)" nil nil)
-
+(fn &optional SPECIFIED-TIME)" nil nil)
(autoload 'url-eat-trailing-space "url-util" "\
Remove spaces/tabs at the end of a string.
-\(fn X)" nil nil)
-
+(fn X)" nil nil)
(autoload 'url-strip-leading-spaces "url-util" "\
Remove spaces at the front of a string.
-\(fn X)" nil nil)
-
+(fn X)" nil nil)
(autoload 'url-display-percentage "url-util" "\
-\(fn FMT PERC &rest ARGS)" nil nil)
-
+(fn FMT PERC &rest ARGS)" nil nil)
(autoload 'url-percentage "url-util" "\
-\(fn X Y)" nil nil)
-
+(fn X Y)" nil nil)
(defalias 'url-basepath 'url-file-directory)
-
(autoload 'url-file-directory "url-util" "\
Return the directory part of FILE, for a URL.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'url-file-nondirectory "url-util" "\
Return the nondirectory part of FILE, for a URL.
-\(fn FILE)" nil nil)
-
+(fn FILE)" nil nil)
(autoload 'url-parse-query-string "url-util" "\
-\(fn QUERY &optional DOWNCASE ALLOW-NEWLINES)" nil nil)
-
+(fn QUERY &optional DOWNCASE ALLOW-NEWLINES)" nil nil)
(autoload 'url-build-query-string "url-util" "\
Build a query-string.
@@ -36202,7 +32750,7 @@ Given a QUERY in the form:
(key4)
(key5 \"\"))
-\(This is the same format as produced by `url-parse-query-string')
+(This is the same format as produced by `url-parse-query-string')
This will return a string
\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may
@@ -36214,8 +32762,7 @@ When SEMICOLONS is given, the separator will be \";\".
When KEEP-EMPTY is given, empty values will show as \"key=\"
instead of just \"key\" as in the example above.
-\(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil)
-
+(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil)
(autoload 'url-unhex-string "url-util" "\
Decode %XX sequences in a percent-encoded URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
@@ -36225,8 +32772,7 @@ forbidden in URL encoding.
The resulting string in general requires decoding using an
appropriate coding-system; see `decode-coding-string'.
-\(fn STR &optional ALLOW-NEWLINES)" nil nil)
-
+(fn STR &optional ALLOW-NEWLINES)" nil nil)
(autoload 'url-hexify-string "url-util" "\
URI-encode STRING and return the result.
If STRING is multibyte, it is first converted to a utf-8 byte
@@ -36240,8 +32786,7 @@ allowed characters. Otherwise, ALLOWED-CHARS should be either a
list of allowed chars, or a vector whose Nth element is non-nil
if character N is allowed.
-\(fn STRING &optional ALLOWED-CHARS)" nil nil)
-
+(fn STRING &optional ALLOWED-CHARS)" nil nil)
(autoload 'url-encode-url "url-util" "\
Return a properly URI-encoded version of URL.
This function also performs URI normalization, e.g. converting
@@ -36249,21 +32794,18 @@ the scheme to lowercase if it is uppercase. Apart from
normalization, if URL is already URI-encoded, this function
should return it unchanged.
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(autoload 'url-file-extension "url-util" "\
Return the filename extension of FNAME.
If optional argument X is t, then return the basename
of the file with the extension stripped off.
-\(fn FNAME &optional X)" nil nil)
-
+(fn FNAME &optional X)" nil nil)
(autoload 'url-truncate-url-for-viewing "url-util" "\
Return a shortened version of URL that is WIDTH characters wide or less.
WIDTH defaults to the current frame width.
-\(fn URL &optional WIDTH)" nil nil)
-
+(fn URL &optional WIDTH)" nil nil)
(autoload 'url-view-url "url-util" "\
View the current document's URL.
Optional argument NO-SHOW means just return the URL, don't show it in
@@ -36271,8 +32813,7 @@ the minibuffer.
This uses `url-current-object', set locally to the buffer.
-\(fn &optional NO-SHOW)" t nil)
-
+(fn &optional NO-SHOW)" t nil)
(autoload 'url-domain "url-util" "\
Return the domain of the host of the URL.
Return nil if this can't be determined.
@@ -36280,24 +32821,18 @@ Return nil if this can't be determined.
For instance, this function will return \"fsf.co.uk\" if the host in URL
is \"www.fsf.co.uk\".
-\(fn URL)" nil nil)
-
+(fn URL)" nil nil)
(register-definition-prefixes "url-util" '("url-"))
-;;;***
-;;;### (autoloads nil "url-vars" "url/url-vars.el" (0 0 0 0))
;;; Generated autoloads from url/url-vars.el
(register-definition-prefixes "url-vars" '("url-"))
-;;;***
-;;;### (autoloads nil "userlock" "userlock.el" (0 0 0 0))
;;; Generated autoloads from userlock.el
(put 'create-lockfiles 'safe-local-variable 'booleanp)
-
(autoload 'ask-user-about-lock "userlock" "\
Ask user what to do when he wants to edit FILE but it is locked by OPPONENT.
This function has a choice of three things to do:
@@ -36308,13 +32843,11 @@ This function has a choice of three things to do:
You can redefine this function to choose among those three alternatives
in any way you like.
-\(fn FILE OPPONENT)" nil nil)
-
+(fn FILE OPPONENT)" nil nil)
(autoload 'userlock--ask-user-about-supersession-threat "userlock" "\
-\(fn FILENAME)" nil nil)
-
+(fn FILENAME)" nil nil)
(autoload 'ask-user-about-supersession-threat "userlock" "\
Ask a user who is about to modify an obsolete buffer what to do.
This function has two choices: it can return, in which case the modification
@@ -36324,57 +32857,59 @@ in which case the proposed buffer modification will not be made.
You can rewrite this to use any criterion you like to choose which one to do.
The buffer in question is current when this function is called.
-\(fn FILENAME)" nil nil)
-
+(fn FILENAME)" nil nil)
(autoload 'userlock--handle-unlock-error "userlock" "\
Report an ERROR that occurred while unlocking a file.
-\(fn ERROR)" nil nil)
-
-(register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--"))
+(fn ERROR)" nil nil)
+(register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--check-content-unchanged"))
-;;;***
-;;;### (autoloads nil "utf-7" "international/utf-7.el" (0 0 0 0))
;;; Generated autoloads from international/utf-7.el
(autoload 'utf-7-post-read-conversion "utf-7" "\
-\(fn LEN)" nil nil)
-
+(fn LEN)" nil nil)
(autoload 'utf-7-imap-post-read-conversion "utf-7" "\
-\(fn LEN)" nil nil)
-
+(fn LEN)" nil nil)
(autoload 'utf-7-pre-write-conversion "utf-7" "\
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(autoload 'utf-7-imap-pre-write-conversion "utf-7" "\
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(register-definition-prefixes "utf-7" '("utf-7-"))
-;;;***
-;;;### (autoloads nil "utf7" "international/utf7.el" (0 0 0 0))
;;; Generated autoloads from international/utf7.el
(autoload 'utf7-encode "utf7" "\
Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil.
-\(fn STRING &optional FOR-IMAP)" nil nil)
-
+(fn STRING &optional FOR-IMAP)" nil nil)
(register-definition-prefixes "utf7" '("utf7-"))
-;;;***
-;;;### (autoloads nil "uudecode" "mail/uudecode.el" (0 0 0 0))
+;;; Generated autoloads from cedet/semantic/util.el
+
+(register-definition-prefixes "semantic/util" '("semantic-"))
+
+
+;;; Generated autoloads from cedet/ede/util.el
+
+(register-definition-prefixes "ede/util" '("ede-make-buffer-writable"))
+
+
+;;; Generated autoloads from cedet/semantic/util-modes.el
+
+(register-definition-prefixes "semantic/util-modes" '("semantic-"))
+
+
;;; Generated autoloads from mail/uudecode.el
(autoload 'uudecode-decode-region-external "uudecode" "\
@@ -36382,45 +32917,34 @@ Uudecode region between START and END using external program.
If FILE-NAME is non-nil, save the result to FILE-NAME. The program
used is specified by `uudecode-decoder-program'.
-\(fn START END &optional FILE-NAME)" t nil)
-
+(fn START END &optional FILE-NAME)" t nil)
(autoload 'uudecode-decode-region-internal "uudecode" "\
Uudecode region between START and END without using an external program.
If FILE-NAME is non-nil, save the result to FILE-NAME.
-\(fn START END &optional FILE-NAME)" t nil)
-
+(fn START END &optional FILE-NAME)" t nil)
(autoload 'uudecode-decode-region "uudecode" "\
Uudecode region between START and END.
If FILE-NAME is non-nil, save the result to FILE-NAME.
-\(fn START END &optional FILE-NAME)" nil nil)
-
+(fn START END &optional FILE-NAME)" nil nil)
(register-definition-prefixes "uudecode" '("uudecode-"))
-;;;***
-;;;### (autoloads nil "vc" "vc/vc.el" (0 0 0 0))
;;; Generated autoloads from vc/vc.el
(defvar vc-checkout-hook nil "\
Normal hook (list of functions) run after checking out a file.
See `run-hooks'.")
-
(custom-autoload 'vc-checkout-hook "vc" t)
-
(defvar vc-checkin-hook nil "\
Normal hook (list of functions) run after commit or file checkin.
See also `log-edit-done-hook'.")
-
(custom-autoload 'vc-checkin-hook "vc" t)
-
(defvar vc-before-checkin-hook nil "\
Normal hook (list of functions) run before a commit or a file checkin.
See `run-hooks'.")
-
(custom-autoload 'vc-before-checkin-hook "vc" t)
-
(autoload 'vc-responsible-backend "vc" "\
Return the name of a backend system that is responsible for FILE.
@@ -36436,8 +32960,7 @@ be reported.
If NO-ERROR is nil, signal an error that no VC backend is
responsible for the given file.
-\(fn FILE &optional NO-ERROR)" nil nil)
-
+(fn FILE &optional NO-ERROR)" nil nil)
(autoload 'vc-next-action "vc" "\
Do the next logical version control operation on the current fileset.
This requires that all files in the current VC fileset be in the
@@ -36461,8 +32984,11 @@ For old-style locking-based version control systems, like RCS:
If every file is locked by you and unchanged, unlock them.
If every file is locked by someone else, offer to steal the lock.
-\(fn VERBOSE)" t nil)
+When using this command to register a new file (or files), it
+will automatically deduce which VC repository to register it
+with, using the most specific one.
+(fn VERBOSE)" t nil)
(autoload 'vc-register "vc" "\
Register into a version control system.
If VC-FILESET is given, register the files in that fileset.
@@ -36476,8 +33002,7 @@ directory are already registered under that backend) will be used to
register the file. If no backend declares itself responsible, the
first backend that could register the file is used.
-\(fn &optional VC-FILESET COMMENT)" t nil)
-
+(fn &optional VC-FILESET COMMENT)" t nil)
(autoload 'vc-ignore "vc" "\
Ignore FILE under the VCS of DIRECTORY.
@@ -36492,8 +33017,7 @@ When called interactively, prompt for a FILE to ignore, unless a
prefix argument is given, in which case prompt for a file FILE to
remove from the list of ignored files.
-\(fn FILE &optional DIRECTORY REMOVE)" t nil)
-
+(fn FILE &optional DIRECTORY REMOVE)" t nil)
(autoload 'vc-version-diff "vc" "\
Report diffs between revisions REV1 and REV2 in the repository history.
This compares two revisions of the current fileset.
@@ -36502,13 +33026,11 @@ of the last commit.
If REV2 is nil, it defaults to the work tree, i.e. the current
state of each file in the fileset.
-\(fn FILES REV1 REV2)" t nil)
-
+(fn FILES REV1 REV2)" t nil)
(autoload 'vc-root-version-diff "vc" "\
Report diffs between REV1 and REV2 revisions of the whole tree.
-\(fn FILES REV1 REV2)" t nil)
-
+(fn FILES REV1 REV2)" t nil)
(autoload 'vc-diff "vc" "\
Display diffs between file revisions.
Normally this compares the currently selected fileset with their
@@ -36518,14 +33040,12 @@ designators specifying which revisions to compare.
The optional argument NOT-URGENT non-nil means it is ok to say no to
saving the buffer.
-\(fn &optional HISTORIC NOT-URGENT)" t nil)
-
+(fn &optional HISTORIC NOT-URGENT)" t nil)
(autoload 'vc-diff-mergebase "vc" "\
Report diffs between the merge base of REV1 and REV2 revisions.
The merge base is a common ancestor between REV1 and REV2 revisions.
-\(fn FILES REV1 REV2)" t nil)
-
+(fn FILES REV1 REV2)" t nil)
(autoload 'vc-version-ediff "vc" "\
Show differences between REV1 and REV2 of FILES using ediff.
This compares two revisions of the files in FILES. Currently,
@@ -36536,8 +33056,7 @@ of the last commit.
If REV2 is nil, it defaults to the work tree, i.e. the current
state of each file in FILES.
-\(fn FILES REV1 REV2)" t nil)
-
+(fn FILES REV1 REV2)" t nil)
(autoload 'vc-ediff "vc" "\
Display diffs between file revisions using ediff.
Normally this compares the currently selected fileset with their
@@ -36547,8 +33066,7 @@ designators specifying which revisions to compare.
The optional argument NOT-URGENT non-nil means it is ok to say no to
saving the buffer.
-\(fn HISTORIC &optional NOT-URGENT)" t nil)
-
+(fn HISTORIC &optional NOT-URGENT)" t nil)
(autoload 'vc-root-diff "vc" "\
Display diffs between VC-controlled whole tree revisions.
Normally, this compares the tree corresponding to the current
@@ -36559,24 +33077,20 @@ designators specifying which revisions to compare.
The optional argument NOT-URGENT non-nil means it is ok to say no to
saving the buffer.
-\(fn HISTORIC &optional NOT-URGENT)" t nil)
-
+(fn HISTORIC &optional NOT-URGENT)" t nil)
(autoload 'vc-root-dir "vc" "\
Return the root directory for the current VC tree.
Return nil if the root directory cannot be identified." nil nil)
-
(autoload 'vc-revision-other-window "vc" "\
Visit revision REV of the current file in another window.
If the current file is named `F', the revision is named `F.~REV~'.
If `F.~REV~' already exists, use it instead of checking it out again.
-\(fn REV)" t nil)
-
+(fn REV)" t nil)
(autoload 'vc-insert-headers "vc" "\
Insert headers into a file for use with a version control system.
Headers desired are inserted at point, and are pulled from
the variable `vc-BACKEND-header'." t nil)
-
(autoload 'vc-merge "vc" "\
Perform a version control merge operation.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
@@ -36590,17 +33104,13 @@ two revisions to merge from in the minibuffer. If the first
revision is a branch number, then merge all changes from that
branch. If the first revision is empty, merge the most recent
changes from the current branch." t nil)
-
(autoload 'vc-message-unresolved-conflicts "vc" "\
Display a message indicating unresolved conflicts in FILENAME.
-\(fn FILENAME)" nil nil)
-
+(fn FILENAME)" nil nil)
(defalias 'vc-resolve-conflicts 'smerge-ediff)
-
(autoload 'vc-find-conflicted-file "vc" "\
Visit the next conflicted file in the current project." t nil)
-
(autoload 'vc-create-tag "vc" "\
Descending recursively from DIR, make a tag called NAME.
For each registered file, the working revision becomes part of
@@ -36608,8 +33118,7 @@ the named configuration. If the prefix argument BRANCHP is
given, the tag is made as a new branch and the files are
checked out in that new branch.
-\(fn DIR NAME BRANCHP)" t nil)
-
+(fn DIR NAME BRANCHP)" t nil)
(autoload 'vc-retrieve-tag "vc" "\
For each file in or below DIR, retrieve their tagged version NAME.
NAME can name a branch, in which case this command will switch to the
@@ -36622,8 +33131,7 @@ locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped).
This function runs the hook `vc-retrieve-tag-hook' when finished.
-\(fn DIR NAME)" t nil)
-
+(fn DIR NAME)" t nil)
(autoload 'vc-print-log "vc" "\
List the change log of the current fileset in a window.
If WORKING-REVISION is non-nil, leave point at that revision.
@@ -36633,8 +33141,7 @@ number of revisions to show; the default is `vc-log-show-limit'.
When called interactively with a prefix argument, prompt for
WORKING-REVISION and LIMIT.
-\(fn &optional WORKING-REVISION LIMIT)" t nil)
-
+(fn &optional WORKING-REVISION LIMIT)" t nil)
(autoload 'vc-print-root-log "vc" "\
List the revision history for the current VC controlled tree in a window.
If LIMIT is non-nil, it should be a number specifying the maximum
@@ -36645,25 +33152,21 @@ A special case is when the prefix argument is 1: in this case
the command asks for the ID of a revision, and shows that revision
with its diffs (if the underlying VCS supports that).
-\(fn &optional LIMIT REVISION)" t nil)
-
+(fn &optional LIMIT REVISION)" t nil)
(autoload 'vc-print-branch-log "vc" "\
Show the change log for BRANCH root in a window.
-\(fn BRANCH)" t nil)
-
+(fn BRANCH)" t nil)
(autoload 'vc-log-incoming "vc" "\
Show log of changes that will be received with pull from REMOTE-LOCATION.
When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
-\(fn &optional REMOTE-LOCATION)" t nil)
-
+(fn &optional REMOTE-LOCATION)" t nil)
(autoload 'vc-log-outgoing "vc" "\
Show log of changes that will be sent with a push operation to REMOTE-LOCATION.
When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
-\(fn &optional REMOTE-LOCATION)" t nil)
-
+(fn &optional REMOTE-LOCATION)" t nil)
(autoload 'vc-log-search "vc" "\
Search the log of changes for PATTERN.
@@ -36675,27 +33178,23 @@ Display all entries that match log messages in long format.
With a prefix argument, ask for a command to run that will output
log entries.
-\(fn PATTERN)" t nil)
-
+(fn PATTERN)" t nil)
(autoload 'vc-log-mergebase "vc" "\
Show a log of changes between the merge base of REV1 and REV2 revisions.
The merge base is a common ancestor between REV1 and REV2 revisions.
-\(fn FILES REV1 REV2)" t nil)
-
+(fn FILES REV1 REV2)" t nil)
(autoload 'vc-region-history "vc" "\
Show the history of the region between FROM and TO.
If called interactively, show the history between point and
mark.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'vc-revert "vc" "\
Revert working copies of the selected fileset to their repository contents.
This asks for confirmation if the buffer contents are not identical
to the working revision (except for keyword expansion)." t nil)
-
(autoload 'vc-pull "vc" "\
Update the current fileset or branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
@@ -36710,10 +33209,8 @@ file, this simply replaces the work file with the latest revision
on its branch. If the file contains changes, any changes in the
tip revision are merged into the working file.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(defalias 'vc-update 'vc-pull)
-
(autoload 'vc-push "vc" "\
Push the current branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
@@ -36725,8 +33222,7 @@ VCS command to run.
On a non-distributed version control system, this signals an error.
It also signals an error in a Bazaar bound branch.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'vc-switch-backend "vc" "\
Make BACKEND the current version control system for FILE.
FILE must already be registered in BACKEND. The change is not
@@ -36735,36 +33231,31 @@ VC's perspective on FILE, it does not register or unregister it.
By default, this command cycles through the registered backends.
To get a prompt, use a prefix argument.
-\(fn FILE BACKEND)" t nil)
-
-(make-obsolete 'vc-switch-backend 'nil '"28.1")
-
+(fn FILE BACKEND)" t nil)
+(make-obsolete 'vc-switch-backend 'nil "28.1")
(autoload 'vc-transfer-file "vc" "\
Transfer FILE to another version control system NEW-BACKEND.
If NEW-BACKEND has a higher precedence than FILE's current backend
-\(i.e. it comes earlier in `vc-handled-backends'), then register FILE in
+(i.e. it comes earlier in `vc-handled-backends'), then register FILE in
NEW-BACKEND, using the revision number from the current backend as the
base level. If NEW-BACKEND has a lower precedence than the current
backend, then commit all changes that were made under the current
backend to NEW-BACKEND, and unregister FILE from the current backend.
-\(If FILE is not yet registered under NEW-BACKEND, register it.)
-
-\(fn FILE NEW-BACKEND)" nil nil)
+(If FILE is not yet registered under NEW-BACKEND, register it.)
+(fn FILE NEW-BACKEND)" nil nil)
(autoload 'vc-delete-file "vc" "\
Delete file and mark it as such in the version control system.
If called interactively, read FILE, defaulting to the current
buffer's file name if it's under version control.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'vc-rename-file "vc" "\
Rename file OLD to NEW in both work area and repository.
If called interactively, read OLD and NEW, defaulting OLD to the
current buffer's file name if it's under version control.
-\(fn OLD NEW)" t nil)
-
+(fn OLD NEW)" t nil)
(autoload 'vc-update-change-log "vc" "\
Find change log file and add entries from recent version control logs.
Normally, find log entries for all registered files in the default
@@ -36779,13 +33270,10 @@ log for the default directory, which may not be appropriate.
From a program, any ARGS are assumed to be filenames for which
log entries should be gathered.
-\(fn &rest ARGS)" t nil)
-
+(fn &rest ARGS)" t nil)
(register-definition-prefixes "vc" '("vc-" "with-vc-properties"))
-;;;***
-;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-annotate.el
(autoload 'vc-annotate "vc-annotate" "\
@@ -36801,7 +33289,7 @@ everything that is older than that is shown in blue.
With a prefix argument, this command asks two questions in the
minibuffer. First, you may enter a revision number REV; then the buffer
displays and annotates that revision instead of the working revision
-\(type RET in the minibuffer to leave that default unchanged). Then,
+(type RET in the minibuffer to leave that default unchanged). Then,
you are prompted for the time span in days which the color range
should cover. For example, a time span of 20 days means that changes
over the past 20 days are shown in red to blue, according to their
@@ -36820,18 +33308,14 @@ mode-specific menu. `vc-annotate-color-map' and
`vc-annotate-background-mode' specifies whether the color map
should be applied to the background or to the foreground.
-\(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t nil)
-
+(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t nil)
(register-definition-prefixes "vc-annotate" '("vc-"))
-;;;***
-;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-bzr.el
(defconst vc-bzr-admin-dirname ".bzr" "\
Name of the directory containing Bzr repository status files.")
-
(defconst vc-bzr-admin-checkout-format-file (concat vc-bzr-admin-dirname "/checkout/format") "\
Name of the format file in a .bzr directory.")
(defun vc-bzr-registered (file)
@@ -36839,39 +33323,31 @@ Name of the format file in a .bzr directory.")
(progn
(load "vc-bzr" nil t)
(vc-bzr-registered file))))
-
(register-definition-prefixes "vc-bzr" '("vc-bzr-"))
-;;;***
-;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-cvs.el
+
(defun vc-cvs-registered (f)
"Return non-nil if file F is registered with CVS."
(when (file-readable-p (expand-file-name
- "CVS/Entries" (file-name-directory f)))
+ "CVS/Entries" (file-name-directory f)))
(load "vc-cvs" nil t)
(vc-cvs-registered f)))
-
(register-definition-prefixes "vc-cvs" '("vc-cvs-"))
-;;;***
-;;;### (autoloads nil "vc-dav" "vc/vc-dav.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-dav.el
(register-definition-prefixes "vc-dav" '("vc-dav-"))
-;;;***
-;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-dir.el
(autoload 'vc-dir-root "vc-dir" "\
Run `vc-dir' in the repository root directory without prompt.
If the default directory of the current buffer is
not under version control, prompt for a directory." t nil)
-
(autoload 'vc-dir "vc-dir" "\
Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -36889,21 +33365,16 @@ These are the commands available for use in the file status buffer:
\\{vc-dir-mode-map}
-\(fn DIR &optional BACKEND)" t nil)
-
+(fn DIR &optional BACKEND)" t nil)
(autoload 'vc-dir-bookmark-jump "vc-dir" "\
Provide the `bookmark-jump' behavior for a `vc-dir' buffer.
This implements the `handler' function interface for the record
type returned by `vc-dir-bookmark-make-record'.
-\(fn BMK)" nil nil)
-
+(fn BMK)" nil nil)
(register-definition-prefixes "vc-dir" '("vc-"))
-;;;***
-;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from vc/vc-dispatcher.el
(autoload 'vc-do-command "vc-dispatcher" "\
@@ -36922,115 +33393,73 @@ that is inserted into the command line before the filename.
Return the return value of the slave command in the synchronous
case, and the process object in the asynchronous case.
-\(fn BUFFER OKSTATUS COMMAND FILE-OR-LIST &rest FLAGS)" nil nil)
-
+(fn BUFFER OKSTATUS COMMAND FILE-OR-LIST &rest FLAGS)" nil nil)
(register-definition-prefixes "vc-dispatcher" '("vc-"))
-;;;***
-;;;### (autoloads nil "vc-filewise" "vc/vc-filewise.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-filewise.el
(register-definition-prefixes "vc-filewise" '("vc-"))
-;;;***
-;;;### (autoloads nil "vc-git" "vc/vc-git.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-git.el
+
(defun vc-git-registered (file)
"Return non-nil if FILE is registered with git."
(if (vc-find-root file ".git") ; Short cut.
(progn
(load "vc-git" nil t)
(vc-git-registered file))))
+(register-definition-prefixes "vc-git" '("vc-"))
-(register-definition-prefixes "vc-git" '("vc-git-"))
-
-;;;***
-;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-hg.el
+
(defun vc-hg-registered (file)
"Return non-nil if FILE is registered with hg."
(if (vc-find-root file ".hg") ; short cut
(progn
(load "vc-hg" nil t)
(vc-hg-registered file))))
-
(register-definition-prefixes "vc-hg" '("vc-hg-"))
-;;;***
-;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (0 0 0 0))
-;;; Generated autoloads from vc/vc-mtn.el
-
-(defconst vc-mtn-admin-dir "_MTN" "\
-Name of the monotone directory.")
-
-(defconst vc-mtn-admin-format (concat vc-mtn-admin-dir "/format") "\
-Name of the monotone directory's format file.")
- (defun vc-mtn-registered (file)
- (if (vc-find-root file vc-mtn-admin-format)
- (progn
- (load "vc-mtn" nil t)
- (vc-mtn-registered file))))
-
-(register-definition-prefixes "vc-mtn" '("vc-mtn-"))
-
-;;;***
-
-;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-rcs.el
(defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\
Where to look for RCS master files.
For a description of possible values, see `vc-check-master-templates'.")
-
(custom-autoload 'vc-rcs-master-templates "vc-rcs" t)
-
(defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
-
(register-definition-prefixes "vc-rcs" '("vc-r"))
-;;;***
-;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-sccs.el
(defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\
Where to look for SCCS master files.
For a description of possible values, see `vc-check-master-templates'.")
-
(custom-autoload 'vc-sccs-master-templates "vc-sccs" t)
-
(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))
-
(defun vc-sccs-search-project-dir (_dirname basename) "\
Return the name of a master file in the SCCS project directory.
Does not check whether the file exists but returns nil if it does not
find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) (when project-dir (if (file-name-absolute-p project-dir) (setq dirs '("SCCS" "")) (setq dirs '("src/SCCS" "src" "source/SCCS" "source")) (setq project-dir (expand-file-name (concat "~" project-dir)))) (while (and (not dir) dirs) (setq dir (expand-file-name (car dirs) project-dir)) (unless (file-directory-p dir) (setq dir nil) (setq dirs (cdr dirs)))) (and dir (expand-file-name (concat "s." basename) dir)))))
-
(register-definition-prefixes "vc-sccs" '("vc-sccs-"))
-;;;***
-;;;### (autoloads nil "vc-src" "vc/vc-src.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-src.el
(defvar vc-src-master-templates (purecopy '("%s.src/%s,v")) "\
Where to look for SRC master files.
For a description of possible values, see `vc-check-master-templates'.")
-
(custom-autoload 'vc-src-master-templates "vc-src" t)
-
(defun vc-src-registered (f) (vc-default-registered 'src f))
-
(register-definition-prefixes "vc-src" '("vc-src-"))
-;;;***
-;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-svn.el
+
(defun vc-svn-registered (f)
(let ((admin-dir (cond ((and (eq system-type 'windows-nt)
(getenv "SVN_ASP_DOT_NET_HACK"))
@@ -37039,24 +33468,18 @@ For a description of possible values, see `vc-check-master-templates'.")
(when (vc-find-root f admin-dir)
(load "vc-svn" nil t)
(vc-svn-registered f))))
-
(register-definition-prefixes "vc-svn" '("vc-svn-"))
-;;;***
-;;;### (autoloads nil "vcursor" "vcursor.el" (0 0 0 0))
;;; Generated autoloads from vcursor.el
(register-definition-prefixes "vcursor" '("vcursor-"))
-;;;***
-;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/vera-mode.el
+
(push (purecopy '(vera-mode 2 28)) package--builtin-versions)
(add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode))
-
(autoload 'vera-mode "vera-mode" "\
Major mode for editing Vera code.
@@ -37106,17 +33529,13 @@ Key bindings:
\\{vera-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "vera-mode" '("vera-"))
-;;;***
-;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el"
-;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/verilog-mode.el
-(push (purecopy '(verilog-mode 2021 9 23 89128420)) package--builtin-versions)
+(push (purecopy '(verilog-mode 2021 10 14 127365406)) package--builtin-versions)
(autoload 'verilog-mode "verilog-mode" "\
Major mode for editing Verilog code.
\\<verilog-mode-map>
@@ -37252,14 +33671,10 @@ Key bindings specific to `verilog-mode-map' are:
\\{verilog-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "verilog-mode" '("electric-verilog-" "verilog-" "vl-"))
-;;;***
-;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload 'vhdl-mode "vhdl-mode" "\
@@ -37809,74 +34224,57 @@ Key bindings:
\\{vhdl-mode-map}
-\(fn)" t nil)
-
+(fn)" t nil)
(register-definition-prefixes "vhdl-mode" '("vhdl-"))
-;;;***
-;;;### (autoloads nil "viet-util" "language/viet-util.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from language/viet-util.el
(autoload 'viet-encode-viscii-char "viet-util" "\
Return VISCII character code of CHAR if appropriate.
-\(fn CHAR)" nil nil)
-
+(fn CHAR)" nil nil)
(autoload 'viet-decode-viqr-region "viet-util" "\
Convert `VIQR' mnemonics of the current region to Vietnamese characters.
When called from a program, expects two arguments,
positions (integers or markers) specifying the stretch of the region.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'viet-decode-viqr-buffer "viet-util" "\
Convert `VIQR' mnemonics of the current buffer to Vietnamese characters." t nil)
-
(autoload 'viet-encode-viqr-region "viet-util" "\
Convert Vietnamese characters of the current region to `VIQR' mnemonics.
When called from a program, expects two arguments,
positions (integers or markers) specifying the stretch of the region.
-\(fn FROM TO)" t nil)
-
+(fn FROM TO)" t nil)
(autoload 'viet-encode-viqr-buffer "viet-util" "\
Convert Vietnamese characters of the current buffer to `VIQR' mnemonics." t nil)
-
(autoload 'viqr-post-read-conversion "viet-util" "\
-\(fn LEN)" nil nil)
-
+(fn LEN)" nil nil)
(autoload 'viqr-pre-write-conversion "viet-util" "\
-\(fn FROM TO)" nil nil)
-
+(fn FROM TO)" nil nil)
(register-definition-prefixes "viet-util" '("viet-viqr-alist" "viqr-regexp"))
-;;;***
-;;;### (autoloads nil "view" "view.el" (0 0 0 0))
;;; Generated autoloads from view.el
(defvar view-remove-frame-by-deleting t "\
Determine how View mode removes a frame no longer needed.
If nil, make an icon of the frame. If non-nil, delete the frame.")
-
(custom-autoload 'view-remove-frame-by-deleting "view" t)
-
(defvar-local view-mode nil "\
Non-nil if View mode is enabled.
Don't change this variable directly, you must change it by one of the
functions that enable or disable view mode.")
-
(autoload 'kill-buffer-if-not-modified "view" "\
Like `kill-buffer', but does nothing if buffer BUF is modified.
-\(fn BUF)" nil nil)
-
+(fn BUF)" nil nil)
(autoload 'view-file "view" "\
View FILE in View mode, returning to previous buffer when done.
Emacs commands editing the buffer contents are not available; instead, a
@@ -37887,8 +34285,7 @@ For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'view-file-other-window "view" "\
View FILE in View mode in another window.
When done, return that window to its previous buffer, and kill the
@@ -37902,8 +34299,7 @@ For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'view-file-other-frame "view" "\
View FILE in View mode in another frame.
When done, kill the buffer visiting FILE if unmodified and if it wasn't
@@ -37918,8 +34314,7 @@ For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
-\(fn FILE)" t nil)
-
+(fn FILE)" t nil)
(autoload 'view-buffer "view" "\
View BUFFER in View mode, returning to previous buffer when done.
Emacs commands editing the buffer contents are not available; instead, a
@@ -37943,8 +34338,7 @@ This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings.
-\(fn BUFFER &optional EXIT-ACTION)" t nil)
-
+(fn BUFFER &optional EXIT-ACTION)" t nil)
(autoload 'view-buffer-other-window "view" "\
View BUFFER in View mode in another window.
Emacs commands editing the buffer contents are not available;
@@ -37965,8 +34359,7 @@ This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings.
-\(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
-
+(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
(autoload 'view-buffer-other-frame "view" "\
View BUFFER in View mode in another frame.
Emacs commands editing the buffer contents are not available;
@@ -37987,25 +34380,10 @@ This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings.
-\(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
-
+(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
(autoload 'view-mode "view" "\
Toggle View mode, a minor mode for viewing text but not editing it.
-This is a minor mode. If called interactively, toggle the `View mode'
-mode. If the prefix argument is positive, enable the mode, and if it
-is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `view-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
When View mode is enabled, commands that do not change the buffer
contents are available as usual. Kill commands save text but
do not delete it from the buffer. Most other commands beep and
@@ -38083,8 +34461,21 @@ then \\[View-leave], \\[View-quit] and \\[View-kill-and-leave] will return to th
Entry to view-mode runs the normal hook `view-mode-hook'.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the `View
+mode' mode. If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `view-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'view-return-to-alist-update "view" "\
Update `view-return-to-alist' of buffer BUFFER.
Remove from `view-return-to-alist' all entries referencing dead
@@ -38095,10 +34486,8 @@ function `view-mode-exit'. If `view-return-to-alist' contains an
entry for the selected window, purge that entry from
`view-return-to-alist' before adding ITEM.
-\(fn BUFFER &optional ITEM)" nil nil)
-
-(make-obsolete 'view-return-to-alist-update '"this function has no effect." '"24.1")
-
+(fn BUFFER &optional ITEM)" nil nil)
+(make-obsolete 'view-return-to-alist-update '"this function has no effect." "24.1")
(autoload 'view-mode-enter "view" "\
Enter View mode and set up exit from view mode depending on optional arguments.
Optional argument QUIT-RESTORE if non-nil must specify a valid
@@ -38114,115 +34503,78 @@ For a list of all View commands, type H or h while viewing.
This function runs the normal hook `view-mode-hook'.
-\(fn &optional QUIT-RESTORE EXIT-ACTION)" nil nil)
-
+(fn &optional QUIT-RESTORE EXIT-ACTION)" nil nil)
(autoload 'View-exit-and-edit "view" "\
Exit View mode and make the current buffer editable." t nil)
-
(register-definition-prefixes "view" '("View-" "view-"))
-;;;***
-;;;### (autoloads nil "viper" "emulation/viper.el" (0 0 0 0))
;;; Generated autoloads from emulation/viper.el
-(push (purecopy '(viper 3 14 1)) package--builtin-versions)
+(push (purecopy '(viper 3 14 1)) package--builtin-versions)
(autoload 'toggle-viper-mode "viper" "\
Toggle Viper on/off.
If Viper is enabled, turn it off. Otherwise, turn it on." t nil)
-
(autoload 'viper-mode "viper" "\
Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
-
(register-definition-prefixes "viper" '("set-viper-state-in-major-mode" "this-major-mode-requires-vi-state" "viper-"))
-;;;***
-;;;### (autoloads nil "viper-cmd" "emulation/viper-cmd.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emulation/viper-cmd.el
(register-definition-prefixes "viper-cmd" '("viper-"))
-;;;***
-;;;### (autoloads nil "viper-ex" "emulation/viper-ex.el" (0 0 0 0))
;;; Generated autoloads from emulation/viper-ex.el
(register-definition-prefixes "viper-ex" '("ex-" "viper-"))
-;;;***
-;;;### (autoloads nil "viper-init" "emulation/viper-init.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-init.el
(register-definition-prefixes "viper-init" '("viper-"))
-;;;***
-;;;### (autoloads nil "viper-keym" "emulation/viper-keym.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-keym.el
(register-definition-prefixes "viper-keym" '("ex-read-filename-map" "viper-"))
-;;;***
-;;;### (autoloads nil "viper-macs" "emulation/viper-macs.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-macs.el
(register-definition-prefixes "viper-macs" '("ex-" "viper-"))
-;;;***
-;;;### (autoloads nil "viper-mous" "emulation/viper-mous.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-mous.el
(register-definition-prefixes "viper-mous" '("viper-"))
-;;;***
-;;;### (autoloads nil "viper-util" "emulation/viper-util.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-util.el
(register-definition-prefixes "viper-util" '("viper"))
-;;;***
-;;;### (autoloads nil "vt-control" "vt-control.el" (0 0 0 0))
-;;; Generated autoloads from vt-control.el
+;;; Generated autoloads from leim/quail/viqr.el
-(register-definition-prefixes "vt-control" '("vt-"))
+(register-definition-prefixes "quail/viqr" '("viet-quail-define-rules"))
-;;;***
-;;;### (autoloads nil "vt100-led" "vt100-led.el" (0 0 0 0))
-;;; Generated autoloads from vt100-led.el
+;;; Generated autoloads from emacs-lisp/vtable.el
-(register-definition-prefixes "vt100-led" '("led-"))
+(register-definition-prefixes "vtable" '("vtable"))
-;;;***
-;;;### (autoloads nil "w32-fns" "w32-fns.el" (0 0 0 0))
;;; Generated autoloads from w32-fns.el
(register-definition-prefixes "w32-fns" '("w32-"))
-;;;***
-;;;### (autoloads nil "w32-vars" "w32-vars.el" (0 0 0 0))
;;; Generated autoloads from w32-vars.el
(register-definition-prefixes "w32-vars" '("w32-"))
-;;;***
-;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (0 0 0
-;;;;;; 0))
;;; Generated autoloads from emacs-lisp/warnings.el
(defvar warning-prefix-function nil "\
@@ -38233,7 +34585,6 @@ and should return the entry that should actually be used.
The warnings buffer is current when this function is called
and the function can insert text in it. This text becomes
the beginning of the warning.")
-
(defvar warning-series nil "\
Non-nil means treat multiple `display-warning' calls as a series.
A marker indicates a position in the warnings buffer
@@ -38242,24 +34593,21 @@ additional warnings in the same buffer should not move point.
If t, the next warning begins a series (and stores a marker here).
A symbol with a function definition is like t, except
also call that function before the next warning.")
-
(defvar warning-fill-prefix nil "\
Non-nil means fill each warning text using this string as `fill-prefix'.")
-
(defvar warning-type-format (purecopy " (%s)") "\
Format for displaying the warning type in the warning message.
The result of formatting the type this way gets included in the
message under the control of the string in `warning-levels'.")
-
(autoload 'display-warning "warnings" "\
Display a warning message, MESSAGE.
TYPE is the warning type: either a custom group name (a symbol),
or a list of symbols whose first element is a custom group name.
-\(The rest of the symbols represent subcategories, for warning purposes
+(The rest of the symbols represent subcategories, for warning purposes
only, and you can use whatever symbols you like.)
LEVEL should be either :debug, :warning, :error, or :emergency
-\(but see `warning-minimum-level' and `warning-minimum-log-level').
+(but see `warning-minimum-level' and `warning-minimum-log-level').
Default is :warning.
:emergency -- a problem that will seriously impair Emacs operation soon
@@ -38284,8 +34632,7 @@ disable automatic display of the warning or disable the warning
entirely by setting `warning-suppress-types' or
`warning-suppress-log-types' on their behalf.
-\(fn TYPE MESSAGE &optional LEVEL BUFFER-NAME)" nil nil)
-
+(fn TYPE MESSAGE &optional LEVEL BUFFER-NAME)" nil nil)
(autoload 'lwarn "warnings" "\
Display a warning message made from (format-message MESSAGE ARGS...).
\\<special-mode-map>
@@ -38294,11 +34641,11 @@ this is equivalent to `display-warning'.
TYPE is the warning type: either a custom group name (a symbol),
or a list of symbols whose first element is a custom group name.
-\(The rest of the symbols represent subcategories and
+(The rest of the symbols represent subcategories and
can be whatever you like.)
LEVEL should be either :debug, :warning, :error, or :emergency
-\(but see `warning-minimum-level' and `warning-minimum-log-level').
+(but see `warning-minimum-level' and `warning-minimum-log-level').
:emergency -- a problem that will seriously impair Emacs operation soon
if you do not attend to it promptly.
@@ -38306,21 +34653,17 @@ LEVEL should be either :debug, :warning, :error, or :emergency
:warning -- suspicious data or circumstances.
:debug -- info for debugging only.
-\(fn TYPE LEVEL MESSAGE &rest ARGS)" nil nil)
-
+(fn TYPE LEVEL MESSAGE &rest ARGS)" nil nil)
(autoload 'warn "warnings" "\
Display a warning message made from (format-message MESSAGE ARGS...).
Aside from generating the message with `format-message',
this is equivalent to `display-warning', using
`emacs' as the type and `:warning' as the level.
-\(fn MESSAGE &rest ARGS)" nil nil)
-
+(fn MESSAGE &rest ARGS)" nil nil)
(register-definition-prefixes "warnings" '("warning-"))
-;;;***
-;;;### (autoloads nil "wdired" "wdired.el" (0 0 0 0))
;;; Generated autoloads from wdired.el
(autoload 'wdired-change-to-wdired-mode "wdired" "\
@@ -38332,12 +34675,9 @@ files. After typing \\[wdired-finish-edit], Emacs modifies the files and
directories to reflect your edits.
See `wdired-mode'." t nil)
-
(register-definition-prefixes "wdired" '("wdired-"))
-;;;***
-;;;### (autoloads nil "webjump" "net/webjump.el" (0 0 0 0))
;;; Generated autoloads from net/webjump.el
(autoload 'webjump "webjump" "\
@@ -38348,19 +34688,14 @@ hotlist.
Please submit bug reports and other feedback to the author, Neil W. Van Dyke
<nwv@acm.org>." t nil)
-
(register-definition-prefixes "webjump" '("webjump-"))
-;;;***
-;;;### (autoloads nil "which-func" "progmodes/which-func.el" (0 0
-;;;;;; 0 0))
;;; Generated autoloads from progmodes/which-func.el
+
(put 'which-func-format 'risky-local-variable t)
(put 'which-func-current 'risky-local-variable t)
-
(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1")
-
(defvar which-function-mode nil "\
Non-nil if Which-Function mode is enabled.
See the `which-function-mode' command
@@ -38368,81 +34703,61 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `which-function-mode'.")
-
(custom-autoload 'which-function-mode "which-func" nil)
-
(autoload 'which-function-mode "which-func" "\
Toggle mode line display of current function (Which Function mode).
-This is a minor mode. If called interactively, toggle the
+Which Function mode is a global minor mode. When enabled, the
+current function name is continuously displayed in the mode line,
+in certain major modes.
+
+This is a global minor mode. If called interactively, toggle the
`Which-Function mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='which-function-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-Which Function mode is a global minor mode. When enabled, the
-current function name is continuously displayed in the mode line,
-in certain major modes.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "which-func" '("which-func"))
-;;;***
-;;;### (autoloads nil "whitespace" "whitespace.el" (0 0 0 0))
;;; Generated autoloads from whitespace.el
-(push (purecopy '(whitespace 13 2 2)) package--builtin-versions)
+(push (purecopy '(whitespace 13 2 2)) package--builtin-versions)
(autoload 'whitespace-mode "whitespace" "\
Toggle whitespace visualization (Whitespace mode).
-This is a minor mode. If called interactively, toggle the `Whitespace
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `whitespace-mode'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
See also `whitespace-style', `whitespace-newline' and
`whitespace-display-mappings'.
This mode uses a number of faces to visualize the whitespace; see
the customization group `whitespace' for details.
-\(fn &optional ARG)" t nil)
-
-(autoload 'whitespace-newline-mode "whitespace" "\
-Toggle newline visualization (Whitespace Newline mode).
-
This is a minor mode. If called interactively, toggle the
-`Whitespace-Newline mode' mode. If the prefix argument is positive,
+`Whitespace mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
-evaluate `whitespace-newline-mode'.
+evaluate `whitespace-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(autoload 'whitespace-newline-mode "whitespace" "\
+Toggle newline visualization (Whitespace Newline mode).
Use `whitespace-newline-mode' only for NEWLINE visualization
exclusively. For other visualizations, including NEWLINE
@@ -38451,8 +34766,22 @@ use `whitespace-mode'.
See also `whitespace-newline' and `whitespace-display-mappings'.
-\(fn &optional ARG)" t nil)
+This is a minor mode. If called interactively, toggle the
+`Whitespace-Newline mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `whitespace-newline-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(defvar global-whitespace-mode nil "\
Non-nil if Global Whitespace mode is enabled.
See the `global-whitespace-mode' command
@@ -38460,31 +34789,29 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-whitespace-mode'.")
-
(custom-autoload 'global-whitespace-mode "whitespace" nil)
-
(autoload 'global-whitespace-mode "whitespace" "\
Toggle whitespace visualization globally (Global Whitespace mode).
-This is a minor mode. If called interactively, toggle the `Global
-Whitespace mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+See also `whitespace-style', `whitespace-newline' and
+`whitespace-display-mappings'.
+
+This is a global minor mode. If called interactively, toggle the
+`Global Whitespace mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='global-whitespace-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-See also `whitespace-style', `whitespace-newline' and
-`whitespace-display-mappings'.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(defvar global-whitespace-newline-mode nil "\
Non-nil if Global Whitespace-Newline mode is enabled.
See the `global-whitespace-newline-mode' command
@@ -38492,26 +34819,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-whitespace-newline-mode'.")
-
(custom-autoload 'global-whitespace-newline-mode "whitespace" nil)
-
(autoload 'global-whitespace-newline-mode "whitespace" "\
Toggle global newline visualization (Global Whitespace Newline mode).
-This is a minor mode. If called interactively, toggle the `Global
-Whitespace-Newline mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='global-whitespace-newline-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Use `global-whitespace-newline-mode' only for NEWLINE
visualization exclusively. For other visualizations, including
NEWLINE visualization together with (HARD) SPACEs and/or TABs,
@@ -38519,8 +34830,22 @@ please use `global-whitespace-mode'.
See also `whitespace-newline' and `whitespace-display-mappings'.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Global Whitespace-Newline mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='global-whitespace-newline-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(autoload 'whitespace-toggle-options "whitespace" "\
Toggle local `whitespace-mode' options.
@@ -38591,8 +34916,7 @@ The valid symbols are:
See `whitespace-style' and `indent-tabs-mode' for documentation.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'global-whitespace-toggle-options "whitespace" "\
Toggle global `whitespace-mode' options.
@@ -38612,6 +34936,7 @@ Interactively, it accepts one of the following chars:
r toggle trailing blanks visualization
l toggle \"long lines\" visualization
L toggle \"long lines\" tail visualization
+ C-l toggle \"long lines\" one character visualization
n toggle NEWLINE visualization
e toggle empty line at bob and/or eob visualization
C-i toggle indentation SPACEs visualization (via `indent-tabs-mode')
@@ -38642,6 +34967,7 @@ The valid symbols are:
trailing toggle trailing blanks visualization
lines toggle \"long lines\" visualization
lines-tail toggle \"long lines\" tail visualization
+ lines-char toggle \"long lines\" one character visualization
newline toggle NEWLINE visualization
empty toggle empty line at bob and/or eob visualization
indentation toggle indentation SPACEs visualization
@@ -38663,8 +34989,7 @@ The valid symbols are:
See `whitespace-style' and `indent-tabs-mode' for documentation.
-\(fn ARG)" t nil)
-
+(fn ARG)" t nil)
(autoload 'whitespace-cleanup "whitespace" "\
Cleanup some blank problems in all buffer or at region.
@@ -38717,7 +35042,6 @@ The problems cleaned up are:
See `whitespace-style', `indent-tabs-mode' and `tab-width' for
documentation." t nil)
-
(autoload 'whitespace-cleanup-region "whitespace" "\
Cleanup some blank problems at region.
@@ -38758,15 +35082,13 @@ The problems cleaned up are:
See `whitespace-style', `indent-tabs-mode' and `tab-width' for
documentation.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'whitespace-report "whitespace" "\
Report some whitespace problems in buffer.
Perform `whitespace-report-region' on the current buffer.
-\(fn &optional FORCE REPORT-IF-BOGUS)" t nil)
-
+(fn &optional FORCE REPORT-IF-BOGUS)" t nil)
(autoload 'whitespace-report-region "whitespace" "\
Report some whitespace problems in a region.
@@ -38804,96 +35126,83 @@ See `whitespace-style' for documentation.
See also `whitespace-cleanup' and `whitespace-cleanup-region' for
cleaning up these problems.
-\(fn START END &optional FORCE REPORT-IF-BOGUS)" t nil)
-
+(fn START END &optional FORCE REPORT-IF-BOGUS)" t nil)
(register-definition-prefixes "whitespace" '("whitespace-"))
-;;;***
-;;;### (autoloads nil "wid-browse" "wid-browse.el" (0 0 0 0))
;;; Generated autoloads from wid-browse.el
(autoload 'widget-browse-at "wid-browse" "\
Browse the widget under point.
-\(fn POS)" t nil)
-
+(fn POS)" t nil)
(autoload 'widget-browse "wid-browse" "\
Create a widget browser for WIDGET.
-\(fn WIDGET)" t nil)
-
+(fn WIDGET)" t nil)
(autoload 'widget-browse-other-window "wid-browse" "\
Show widget browser for WIDGET in other window.
-\(fn &optional WIDGET)" t nil)
-
+(fn &optional WIDGET)" t nil)
(autoload 'widget-minor-mode "wid-browse" "\
Minor mode for traversing widgets.
-This is a minor mode. If called interactively, toggle the `Widget
-minor mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Widget minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `widget-minor-mode'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "wid-browse" '("widget-"))
-;;;***
-;;;### (autoloads nil "wid-edit" "wid-edit.el" (0 0 0 0))
;;; Generated autoloads from wid-edit.el
(autoload 'widgetp "wid-edit" "\
Return non-nil if WIDGET is a widget.
-\(fn WIDGET)" nil nil)
-
+(fn WIDGET)" nil nil)
(autoload 'widget-prompt-value "wid-edit" "\
Prompt for a value matching WIDGET, using PROMPT.
The current value is assumed to be VALUE, unless UNBOUND is non-nil.
-\(fn WIDGET PROMPT &optional VALUE UNBOUND)" nil nil)
-
+(fn WIDGET PROMPT &optional VALUE UNBOUND)" nil nil)
(autoload 'widget-create "wid-edit" "\
Create widget of TYPE.
The optional ARGS are additional keyword arguments.
-\(fn TYPE &rest ARGS)" nil nil)
-
+(fn TYPE &rest ARGS)" nil nil)
(autoload 'widget-delete "wid-edit" "\
Delete WIDGET.
-\(fn WIDGET)" nil nil)
+(fn WIDGET)" nil nil)
+(autoload 'widget-convert "wid-edit" "\
+Convert TYPE to a widget without inserting it in the buffer.
+The optional ARGS are additional keyword arguments.
+(fn TYPE &rest ARGS)" nil nil)
(autoload 'widget-insert "wid-edit" "\
Call `insert' with ARGS even if surrounding text is read only.
-\(fn &rest ARGS)" nil nil)
-
+(fn &rest ARGS)" nil nil)
(defvar widget-keymap (let ((map (make-sparse-keymap))) (define-key map "\11" 'widget-forward) (define-key map "\33\11" 'widget-backward) (define-key map [(shift tab)] 'widget-backward) (put 'widget-backward :advertised-binding [(shift tab)]) (define-key map [backtab] 'widget-backward) (define-key map [down-mouse-2] 'widget-button-click) (define-key map [down-mouse-1] 'widget-button-click) (define-key map [(control 109)] 'widget-button-press) map) "\
Keymap containing useful binding for buffers containing widgets.
Recommended as a parent keymap for modes using widgets.
Note that such modes will need to require wid-edit.")
-
(autoload 'widget-setup "wid-edit" "\
Setup current buffer so editing string widgets works." nil nil)
-
(register-definition-prefixes "wid-edit" '("widget-"))
-;;;***
-;;;### (autoloads nil "windmove" "windmove.el" (0 0 0 0))
;;; Generated autoloads from windmove.el
(autoload 'windmove-left "windmove" "\
@@ -38901,12 +35210,11 @@ Select the window to the left of the current one.
With no prefix argument, or with prefix argument equal to zero,
\"left\" is relative to the position of point in the window; otherwise
it is relative to the top edge (for positive ARG) or the bottom edge
-\(for negative ARG) of the current window.
+(for negative ARG) of the current window.
If no window is at the desired location, an error is signaled
unless `windmove-create-window' is non-nil and a new window is created.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-up "windmove" "\
Select the window above the current one.
With no prefix argument, or with prefix argument equal to zero, \"up\"
@@ -38916,8 +35224,7 @@ negative ARG) of the current window.
If no window is at the desired location, an error is signaled
unless `windmove-create-window' is non-nil and a new window is created.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-right "windmove" "\
Select the window to the right of the current one.
With no prefix argument, or with prefix argument equal to zero,
@@ -38927,19 +35234,40 @@ bottom edge (for negative ARG) of the current window.
If no window is at the desired location, an error is signaled
unless `windmove-create-window' is non-nil and a new window is created.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-down "windmove" "\
Select the window below the current one.
With no prefix argument, or with prefix argument equal to zero,
\"down\" is relative to the position of point in the window; otherwise
it is relative to the left edge (for positive ARG) or the right edge
-\(for negative ARG) of the current window.
+(for negative ARG) of the current window.
If no window is at the desired location, an error is signaled
unless `windmove-create-window' is non-nil and a new window is created.
-\(fn &optional ARG)" t nil)
+(fn &optional ARG)" t nil)
+(defvar windmove-mode t "\
+Non-nil if Windmove mode is enabled.
+See the `windmove-mode' command
+for a description of this minor mode.")
+(custom-autoload 'windmove-mode "windmove" nil)
+(autoload 'windmove-mode "windmove" "\
+Global minor mode for default windmove commands.
+
+This is a global minor mode. If called interactively, toggle the
+`Windmove mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='windmove-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
(autoload 'windmove-default-keybindings "windmove" "\
Set up keybindings for `windmove'.
Keybindings are of the form MODIFIERS-{left,right,up,down},
@@ -38948,51 +35276,43 @@ If MODIFIERS is `none', the keybindings will be directly bound to
the arrow keys.
Default value of MODIFIERS is `shift'.
-\(fn &optional MODIFIERS)" t nil)
-
+(fn &optional MODIFIERS)" t nil)
(autoload 'windmove-display-left "windmove" "\
Display the next buffer in window to the left of the current one.
See the logic of the prefix ARG and `windmove-display-no-select'
in `windmove-display-in-direction'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-display-up "windmove" "\
Display the next buffer in window above the current one.
See the logic of the prefix ARG and `windmove-display-no-select'
in `windmove-display-in-direction'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-display-right "windmove" "\
Display the next buffer in window to the right of the current one.
See the logic of the prefix ARG and `windmove-display-no-select'
in `windmove-display-in-direction'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-display-down "windmove" "\
Display the next buffer in window below the current one.
See the logic of the prefix ARG and `windmove-display-no-select'
in `windmove-display-in-direction'.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-display-same-window "windmove" "\
Display the next buffer in the same window.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-display-new-frame "windmove" "\
Display the next buffer in a new frame.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-display-new-tab "windmove" "\
Display the next buffer in a new tab.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-display-default-keybindings "windmove" "\
Set up keybindings for directional buffer display.
Keys are bound to commands that display the next buffer in the specified
@@ -39002,36 +35322,31 @@ If MODIFIERS is `none', the keybindings will be directly bound to
the arrow keys.
Default value of MODIFIERS is `shift-meta'.
-\(fn &optional MODIFIERS)" t nil)
-
+(fn &optional MODIFIERS)" t nil)
(autoload 'windmove-delete-left "windmove" "\
Delete the window to the left of the current one.
If prefix ARG is \\[universal-argument], delete the selected window and
select the window that was to the left of the current one.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-delete-up "windmove" "\
Delete the window above the current one.
If prefix ARG is \\[universal-argument], delete the selected window and
select the window that was above the current one.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-delete-right "windmove" "\
Delete the window to the right of the current one.
If prefix ARG is \\[universal-argument], delete the selected window and
select the window that was to the right of the current one.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-delete-down "windmove" "\
Delete the window below the current one.
If prefix ARG is \\[universal-argument], delete the selected window and
select the window that was below the current one.
-\(fn &optional ARG)" t nil)
-
+(fn &optional ARG)" t nil)
(autoload 'windmove-delete-default-keybindings "windmove" "\
Set up keybindings for directional window deletion.
Keys are bound to commands that delete windows in the specified
@@ -39040,22 +35355,17 @@ where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or
a single modifier.
If PREFIX is `none', no prefix is used. If MODIFIERS is `none',
the keybindings are directly bound to the arrow keys.
-Default value of PREFIX is `C-x' and MODIFIERS is `shift'.
-
-\(fn &optional PREFIX MODIFIERS)" t nil)
+Default value of PREFIX is \\`C-x' and MODIFIERS is `shift'.
+(fn &optional PREFIX MODIFIERS)" t nil)
(autoload 'windmove-swap-states-left "windmove" "\
Swap the states with the window on the left from the current one." t nil)
-
(autoload 'windmove-swap-states-up "windmove" "\
Swap the states with the window above from the current one." t nil)
-
(autoload 'windmove-swap-states-down "windmove" "\
Swap the states with the window below from the current one." t nil)
-
(autoload 'windmove-swap-states-right "windmove" "\
Swap the states with the window on the right from the current one." t nil)
-
(autoload 'windmove-swap-states-default-keybindings "windmove" "\
Set up keybindings for directional window swap states.
Keys are bound to commands that swap the states of the selected window
@@ -39066,13 +35376,10 @@ If MODIFIERS is `none', the keybindings will be directly bound to the
arrow keys.
Default value of MODIFIERS is `shift-super'.
-\(fn &optional MODIFIERS)" t nil)
-
+(fn &optional MODIFIERS)" t nil)
(register-definition-prefixes "windmove" '("windmove-"))
-;;;***
-;;;### (autoloads nil "winner" "winner.el" (0 0 0 0))
;;; Generated autoloads from winner.el
(defvar winner-mode nil "\
@@ -39082,50 +35389,53 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `winner-mode'.")
-
(custom-autoload 'winner-mode "winner" nil)
-
(autoload 'winner-mode "winner" "\
Toggle Winner mode on or off.
-This is a minor mode. If called interactively, toggle the `Winner
-mode' mode. If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+Winner mode is a global minor mode that records the changes in
+the window configuration (i.e. how the frames are partitioned
+into windows) so that the changes can be \"undone\" using the
+command `winner-undo'. By default this one is bound to the key
+sequence \\`C-c <left>'. If you change your mind (while undoing),
+you can press \\`C-c <right>' (calling `winner-redo').
+
+This is a global minor mode. If called interactively, toggle the
+`Winner mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='winner-mode)'.
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
-Winner mode is a global minor mode that records the changes in
-the window configuration (i.e. how the frames are partitioned
-into windows) so that the changes can be \"undone\" using the
-command `winner-undo'. By default this one is bound to the key
-sequence `C-c <left>'. If you change your mind (while undoing),
-you can press `C-c <right>' (calling `winner-redo').
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "winner" '("winner-"))
-\(fn &optional ARG)" t nil)
+
+;;; Generated autoloads from cedet/semantic/wisent/wisent.el
-(register-definition-prefixes "winner" '("winner-"))
+(register-definition-prefixes "semantic/wisent/wisent" '("$action" "$nterm" "$region" "wisent-"))
+
+
+;;; Generated autoloads from cedet/semantic/wisent.el
+
+(register-definition-prefixes "semantic/wisent" '("define-wisent-lexer" "wisent-"))
-;;;***
-;;;### (autoloads nil "woman" "woman.el" (0 0 0 0))
;;; Generated autoloads from woman.el
(defvar woman-locale nil "\
String specifying a manual page locale, or nil.
If a manual page is available in the specified locale
-\(e.g. \"sv_SE.ISO8859-1\"), it will be offered in preference to the
+(e.g. \"sv_SE.ISO8859-1\"), it will be offered in preference to the
default version. Normally, `set-locale-environment' sets this at startup.")
-
(custom-autoload 'woman-locale "woman" t)
-
(autoload 'woman "woman" "\
Browse UN*X man page for TOPIC (Without using external Man program).
The major browsing mode used is essentially the standard Man mode.
@@ -39138,11 +35448,9 @@ updated (e.g. to re-interpret the current directory).
Used non-interactively, arguments are optional: if given then TOPIC
should be a topic string and non-nil RE-CACHE forces re-caching.
-\(fn &optional TOPIC RE-CACHE)" t nil)
-
+(fn &optional TOPIC RE-CACHE)" t nil)
(autoload 'woman-dired-find-file "woman" "\
In dired, run the WoMan man-page browser on this file." t nil)
-
(autoload 'woman-find-file "woman" "\
Find, decode and browse a specific UN*X man-page source file FILE-NAME.
Use existing buffer if possible; reformat only if prefix arg given.
@@ -39152,32 +35460,75 @@ No external programs are used, except that `gunzip' will be used to
decompress the file if appropriate. See the documentation for the
`woman' command for further details.
-\(fn FILE-NAME &optional REFORMAT)" t nil)
-
+(fn FILE-NAME &optional REFORMAT)" t nil)
(autoload 'woman-bookmark-jump "woman" "\
Default bookmark handler for Woman buffers.
-\(fn BOOKMARK)" nil nil)
-
+(fn BOOKMARK)" nil nil)
(register-definition-prefixes "woman" '("WoMan-" "menu-bar-manuals-menu" "set-woman-file-regexp" "woman"))
-;;;***
-;;;### (autoloads nil "x-dnd" "x-dnd.el" (0 0 0 0))
+;;; Generated autoloads from textmodes/word-wrap-mode.el
+
+(autoload 'word-wrap-whitespace-mode "word-wrap-mode" "\
+Allow `word-wrap' to fold on all breaking whitespace characters.
+
+The characters to break on are defined by `word-wrap-whitespace-characters'.
+
+This is a minor mode. If called interactively, toggle the
+`Word-Wrap-Whitespace mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `word-wrap-whitespace-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+(fn &optional ARG)" t nil)
+(put 'global-word-wrap-whitespace-mode 'globalized-minor-mode t)
+(defvar global-word-wrap-whitespace-mode nil "\
+Non-nil if Global Word-Wrap-Whitespace mode is enabled.
+See the `global-word-wrap-whitespace-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-word-wrap-whitespace-mode'.")
+(custom-autoload 'global-word-wrap-whitespace-mode "word-wrap-mode" nil)
+(autoload 'global-word-wrap-whitespace-mode "word-wrap-mode" "\
+Toggle Word-Wrap-Whitespace mode in all buffers.
+With prefix ARG, enable Global Word-Wrap-Whitespace mode if ARG is
+positive; otherwise, disable it.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+Word-Wrap-Whitespace mode is enabled in all buffers where
+`word-wrap-whitespace-mode' would do it.
+
+See `word-wrap-whitespace-mode' for more information on
+Word-Wrap-Whitespace mode.
+
+(fn &optional ARG)" t nil)
+(register-definition-prefixes "word-wrap-mode" '("word-wrap-whitespace-characters"))
+
+
;;; Generated autoloads from x-dnd.el
(register-definition-prefixes "x-dnd" '("x-dnd-"))
-;;;***
-;;;### (autoloads nil "xdg" "xdg.el" (0 0 0 0))
;;; Generated autoloads from xdg.el
(register-definition-prefixes "xdg" '("xdg-"))
-;;;***
-;;;### (autoloads nil "xml" "xml.el" (0 0 0 0))
;;; Generated autoloads from xml.el
(autoload 'xml-parse-file "xml" "\
@@ -39201,8 +35552,7 @@ Both features can be combined by providing a cons cell
(symbol-qnames . ALIST).
-\(fn FILE &optional PARSE-DTD PARSE-NS)" nil nil)
-
+(fn FILE &optional PARSE-DTD PARSE-NS)" nil nil)
(autoload 'xml-parse-region "xml" "\
Parse the region from BEG to END in BUFFER.
Return the XML parse tree, or raise an error if the region does
@@ -39229,19 +35579,15 @@ Both features can be combined by providing a cons cell
(symbol-qnames . ALIST).
-\(fn &optional BEG END BUFFER PARSE-DTD PARSE-NS)" nil nil)
-
+(fn &optional BEG END BUFFER PARSE-DTD PARSE-NS)" nil nil)
(autoload 'xml-remove-comments "xml" "\
Remove XML/HTML comments in the region between BEG and END.
All text between the <!-- ... --> markers will be removed.
-\(fn BEG END)" nil nil)
-
+(fn BEG END)" nil nil)
(register-definition-prefixes "xml" '("xml-"))
-;;;***
-;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (0 0 0 0))
;;; Generated autoloads from nxml/xmltok.el
(autoload 'xmltok-get-declared-encoding-position "xmltok" "\
@@ -39255,24 +35601,30 @@ If there is XML that is not well-formed that looks like an XML
declaration, return nil. Otherwise, return t.
If LIMIT is non-nil, then do not consider characters beyond LIMIT.
-\(fn &optional LIMIT)" nil nil)
-
+(fn &optional LIMIT)" nil nil)
(register-definition-prefixes "xmltok" '("xmltok-"))
-;;;***
-;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xref.el
-(push (purecopy '(xref 1 3 0)) package--builtin-versions)
+(push (purecopy '(xref 1 4 1)) package--builtin-versions)
(autoload 'xref-find-backend "xref" nil nil nil)
-
-(autoload 'xref-pop-marker-stack "xref" "\
-Pop back to where \\[xref-find-definitions] was last invoked." t nil)
-
+(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1")
+(autoload 'xref-go-back "xref" "\
+Go back to the previous position in xref history.
+To undo, use \\[xref-go-forward]." t nil)
+(autoload 'xref-go-forward "xref" "\
+Got to the point where a previous \\[xref-go-back] was invoked." t nil)
(autoload 'xref-marker-stack-empty-p "xref" "\
-Return t if the marker stack is empty; nil otherwise." nil nil)
-
+Whether the xref back-history is empty." nil nil)
+(autoload 'xref-forward-history-empty-p "xref" "\
+Whether the xref forward-history is empty." nil nil)
+(autoload 'xref-show-xrefs "xref" "\
+Display some Xref values produced by FETCHER using DISPLAY-ACTION.
+The meanings of both arguments are the same as documented in
+`xref-show-xrefs-function'.
+
+(fn FETCHER DISPLAY-ACTION)" nil nil)
(autoload 'xref-find-definitions "xref" "\
Find the definition of the identifier at point.
With prefix argument or when there's no identifier at point,
@@ -39283,20 +35635,17 @@ definition for IDENTIFIER, display it in the selected window.
Otherwise, display the list of the possible definitions in a
buffer where the user can select from the list.
-Use \\[xref-pop-marker-stack] to return back to where you invoked this command.
-
-\(fn IDENTIFIER)" t nil)
+Use \\[xref-go-back] to return back to where you invoked this command.
+(fn IDENTIFIER)" t nil)
(autoload 'xref-find-definitions-other-window "xref" "\
Like `xref-find-definitions' but switch to the other window.
-\(fn IDENTIFIER)" t nil)
-
+(fn IDENTIFIER)" t nil)
(autoload 'xref-find-definitions-other-frame "xref" "\
Like `xref-find-definitions' but switch to the other frame.
-\(fn IDENTIFIER)" t nil)
-
+(fn IDENTIFIER)" t nil)
(autoload 'xref-find-references "xref" "\
Find references to the identifier at point.
This command might prompt for the identifier as needed, perhaps
@@ -39305,34 +35654,31 @@ With prefix argument, or if `xref-prompt-for-identifier' is t,
always prompt for the identifier. If `xref-prompt-for-identifier'
is nil, prompt only if there's no usable symbol at point.
-\(fn IDENTIFIER)" t nil)
-
+(fn IDENTIFIER)" t nil)
(autoload 'xref-find-definitions-at-mouse "xref" "\
Find the definition of identifier at or around mouse click.
This command is intended to be bound to a mouse event.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'xref-find-references-at-mouse "xref" "\
Find references to the identifier at or around mouse click.
This command is intended to be bound to a mouse event.
-\(fn EVENT)" t nil)
-
+(fn EVENT)" t nil)
(autoload 'xref-find-apropos "xref" "\
Find all meaningful symbols that match PATTERN.
The argument has the same meaning as in `apropos'.
See `tags-apropos-additional-actions' for how to augment the
output of this command when the backend is etags.
-\(fn PATTERN)" t nil)
+(fn PATTERN)" t nil)
(define-key esc-map "." #'xref-find-definitions)
- (define-key esc-map "," #'xref-pop-marker-stack)
+ (define-key esc-map "," #'xref-go-back)
+ (define-key esc-map [?\C-,] #'xref-go-forward)
(define-key esc-map "?" #'xref-find-references)
(define-key esc-map [?\C-.] #'xref-find-apropos)
(define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
(define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
-
(autoload 'xref-references-in-directory "xref" "\
Find all references to SYMBOL in directory DIR.
Return a list of xref values.
@@ -39341,8 +35687,7 @@ This function uses the Semantic Symbol Reference API, see
`semantic-symref-tool-alist' for details on which tools are used,
and when.
-\(fn SYMBOL DIR)" nil nil)
-
+(fn SYMBOL DIR)" nil nil)
(autoload 'xref-matches-in-directory "xref" "\
Find all matches for REGEXP in directory DIR.
Return a list of xref values.
@@ -39350,8 +35695,7 @@ Only files matching some of FILES and none of IGNORES are searched.
FILES is a string with glob patterns separated by spaces.
IGNORES is a list of glob patterns for files to ignore.
-\(fn REGEXP FILES DIR IGNORES)" nil nil)
-
+(fn REGEXP FILES DIR IGNORES)" nil nil)
(autoload 'xref-matches-in-files "xref" "\
Find all matches for REGEXP in FILES.
Return a list of xref values.
@@ -39360,27 +35704,20 @@ FILES must be a list of absolute file names.
See `xref-search-program' and `xref-search-program-alist' for how
to control which program to use when looking for matches.
-\(fn REGEXP FILES)" nil nil)
-
+(fn REGEXP FILES)" nil nil)
(register-definition-prefixes "xref" '("xref-"))
-;;;***
-;;;### (autoloads nil "xscheme" "progmodes/xscheme.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xscheme.el
(register-definition-prefixes "xscheme" '("default-xscheme-runlight" "exit-scheme-interaction-mode" "global-set-scheme-interaction-buffer" "local-" "reset-scheme" "run-scheme" "scheme-" "start-scheme" "verify-xscheme-buffer" "xscheme-"))
-;;;***
-;;;### (autoloads nil "xsd-regexp" "nxml/xsd-regexp.el" (0 0 0 0))
;;; Generated autoloads from nxml/xsd-regexp.el
(register-definition-prefixes "xsd-regexp" '("xsdre-"))
-;;;***
-;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (0 0 0 0))
;;; Generated autoloads from xt-mouse.el
(defvar xterm-mouse-mode nil "\
@@ -39390,26 +35727,10 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `xterm-mouse-mode'.")
-
(custom-autoload 'xterm-mouse-mode "xt-mouse" nil)
-
(autoload 'xterm-mouse-mode "xt-mouse" "\
Toggle XTerm mouse mode.
-This is a minor mode. If called interactively, toggle the
-`Xterm-Mouse mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the
-mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='xterm-mouse-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
This works in terminal emulators compatible with xterm. It only
works for simple uses of the mouse. Basically, only non-modified
@@ -39417,13 +35738,24 @@ single clicks are supported. When turned on, the normal xterm
mouse functionality for such clicks is still available by holding
down the SHIFT key while pressing the mouse button.
-\(fn &optional ARG)" t nil)
+This is a global minor mode. If called interactively, toggle the
+`Xterm-Mouse mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='xterm-mouse-mode)'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+(fn &optional ARG)" t nil)
(register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-"))
-;;;***
-;;;### (autoloads nil "xwidget" "xwidget.el" (0 0 0 0))
;;; Generated autoloads from xwidget.el
(autoload 'xwidget-webkit-browse-url "xwidget" "\
@@ -39431,174 +35763,70 @@ Ask xwidget-webkit to browse URL.
NEW-SESSION specifies whether to create a new xwidget-webkit session.
Interactively, URL defaults to the string looking like a url around point.
-\(fn URL &optional NEW-SESSION)" t nil)
+(fn URL &optional NEW-SESSION)" t nil)
+(autoload 'xwidget-webkit-bookmark-jump-handler "xwidget" "\
+Jump to the web page bookmarked by the bookmark record BOOKMARK.
+If `xwidget-webkit-bookmark-jump-new-session' is non-nil, create
+a new xwidget-webkit session, otherwise use an existing session.
+(fn BOOKMARK)" nil nil)
(register-definition-prefixes "xwidget" '("xwidget-"))
-;;;***
-;;;### (autoloads nil "yenc" "mail/yenc.el" (0 0 0 0))
+;;; Generated autoloads from yank-media.el
+
+(autoload 'yank-media "yank-media" "\
+Yank media (images, HTML and the like) from the clipboard.
+This command depends on the current major mode having support for
+accepting the media type. The mode has to register itself using
+the `yank-media-handler' mechanism.
+
+Also see `yank-media-types' for a command that lets you explore
+all the different selection types." t nil)
+(autoload 'yank-media-handler "yank-media" "\
+Register HANDLER for dealing with `yank-media' actions for TYPES.
+TYPES should be a MIME media type symbol, a regexp, or a list
+that can contain both symbols and regexps.
+
+HANDLER is a function that will be called with two arguments: The
+MIME type (a symbol on the form `image/png') and the selection
+data (a string).
+
+(fn TYPES HANDLER)" nil nil)
+(register-definition-prefixes "yank-media" '("yank-media-"))
+
+
;;; Generated autoloads from mail/yenc.el
(autoload 'yenc-decode-region "yenc" "\
Yenc decode region between START and END using an internal decoder.
-\(fn START END)" t nil)
-
+(fn START END)" t nil)
(autoload 'yenc-extract-filename "yenc" "\
Extract file name from an yenc header." nil nil)
-
(register-definition-prefixes "yenc" '("yenc-"))
-;;;***
-;;;### (autoloads nil "zeroconf" "net/zeroconf.el" (0 0 0 0))
;;; Generated autoloads from net/zeroconf.el
(register-definition-prefixes "zeroconf" '("zeroconf-"))
-;;;***
-;;;### (autoloads nil "zone" "play/zone.el" (0 0 0 0))
;;; Generated autoloads from play/zone.el
(autoload 'zone "zone" "\
Zone out, completely." t nil)
-
(register-definition-prefixes "zone" '("zone-"))
-
-;;;***
-
-;;;### (autoloads nil nil ("abbrev.el" "bindings.el" "buff-menu.el"
-;;;;;; "button.el" "calc/calc-aent.el" "calc/calc-embed.el" "calc/calc-misc.el"
-;;;;;; "calc/calc-yank.el" "calendar/cal-loaddefs.el" "calendar/diary-loaddefs.el"
-;;;;;; "calendar/hol-loaddefs.el" "case-table.el" "cedet/ede/base.el"
-;;;;;; "cedet/ede/config.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el"
-;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el"
-;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/locate.el"
-;;;;;; "cedet/ede/make.el" "cedet/ede/shell.el" "cedet/ede/speedbar.el"
-;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/semantic/analyze.el"
-;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/refs.el"
-;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c-by.el"
-;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/el.el"
-;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make-by.el"
-;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.el"
-;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/complete.el"
-;;;;;; "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el"
-;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-mode.el"
-;;;;;; "cedet/semantic/db-typecache.el" "cedet/semantic/db.el" "cedet/semantic/debug.el"
-;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el"
-;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/edit.el"
-;;;;;; "cedet/semantic/find.el" "cedet/semantic/format.el" "cedet/semantic/grammar-wy.el"
-;;;;;; "cedet/semantic/grm-wy-boot.el" "cedet/semantic/html.el"
-;;;;;; "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" "cedet/semantic/idle.el"
-;;;;;; "cedet/semantic/imenu.el" "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el"
-;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/scope.el"
-;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el"
-;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/global.el"
-;;;;;; "cedet/semantic/symref/grep.el" "cedet/semantic/symref/idutils.el"
-;;;;;; "cedet/semantic/symref/list.el" "cedet/semantic/tag-file.el"
-;;;;;; "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el"
-;;;;;; "cedet/semantic/tag.el" "cedet/semantic/texi.el" "cedet/semantic/util-modes.el"
-;;;;;; "cedet/semantic/wisent/java-tags.el" "cedet/semantic/wisent/javascript.el"
-;;;;;; "cedet/semantic/wisent/javat-wy.el" "cedet/semantic/wisent/js-wy.el"
-;;;;;; "cedet/semantic/wisent/python-wy.el" "cedet/semantic/wisent/python.el"
-;;;;;; "cedet/srecode/compile.el" "cedet/srecode/cpp.el" "cedet/srecode/document.el"
-;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/getset.el"
-;;;;;; "cedet/srecode/insert.el" "cedet/srecode/java.el" "cedet/srecode/map.el"
-;;;;;; "cedet/srecode/mode.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el"
-;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "composite.el"
-;;;;;; "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" "dired-x.el"
-;;;;;; "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el"
-;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el"
-;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/easymenu.el" "emacs-lisp/eieio-compat.el"
-;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-opt.el" "emacs-lisp/float-sup.el"
-;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el"
-;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/shorthands.el"
-;;;;;; "emacs-lisp/syntax.el" "emacs-lisp/timer.el" "env.el" "epa-hook.el"
-;;;;;; "erc/erc-autoaway.el" "erc/erc-button.el" "erc/erc-capab.el"
-;;;;;; "erc/erc-compat.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el"
-;;;;;; "erc/erc-ezbounce.el" "erc/erc-fill.el" "erc/erc-identd.el"
-;;;;;; "erc/erc-imenu.el" "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el"
-;;;;;; "erc/erc-match.el" "erc/erc-menu.el" "erc/erc-netsplit.el"
-;;;;;; "erc/erc-notify.el" "erc/erc-page.el" "erc/erc-pcomplete.el"
-;;;;;; "erc/erc-replace.el" "erc/erc-ring.el" "erc/erc-services.el"
-;;;;;; "erc/erc-sound.el" "erc/erc-speedbar.el" "erc/erc-spelling.el"
-;;;;;; "erc/erc-stamp.el" "erc/erc-status-sidebar.el" "erc/erc-track.el"
-;;;;;; "erc/erc-truncate.el" "erc/erc-xdcc.el" "eshell/em-alias.el"
-;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el"
-;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el"
-;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el"
-;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el"
-;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el"
-;;;;;; "eshell/em-xtra.el" "faces.el" "files.el" "font-core.el"
-;;;;;; "font-lock.el" "format.el" "frame.el" "help.el" "hfy-cmap.el"
-;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charscript.el"
-;;;;;; "international/cp51932.el" "international/emoji-zwj.el" "international/eucjp-ms.el"
-;;;;;; "international/iso-transl.el" "international/mule-cmds.el"
-;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el"
-;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el"
-;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el"
-;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el"
-;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el"
-;;;;;; "language/indian.el" "language/japanese.el" "language/khmer.el"
-;;;;;; "language/korean.el" "language/lao.el" "language/misc-lang.el"
-;;;;;; "language/romanian.el" "language/sinhala.el" "language/slovak.el"
-;;;;;; "language/tai-viet.el" "language/thai.el" "language/tibetan.el"
-;;;;;; "language/utf-8-lang.el" "language/vietnamese.el" "ldefs-boot.el"
-;;;;;; "leim/ja-dic/ja-dic.el" "leim/leim-list.el" "leim/quail/4Corner.el"
-;;;;;; "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el" "leim/quail/CTLau-b5.el"
-;;;;;; "leim/quail/CTLau.el" "leim/quail/ECDICT.el" "leim/quail/ETZY.el"
-;;;;;; "leim/quail/PY-b5.el" "leim/quail/PY.el" "leim/quail/Punct-b5.el"
-;;;;;; "leim/quail/Punct.el" "leim/quail/QJ-b5.el" "leim/quail/QJ.el"
-;;;;;; "leim/quail/SW.el" "leim/quail/TONEPY.el" "leim/quail/ZIRANMA.el"
-;;;;;; "leim/quail/ZOZY.el" "leim/quail/arabic.el" "leim/quail/cham.el"
-;;;;;; "leim/quail/compose.el" "leim/quail/croatian.el" "leim/quail/cyril-jis.el"
-;;;;;; "leim/quail/cyrillic.el" "leim/quail/czech.el" "leim/quail/georgian.el"
-;;;;;; "leim/quail/greek.el" "leim/quail/hanja-jis.el" "leim/quail/hanja.el"
-;;;;;; "leim/quail/hanja3.el" "leim/quail/hebrew.el" "leim/quail/ipa-praat.el"
-;;;;;; "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" "leim/quail/latin-post.el"
-;;;;;; "leim/quail/latin-pre.el" "leim/quail/persian.el" "leim/quail/programmer-dvorak.el"
-;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el"
-;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sami.el"
-;;;;;; "leim/quail/sgml-input.el" "leim/quail/slovak.el" "leim/quail/symbol-ksc.el"
-;;;;;; "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el"
-;;;;;; "leim/quail/vntelex.el" "leim/quail/vnvni.el" "leim/quail/welsh.el"
-;;;;;; "loadup.el" "mail/blessmail.el" "mail/rmailedit.el" "mail/rmailkwd.el"
-;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
-;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el"
-;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el"
-;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-lob.el"
-;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el"
-;;;;;; "org/ol-irc.el" "org/ol.el" "org/org-archive.el" "org/org-attach.el"
-;;;;;; "org/org-clock.el" "org/org-colview.el" "org/org-compat.el"
-;;;;;; "org/org-datetree.el" "org/org-duration.el" "org/org-element.el"
-;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-goto.el"
-;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-install.el"
-;;;;;; "org/org-keys.el" "org/org-lint.el" "org/org-list.el" "org/org-macs.el"
-;;;;;; "org/org-mobile.el" "org/org-num.el" "org/org-plot.el" "org/org-refile.el"
-;;;;;; "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el"
-;;;;;; "org/ox-html.el" "org/ox-icalendar.el" "org/ox-latex.el"
-;;;;;; "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el"
-;;;;;; "org/ox-texinfo.el" "org/ox.el" "paren.el" "progmodes/elisp-mode.el"
-;;;;;; "progmodes/prog-mode.el" "ps-mule.el" "register.el" "replace.el"
-;;;;;; "rfn-eshadow.el" "select.el" "simple.el" "startup.el" "subdirs.el"
-;;;;;; "subr.el" "tab-bar.el" "textmodes/fill.el" "textmodes/makeinfo.el"
-;;;;;; "textmodes/page.el" "textmodes/paragraphs.el" "textmodes/reftex-auc.el"
-;;;;;; "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" "textmodes/reftex-global.el"
-;;;;;; "textmodes/reftex-index.el" "textmodes/reftex-parse.el" "textmodes/reftex-ref.el"
-;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el"
-;;;;;; "textmodes/text-mode.el" "uniquify.el" "vc/ediff-hook.el"
-;;;;;; "vc/vc-hooks.el" "version.el" "widget.el" "window.el") (0
-;;;;;; 0 0 0))
-
-;;;***
+;;; End of scraped data
+
(provide 'loaddefs)
+
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
-;; coding: utf-8
+;; coding: utf-8-emacs-unix
;; End:
+
;;; loaddefs.el ends here
diff --git a/lisp/leim/quail/compose.el b/lisp/leim/quail/compose.el
index 2aa8ae78fe7..60c73d7dff8 100644
--- a/lisp/leim/quail/compose.el
+++ b/lisp/leim/quail/compose.el
@@ -464,9 +464,9 @@ Examples:
("2^" ?²)
("^3" ?³)
("3^" ?³)
- ("mu" ?µ)
- ("/u" ?µ)
- ("u/" ?µ)
+ ("mu" ?μ)
+ ("/u" ?μ)
+ ("u/" ?μ)
("^1" ?¹)
("1^" ?¹)
("^_o" ?º)
diff --git a/lisp/leim/quail/emoji.el b/lisp/leim/quail/emoji.el
new file mode 100644
index 00000000000..f9d3e170be5
--- /dev/null
+++ b/lisp/leim/quail/emoji.el
@@ -0,0 +1,2003 @@
+;;; emoji.el --- Quail package for emoji character composition -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Juri Linkov <juri@linkov.net>
+;; Keywords: multilingual, input method, i18n
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This input method supports the same key sequences as the names
+;; defined by the `C-x 8 e s' completions in emoji.el. Also it adds
+;; more emoji that enclosed in double colons.
+
+;; You can enable this input method transiently with `C-u C-x \ emoji RET'.
+;; Then typing `C-x \' will enable this input method temporarily, and
+;; after typing a key sequence it will be disabled. So typing
+;; e.g. `C-x \ : )' will insert the smiling character, and disable
+;; this input method automatically afterwards.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "emoji" "UTF-8" "🙂" t
+ "Emoji input method for inserting emoji characters.
+Examples:
+ slightly smiling face -> 🙂
+ :slightly_smiling_face: -> 🙂
+ :-) -> 🙂"
+ '(("\t" . quail-completion))
+ t nil nil nil nil nil nil nil nil t)
+
+(eval-when-compile
+ (require 'emoji)
+ (emoji--init)
+ (defmacro emoji--define-rules ()
+ `(quail-define-rules
+ ,@(let ((rules nil))
+ (maphash (lambda (from to)
+ (push (list from (if (stringp to)
+ (vector to)
+ to))
+ rules))
+ emoji--all-bases)
+ (append
+ rules
+ '((":hash:" ["#️⃣"])
+ (":keycap_star:" ["*️⃣"])
+ (":zero:" ["0️⃣"])
+ (":one:" ["1️⃣"])
+ (":two:" ["2️⃣"])
+ (":three:" ["3️⃣"])
+ (":four:" ["4️⃣"])
+ (":five:" ["5️⃣"])
+ (":six:" ["6️⃣"])
+ (":seven:" ["7️⃣"])
+ (":eight:" ["8️⃣"])
+ (":nine:" ["9️⃣"])
+ (":copyright:" ["©️"])
+ (":registered:" ["®️"])
+ (":mahjong:" ["🀄"])
+ (":black_joker:" ["🃏"])
+ (":a:" ["🅰️"])
+ (":b:" ["🅱️"])
+ (":o2:" ["🅾️"])
+ (":parking:" ["🅿️"])
+ (":ab:" ["🆎"])
+ (":cl:" ["🆑"])
+ (":cool:" ["🆒"])
+ (":free:" ["🆓"])
+ (":id:" ["🆔"])
+ (":new:" ["🆕"])
+ (":ng:" ["🆖"])
+ (":ok:" ["🆗"])
+ (":sos:" ["🆘"])
+ (":up:" ["🆙"])
+ (":vs:" ["🆚"])
+ (":flag-ac:" ["🇦🇨"])
+ (":flag-ad:" ["🇦🇩"])
+ (":flag-ae:" ["🇦🇪"])
+ (":flag-af:" ["🇦🇫"])
+ (":flag-ag:" ["🇦🇬"])
+ (":flag-ai:" ["🇦🇮"])
+ (":flag-al:" ["🇦🇱"])
+ (":flag-am:" ["🇦🇲"])
+ (":flag-ao:" ["🇦🇴"])
+ (":flag-aq:" ["🇦🇶"])
+ (":flag-ar:" ["🇦🇷"])
+ (":flag-as:" ["🇦🇸"])
+ (":flag-at:" ["🇦🇹"])
+ (":flag-au:" ["🇦🇺"])
+ (":flag-aw:" ["🇦🇼"])
+ (":flag-ax:" ["🇦🇽"])
+ (":flag-az:" ["🇦🇿"])
+ (":flag-ba:" ["🇧🇦"])
+ (":flag-bb:" ["🇧🇧"])
+ (":flag-bd:" ["🇧🇩"])
+ (":flag-be:" ["🇧🇪"])
+ (":flag-bf:" ["🇧🇫"])
+ (":flag-bg:" ["🇧🇬"])
+ (":flag-bh:" ["🇧🇭"])
+ (":flag-bi:" ["🇧🇮"])
+ (":flag-bj:" ["🇧🇯"])
+ (":flag-bl:" ["🇧🇱"])
+ (":flag-bm:" ["🇧🇲"])
+ (":flag-bn:" ["🇧🇳"])
+ (":flag-bo:" ["🇧🇴"])
+ (":flag-bq:" ["🇧🇶"])
+ (":flag-br:" ["🇧🇷"])
+ (":flag-bs:" ["🇧🇸"])
+ (":flag-bt:" ["🇧🇹"])
+ (":flag-bv:" ["🇧🇻"])
+ (":flag-bw:" ["🇧🇼"])
+ (":flag-by:" ["🇧🇾"])
+ (":flag-bz:" ["🇧🇿"])
+ (":flag-ca:" ["🇨🇦"])
+ (":flag-cc:" ["🇨🇨"])
+ (":flag-cd:" ["🇨🇩"])
+ (":flag-cf:" ["🇨🇫"])
+ (":flag-cg:" ["🇨🇬"])
+ (":flag-ch:" ["🇨🇭"])
+ (":flag-ci:" ["🇨🇮"])
+ (":flag-ck:" ["🇨🇰"])
+ (":flag-cl:" ["🇨🇱"])
+ (":flag-cm:" ["🇨🇲"])
+ (":cn:" ["🇨🇳"])
+ (":flag-cn:" ["🇨🇳"])
+ (":flag-co:" ["🇨🇴"])
+ (":flag-cp:" ["🇨🇵"])
+ (":flag-cr:" ["🇨🇷"])
+ (":flag-cu:" ["🇨🇺"])
+ (":flag-cv:" ["🇨🇻"])
+ (":flag-cw:" ["🇨🇼"])
+ (":flag-cx:" ["🇨🇽"])
+ (":flag-cy:" ["🇨🇾"])
+ (":flag-cz:" ["🇨🇿"])
+ (":de:" ["🇩🇪"])
+ (":flag-de:" ["🇩🇪"])
+ (":flag-dg:" ["🇩🇬"])
+ (":flag-dj:" ["🇩🇯"])
+ (":flag-dk:" ["🇩🇰"])
+ (":flag-dm:" ["🇩🇲"])
+ (":flag-do:" ["🇩🇴"])
+ (":flag-dz:" ["🇩🇿"])
+ (":flag-ea:" ["🇪🇦"])
+ (":flag-ec:" ["🇪🇨"])
+ (":flag-ee:" ["🇪🇪"])
+ (":flag-eg:" ["🇪🇬"])
+ (":flag-eh:" ["🇪🇭"])
+ (":flag-er:" ["🇪🇷"])
+ (":es:" ["🇪🇸"])
+ (":flag-es:" ["🇪🇸"])
+ (":flag-et:" ["🇪🇹"])
+ (":flag-eu:" ["🇪🇺"])
+ (":flag-fi:" ["🇫🇮"])
+ (":flag-fj:" ["🇫🇯"])
+ (":flag-fk:" ["🇫🇰"])
+ (":flag-fm:" ["🇫🇲"])
+ (":flag-fo:" ["🇫🇴"])
+ (":fr:" ["🇫🇷"])
+ (":flag-fr:" ["🇫🇷"])
+ (":flag-ga:" ["🇬🇦"])
+ (":gb:" ["🇬🇧"])
+ (":uk:" ["🇬🇧"])
+ (":flag-gb:" ["🇬🇧"])
+ (":flag-gd:" ["🇬🇩"])
+ (":flag-ge:" ["🇬🇪"])
+ (":flag-gf:" ["🇬🇫"])
+ (":flag-gg:" ["🇬🇬"])
+ (":flag-gh:" ["🇬🇭"])
+ (":flag-gi:" ["🇬🇮"])
+ (":flag-gl:" ["🇬🇱"])
+ (":flag-gm:" ["🇬🇲"])
+ (":flag-gn:" ["🇬🇳"])
+ (":flag-gp:" ["🇬🇵"])
+ (":flag-gq:" ["🇬🇶"])
+ (":flag-gr:" ["🇬🇷"])
+ (":flag-gs:" ["🇬🇸"])
+ (":flag-gt:" ["🇬🇹"])
+ (":flag-gu:" ["🇬🇺"])
+ (":flag-gw:" ["🇬🇼"])
+ (":flag-gy:" ["🇬🇾"])
+ (":flag-hk:" ["🇭🇰"])
+ (":flag-hm:" ["🇭🇲"])
+ (":flag-hn:" ["🇭🇳"])
+ (":flag-hr:" ["🇭🇷"])
+ (":flag-ht:" ["🇭🇹"])
+ (":flag-hu:" ["🇭🇺"])
+ (":flag-ic:" ["🇮🇨"])
+ (":flag-id:" ["🇮🇩"])
+ (":flag-ie:" ["🇮🇪"])
+ (":flag-il:" ["🇮🇱"])
+ (":flag-im:" ["🇮🇲"])
+ (":flag-in:" ["🇮🇳"])
+ (":flag-io:" ["🇮🇴"])
+ (":flag-iq:" ["🇮🇶"])
+ (":flag-ir:" ["🇮🇷"])
+ (":flag-is:" ["🇮🇸"])
+ (":it:" ["🇮🇹"])
+ (":flag-it:" ["🇮🇹"])
+ (":flag-je:" ["🇯🇪"])
+ (":flag-jm:" ["🇯🇲"])
+ (":flag-jo:" ["🇯🇴"])
+ (":jp:" ["🇯🇵"])
+ (":flag-jp:" ["🇯🇵"])
+ (":flag-ke:" ["🇰🇪"])
+ (":flag-kg:" ["🇰🇬"])
+ (":flag-kh:" ["🇰🇭"])
+ (":flag-ki:" ["🇰🇮"])
+ (":flag-km:" ["🇰🇲"])
+ (":flag-kn:" ["🇰🇳"])
+ (":flag-kp:" ["🇰🇵"])
+ (":kr:" ["🇰🇷"])
+ (":flag-kr:" ["🇰🇷"])
+ (":flag-kw:" ["🇰🇼"])
+ (":flag-ky:" ["🇰🇾"])
+ (":flag-kz:" ["🇰🇿"])
+ (":flag-la:" ["🇱🇦"])
+ (":flag-lb:" ["🇱🇧"])
+ (":flag-lc:" ["🇱🇨"])
+ (":flag-li:" ["🇱🇮"])
+ (":flag-lk:" ["🇱🇰"])
+ (":flag-lr:" ["🇱🇷"])
+ (":flag-ls:" ["🇱🇸"])
+ (":flag-lt:" ["🇱🇹"])
+ (":flag-lu:" ["🇱🇺"])
+ (":flag-lv:" ["🇱🇻"])
+ (":flag-ly:" ["🇱🇾"])
+ (":flag-ma:" ["🇲🇦"])
+ (":flag-mc:" ["🇲🇨"])
+ (":flag-md:" ["🇲🇩"])
+ (":flag-me:" ["🇲🇪"])
+ (":flag-mf:" ["🇲🇫"])
+ (":flag-mg:" ["🇲🇬"])
+ (":flag-mh:" ["🇲🇭"])
+ (":flag-mk:" ["🇲🇰"])
+ (":flag-ml:" ["🇲🇱"])
+ (":flag-mm:" ["🇲🇲"])
+ (":flag-mn:" ["🇲🇳"])
+ (":flag-mo:" ["🇲🇴"])
+ (":flag-mp:" ["🇲🇵"])
+ (":flag-mq:" ["🇲🇶"])
+ (":flag-mr:" ["🇲🇷"])
+ (":flag-ms:" ["🇲🇸"])
+ (":flag-mt:" ["🇲🇹"])
+ (":flag-mu:" ["🇲🇺"])
+ (":flag-mv:" ["🇲🇻"])
+ (":flag-mw:" ["🇲🇼"])
+ (":flag-mx:" ["🇲🇽"])
+ (":flag-my:" ["🇲🇾"])
+ (":flag-mz:" ["🇲🇿"])
+ (":flag-na:" ["🇳🇦"])
+ (":flag-nc:" ["🇳🇨"])
+ (":flag-ne:" ["🇳🇪"])
+ (":flag-nf:" ["🇳🇫"])
+ (":flag-ng:" ["🇳🇬"])
+ (":flag-ni:" ["🇳🇮"])
+ (":flag-nl:" ["🇳🇱"])
+ (":flag-no:" ["🇳🇴"])
+ (":flag-np:" ["🇳🇵"])
+ (":flag-nr:" ["🇳🇷"])
+ (":flag-nu:" ["🇳🇺"])
+ (":flag-nz:" ["🇳🇿"])
+ (":flag-om:" ["🇴🇲"])
+ (":flag-pa:" ["🇵🇦"])
+ (":flag-pe:" ["🇵🇪"])
+ (":flag-pf:" ["🇵🇫"])
+ (":flag-pg:" ["🇵🇬"])
+ (":flag-ph:" ["🇵🇭"])
+ (":flag-pk:" ["🇵🇰"])
+ (":flag-pl:" ["🇵🇱"])
+ (":flag-pm:" ["🇵🇲"])
+ (":flag-pn:" ["🇵🇳"])
+ (":flag-pr:" ["🇵🇷"])
+ (":flag-ps:" ["🇵🇸"])
+ (":flag-pt:" ["🇵🇹"])
+ (":flag-pw:" ["🇵🇼"])
+ (":flag-py:" ["🇵🇾"])
+ (":flag-qa:" ["🇶🇦"])
+ (":flag-re:" ["🇷🇪"])
+ (":flag-ro:" ["🇷🇴"])
+ (":flag-rs:" ["🇷🇸"])
+ (":ru:" ["🇷🇺"])
+ (":flag-ru:" ["🇷🇺"])
+ (":flag-rw:" ["🇷🇼"])
+ (":flag-sa:" ["🇸🇦"])
+ (":flag-sb:" ["🇸🇧"])
+ (":flag-sc:" ["🇸🇨"])
+ (":flag-sd:" ["🇸🇩"])
+ (":flag-se:" ["🇸🇪"])
+ (":flag-sg:" ["🇸🇬"])
+ (":flag-sh:" ["🇸🇭"])
+ (":flag-si:" ["🇸🇮"])
+ (":flag-sj:" ["🇸🇯"])
+ (":flag-sk:" ["🇸🇰"])
+ (":flag-sl:" ["🇸🇱"])
+ (":flag-sm:" ["🇸🇲"])
+ (":flag-sn:" ["🇸🇳"])
+ (":flag-so:" ["🇸🇴"])
+ (":flag-sr:" ["🇸🇷"])
+ (":flag-ss:" ["🇸🇸"])
+ (":flag-st:" ["🇸🇹"])
+ (":flag-sv:" ["🇸🇻"])
+ (":flag-sx:" ["🇸🇽"])
+ (":flag-sy:" ["🇸🇾"])
+ (":flag-sz:" ["🇸🇿"])
+ (":flag-ta:" ["🇹🇦"])
+ (":flag-tc:" ["🇹🇨"])
+ (":flag-td:" ["🇹🇩"])
+ (":flag-tf:" ["🇹🇫"])
+ (":flag-tg:" ["🇹🇬"])
+ (":flag-th:" ["🇹🇭"])
+ (":flag-tj:" ["🇹🇯"])
+ (":flag-tk:" ["🇹🇰"])
+ (":flag-tl:" ["🇹🇱"])
+ (":flag-tm:" ["🇹🇲"])
+ (":flag-tn:" ["🇹🇳"])
+ (":flag-to:" ["🇹🇴"])
+ (":flag-tr:" ["🇹🇷"])
+ (":flag-tt:" ["🇹🇹"])
+ (":flag-tv:" ["🇹🇻"])
+ (":flag-tw:" ["🇹🇼"])
+ (":flag-tz:" ["🇹🇿"])
+ (":flag-ua:" ["🇺🇦"])
+ (":flag-ug:" ["🇺🇬"])
+ (":flag-um:" ["🇺🇲"])
+ (":flag-un:" ["🇺🇳"])
+ (":us:" ["🇺🇸"])
+ (":flag-us:" ["🇺🇸"])
+ (":flag-uy:" ["🇺🇾"])
+ (":flag-uz:" ["🇺🇿"])
+ (":flag-va:" ["🇻🇦"])
+ (":flag-vc:" ["🇻🇨"])
+ (":flag-ve:" ["🇻🇪"])
+ (":flag-vg:" ["🇻🇬"])
+ (":flag-vi:" ["🇻🇮"])
+ (":flag-vn:" ["🇻🇳"])
+ (":flag-vu:" ["🇻🇺"])
+ (":flag-wf:" ["🇼🇫"])
+ (":flag-ws:" ["🇼🇸"])
+ (":flag-xk:" ["🇽🇰"])
+ (":flag-ye:" ["🇾🇪"])
+ (":flag-yt:" ["🇾🇹"])
+ (":flag-za:" ["🇿🇦"])
+ (":flag-zm:" ["🇿🇲"])
+ (":flag-zw:" ["🇿🇼"])
+ (":koko:" ["🈁"])
+ (":sa:" ["🈂️"])
+ (":u7121:" ["🈚"])
+ (":u6307:" ["🈯"])
+ (":u7981:" ["🈲"])
+ (":u7a7a:" ["🈳"])
+ (":u5408:" ["🈴"])
+ (":u6e80:" ["🈵"])
+ (":u6709:" ["🈶"])
+ (":u6708:" ["🈷️"])
+ (":u7533:" ["🈸"])
+ (":u5272:" ["🈹"])
+ (":u55b6:" ["🈺"])
+ (":ideograph_advantage:" ["🉐"])
+ (":accept:" ["🉑"])
+ (":cyclone:" ["🌀"])
+ (":foggy:" ["🌁"])
+ (":closed_umbrella:" ["🌂"])
+ (":night_with_stars:" ["🌃"])
+ (":sunrise_over_mountains:" ["🌄"])
+ (":sunrise:" ["🌅"])
+ (":city_sunset:" ["🌆"])
+ (":city_sunrise:" ["🌇"])
+ (":rainbow:" ["🌈"])
+ (":bridge_at_night:" ["🌉"])
+ (":ocean:" ["🌊"])
+ (":volcano:" ["🌋"])
+ (":milky_way:" ["🌌"])
+ (":earth_africa:" ["🌍"])
+ (":earth_americas:" ["🌎"])
+ (":earth_asia:" ["🌏"])
+ (":globe_with_meridians:" ["🌐"])
+ (":new_moon:" ["🌑"])
+ (":waxing_crescent_moon:" ["🌒"])
+ (":first_quarter_moon:" ["🌓"])
+ (":moon:" ["🌔"])
+ (":waxing_gibbous_moon:" ["🌔"])
+ (":full_moon:" ["🌕"])
+ (":waning_gibbous_moon:" ["🌖"])
+ (":last_quarter_moon:" ["🌗"])
+ (":waning_crescent_moon:" ["🌘"])
+ (":crescent_moon:" ["🌙"])
+ (":new_moon_with_face:" ["🌚"])
+ (":first_quarter_moon_with_face:" ["🌛"])
+ (":last_quarter_moon_with_face:" ["🌜"])
+ (":full_moon_with_face:" ["🌝"])
+ (":sun_with_face:" ["🌞"])
+ (":star2:" ["🌟"])
+ (":stars:" ["🌠"])
+ (":thermometer:" ["🌡️"])
+ (":mostly_sunny:" ["🌤️"])
+ (":sun_small_cloud:" ["🌤️"])
+ (":barely_sunny:" ["🌥️"])
+ (":sun_behind_cloud:" ["🌥️"])
+ (":partly_sunny_rain:" ["🌦️"])
+ (":sun_behind_rain_cloud:" ["🌦️"])
+ (":rain_cloud:" ["🌧️"])
+ (":snow_cloud:" ["🌨️"])
+ (":lightning:" ["🌩️"])
+ (":lightning_cloud:" ["🌩️"])
+ (":tornado:" ["🌪️"])
+ (":tornado_cloud:" ["🌪️"])
+ (":fog:" ["🌫️"])
+ (":wind_blowing_face:" ["🌬️"])
+ (":hotdog:" ["🌭"])
+ (":taco:" ["🌮"])
+ (":burrito:" ["🌯"])
+ (":chestnut:" ["🌰"])
+ (":seedling:" ["🌱"])
+ (":evergreen_tree:" ["🌲"])
+ (":deciduous_tree:" ["🌳"])
+ (":palm_tree:" ["🌴"])
+ (":cactus:" ["🌵"])
+ (":hot_pepper:" ["🌶️"])
+ (":tulip:" ["🌷"])
+ (":cherry_blossom:" ["🌸"])
+ (":rose:" ["🌹"])
+ (":hibiscus:" ["🌺"])
+ (":sunflower:" ["🌻"])
+ (":blossom:" ["🌼"])
+ (":corn:" ["🌽"])
+ (":ear_of_rice:" ["🌾"])
+ (":herb:" ["🌿"])
+ (":four_leaf_clover:" ["🍀"])
+ (":maple_leaf:" ["🍁"])
+ (":fallen_leaf:" ["🍂"])
+ (":leaves:" ["🍃"])
+ (":mushroom:" ["🍄"])
+ (":tomato:" ["🍅"])
+ (":eggplant:" ["🍆"])
+ (":grapes:" ["🍇"])
+ (":melon:" ["🍈"])
+ (":watermelon:" ["🍉"])
+ (":tangerine:" ["🍊"])
+ (":lemon:" ["🍋"])
+ (":banana:" ["🍌"])
+ (":pineapple:" ["🍍"])
+ (":apple:" ["🍎"])
+ (":green_apple:" ["🍏"])
+ (":pear:" ["🍐"])
+ (":peach:" ["🍑"])
+ (":cherries:" ["🍒"])
+ (":strawberry:" ["🍓"])
+ (":hamburger:" ["🍔"])
+ (":pizza:" ["🍕"])
+ (":meat_on_bone:" ["🍖"])
+ (":poultry_leg:" ["🍗"])
+ (":rice_cracker:" ["🍘"])
+ (":rice_ball:" ["🍙"])
+ (":rice:" ["🍚"])
+ (":curry:" ["🍛"])
+ (":ramen:" ["🍜"])
+ (":spaghetti:" ["🍝"])
+ (":bread:" ["🍞"])
+ (":fries:" ["🍟"])
+ (":sweet_potato:" ["🍠"])
+ (":dango:" ["🍡"])
+ (":oden:" ["🍢"])
+ (":sushi:" ["🍣"])
+ (":fried_shrimp:" ["🍤"])
+ (":fish_cake:" ["🍥"])
+ (":icecream:" ["🍦"])
+ (":shaved_ice:" ["🍧"])
+ (":ice_cream:" ["🍨"])
+ (":doughnut:" ["🍩"])
+ (":cookie:" ["🍪"])
+ (":chocolate_bar:" ["🍫"])
+ (":candy:" ["🍬"])
+ (":lollipop:" ["🍭"])
+ (":custard:" ["🍮"])
+ (":honey_pot:" ["🍯"])
+ (":cake:" ["🍰"])
+ (":bento:" ["🍱"])
+ (":stew:" ["🍲"])
+ (":fried_egg:" ["🍳"])
+ (":cooking:" ["🍳"])
+ (":fork_and_knife:" ["🍴"])
+ (":tea:" ["🍵"])
+ (":sake:" ["🍶"])
+ (":wine_glass:" ["🍷"])
+ (":cocktail:" ["🍸"])
+ (":tropical_drink:" ["🍹"])
+ (":beer:" ["🍺"])
+ (":beers:" ["🍻"])
+ (":baby_bottle:" ["🍼"])
+ (":knife_fork_plate:" ["🍽️"])
+ (":champagne:" ["🍾"])
+ (":popcorn:" ["🍿"])
+ (":ribbon:" ["🎀"])
+ (":gift:" ["🎁"])
+ (":birthday:" ["🎂"])
+ (":jack_o_lantern:" ["🎃"])
+ (":christmas_tree:" ["🎄"])
+ (":santa:" ["🎅"])
+ (":fireworks:" ["🎆"])
+ (":sparkler:" ["🎇"])
+ (":balloon:" ["🎈"])
+ (":tada:" ["🎉"])
+ (":confetti_ball:" ["🎊"])
+ (":tanabata_tree:" ["🎋"])
+ (":crossed_flags:" ["🎌"])
+ (":bamboo:" ["🎍"])
+ (":dolls:" ["🎎"])
+ (":flags:" ["🎏"])
+ (":wind_chime:" ["🎐"])
+ (":rice_scene:" ["🎑"])
+ (":school_satchel:" ["🎒"])
+ (":mortar_board:" ["🎓"])
+ (":medal:" ["🎖️"])
+ (":reminder_ribbon:" ["🎗️"])
+ (":studio_microphone:" ["🎙️"])
+ (":level_slider:" ["🎚️"])
+ (":control_knobs:" ["🎛️"])
+ (":film_frames:" ["🎞️"])
+ (":admission_tickets:" ["🎟️"])
+ (":carousel_horse:" ["🎠"])
+ (":ferris_wheel:" ["🎡"])
+ (":roller_coaster:" ["🎢"])
+ (":fishing_pole_and_fish:" ["🎣"])
+ (":microphone:" ["🎤"])
+ (":movie_camera:" ["🎥"])
+ (":cinema:" ["🎦"])
+ (":headphones:" ["🎧"])
+ (":art:" ["🎨"])
+ (":tophat:" ["🎩"])
+ (":circus_tent:" ["🎪"])
+ (":ticket:" ["🎫"])
+ (":clapper:" ["🎬"])
+ (":performing_arts:" ["🎭"])
+ (":video_game:" ["🎮"])
+ (":dart:" ["🎯"])
+ (":slot_machine:" ["🎰"])
+ (":8ball:" ["🎱"])
+ (":game_die:" ["🎲"])
+ (":bowling:" ["🎳"])
+ (":flower_playing_cards:" ["🎴"])
+ (":musical_note:" ["🎵"])
+ (":notes:" ["🎶"])
+ (":saxophone:" ["🎷"])
+ (":guitar:" ["🎸"])
+ (":musical_keyboard:" ["🎹"])
+ (":trumpet:" ["🎺"])
+ (":violin:" ["🎻"])
+ (":musical_score:" ["🎼"])
+ (":running_shirt_with_sash:" ["🎽"])
+ (":tennis:" ["🎾"])
+ (":ski:" ["🎿"])
+ (":basketball:" ["🏀"])
+ (":checkered_flag:" ["🏁"])
+ (":snowboarder:" ["🏂"])
+ (":woman-running:" ["🏃‍♀️"])
+ (":man-running:" ["🏃‍♂️"])
+ (":runner:" ["🏃"])
+ (":running:" ["🏃"])
+ (":woman-surfing:" ["🏄‍♀️"])
+ (":man-surfing:" ["🏄‍♂️"])
+ (":surfer:" ["🏄"])
+ (":sports_medal:" ["🏅"])
+ (":trophy:" ["🏆"])
+ (":horse_racing:" ["🏇"])
+ (":football:" ["🏈"])
+ (":rugby_football:" ["🏉"])
+ (":woman-swimming:" ["🏊‍♀️"])
+ (":man-swimming:" ["🏊‍♂️"])
+ (":swimmer:" ["🏊"])
+ (":woman-lifting-weights:" ["🏋️‍♀️"])
+ (":man-lifting-weights:" ["🏋️‍♂️"])
+ (":weight_lifter:" ["🏋️"])
+ (":woman-golfing:" ["🏌️‍♀️"])
+ (":man-golfing:" ["🏌️‍♂️"])
+ (":golfer:" ["🏌️"])
+ (":racing_motorcycle:" ["🏍️"])
+ (":racing_car:" ["🏎️"])
+ (":cricket_bat_and_ball:" ["🏏"])
+ (":volleyball:" ["🏐"])
+ (":field_hockey_stick_and_ball:" ["🏑"])
+ (":ice_hockey_stick_and_puck:" ["🏒"])
+ (":table_tennis_paddle_and_ball:" ["🏓"])
+ (":snow_capped_mountain:" ["🏔️"])
+ (":camping:" ["🏕️"])
+ (":beach_with_umbrella:" ["🏖️"])
+ (":building_construction:" ["🏗️"])
+ (":house_buildings:" ["🏘️"])
+ (":cityscape:" ["🏙️"])
+ (":derelict_house_building:" ["🏚️"])
+ (":classical_building:" ["🏛️"])
+ (":desert:" ["🏜️"])
+ (":desert_island:" ["🏝️"])
+ (":national_park:" ["🏞️"])
+ (":stadium:" ["🏟️"])
+ (":house:" ["🏠"])
+ (":house_with_garden:" ["🏡"])
+ (":office:" ["🏢"])
+ (":post_office:" ["🏣"])
+ (":european_post_office:" ["🏤"])
+ (":hospital:" ["🏥"])
+ (":bank:" ["🏦"])
+ (":atm:" ["🏧"])
+ (":hotel:" ["🏨"])
+ (":love_hotel:" ["🏩"])
+ (":convenience_store:" ["🏪"])
+ (":school:" ["🏫"])
+ (":department_store:" ["🏬"])
+ (":factory:" ["🏭"])
+ (":izakaya_lantern:" ["🏮"])
+ (":lantern:" ["🏮"])
+ (":japanese_castle:" ["🏯"])
+ (":european_castle:" ["🏰"])
+ (":rainbow-flag:" ["🏳️‍🌈"])
+ (":transgender_flag:" ["🏳️‍⚧️"])
+ (":waving_white_flag:" ["🏳️"])
+ (":pirate_flag:" ["🏴‍☠️"])
+ (":flag-england:" ["🏴󠁧󠁢󠁥󠁮󠁧󠁿"])
+ (":flag-scotland:" ["🏴󠁧󠁢󠁳󠁣󠁴󠁿"])
+ (":flag-wales:" ["🏴󠁧󠁢󠁷󠁬󠁳󠁿"])
+ (":waving_black_flag:" ["🏴"])
+ (":rosette:" ["🏵️"])
+ (":label:" ["🏷️"])
+ (":badminton_racquet_and_shuttlecock:" ["🏸"])
+ (":bow_and_arrow:" ["🏹"])
+ (":amphora:" ["🏺"])
+ (":skin-tone-2:" ["🏻"])
+ (":skin-tone-3:" ["🏼"])
+ (":skin-tone-4:" ["🏽"])
+ (":skin-tone-5:" ["🏾"])
+ (":skin-tone-6:" ["🏿"])
+ (":rat:" ["🐀"])
+ (":mouse2:" ["🐁"])
+ (":ox:" ["🐂"])
+ (":water_buffalo:" ["🐃"])
+ (":cow2:" ["🐄"])
+ (":tiger2:" ["🐅"])
+ (":leopard:" ["🐆"])
+ (":rabbit2:" ["🐇"])
+ (":black_cat:" ["🐈‍⬛"])
+ (":cat2:" ["🐈"])
+ (":dragon:" ["🐉"])
+ (":crocodile:" ["🐊"])
+ (":whale2:" ["🐋"])
+ (":snail:" ["🐌"])
+ (":snake:" ["🐍"])
+ (":racehorse:" ["🐎"])
+ (":ram:" ["🐏"])
+ (":goat:" ["🐐"])
+ (":sheep:" ["🐑"])
+ (":monkey:" ["🐒"])
+ (":rooster:" ["🐓"])
+ (":chicken:" ["🐔"])
+ (":service_dog:" ["🐕‍🦺"])
+ (":dog2:" ["🐕"])
+ (":pig2:" ["🐖"])
+ (":boar:" ["🐗"])
+ (":elephant:" ["🐘"])
+ (":octopus:" ["🐙"])
+ (":shell:" ["🐚"])
+ (":bug:" ["🐛"])
+ (":ant:" ["🐜"])
+ (":bee:" ["🐝"])
+ (":honeybee:" ["🐝"])
+ (":ladybug:" ["🐞"])
+ (":lady_beetle:" ["🐞"])
+ (":fish:" ["🐟"])
+ (":tropical_fish:" ["🐠"])
+ (":blowfish:" ["🐡"])
+ (":turtle:" ["🐢"])
+ (":hatching_chick:" ["🐣"])
+ (":baby_chick:" ["🐤"])
+ (":hatched_chick:" ["🐥"])
+ (":bird:" ["🐦"])
+ (":penguin:" ["🐧"])
+ (":koala:" ["🐨"])
+ (":poodle:" ["🐩"])
+ (":dromedary_camel:" ["🐪"])
+ (":camel:" ["🐫"])
+ (":dolphin:" ["🐬"])
+ (":flipper:" ["🐬"])
+ (":mouse:" ["🐭"])
+ (":cow:" ["🐮"])
+ (":tiger:" ["🐯"])
+ (":rabbit:" ["🐰"])
+ (":cat:" ["🐱"])
+ (":dragon_face:" ["🐲"])
+ (":whale:" ["🐳"])
+ (":horse:" ["🐴"])
+ (":monkey_face:" ["🐵"])
+ (":o)" ["🐵"])
+ (":dog:" ["🐶"])
+ (":pig:" ["🐷"])
+ (":frog:" ["🐸"])
+ (":hamster:" ["🐹"])
+ (":wolf:" ["🐺"])
+ (":polar_bear:" ["🐻‍❄️"])
+ (":bear:" ["🐻"])
+ (":panda_face:" ["🐼"])
+ (":pig_nose:" ["🐽"])
+ (":feet:" ["🐾"])
+ (":paw_prints:" ["🐾"])
+ (":chipmunk:" ["🐿️"])
+ (":eyes:" ["👀"])
+ (":eye-in-speech-bubble:" ["👁️‍🗨️"])
+ (":eye:" ["👁️"])
+ (":ear:" ["👂"])
+ (":nose:" ["👃"])
+ (":lips:" ["👄"])
+ (":tongue:" ["👅"])
+ (":point_up_2:" ["👆"])
+ (":point_down:" ["👇"])
+ (":point_left:" ["👈"])
+ (":point_right:" ["👉"])
+ (":facepunch:" ["👊"])
+ (":punch:" ["👊"])
+ (":wave:" ["👋"])
+ (":ok_hand:" ["👌"])
+ (":+1:" ["👍"])
+ (":thumbsup:" ["👍"])
+ (":-1:" ["👎"])
+ (":thumbsdown:" ["👎"])
+ (":clap:" ["👏"])
+ (":open_hands:" ["👐"])
+ (":crown:" ["👑"])
+ (":womans_hat:" ["👒"])
+ (":eyeglasses:" ["👓"])
+ (":necktie:" ["👔"])
+ (":shirt:" ["👕"])
+ (":tshirt:" ["👕"])
+ (":jeans:" ["👖"])
+ (":dress:" ["👗"])
+ (":kimono:" ["👘"])
+ (":bikini:" ["👙"])
+ (":womans_clothes:" ["👚"])
+ (":purse:" ["👛"])
+ (":handbag:" ["👜"])
+ (":pouch:" ["👝"])
+ (":mans_shoe:" ["👞"])
+ (":shoe:" ["👞"])
+ (":athletic_shoe:" ["👟"])
+ (":high_heel:" ["👠"])
+ (":sandal:" ["👡"])
+ (":boot:" ["👢"])
+ (":footprints:" ["👣"])
+ (":bust_in_silhouette:" ["👤"])
+ (":busts_in_silhouette:" ["👥"])
+ (":boy:" ["👦"])
+ (":girl:" ["👧"])
+ (":male-farmer:" ["👨‍🌾"])
+ (":male-cook:" ["👨‍🍳"])
+ (":man_feeding_baby:" ["👨‍🍼"])
+ (":male-student:" ["👨‍🎓"])
+ (":male-singer:" ["👨‍🎤"])
+ (":male-artist:" ["👨‍🎨"])
+ (":male-teacher:" ["👨‍🏫"])
+ (":male-factory-worker:" ["👨‍🏭"])
+ (":man-boy-boy:" ["👨‍👦‍👦"])
+ (":man-boy:" ["👨‍👦"])
+ (":man-girl-boy:" ["👨‍👧‍👦"])
+ (":man-girl-girl:" ["👨‍👧‍👧"])
+ (":man-girl:" ["👨‍👧"])
+ (":man-man-boy:" ["👨‍👨‍👦"])
+ (":man-man-boy-boy:" ["👨‍👨‍👦‍👦"])
+ (":man-man-girl:" ["👨‍👨‍👧"])
+ (":man-man-girl-boy:" ["👨‍👨‍👧‍👦"])
+ (":man-man-girl-girl:" ["👨‍👨‍👧‍👧"])
+ (":man-woman-boy:" ["👨‍👩‍👦"])
+ (":man-woman-boy-boy:" ["👨‍👩‍👦‍👦"])
+ (":man-woman-girl:" ["👨‍👩‍👧"])
+ (":man-woman-girl-boy:" ["👨‍👩‍👧‍👦"])
+ (":man-woman-girl-girl:" ["👨‍👩‍👧‍👧"])
+ (":male-technologist:" ["👨‍💻"])
+ (":male-office-worker:" ["👨‍💼"])
+ (":male-mechanic:" ["👨‍🔧"])
+ (":male-scientist:" ["👨‍🔬"])
+ (":male-astronaut:" ["👨‍🚀"])
+ (":male-firefighter:" ["👨‍🚒"])
+ (":man_with_probing_cane:" ["👨‍🦯"])
+ (":red_haired_man:" ["👨‍🦰"])
+ (":curly_haired_man:" ["👨‍🦱"])
+ (":bald_man:" ["👨‍🦲"])
+ (":white_haired_man:" ["👨‍🦳"])
+ (":man_in_motorized_wheelchair:" ["👨‍🦼"])
+ (":man_in_manual_wheelchair:" ["👨‍🦽"])
+ (":male-doctor:" ["👨‍⚕️"])
+ (":male-judge:" ["👨‍⚖️"])
+ (":male-pilot:" ["👨‍✈️"])
+ (":man-heart-man:" ["👨‍❤️‍👨"])
+ (":man-kiss-man:" ["👨‍❤️‍💋‍👨"])
+ (":man:" ["👨"])
+ (":female-farmer:" ["👩‍🌾"])
+ (":female-cook:" ["👩‍🍳"])
+ (":woman_feeding_baby:" ["👩‍🍼"])
+ (":female-student:" ["👩‍🎓"])
+ (":female-singer:" ["👩‍🎤"])
+ (":female-artist:" ["👩‍🎨"])
+ (":female-teacher:" ["👩‍🏫"])
+ (":female-factory-worker:" ["👩‍🏭"])
+ (":woman-boy-boy:" ["👩‍👦‍👦"])
+ (":woman-boy:" ["👩‍👦"])
+ (":woman-girl-boy:" ["👩‍👧‍👦"])
+ (":woman-girl-girl:" ["👩‍👧‍👧"])
+ (":woman-girl:" ["👩‍👧"])
+ (":woman-woman-boy:" ["👩‍👩‍👦"])
+ (":woman-woman-boy-boy:" ["👩‍👩‍👦‍👦"])
+ (":woman-woman-girl:" ["👩‍👩‍👧"])
+ (":woman-woman-girl-boy:" ["👩‍👩‍👧‍👦"])
+ (":woman-woman-girl-girl:" ["👩‍👩‍👧‍👧"])
+ (":female-technologist:" ["👩‍💻"])
+ (":female-office-worker:" ["👩‍💼"])
+ (":female-mechanic:" ["👩‍🔧"])
+ (":female-scientist:" ["👩‍🔬"])
+ (":female-astronaut:" ["👩‍🚀"])
+ (":female-firefighter:" ["👩‍🚒"])
+ (":woman_with_probing_cane:" ["👩‍🦯"])
+ (":red_haired_woman:" ["👩‍🦰"])
+ (":curly_haired_woman:" ["👩‍🦱"])
+ (":bald_woman:" ["👩‍🦲"])
+ (":white_haired_woman:" ["👩‍🦳"])
+ (":woman_in_motorized_wheelchair:" ["👩‍🦼"])
+ (":woman_in_manual_wheelchair:" ["👩‍🦽"])
+ (":female-doctor:" ["👩‍⚕️"])
+ (":female-judge:" ["👩‍⚖️"])
+ (":female-pilot:" ["👩‍✈️"])
+ (":woman-heart-man:" ["👩‍❤️‍👨"])
+ (":woman-heart-woman:" ["👩‍❤️‍👩"])
+ (":woman-kiss-man:" ["👩‍❤️‍💋‍👨"])
+ (":woman-kiss-woman:" ["👩‍❤️‍💋‍👩"])
+ (":woman:" ["👩"])
+ (":family:" ["👪"])
+ (":man_and_woman_holding_hands:" ["👫"])
+ (":woman_and_man_holding_hands:" ["👫"])
+ (":couple:" ["👫"])
+ (":two_men_holding_hands:" ["👬"])
+ (":men_holding_hands:" ["👬"])
+ (":two_women_holding_hands:" ["👭"])
+ (":women_holding_hands:" ["👭"])
+ (":female-police-officer:" ["👮‍♀️"])
+ (":male-police-officer:" ["👮‍♂️"])
+ (":cop:" ["👮"])
+ (":women-with-bunny-ears-partying:" ["👯‍♀️"])
+ (":woman-with-bunny-ears-partying:" ["👯‍♀️"])
+ (":men-with-bunny-ears-partying:" ["👯‍♂️"])
+ (":man-with-bunny-ears-partying:" ["👯‍♂️"])
+ (":dancers:" ["👯"])
+ (":woman_with_veil:" ["👰‍♀️"])
+ (":man_with_veil:" ["👰‍♂️"])
+ (":bride_with_veil:" ["👰"])
+ (":blond-haired-woman:" ["👱‍♀️"])
+ (":blond-haired-man:" ["👱‍♂️"])
+ (":person_with_blond_hair:" ["👱"])
+ (":man_with_gua_pi_mao:" ["👲"])
+ (":woman-wearing-turban:" ["👳‍♀️"])
+ (":man-wearing-turban:" ["👳‍♂️"])
+ (":man_with_turban:" ["👳"])
+ (":older_man:" ["👴"])
+ (":older_woman:" ["👵"])
+ (":baby:" ["👶"])
+ (":female-construction-worker:" ["👷‍♀️"])
+ (":male-construction-worker:" ["👷‍♂️"])
+ (":construction_worker:" ["👷"])
+ (":princess:" ["👸"])
+ (":japanese_ogre:" ["👹"])
+ (":japanese_goblin:" ["👺"])
+ (":ghost:" ["👻"])
+ (":angel:" ["👼"])
+ (":alien:" ["👽"])
+ (":space_invader:" ["👾"])
+ (":imp:" ["👿"])
+ (":skull:" ["💀"])
+ (":woman-tipping-hand:" ["💁‍♀️"])
+ (":man-tipping-hand:" ["💁‍♂️"])
+ (":information_desk_person:" ["💁"])
+ (":female-guard:" ["💂‍♀️"])
+ (":male-guard:" ["💂‍♂️"])
+ (":guardsman:" ["💂"])
+ (":dancer:" ["💃"])
+ (":lipstick:" ["💄"])
+ (":nail_care:" ["💅"])
+ (":woman-getting-massage:" ["💆‍♀️"])
+ (":man-getting-massage:" ["💆‍♂️"])
+ (":massage:" ["💆"])
+ (":woman-getting-haircut:" ["💇‍♀️"])
+ (":man-getting-haircut:" ["💇‍♂️"])
+ (":haircut:" ["💇"])
+ (":barber:" ["💈"])
+ (":syringe:" ["💉"])
+ (":pill:" ["💊"])
+ (":kiss:" ["💋"])
+ (":love_letter:" ["💌"])
+ (":ring:" ["💍"])
+ (":gem:" ["💎"])
+ (":couplekiss:" ["💏"])
+ (":bouquet:" ["💐"])
+ (":couple_with_heart:" ["💑"])
+ (":wedding:" ["💒"])
+ (":heartbeat:" ["💓"])
+ (":broken_heart:" ["💔"])
+ ("</3" ["💔"])
+ (":two_hearts:" ["💕"])
+ (":sparkling_heart:" ["💖"])
+ (":heartpulse:" ["💗"])
+ (":cupid:" ["💘"])
+ (":blue_heart:" ["💙"])
+ ("<3" ["💙"])
+ (":green_heart:" ["💚"])
+ ("<3" ["💚"])
+ (":yellow_heart:" ["💛"])
+ ("<3" ["💛"])
+ (":purple_heart:" ["💜"])
+ ("<3" ["💜"])
+ (":gift_heart:" ["💝"])
+ (":revolving_hearts:" ["💞"])
+ (":heart_decoration:" ["💟"])
+ (":diamond_shape_with_a_dot_inside:" ["💠"])
+ (":bulb:" ["💡"])
+ (":anger:" ["💢"])
+ (":bomb:" ["💣"])
+ (":zzz:" ["💤"])
+ (":boom:" ["💥"])
+ (":collision:" ["💥"])
+ (":sweat_drops:" ["💦"])
+ (":droplet:" ["💧"])
+ (":dash:" ["💨"])
+ (":hankey:" ["💩"])
+ (":poop:" ["💩"])
+ (":shit:" ["💩"])
+ (":muscle:" ["💪"])
+ (":dizzy:" ["💫"])
+ (":speech_balloon:" ["💬"])
+ (":thought_balloon:" ["💭"])
+ (":white_flower:" ["💮"])
+ (":100:" ["💯"])
+ (":moneybag:" ["💰"])
+ (":currency_exchange:" ["💱"])
+ (":heavy_dollar_sign:" ["💲"])
+ (":credit_card:" ["💳"])
+ (":yen:" ["💴"])
+ (":dollar:" ["💵"])
+ (":euro:" ["💶"])
+ (":pound:" ["💷"])
+ (":money_with_wings:" ["💸"])
+ (":chart:" ["💹"])
+ (":seat:" ["💺"])
+ (":computer:" ["💻"])
+ (":briefcase:" ["💼"])
+ (":minidisc:" ["💽"])
+ (":floppy_disk:" ["💾"])
+ (":cd:" ["💿"])
+ (":dvd:" ["📀"])
+ (":file_folder:" ["📁"])
+ (":open_file_folder:" ["📂"])
+ (":page_with_curl:" ["📃"])
+ (":page_facing_up:" ["📄"])
+ (":date:" ["📅"])
+ (":calendar:" ["📆"])
+ (":card_index:" ["📇"])
+ (":chart_with_upwards_trend:" ["📈"])
+ (":chart_with_downwards_trend:" ["📉"])
+ (":bar_chart:" ["📊"])
+ (":clipboard:" ["📋"])
+ (":pushpin:" ["📌"])
+ (":round_pushpin:" ["📍"])
+ (":paperclip:" ["📎"])
+ (":straight_ruler:" ["📏"])
+ (":triangular_ruler:" ["📐"])
+ (":bookmark_tabs:" ["📑"])
+ (":ledger:" ["📒"])
+ (":notebook:" ["📓"])
+ (":notebook_with_decorative_cover:" ["📔"])
+ (":closed_book:" ["📕"])
+ (":book:" ["📖"])
+ (":open_book:" ["📖"])
+ (":green_book:" ["📗"])
+ (":blue_book:" ["📘"])
+ (":orange_book:" ["📙"])
+ (":books:" ["📚"])
+ (":name_badge:" ["📛"])
+ (":scroll:" ["📜"])
+ (":memo:" ["📝"])
+ (":pencil:" ["📝"])
+ (":telephone_receiver:" ["📞"])
+ (":pager:" ["📟"])
+ (":fax:" ["📠"])
+ (":satellite_antenna:" ["📡"])
+ (":loudspeaker:" ["📢"])
+ (":mega:" ["📣"])
+ (":outbox_tray:" ["📤"])
+ (":inbox_tray:" ["📥"])
+ (":package:" ["📦"])
+ (":e-mail:" ["📧"])
+ (":incoming_envelope:" ["📨"])
+ (":envelope_with_arrow:" ["📩"])
+ (":mailbox_closed:" ["📪"])
+ (":mailbox:" ["📫"])
+ (":mailbox_with_mail:" ["📬"])
+ (":mailbox_with_no_mail:" ["📭"])
+ (":postbox:" ["📮"])
+ (":postal_horn:" ["📯"])
+ (":newspaper:" ["📰"])
+ (":iphone:" ["📱"])
+ (":calling:" ["📲"])
+ (":vibration_mode:" ["📳"])
+ (":mobile_phone_off:" ["📴"])
+ (":no_mobile_phones:" ["📵"])
+ (":signal_strength:" ["📶"])
+ (":camera:" ["📷"])
+ (":camera_with_flash:" ["📸"])
+ (":video_camera:" ["📹"])
+ (":tv:" ["📺"])
+ (":radio:" ["📻"])
+ (":vhs:" ["📼"])
+ (":film_projector:" ["📽️"])
+ (":prayer_beads:" ["📿"])
+ (":twisted_rightwards_arrows:" ["🔀"])
+ (":repeat:" ["🔁"])
+ (":repeat_one:" ["🔂"])
+ (":arrows_clockwise:" ["🔃"])
+ (":arrows_counterclockwise:" ["🔄"])
+ (":low_brightness:" ["🔅"])
+ (":high_brightness:" ["🔆"])
+ (":mute:" ["🔇"])
+ (":speaker:" ["🔈"])
+ (":sound:" ["🔉"])
+ (":loud_sound:" ["🔊"])
+ (":battery:" ["🔋"])
+ (":electric_plug:" ["🔌"])
+ (":mag:" ["🔍"])
+ (":mag_right:" ["🔎"])
+ (":lock_with_ink_pen:" ["🔏"])
+ (":closed_lock_with_key:" ["🔐"])
+ (":key:" ["🔑"])
+ (":lock:" ["🔒"])
+ (":unlock:" ["🔓"])
+ (":bell:" ["🔔"])
+ (":no_bell:" ["🔕"])
+ (":bookmark:" ["🔖"])
+ (":link:" ["🔗"])
+ (":radio_button:" ["🔘"])
+ (":back:" ["🔙"])
+ (":end:" ["🔚"])
+ (":on:" ["🔛"])
+ (":soon:" ["🔜"])
+ (":top:" ["🔝"])
+ (":underage:" ["🔞"])
+ (":keycap_ten:" ["🔟"])
+ (":capital_abcd:" ["🔠"])
+ (":abcd:" ["🔡"])
+ (":1234:" ["🔢"])
+ (":symbols:" ["🔣"])
+ (":abc:" ["🔤"])
+ (":fire:" ["🔥"])
+ (":flashlight:" ["🔦"])
+ (":wrench:" ["🔧"])
+ (":hammer:" ["🔨"])
+ (":nut_and_bolt:" ["🔩"])
+ (":hocho:" ["🔪"])
+ (":knife:" ["🔪"])
+ (":gun:" ["🔫"])
+ (":microscope:" ["🔬"])
+ (":telescope:" ["🔭"])
+ (":crystal_ball:" ["🔮"])
+ (":six_pointed_star:" ["🔯"])
+ (":beginner:" ["🔰"])
+ (":trident:" ["🔱"])
+ (":black_square_button:" ["🔲"])
+ (":white_square_button:" ["🔳"])
+ (":red_circle:" ["🔴"])
+ (":large_blue_circle:" ["🔵"])
+ (":large_orange_diamond:" ["🔶"])
+ (":large_blue_diamond:" ["🔷"])
+ (":small_orange_diamond:" ["🔸"])
+ (":small_blue_diamond:" ["🔹"])
+ (":small_red_triangle:" ["🔺"])
+ (":small_red_triangle_down:" ["🔻"])
+ (":arrow_up_small:" ["🔼"])
+ (":arrow_down_small:" ["🔽"])
+ (":om_symbol:" ["🕉️"])
+ (":dove_of_peace:" ["🕊️"])
+ (":kaaba:" ["🕋"])
+ (":mosque:" ["🕌"])
+ (":synagogue:" ["🕍"])
+ (":menorah_with_nine_branches:" ["🕎"])
+ (":clock1:" ["🕐"])
+ (":clock2:" ["🕑"])
+ (":clock3:" ["🕒"])
+ (":clock4:" ["🕓"])
+ (":clock5:" ["🕔"])
+ (":clock6:" ["🕕"])
+ (":clock7:" ["🕖"])
+ (":clock8:" ["🕗"])
+ (":clock9:" ["🕘"])
+ (":clock10:" ["🕙"])
+ (":clock11:" ["🕚"])
+ (":clock12:" ["🕛"])
+ (":clock130:" ["🕜"])
+ (":clock230:" ["🕝"])
+ (":clock330:" ["🕞"])
+ (":clock430:" ["🕟"])
+ (":clock530:" ["🕠"])
+ (":clock630:" ["🕡"])
+ (":clock730:" ["🕢"])
+ (":clock830:" ["🕣"])
+ (":clock930:" ["🕤"])
+ (":clock1030:" ["🕥"])
+ (":clock1130:" ["🕦"])
+ (":clock1230:" ["🕧"])
+ (":candle:" ["🕯️"])
+ (":mantelpiece_clock:" ["🕰️"])
+ (":hole:" ["🕳️"])
+ (":man_in_business_suit_levitating:" ["🕴️"])
+ (":female-detective:" ["🕵️‍♀️"])
+ (":male-detective:" ["🕵️‍♂️"])
+ (":sleuth_or_spy:" ["🕵️"])
+ (":dark_sunglasses:" ["🕶️"])
+ (":spider:" ["🕷️"])
+ (":spider_web:" ["🕸️"])
+ (":joystick:" ["🕹️"])
+ (":man_dancing:" ["🕺"])
+ (":linked_paperclips:" ["🖇️"])
+ (":lower_left_ballpoint_pen:" ["🖊️"])
+ (":lower_left_fountain_pen:" ["🖋️"])
+ (":lower_left_paintbrush:" ["🖌️"])
+ (":lower_left_crayon:" ["🖍️"])
+ (":raised_hand_with_fingers_splayed:" ["🖐️"])
+ (":middle_finger:" ["🖕"])
+ (":reversed_hand_with_middle_finger_extended:" ["🖕"])
+ (":spock-hand:" ["🖖"])
+ (":black_heart:" ["🖤"])
+ (":desktop_computer:" ["🖥️"])
+ (":printer:" ["🖨️"])
+ (":three_button_mouse:" ["🖱️"])
+ (":trackball:" ["🖲️"])
+ (":frame_with_picture:" ["🖼️"])
+ (":card_index_dividers:" ["🗂️"])
+ (":card_file_box:" ["🗃️"])
+ (":file_cabinet:" ["🗄️"])
+ (":wastebasket:" ["🗑️"])
+ (":spiral_note_pad:" ["🗒️"])
+ (":spiral_calendar_pad:" ["🗓️"])
+ (":compression:" ["🗜️"])
+ (":old_key:" ["🗝️"])
+ (":rolled_up_newspaper:" ["🗞️"])
+ (":dagger_knife:" ["🗡️"])
+ (":speaking_head_in_silhouette:" ["🗣️"])
+ (":left_speech_bubble:" ["🗨️"])
+ (":right_anger_bubble:" ["🗯️"])
+ (":ballot_box_with_ballot:" ["🗳️"])
+ (":world_map:" ["🗺️"])
+ (":mount_fuji:" ["🗻"])
+ (":tokyo_tower:" ["🗼"])
+ (":statue_of_liberty:" ["🗽"])
+ (":japan:" ["🗾"])
+ (":moyai:" ["🗿"])
+ (":grinning:" ["😀"])
+ (":D" ["😀"])
+ (":grin:" ["😁"])
+ (":joy:" ["😂"])
+ (":smiley:" ["😃"])
+ (":)" ["😃"])
+ ("=)" ["😃"])
+ ("=-)" ["😃"])
+ (":smile:" ["😄"])
+ (":)" ["😄"])
+ ("C:" ["😄"])
+ ("c:" ["😄"])
+ (":D" ["😄"])
+ (":-D" ["😄"])
+ (":sweat_smile:" ["😅"])
+ (":laughing:" ["😆"])
+ (":satisfied:" ["😆"])
+ (":>" ["😆"])
+ (":->" ["😆"])
+ (":innocent:" ["😇"])
+ (":smiling_imp:" ["😈"])
+ (":wink:" ["😉"])
+ (";)" ["😉"])
+ (";-)" ["😉"])
+ (":blush:" ["😊"])
+ (":)" ["😊"])
+ (":yum:" ["😋"])
+ (":relieved:" ["😌"])
+ (":heart_eyes:" ["😍"])
+ (":sunglasses:" ["😎"])
+ ("8)" ["😎"])
+ (":smirk:" ["😏"])
+ (":neutral_face:" ["😐"])
+ (":|" ["😐"])
+ (":-|" ["😐"])
+ (":expressionless:" ["😑"])
+ (":unamused:" ["😒"])
+ (":(" ["😒"])
+ (":sweat:" ["😓"])
+ (":pensive:" ["😔"])
+ (":confused:" ["😕"])
+ (":\\" ["😕"])
+ (":-\\" ["😕"])
+ (":/" ["😕"])
+ (":-/" ["😕"])
+ (":confounded:" ["😖"])
+ (":kissing:" ["😗"])
+ (":kissing_heart:" ["😘"])
+ (":*" ["😘"])
+ (":-*" ["😘"])
+ (":kissing_smiling_eyes:" ["😙"])
+ (":kissing_closed_eyes:" ["😚"])
+ (":stuck_out_tongue:" ["😛"])
+ (":p" ["😛"])
+ (":-p" ["😛"])
+ (":P" ["😛"])
+ (":-P" ["😛"])
+ (":b" ["😛"])
+ (":-b" ["😛"])
+ (":stuck_out_tongue_winking_eye:" ["😜"])
+ (";p" ["😜"])
+ (";-p" ["😜"])
+ (";b" ["😜"])
+ (";-b" ["😜"])
+ (";P" ["😜"])
+ (";-P" ["😜"])
+ (":stuck_out_tongue_closed_eyes:" ["😝"])
+ (":disappointed:" ["😞"])
+ (":(" ["😞"])
+ ("):" ["😞"])
+ (":-(" ["😞"])
+ (":worried:" ["😟"])
+ (":angry:" ["😠"])
+ (">:(" ["😠"])
+ (">:-(" ["😠"])
+ (":rage:" ["😡"])
+ (":cry:" ["😢"])
+ (":'(" ["😢"])
+ (":persevere:" ["😣"])
+ (":triumph:" ["😤"])
+ (":disappointed_relieved:" ["😥"])
+ (":frowning:" ["😦"])
+ (":anguished:" ["😧"])
+ ("D:" ["😧"])
+ (":fearful:" ["😨"])
+ (":weary:" ["😩"])
+ (":sleepy:" ["😪"])
+ (":tired_face:" ["😫"])
+ (":grimacing:" ["😬"])
+ (":sob:" ["😭"])
+ (":'(" ["😭"])
+ (":face_exhaling:" ["😮‍💨"])
+ (":open_mouth:" ["😮"])
+ (":o" ["😮"])
+ (":-o" ["😮"])
+ (":O" ["😮"])
+ (":-O" ["😮"])
+ (":hushed:" ["😯"])
+ (":cold_sweat:" ["😰"])
+ (":scream:" ["😱"])
+ (":astonished:" ["😲"])
+ (":flushed:" ["😳"])
+ (":sleeping:" ["😴"])
+ (":face_with_spiral_eyes:" ["😵‍💫"])
+ (":dizzy_face:" ["😵"])
+ (":face_in_clouds:" ["😶‍🌫️"])
+ (":no_mouth:" ["😶"])
+ (":mask:" ["😷"])
+ (":smile_cat:" ["😸"])
+ (":joy_cat:" ["😹"])
+ (":smiley_cat:" ["😺"])
+ (":heart_eyes_cat:" ["😻"])
+ (":smirk_cat:" ["😼"])
+ (":kissing_cat:" ["😽"])
+ (":pouting_cat:" ["😾"])
+ (":crying_cat_face:" ["😿"])
+ (":scream_cat:" ["🙀"])
+ (":slightly_frowning_face:" ["🙁"])
+ (":slightly_smiling_face:" ["🙂"])
+ (":)" ["🙂"])
+ ("(:" ["🙂"])
+ (":-)" ["🙂"])
+ (":upside_down_face:" ["🙃"])
+ (":face_with_rolling_eyes:" ["🙄"])
+ (":woman-gesturing-no:" ["🙅‍♀️"])
+ (":man-gesturing-no:" ["🙅‍♂️"])
+ (":no_good:" ["🙅"])
+ (":woman-gesturing-ok:" ["🙆‍♀️"])
+ (":man-gesturing-ok:" ["🙆‍♂️"])
+ (":ok_woman:" ["🙆"])
+ (":woman-bowing:" ["🙇‍♀️"])
+ (":man-bowing:" ["🙇‍♂️"])
+ (":bow:" ["🙇"])
+ (":see_no_evil:" ["🙈"])
+ (":hear_no_evil:" ["🙉"])
+ (":speak_no_evil:" ["🙊"])
+ (":woman-raising-hand:" ["🙋‍♀️"])
+ (":man-raising-hand:" ["🙋‍♂️"])
+ (":raising_hand:" ["🙋"])
+ (":raised_hands:" ["🙌"])
+ (":woman-frowning:" ["🙍‍♀️"])
+ (":man-frowning:" ["🙍‍♂️"])
+ (":person_frowning:" ["🙍"])
+ (":woman-pouting:" ["🙎‍♀️"])
+ (":man-pouting:" ["🙎‍♂️"])
+ (":person_with_pouting_face:" ["🙎"])
+ (":pray:" ["🙏"])
+ (":rocket:" ["🚀"])
+ (":helicopter:" ["🚁"])
+ (":steam_locomotive:" ["🚂"])
+ (":railway_car:" ["🚃"])
+ (":bullettrain_side:" ["🚄"])
+ (":bullettrain_front:" ["🚅"])
+ (":train2:" ["🚆"])
+ (":metro:" ["🚇"])
+ (":light_rail:" ["🚈"])
+ (":station:" ["🚉"])
+ (":tram:" ["🚊"])
+ (":train:" ["🚋"])
+ (":bus:" ["🚌"])
+ (":oncoming_bus:" ["🚍"])
+ (":trolleybus:" ["🚎"])
+ (":busstop:" ["🚏"])
+ (":minibus:" ["🚐"])
+ (":ambulance:" ["🚑"])
+ (":fire_engine:" ["🚒"])
+ (":police_car:" ["🚓"])
+ (":oncoming_police_car:" ["🚔"])
+ (":taxi:" ["🚕"])
+ (":oncoming_taxi:" ["🚖"])
+ (":car:" ["🚗"])
+ (":red_car:" ["🚗"])
+ (":oncoming_automobile:" ["🚘"])
+ (":blue_car:" ["🚙"])
+ (":truck:" ["🚚"])
+ (":articulated_lorry:" ["🚛"])
+ (":tractor:" ["🚜"])
+ (":monorail:" ["🚝"])
+ (":mountain_railway:" ["🚞"])
+ (":suspension_railway:" ["🚟"])
+ (":mountain_cableway:" ["🚠"])
+ (":aerial_tramway:" ["🚡"])
+ (":ship:" ["🚢"])
+ (":woman-rowing-boat:" ["🚣‍♀️"])
+ (":man-rowing-boat:" ["🚣‍♂️"])
+ (":rowboat:" ["🚣"])
+ (":speedboat:" ["🚤"])
+ (":traffic_light:" ["🚥"])
+ (":vertical_traffic_light:" ["🚦"])
+ (":construction:" ["🚧"])
+ (":rotating_light:" ["🚨"])
+ (":triangular_flag_on_post:" ["🚩"])
+ (":door:" ["🚪"])
+ (":no_entry_sign:" ["🚫"])
+ (":smoking:" ["🚬"])
+ (":no_smoking:" ["🚭"])
+ (":put_litter_in_its_place:" ["🚮"])
+ (":do_not_litter:" ["🚯"])
+ (":potable_water:" ["🚰"])
+ (":non-potable_water:" ["🚱"])
+ (":bike:" ["🚲"])
+ (":no_bicycles:" ["🚳"])
+ (":woman-biking:" ["🚴‍♀️"])
+ (":man-biking:" ["🚴‍♂️"])
+ (":bicyclist:" ["🚴"])
+ (":woman-mountain-biking:" ["🚵‍♀️"])
+ (":man-mountain-biking:" ["🚵‍♂️"])
+ (":mountain_bicyclist:" ["🚵"])
+ (":woman-walking:" ["🚶‍♀️"])
+ (":man-walking:" ["🚶‍♂️"])
+ (":walking:" ["🚶"])
+ (":no_pedestrians:" ["🚷"])
+ (":children_crossing:" ["🚸"])
+ (":mens:" ["🚹"])
+ (":womens:" ["🚺"])
+ (":restroom:" ["🚻"])
+ (":baby_symbol:" ["🚼"])
+ (":toilet:" ["🚽"])
+ (":wc:" ["🚾"])
+ (":shower:" ["🚿"])
+ (":bath:" ["🛀"])
+ (":bathtub:" ["🛁"])
+ (":passport_control:" ["🛂"])
+ (":customs:" ["🛃"])
+ (":baggage_claim:" ["🛄"])
+ (":left_luggage:" ["🛅"])
+ (":couch_and_lamp:" ["🛋️"])
+ (":sleeping_accommodation:" ["🛌"])
+ (":shopping_bags:" ["🛍️"])
+ (":bellhop_bell:" ["🛎️"])
+ (":bed:" ["🛏️"])
+ (":place_of_worship:" ["🛐"])
+ (":octagonal_sign:" ["🛑"])
+ (":shopping_trolley:" ["🛒"])
+ (":hindu_temple:" ["🛕"])
+ (":hut:" ["🛖"])
+ (":elevator:" ["🛗"])
+ (":hammer_and_wrench:" ["🛠️"])
+ (":shield:" ["🛡️"])
+ (":oil_drum:" ["🛢️"])
+ (":motorway:" ["🛣️"])
+ (":railway_track:" ["🛤️"])
+ (":motor_boat:" ["🛥️"])
+ (":small_airplane:" ["🛩️"])
+ (":airplane_departure:" ["🛫"])
+ (":airplane_arriving:" ["🛬"])
+ (":satellite:" ["🛰️"])
+ (":passenger_ship:" ["🛳️"])
+ (":scooter:" ["🛴"])
+ (":motor_scooter:" ["🛵"])
+ (":canoe:" ["🛶"])
+ (":sled:" ["🛷"])
+ (":flying_saucer:" ["🛸"])
+ (":skateboard:" ["🛹"])
+ (":auto_rickshaw:" ["🛺"])
+ (":pickup_truck:" ["🛻"])
+ (":roller_skate:" ["🛼"])
+ (":large_orange_circle:" ["🟠"])
+ (":large_yellow_circle:" ["🟡"])
+ (":large_green_circle:" ["🟢"])
+ (":large_purple_circle:" ["🟣"])
+ (":large_brown_circle:" ["🟤"])
+ (":large_red_square:" ["🟥"])
+ (":large_blue_square:" ["🟦"])
+ (":large_orange_square:" ["🟧"])
+ (":large_yellow_square:" ["🟨"])
+ (":large_green_square:" ["🟩"])
+ (":large_purple_square:" ["🟪"])
+ (":large_brown_square:" ["🟫"])
+ (":pinched_fingers:" ["🤌"])
+ (":white_heart:" ["🤍"])
+ (":brown_heart:" ["🤎"])
+ (":pinching_hand:" ["🤏"])
+ (":zipper_mouth_face:" ["🤐"])
+ (":money_mouth_face:" ["🤑"])
+ (":face_with_thermometer:" ["🤒"])
+ (":nerd_face:" ["🤓"])
+ (":thinking_face:" ["🤔"])
+ (":face_with_head_bandage:" ["🤕"])
+ (":robot_face:" ["🤖"])
+ (":hugging_face:" ["🤗"])
+ (":the_horns:" ["🤘"])
+ (":sign_of_the_horns:" ["🤘"])
+ (":call_me_hand:" ["🤙"])
+ (":raised_back_of_hand:" ["🤚"])
+ (":left-facing_fist:" ["🤛"])
+ (":right-facing_fist:" ["🤜"])
+ (":handshake:" ["🤝"])
+ (":crossed_fingers:" ["🤞"])
+ (":hand_with_index_and_middle_fingers_crossed:" ["🤞"])
+ (":i_love_you_hand_sign:" ["🤟"])
+ (":face_with_cowboy_hat:" ["🤠"])
+ (":clown_face:" ["🤡"])
+ (":nauseated_face:" ["🤢"])
+ (":rolling_on_the_floor_laughing:" ["🤣"])
+ (":drooling_face:" ["🤤"])
+ (":lying_face:" ["🤥"])
+ (":woman-facepalming:" ["🤦‍♀️"])
+ (":man-facepalming:" ["🤦‍♂️"])
+ (":face_palm:" ["🤦"])
+ (":sneezing_face:" ["🤧"])
+ (":face_with_raised_eyebrow:" ["🤨"])
+ (":face_with_one_eyebrow_raised:" ["🤨"])
+ (":star-struck:" ["🤩"])
+ (":grinning_face_with_star_eyes:" ["🤩"])
+ (":zany_face:" ["🤪"])
+ (":grinning_face_with_one_large_and_one_small_eye:" ["🤪"])
+ (":shushing_face:" ["🤫"])
+ (":face_with_finger_covering_closed_lips:" ["🤫"])
+ (":face_with_symbols_on_mouth:" ["🤬"])
+ (":serious_face_with_symbols_covering_mouth:" ["🤬"])
+ (":face_with_hand_over_mouth:" ["🤭"])
+ (":smiling_face_with_smiling_eyes_and_hand_covering_mouth:" ["🤭"])
+ (":face_vomiting:" ["🤮"])
+ (":face_with_open_mouth_vomiting:" ["🤮"])
+ (":exploding_head:" ["🤯"])
+ (":shocked_face_with_exploding_head:" ["🤯"])
+ (":pregnant_woman:" ["🤰"])
+ (":breast-feeding:" ["🤱"])
+ (":palms_up_together:" ["🤲"])
+ (":selfie:" ["🤳"])
+ (":prince:" ["🤴"])
+ (":woman_in_tuxedo:" ["🤵‍♀️"])
+ (":man_in_tuxedo:" ["🤵‍♂️"])
+ (":person_in_tuxedo:" ["🤵"])
+ (":mrs_claus:" ["🤶"])
+ (":mother_christmas:" ["🤶"])
+ (":woman-shrugging:" ["🤷‍♀️"])
+ (":man-shrugging:" ["🤷‍♂️"])
+ (":shrug:" ["🤷"])
+ (":woman-cartwheeling:" ["🤸‍♀️"])
+ (":man-cartwheeling:" ["🤸‍♂️"])
+ (":person_doing_cartwheel:" ["🤸"])
+ (":woman-juggling:" ["🤹‍♀️"])
+ (":man-juggling:" ["🤹‍♂️"])
+ (":juggling:" ["🤹"])
+ (":fencer:" ["🤺"])
+ (":woman-wrestling:" ["🤼‍♀️"])
+ (":man-wrestling:" ["🤼‍♂️"])
+ (":wrestlers:" ["🤼"])
+ (":woman-playing-water-polo:" ["🤽‍♀️"])
+ (":man-playing-water-polo:" ["🤽‍♂️"])
+ (":water_polo:" ["🤽"])
+ (":woman-playing-handball:" ["🤾‍♀️"])
+ (":man-playing-handball:" ["🤾‍♂️"])
+ (":handball:" ["🤾"])
+ (":diving_mask:" ["🤿"])
+ (":wilted_flower:" ["🥀"])
+ (":drum_with_drumsticks:" ["🥁"])
+ (":clinking_glasses:" ["🥂"])
+ (":tumbler_glass:" ["🥃"])
+ (":spoon:" ["🥄"])
+ (":goal_net:" ["🥅"])
+ (":first_place_medal:" ["🥇"])
+ (":second_place_medal:" ["🥈"])
+ (":third_place_medal:" ["🥉"])
+ (":boxing_glove:" ["🥊"])
+ (":martial_arts_uniform:" ["🥋"])
+ (":curling_stone:" ["🥌"])
+ (":lacrosse:" ["🥍"])
+ (":softball:" ["🥎"])
+ (":flying_disc:" ["🥏"])
+ (":croissant:" ["🥐"])
+ (":avocado:" ["🥑"])
+ (":cucumber:" ["🥒"])
+ (":bacon:" ["🥓"])
+ (":potato:" ["🥔"])
+ (":carrot:" ["🥕"])
+ (":baguette_bread:" ["🥖"])
+ (":green_salad:" ["🥗"])
+ (":shallow_pan_of_food:" ["🥘"])
+ (":stuffed_flatbread:" ["🥙"])
+ (":egg:" ["🥚"])
+ (":glass_of_milk:" ["🥛"])
+ (":peanuts:" ["🥜"])
+ (":kiwifruit:" ["🥝"])
+ (":pancakes:" ["🥞"])
+ (":dumpling:" ["🥟"])
+ (":fortune_cookie:" ["🥠"])
+ (":takeout_box:" ["🥡"])
+ (":chopsticks:" ["🥢"])
+ (":bowl_with_spoon:" ["🥣"])
+ (":cup_with_straw:" ["🥤"])
+ (":coconut:" ["🥥"])
+ (":broccoli:" ["🥦"])
+ (":pie:" ["🥧"])
+ (":pretzel:" ["🥨"])
+ (":cut_of_meat:" ["🥩"])
+ (":sandwich:" ["🥪"])
+ (":canned_food:" ["🥫"])
+ (":leafy_green:" ["🥬"])
+ (":mango:" ["🥭"])
+ (":moon_cake:" ["🥮"])
+ (":bagel:" ["🥯"])
+ (":smiling_face_with_3_hearts:" ["🥰"])
+ (":yawning_face:" ["🥱"])
+ (":smiling_face_with_tear:" ["🥲"])
+ (":partying_face:" ["🥳"])
+ (":woozy_face:" ["🥴"])
+ (":hot_face:" ["🥵"])
+ (":cold_face:" ["🥶"])
+ (":ninja:" ["🥷"])
+ (":disguised_face:" ["🥸"])
+ (":pleading_face:" ["🥺"])
+ (":sari:" ["🥻"])
+ (":lab_coat:" ["🥼"])
+ (":goggles:" ["🥽"])
+ (":hiking_boot:" ["🥾"])
+ (":womans_flat_shoe:" ["🥿"])
+ (":crab:" ["🦀"])
+ (":lion_face:" ["🦁"])
+ (":scorpion:" ["🦂"])
+ (":turkey:" ["🦃"])
+ (":unicorn_face:" ["🦄"])
+ (":eagle:" ["🦅"])
+ (":duck:" ["🦆"])
+ (":bat:" ["🦇"])
+ (":shark:" ["🦈"])
+ (":owl:" ["🦉"])
+ (":fox_face:" ["🦊"])
+ (":butterfly:" ["🦋"])
+ (":deer:" ["🦌"])
+ (":gorilla:" ["🦍"])
+ (":lizard:" ["🦎"])
+ (":rhinoceros:" ["🦏"])
+ (":shrimp:" ["🦐"])
+ (":squid:" ["🦑"])
+ (":giraffe_face:" ["🦒"])
+ (":zebra_face:" ["🦓"])
+ (":hedgehog:" ["🦔"])
+ (":sauropod:" ["🦕"])
+ (":t-rex:" ["🦖"])
+ (":cricket:" ["🦗"])
+ (":kangaroo:" ["🦘"])
+ (":llama:" ["🦙"])
+ (":peacock:" ["🦚"])
+ (":hippopotamus:" ["🦛"])
+ (":parrot:" ["🦜"])
+ (":raccoon:" ["🦝"])
+ (":lobster:" ["🦞"])
+ (":mosquito:" ["🦟"])
+ (":microbe:" ["🦠"])
+ (":badger:" ["🦡"])
+ (":swan:" ["🦢"])
+ (":mammoth:" ["🦣"])
+ (":dodo:" ["🦤"])
+ (":sloth:" ["🦥"])
+ (":otter:" ["🦦"])
+ (":orangutan:" ["🦧"])
+ (":skunk:" ["🦨"])
+ (":flamingo:" ["🦩"])
+ (":oyster:" ["🦪"])
+ (":beaver:" ["🦫"])
+ (":bison:" ["🦬"])
+ (":seal:" ["🦭"])
+ (":guide_dog:" ["🦮"])
+ (":probing_cane:" ["🦯"])
+ (":bone:" ["🦴"])
+ (":leg:" ["🦵"])
+ (":foot:" ["🦶"])
+ (":tooth:" ["🦷"])
+ (":female_superhero:" ["🦸‍♀️"])
+ (":male_superhero:" ["🦸‍♂️"])
+ (":superhero:" ["🦸"])
+ (":female_supervillain:" ["🦹‍♀️"])
+ (":male_supervillain:" ["🦹‍♂️"])
+ (":supervillain:" ["🦹"])
+ (":safety_vest:" ["🦺"])
+ (":ear_with_hearing_aid:" ["🦻"])
+ (":motorized_wheelchair:" ["🦼"])
+ (":manual_wheelchair:" ["🦽"])
+ (":mechanical_arm:" ["🦾"])
+ (":mechanical_leg:" ["🦿"])
+ (":cheese_wedge:" ["🧀"])
+ (":cupcake:" ["🧁"])
+ (":salt:" ["🧂"])
+ (":beverage_box:" ["🧃"])
+ (":garlic:" ["🧄"])
+ (":onion:" ["🧅"])
+ (":falafel:" ["🧆"])
+ (":waffle:" ["🧇"])
+ (":butter:" ["🧈"])
+ (":mate_drink:" ["🧉"])
+ (":ice_cube:" ["🧊"])
+ (":bubble_tea:" ["🧋"])
+ (":woman_standing:" ["🧍‍♀️"])
+ (":man_standing:" ["🧍‍♂️"])
+ (":standing_person:" ["🧍"])
+ (":woman_kneeling:" ["🧎‍♀️"])
+ (":man_kneeling:" ["🧎‍♂️"])
+ (":kneeling_person:" ["🧎"])
+ (":deaf_woman:" ["🧏‍♀️"])
+ (":deaf_man:" ["🧏‍♂️"])
+ (":deaf_person:" ["🧏"])
+ (":face_with_monocle:" ["🧐"])
+ (":farmer:" ["🧑‍🌾"])
+ (":cook:" ["🧑‍🍳"])
+ (":person_feeding_baby:" ["🧑‍🍼"])
+ (":mx_claus:" ["🧑‍🎄"])
+ (":student:" ["🧑‍🎓"])
+ (":singer:" ["🧑‍🎤"])
+ (":artist:" ["🧑‍🎨"])
+ (":teacher:" ["🧑‍🏫"])
+ (":factory_worker:" ["🧑‍🏭"])
+ (":technologist:" ["🧑‍💻"])
+ (":office_worker:" ["🧑‍💼"])
+ (":mechanic:" ["🧑‍🔧"])
+ (":scientist:" ["🧑‍🔬"])
+ (":astronaut:" ["🧑‍🚀"])
+ (":firefighter:" ["🧑‍🚒"])
+ (":people_holding_hands:" ["🧑‍🤝‍🧑"])
+ (":person_with_probing_cane:" ["🧑‍🦯"])
+ (":red_haired_person:" ["🧑‍🦰"])
+ (":curly_haired_person:" ["🧑‍🦱"])
+ (":bald_person:" ["🧑‍🦲"])
+ (":white_haired_person:" ["🧑‍🦳"])
+ (":person_in_motorized_wheelchair:" ["🧑‍🦼"])
+ (":person_in_manual_wheelchair:" ["🧑‍🦽"])
+ (":health_worker:" ["🧑‍⚕️"])
+ (":judge:" ["🧑‍⚖️"])
+ (":pilot:" ["🧑‍✈️"])
+ (":adult:" ["🧑"])
+ (":child:" ["🧒"])
+ (":older_adult:" ["🧓"])
+ (":woman_with_beard:" ["🧔‍♀️"])
+ (":man_with_beard:" ["🧔‍♂️"])
+ (":bearded_person:" ["🧔"])
+ (":person_with_headscarf:" ["🧕"])
+ (":woman_in_steamy_room:" ["🧖‍♀️"])
+ (":man_in_steamy_room:" ["🧖‍♂️"])
+ (":person_in_steamy_room:" ["🧖"])
+ (":woman_climbing:" ["🧗‍♀️"])
+ (":man_climbing:" ["🧗‍♂️"])
+ (":person_climbing:" ["🧗"])
+ (":woman_in_lotus_position:" ["🧘‍♀️"])
+ (":man_in_lotus_position:" ["🧘‍♂️"])
+ (":person_in_lotus_position:" ["🧘"])
+ (":female_mage:" ["🧙‍♀️"])
+ (":male_mage:" ["🧙‍♂️"])
+ (":mage:" ["🧙"])
+ (":female_fairy:" ["🧚‍♀️"])
+ (":male_fairy:" ["🧚‍♂️"])
+ (":fairy:" ["🧚"])
+ (":female_vampire:" ["🧛‍♀️"])
+ (":male_vampire:" ["🧛‍♂️"])
+ (":vampire:" ["🧛"])
+ (":mermaid:" ["🧜‍♀️"])
+ (":merman:" ["🧜‍♂️"])
+ (":merperson:" ["🧜"])
+ (":female_elf:" ["🧝‍♀️"])
+ (":male_elf:" ["🧝‍♂️"])
+ (":elf:" ["🧝"])
+ (":female_genie:" ["🧞‍♀️"])
+ (":male_genie:" ["🧞‍♂️"])
+ (":genie:" ["🧞"])
+ (":female_zombie:" ["🧟‍♀️"])
+ (":male_zombie:" ["🧟‍♂️"])
+ (":zombie:" ["🧟"])
+ (":brain:" ["🧠"])
+ (":orange_heart:" ["🧡"])
+ (":billed_cap:" ["🧢"])
+ (":scarf:" ["🧣"])
+ (":gloves:" ["🧤"])
+ (":coat:" ["🧥"])
+ (":socks:" ["🧦"])
+ (":red_envelope:" ["🧧"])
+ (":firecracker:" ["🧨"])
+ (":jigsaw:" ["🧩"])
+ (":test_tube:" ["🧪"])
+ (":petri_dish:" ["🧫"])
+ (":dna:" ["🧬"])
+ (":compass:" ["🧭"])
+ (":abacus:" ["🧮"])
+ (":fire_extinguisher:" ["🧯"])
+ (":toolbox:" ["🧰"])
+ (":bricks:" ["🧱"])
+ (":magnet:" ["🧲"])
+ (":luggage:" ["🧳"])
+ (":lotion_bottle:" ["🧴"])
+ (":thread:" ["🧵"])
+ (":yarn:" ["🧶"])
+ (":safety_pin:" ["🧷"])
+ (":teddy_bear:" ["🧸"])
+ (":broom:" ["🧹"])
+ (":basket:" ["🧺"])
+ (":roll_of_paper:" ["🧻"])
+ (":soap:" ["🧼"])
+ (":sponge:" ["🧽"])
+ (":receipt:" ["🧾"])
+ (":nazar_amulet:" ["🧿"])
+ (":ballet_shoes:" ["🩰"])
+ (":one-piece_swimsuit:" ["🩱"])
+ (":briefs:" ["🩲"])
+ (":shorts:" ["🩳"])
+ (":thong_sandal:" ["🩴"])
+ (":drop_of_blood:" ["🩸"])
+ (":adhesive_bandage:" ["🩹"])
+ (":stethoscope:" ["🩺"])
+ (":yo-yo:" ["🪀"])
+ (":kite:" ["🪁"])
+ (":parachute:" ["🪂"])
+ (":boomerang:" ["🪃"])
+ (":magic_wand:" ["🪄"])
+ (":pinata:" ["🪅"])
+ (":nesting_dolls:" ["🪆"])
+ (":ringed_planet:" ["🪐"])
+ (":chair:" ["🪑"])
+ (":razor:" ["🪒"])
+ (":axe:" ["🪓"])
+ (":diya_lamp:" ["🪔"])
+ (":banjo:" ["🪕"])
+ (":military_helmet:" ["🪖"])
+ (":accordion:" ["🪗"])
+ (":long_drum:" ["🪘"])
+ (":coin:" ["🪙"])
+ (":carpentry_saw:" ["🪚"])
+ (":screwdriver:" ["🪛"])
+ (":ladder:" ["🪜"])
+ (":hook:" ["🪝"])
+ (":mirror:" ["🪞"])
+ (":window:" ["🪟"])
+ (":plunger:" ["🪠"])
+ (":sewing_needle:" ["🪡"])
+ (":knot:" ["🪢"])
+ (":bucket:" ["🪣"])
+ (":mouse_trap:" ["🪤"])
+ (":toothbrush:" ["🪥"])
+ (":headstone:" ["🪦"])
+ (":placard:" ["🪧"])
+ (":rock:" ["🪨"])
+ (":fly:" ["🪰"])
+ (":worm:" ["🪱"])
+ (":beetle:" ["🪲"])
+ (":cockroach:" ["🪳"])
+ (":potted_plant:" ["🪴"])
+ (":wood:" ["🪵"])
+ (":feather:" ["🪶"])
+ (":anatomical_heart:" ["🫀"])
+ (":lungs:" ["🫁"])
+ (":people_hugging:" ["🫂"])
+ (":blueberries:" ["🫐"])
+ (":bell_pepper:" ["🫑"])
+ (":olive:" ["🫒"])
+ (":flatbread:" ["🫓"])
+ (":tamale:" ["🫔"])
+ (":fondue:" ["🫕"])
+ (":teapot:" ["🫖"])
+ (":bangbang:" ["‼️"])
+ (":interrobang:" ["⁉️"])
+ (":tm:" ["™️"])
+ (":information_source:" ["ℹ️"])
+ (":left_right_arrow:" ["↔️"])
+ (":arrow_up_down:" ["↕️"])
+ (":arrow_upper_left:" ["↖️"])
+ (":arrow_upper_right:" ["↗️"])
+ (":arrow_lower_right:" ["↘️"])
+ (":arrow_lower_left:" ["↙️"])
+ (":leftwards_arrow_with_hook:" ["↩️"])
+ (":arrow_right_hook:" ["↪️"])
+ (":watch:" ["⌚"])
+ (":hourglass:" ["⌛"])
+ (":keyboard:" ["⌨️"])
+ (":eject:" ["⏏️"])
+ (":fast_forward:" ["⏩"])
+ (":rewind:" ["⏪"])
+ (":arrow_double_up:" ["⏫"])
+ (":arrow_double_down:" ["⏬"])
+ (":black_right_pointing_double_triangle_with_vertical_bar:" ["⏭️"])
+ (":black_left_pointing_double_triangle_with_vertical_bar:" ["⏮️"])
+ (":black_right_pointing_triangle_with_double_vertical_bar:" ["⏯️"])
+ (":alarm_clock:" ["⏰"])
+ (":stopwatch:" ["⏱️"])
+ (":timer_clock:" ["⏲️"])
+ (":hourglass_flowing_sand:" ["⏳"])
+ (":double_vertical_bar:" ["⏸️"])
+ (":black_square_for_stop:" ["⏹️"])
+ (":black_circle_for_record:" ["⏺️"])
+ (":m:" ["Ⓜ️"])
+ (":black_small_square:" ["▪️"])
+ (":white_small_square:" ["▫️"])
+ (":arrow_forward:" ["▶️"])
+ (":arrow_backward:" ["◀️"])
+ (":white_medium_square:" ["◻️"])
+ (":black_medium_square:" ["◼️"])
+ (":white_medium_small_square:" ["◽"])
+ (":black_medium_small_square:" ["◾"])
+ (":sunny:" ["☀️"])
+ (":cloud:" ["☁️"])
+ (":umbrella:" ["☂️"])
+ (":snowman:" ["☃️"])
+ (":comet:" ["☄️"])
+ (":phone:" ["☎️"])
+ (":telephone:" ["☎️"])
+ (":ballot_box_with_check:" ["☑️"])
+ (":umbrella_with_rain_drops:" ["☔"])
+ (":coffee:" ["☕"])
+ (":shamrock:" ["☘️"])
+ (":point_up:" ["☝️"])
+ (":skull_and_crossbones:" ["☠️"])
+ (":radioactive_sign:" ["☢️"])
+ (":biohazard_sign:" ["☣️"])
+ (":orthodox_cross:" ["☦️"])
+ (":star_and_crescent:" ["☪️"])
+ (":peace_symbol:" ["☮️"])
+ (":yin_yang:" ["☯️"])
+ (":wheel_of_dharma:" ["☸️"])
+ (":white_frowning_face:" ["☹️"])
+ (":relaxed:" ["☺️"])
+ (":female_sign:" ["♀️"])
+ (":male_sign:" ["♂️"])
+ (":aries:" ["♈"])
+ (":taurus:" ["♉"])
+ (":gemini:" ["♊"])
+ (":cancer:" ["♋"])
+ (":leo:" ["♌"])
+ (":virgo:" ["♍"])
+ (":libra:" ["♎"])
+ (":scorpius:" ["♏"])
+ (":sagittarius:" ["♐"])
+ (":capricorn:" ["♑"])
+ (":aquarius:" ["♒"])
+ (":pisces:" ["♓"])
+ (":chess_pawn:" ["♟️"])
+ (":spades:" ["♠️"])
+ (":clubs:" ["♣️"])
+ (":hearts:" ["♥️"])
+ (":diamonds:" ["♦️"])
+ (":hotsprings:" ["♨️"])
+ (":recycle:" ["♻️"])
+ (":infinity:" ["♾️"])
+ (":wheelchair:" ["♿"])
+ (":hammer_and_pick:" ["⚒️"])
+ (":anchor:" ["⚓"])
+ (":crossed_swords:" ["⚔️"])
+ (":medical_symbol:" ["⚕️"])
+ (":staff_of_aesculapius:" ["⚕️"])
+ (":scales:" ["⚖️"])
+ (":alembic:" ["⚗️"])
+ (":gear:" ["⚙️"])
+ (":atom_symbol:" ["⚛️"])
+ (":fleur_de_lis:" ["⚜️"])
+ (":warning:" ["⚠️"])
+ (":zap:" ["⚡"])
+ (":transgender_symbol:" ["⚧️"])
+ (":white_circle:" ["⚪"])
+ (":black_circle:" ["⚫"])
+ (":coffin:" ["⚰️"])
+ (":funeral_urn:" ["⚱️"])
+ (":soccer:" ["⚽"])
+ (":baseball:" ["⚾"])
+ (":snowman_without_snow:" ["⛄"])
+ (":partly_sunny:" ["⛅"])
+ (":thunder_cloud_and_rain:" ["⛈️"])
+ (":ophiuchus:" ["⛎"])
+ (":pick:" ["⛏️"])
+ (":helmet_with_white_cross:" ["⛑️"])
+ (":chains:" ["⛓️"])
+ (":no_entry:" ["⛔"])
+ (":shinto_shrine:" ["⛩️"])
+ (":church:" ["⛪"])
+ (":mountain:" ["⛰️"])
+ (":umbrella_on_ground:" ["⛱️"])
+ (":fountain:" ["⛲"])
+ (":golf:" ["⛳"])
+ (":ferry:" ["⛴️"])
+ (":boat:" ["⛵"])
+ (":sailboat:" ["⛵"])
+ (":skier:" ["⛷️"])
+ (":ice_skate:" ["⛸️"])
+ (":woman-bouncing-ball:" ["⛹️‍♀️"])
+ (":man-bouncing-ball:" ["⛹️‍♂️"])
+ (":person_with_ball:" ["⛹️"])
+ (":tent:" ["⛺"])
+ (":fuelpump:" ["⛽"])
+ (":scissors:" ["✂️"])
+ (":white_check_mark:" ["✅"])
+ (":airplane:" ["✈️"])
+ (":email:" ["✉️"])
+ (":envelope:" ["✉️"])
+ (":fist:" ["✊"])
+ (":hand:" ["✋"])
+ (":raised_hand:" ["✋"])
+ (":v:" ["✌️"])
+ (":writing_hand:" ["✍️"])
+ (":pencil2:" ["✏️"])
+ (":black_nib:" ["✒️"])
+ (":heavy_check_mark:" ["✔️"])
+ (":heavy_multiplication_x:" ["✖️"])
+ (":latin_cross:" ["✝️"])
+ (":star_of_david:" ["✡️"])
+ (":sparkles:" ["✨"])
+ (":eight_spoked_asterisk:" ["✳️"])
+ (":eight_pointed_black_star:" ["✴️"])
+ (":snowflake:" ["❄️"])
+ (":sparkle:" ["❇️"])
+ (":x:" ["❌"])
+ (":negative_squared_cross_mark:" ["❎"])
+ (":question:" ["❓"])
+ (":grey_question:" ["❔"])
+ (":grey_exclamation:" ["❕"])
+ (":exclamation:" ["❗"])
+ (":heavy_exclamation_mark:" ["❗"])
+ (":heavy_heart_exclamation_mark_ornament:" ["❣️"])
+ (":heart_on_fire:" ["❤️‍🔥"])
+ (":mending_heart:" ["❤️‍🩹"])
+ (":heart:" ["❤️"])
+ ("<3" ["❤️"])
+ (":heavy_plus_sign:" ["➕"])
+ (":heavy_minus_sign:" ["➖"])
+ (":heavy_division_sign:" ["➗"])
+ (":arrow_right:" ["➡️"])
+ (":curly_loop:" ["➰"])
+ (":loop:" ["➿"])
+ (":arrow_heading_up:" ["⤴️"])
+ (":arrow_heading_down:" ["⤵️"])
+ (":arrow_left:" ["⬅️"])
+ (":arrow_up:" ["⬆️"])
+ (":arrow_down:" ["⬇️"])
+ (":black_large_square:" ["⬛"])
+ (":white_large_square:" ["⬜"])
+ (":star:" ["⭐"])
+ (":o:" ["⭕"])
+ (":wavy_dash:" ["〰️"])
+ (":part_alternation_mark:" ["〽️"])
+ (":congratulations:" ["㊗️"])
+ (":secret:" ["㊙️"])))))))
+
+(emoji--define-rules)
+
+(provide 'emoji)
+;;; emoji.el ends here
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index 39e83f6c331..0ef5b2d5c72 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -429,7 +429,7 @@ When a Korean input method is off, convert the following hangul character."
(hangul3-input-method-jong char))
(t
(setq hangul-queue (make-vector 6 0))
- (insert (decode-char 'ucs char))
+ (insert char)
(move-overlay quail-overlay (point) (point))))))
(defun hangul3-input-method (key)
@@ -476,7 +476,7 @@ When a Korean input method is off, convert the following hangul character."
(hangul3-input-method-jong char))
(t
(setq hangul-queue (make-vector 6 0))
- (insert (decode-char 'ucs char))
+ (insert char)
(move-overlay quail-overlay (point) (point))))))
(defun hangul390-input-method (key)
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 23204c0cd3e..04e95b0737b 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -171,7 +171,7 @@
clm)
(with-temp-buffer
(insert "\n")
- (insert " +")
+ (insert "----+")
(insert-char ?- 74)
(insert "\n |")
(setq clm 6)
@@ -244,19 +244,27 @@
(insert "\n")
(buffer-string))))
-(defvar quail-tamil-itrans-various-signs-and-digits-table
+(defun quail-tamil-itrans-compute-signs-table (digitp)
+ "Compute the signs table for the tamil-itrans input method.
+If DIGITP is non-nil, include the digits translation as well."
(let ((various '((?ஃ . "H") ("ஸ்ரீ" . "srii") (?ௐ)))
(digits "௦௧௨௩௪௫௬௭௮௯")
(width 6) clm)
(with-temp-buffer
- (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (insert "\n" (make-string 18 ?-) "+")
+ (when digitp (insert (make-string 60 ?-)))
+ (insert "\n")
(insert
(propertize "\t" 'display '(space :align-to 5)) "various"
- (propertize "\t" 'display '(space :align-to 18)) "|"
- (propertize "\t" 'display '(space :align-to 45)) "digits")
-
- (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
- (setq clm 0 )
+ (propertize "\t" 'display '(space :align-to 18)) "|")
+ (when digitp
+ (insert
+ (propertize "\t" 'display '(space :align-to 45)) "digits"))
+ (insert "\n" (make-string 18 ?-) "+")
+ (when digitp
+ (insert (make-string 60 ?-)))
+ (insert "\n")
+ (setq clm 0)
(dotimes (i (length various))
(insert (propertize "\t" 'display (list 'space :align-to clm))
@@ -264,10 +272,11 @@
(setq clm (+ clm width)))
(insert (propertize "\t" 'display '(space :align-to 18)) "|")
(setq clm 20)
- (dotimes (i 10)
- (insert (propertize "\t" 'display (list 'space :align-to clm))
- (aref digits i))
- (setq clm (+ clm width)))
+ (when digitp
+ (dotimes (i 10)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (aref digits i))
+ (setq clm (+ clm width))))
(insert "\n")
(setq clm 0)
(dotimes (i (length various))
@@ -276,13 +285,22 @@
(setq clm (+ clm width)))
(insert (propertize "\t" 'display '(space :align-to 18)) "|")
(setq clm 20)
- (dotimes (i 10)
- (insert (propertize "\t" 'display (list 'space :align-to clm))
- (format "%d" i))
- (setq clm (+ clm width)))
- (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (when digitp
+ (dotimes (i 10)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (format "%d" i))
+ (setq clm (+ clm width))))
+ (insert "\n" (make-string 18 ?-) "+")
+ (when digitp
+ (insert (make-string 60 ?-) "\n"))
(buffer-string))))
+(defvar quail-tamil-itrans-various-signs-and-digits-table
+ (quail-tamil-itrans-compute-signs-table t))
+
+(defvar quail-tamil-itrans-various-signs-table
+ (quail-tamil-itrans-compute-signs-table nil))
+
(if nil
(quail-define-package "tamil-itrans" "Tamil" "TmlIT" t "Tamil ITRANS"))
(quail-define-indian-trans-package
@@ -293,16 +311,39 @@ You can input characters using the following mapping tables.
Example: To enter வணக்கம், type vaNakkam.
### Basic syllables (consonants + vowels) ###
-\\<quail-tamil-itrans-syllable-table>
+\\=\\<quail-tamil-itrans-syllable-table>
+
+### Miscellaneous (various signs) ###
+\\=\\<quail-tamil-itrans-various-signs-table>
+
+### Others (numerics + symbols) ###
+
+Characters below have no ITRANS method associated with them.
+Their descriptions are included for easy reference.
+\\=\\<quail-tamil-itrans-numerics-and-symbols-table>
+
+Full key sequences are listed below:")
+
+(if nil
+ (quail-define-package "tamil-itrans-digits" "Tamil" "TmlITD" t "Tamil ITRANS with digits"))
+(quail-define-indian-trans-package
+ indian-tml-itrans-digits-v5-hash "tamil-itrans-digits" "Tamil" "TmlITD"
+ "Tamil transliteration by ITRANS method with Tamil digits support.
+
+You can input characters using the following mapping tables.
+ Example: To enter வணக்கம், type vaNakkam.
+
+### Basic syllables (consonants + vowels) ###
+\\=\\<quail-tamil-itrans-syllable-table>
### Miscellaneous (various signs + digits) ###
-\\<quail-tamil-itrans-various-signs-and-digits-table>
+\\=\\<quail-tamil-itrans-various-signs-and-digits-table>
### Others (numerics + symbols) ###
Characters below have no ITRANS method associated with them.
Their descriptions are included for easy reference.
-\\<quail-tamil-itrans-numerics-and-symbols-table>
+\\=\\<quail-tamil-itrans-numerics-and-symbols-table>
Full key sequences are listed below:")
@@ -479,6 +520,13 @@ Full key sequences are listed below:")
"tamil-inscript" "Tamil" "TmlIS"
"Tamil keyboard Inscript.")
+(if nil
+ (quail-define-package "tamil-inscript-digits" "Tamil" "TmlISD" t "Tamil keyboard Inscript with digits."))
+(quail-define-inscript-package
+ indian-tml-base-digits-table inscript-tml-keytable
+ "tamil-inscript-digits" "Tamil" "TmlISD"
+ "Tamil keyboard Inscript with Tamil digits support.")
+
;; Probhat Input Method
(quail-define-package
"bengali-probhat" "Bengali" "BngPB" t
@@ -633,7 +681,7 @@ Full key sequences are listed below:")
(quail-define-package "malayalam-mozhi" "Malayalam" "MlmMI" t
"Malayalam transliteration by Mozhi method."
nil nil t nil nil nil t nil
- #'indian-mlm-mozhi-update-translation)
+ #'indian-mlm-mozhi-update-translation nil t)
(maphash
(lambda (key val)
@@ -648,4 +696,1271 @@ Full key sequences are listed below:")
(quail-defrule "|" ?‌)
(quail-defrule "||" ?​)
+(quail-define-package
+ "brahmi" "Brahmi" "𑀲" t "Brahmi phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("``" ?₹)
+ ("1" ?𑁧)
+ ("`1" ?1)
+ ("`!" ?𑁒)
+ ("2" ?𑁨)
+ ("`2" ?2)
+ ("`@" ?𑁓)
+ ("3" ?𑁩)
+ ("`3" ?3)
+ ("`#" ?𑁔)
+ ("4" ?𑁪)
+ ("`4" ?4)
+ ("`$" ?𑁕)
+ ("5" ?𑁫)
+ ("`5" ?5)
+ ("`%" ?𑁖)
+ ("6" ?𑁬)
+ ("`6" ?6)
+ ("`^" ?𑁗)
+ ("7" ?𑁭)
+ ("`7" ?7)
+ ("`&" ?𑁘)
+ ("8" ?𑁮)
+ ("`8" ?8)
+ ("`*" ?𑁙)
+ ("9" ?𑁯)
+ ("`9" ?9)
+ ("`(" ?𑁚)
+ ("0" ?𑁦)
+ ("`0" ?0)
+ ("`)" ?𑁛)
+ ("`-" ?𑁜)
+ ("`_" ?𑁝)
+ ("`=" ?𑁞)
+ ("`+" ?𑁟)
+ ("`\\" ?𑁇)
+ ("`|" ?𑁈)
+ ("`" ?𑀝)
+ ("q" ?𑀝)
+ ("Q" ?𑀞)
+ ("`q" ?𑀃)
+ ("`Q" ?𑁠)
+ ("w" ?𑀟)
+ ("W" ?𑀠)
+ ("`w" ?𑀄)
+ ("`W" ?𑁡)
+ ("e" ?𑁂)
+ ("E" ?𑁃)
+ ("`e" ?𑀏)
+ ("`E" ?𑀐)
+ ("r" ?𑀭)
+ ("R" ?𑀾)
+ ("`r" ?𑀋)
+ ("`R" ?𑀶)
+ ("t" ?𑀢)
+ ("T" ?𑀣)
+ ("`t" ?𑁢)
+ ("y" ?𑀬)
+ ("Y" ?𑁣)
+ ("`y" ?𑁤)
+ ("`Y" ?𑁥)
+ ("u" ?𑀼)
+ ("U" ?𑀽)
+ ("`u" ?𑀉)
+ ("`U" ?𑀊)
+ ("i" ?𑀺)
+ ("I" ?𑀻)
+ ("`i" ?𑀇)
+ ("`I" ?𑀈)
+ ("o" ?𑁄)
+ ("O" ?𑁅)
+ ("`o" ?𑀑)
+ ("`O" ?𑀒)
+ ("p" ?𑀧)
+ ("P" ?𑀨)
+ ("`p" ?𑁳)
+ ("`P" ?𑁱)
+ ("`[" ?𑁴)
+ ("`{" ?𑁲)
+ ("a" ?𑀸)
+ ("A" ?𑀆)
+ ("`a" ?𑀅)
+ ("`A" ?𑀹)
+ ("s" ?𑀲)
+ ("S" ?𑀰)
+ ("`s" ?𑀱)
+ ("d" ?𑀤)
+ ("D" ?𑀥)
+ ("`d" ?𑀶)
+ ("f" ?𑁆)
+ ("F" ?𑀿)
+ ("`f" ?𑀌)
+ ("`F" ?𑁰)
+ ("g" ?𑀕)
+ ("G" ?𑀖)
+ ("h" ?𑀳)
+ ("H" ?𑀂)
+ ("j" ?𑀚)
+ ("J" ?𑀛)
+ ("k" ?𑀓)
+ ("K" ?𑀔)
+ ("l" ?𑀮)
+ ("L" ?𑀴)
+ ("`l" ?𑀵)
+ ("`L" ?𑁵)
+ ("z" ?𑁀)
+ ("Z" ?𑀍)
+ ("`z" ?𑁁)
+ ("`Z" ?𑀎)
+ ("x" ?𑁉)
+ ("X" ?𑁊)
+ ("`x" ?𑁋)
+ ("`X" ?𑁌)
+ ("c" ?𑀘)
+ ("C" ?𑀙)
+ ("`c" #x200C) ; ZWNJ
+ ("`C" #x200D) ; ZWJ
+ ("v" ?𑀯)
+ ("V" ?𑀷)
+ ("b" ?𑀩)
+ ("B" ?𑀪)
+ ("n" ?𑀦)
+ ("N" ?𑀡)
+ ("`n" ?𑀗)
+ ("`N" ?𑀜)
+ ("m" ?𑀫)
+ ("M" ?𑀁)
+ ("`m" ?𑀀)
+ ("<" ?𑁍)
+ ("`/" ?𑁿)
+ )
+
+(quail-define-package
+ "kaithi" "Kaithi" "𑂍𑂶" t "Kaithi phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("1" ?१)
+("`1" ?1)
+("2" ?२)
+("`2" ?2)
+("3" ?३)
+("`3" ?3)
+("4" ?४)
+("`4" ?4)
+("5" ?५)
+("`5" ?5)
+("6" ?६)
+("`6" ?6)
+("7" ?७)
+("`7" ?7)
+("8" ?८)
+("`8" ?8)
+("9" ?९)
+("`9" ?9)
+("0" ?०)
+("`0" ?0)
+("`)" ?𑂻)
+("`\\" ?𑃀)
+("`|" ?𑃁)
+("`" ?𑂗)
+("q" ?𑂗)
+("Q" ?𑂘)
+("w" ?𑂙)
+("W" ?𑂛)
+("`w" ?𑂚)
+("`W" ?𑂜)
+("e" ?𑂵)
+("E" ?𑂶)
+("`e" ?𑂉)
+("`E" ?𑂊)
+("r" ?𑂩)
+("R" ?𑃂)
+("t" ?𑂞)
+("T" ?𑂟)
+("y" ?𑂨)
+("Y" ?⸱)
+("u" ?𑂳)
+("U" ?𑂴)
+("`u" ?𑂇)
+("`U" ?𑂈)
+("i" ?𑂱)
+("I" ?𑂲)
+("`i" ?𑂅)
+("`I" ?𑂆)
+("o" ?𑂷)
+("O" ?𑂸)
+("`o" ?𑂋)
+("`O" ?𑂌)
+("p" ?𑂣)
+("P" ?𑂤)
+("a" ?𑂰)
+("A" ?𑂄)
+("`a" ?𑂃)
+("s" ?𑂮)
+("S" ?𑂬)
+("d" ?𑂠)
+("D" ?𑂡)
+("`d" ?𑂼)
+("`D" #x110BD) ; Kaithi Number Sign
+("f" ?𑂹)
+("F" #x110CD) ; Kaithi Number Sign Above
+("`f" ?𑂾)
+("`F" ?𑂿)
+("g" ?𑂏)
+("G" ?𑂐)
+("h" ?𑂯)
+("H" ?𑂂)
+("j" ?𑂔)
+("J" ?𑂕)
+("k" ?𑂍)
+("K" ?𑂎)
+("l" ?𑂪)
+("z" ?𑂖)
+("Z" ?𑂑)
+("x" ?𑂭)
+("X" ?𑂺)
+("c" ?𑂒)
+("C" ?𑂓)
+("`c" #x200C) ; ZWNJ
+("`C" #x200D) ; ZWJ
+("v" ?𑂫)
+("b" ?𑂥)
+("B" ?𑂦)
+("n" ?𑂢)
+("N" ?𑂝)
+("m" ?𑂧)
+("M" ?𑂁)
+("`m" ?𑂀)
+)
+
+(quail-define-package
+ "tirhuta" "Tirhuta" "𑒞𑒱" t "Tirhuta phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("1" ?𑓑)
+("`1" ?1)
+("2" ?𑓒)
+("`2" ?2)
+("3" ?𑓓)
+("`3" ?3)
+("4" ?𑓔)
+("`4" ?4)
+("5" ?𑓕)
+("`5" ?5)
+("6" ?𑓖)
+("`6" ?6)
+("7" ?𑓗)
+("`7" ?7)
+("8" ?𑓘)
+("`8" ?8)
+("9" ?𑓙)
+("`9" ?9)
+("0" ?𑓐)
+("`0" ?0)
+("`)" ?𑓆)
+("`\\" ?।)
+("`|" ?॥)
+("`" ?𑒙)
+("q" ?𑒙)
+("Q" ?𑒚)
+("w" ?𑒛)
+("W" ?𑒜)
+("e" ?𑒺)
+("E" ?𑒹)
+("`e" ?𑒋)
+("r" ?𑒩)
+("R" ?𑒵)
+("`r" ?𑒇)
+("t" ?𑒞)
+("T" ?𑒟)
+("y" ?𑒨)
+("Y" ?𑒻)
+("`y" ?𑒌)
+("u" ?𑒳)
+("U" ?𑒴)
+("`u" ?𑒅)
+("`U" ?𑒆)
+("i" ?𑒱)
+("I" ?𑒲)
+("`i" ?𑒃)
+("`I" ?𑒄)
+("o" ?𑒽)
+("O" ?𑒼)
+("`o" ?𑒍)
+("p" ?𑒣)
+("P" ?𑒤)
+("a" ?𑒰)
+("A" ?𑒂)
+("`a" ?𑒁)
+("s" ?𑒮)
+("S" ?𑒬)
+("d" ?𑒠)
+("D" ?𑒡)
+("f" ?𑓂)
+("F" ?𑒶)
+("`f" ?𑒈)
+("g" ?𑒑)
+("G" ?𑒒)
+("h" ?𑒯)
+("H" ?𑓁)
+("j" ?𑒖)
+("J" ?𑒗)
+("k" ?𑒏)
+("K" ?𑒐)
+("l" ?𑒪)
+("L" ?𑒷)
+("`l" ?𑒉)
+("z" ?𑒘)
+("Z" ?𑒓)
+("`z" ?𑒸)
+("`Z" ?𑒊)
+("x" ?𑒭)
+("X" ?𑓃)
+("c" ?𑒔)
+("C" ?𑒕)
+("`c" #x200C) ; ZWNJ
+("v" ?𑒫)
+("V" ?𑒾)
+("`v" ?𑒎)
+("b" ?𑒥)
+("B" ?𑒦)
+("`b" ?𑒀)
+("`B" ?𑓄)
+("n" ?𑒢)
+("N" ?𑒝)
+("`n" ?𑓇)
+("`N" ?𑓅)
+("m" ?𑒧)
+("M" ?𑓀)
+("`m" ?𑒿)
+)
+
+(quail-define-package
+ "sharada" "Sharada" "𑆯𑆳" t "Sharada phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("1" ?𑇑)
+("`1" ?1)
+("2" ?𑇒)
+("`2" ?2)
+("3" ?𑇓)
+("`3" ?3)
+("4" ?𑇔)
+("`4" ?4)
+("5" ?𑇕)
+("`5" ?5)
+("6" ?𑇖)
+("`6" ?6)
+("7" ?𑇗)
+("`7" ?7)
+("8" ?𑇘)
+("`8" ?8)
+("9" ?𑇙)
+("`9" ?9)
+("0" ?𑇐)
+("`0" ?0)
+("`)" ?𑇇)
+("`\\" ?𑇅)
+("`|" ?𑇆)
+("`" ?𑆛)
+("q" ?𑆛)
+("Q" ?𑆜)
+("`q" ?𑇈)
+("`Q" ?𑇉)
+("w" ?𑆝)
+("W" ?𑆞)
+("`w" ?𑇋)
+("`W" ?𑇍)
+("e" ?𑆼)
+("E" ?𑆽)
+("`e" ?𑆍)
+("`E" ?𑆎)
+("r" ?𑆫)
+("R" ?𑆸)
+("`r" ?𑆉)
+("`R" ?𑇎)
+("t" ?𑆠)
+("T" ?𑆡)
+("y" ?𑆪)
+("u" ?𑆶)
+("U" ?𑆷)
+("`u" ?𑆇)
+("`U" ?𑆈)
+("i" ?𑆴)
+("I" ?𑆵)
+("`i" ?𑆅)
+("`I" ?𑆆)
+("o" ?𑆾)
+("O" ?𑆿)
+("`o" ?𑆏)
+("`O" ?𑆐)
+("p" ?𑆥)
+("P" ?𑆦)
+("`p" ?𑇃)
+("a" ?𑆳)
+("A" ?𑆄)
+("`a" ?𑆃)
+("s" ?𑆱)
+("S" ?𑆯)
+("d" ?𑆢)
+("D" ?𑆣)
+("`d" ?𑇚)
+("`D" ?𑇛)
+("f" ?𑇀)
+("F" ?𑆹)
+("`f" ?𑆊)
+("`F" ?𑇌)
+("g" ?𑆓)
+("G" ?𑆔)
+("`g" ?𑇜)
+("`G" ?𑇝)
+("h" ?𑆲)
+("H" ?𑆂)
+("`h" ?𑇞)
+("`H" ?𑇟)
+("j" ?𑆘)
+("J" ?𑆙)
+("`j" ?᳘)
+("`J" ?᳕)
+("k" ?𑆑)
+("K" ?𑆒)
+("`k" ?𑇂)
+("l" ?𑆬)
+("L" ?𑆭)
+("`l" ?𑆺)
+("`L" ?𑆋)
+("z" ?𑆚)
+("Z" ?𑆕)
+("`z" ?𑆻)
+("`Z" ?𑆌)
+("x" ?𑆰)
+("X" ?𑇊)
+("c" ?𑆖)
+("C" ?𑆗)
+("`c" #x200C) ; ZWNJ
+("v" ?𑆮)
+("b" ?𑆧)
+("B" ?𑆨)
+("n" ?𑆤)
+("N" ?𑆟)
+("`n" ?𑇄)
+("`N" ?𑇁)
+("m" ?𑆩)
+("M" ?𑆁)
+("`m" ?𑆀)
+("`M" ?𑇏)
+)
+
+(quail-define-package
+ "siddham" "Sharada" "𑖭𑖰" t "Siddham phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("`1" ?𑗊)
+("`!" ?𑗔)
+("`2" ?𑗋)
+("`@" ?𑗕)
+("`3" ?𑗌)
+("`#" ?𑗖)
+("`4" ?𑗍)
+("`$" ?𑗗)
+("`5" ?𑗎)
+("`%" ?𑗅)
+("`6" ?𑗏)
+("`^" ?𑗆)
+("`7" ?𑗐)
+("`&" ?𑗇)
+("`8" ?𑗑)
+("`*" ?𑗈)
+("`9" ?𑗒)
+("`(" ?𑗉)
+("`0" ?𑗓)
+("`)" ?𑗄)
+("`\\" ?𑗂)
+("`|" ?𑗃)
+("`" ?𑖘)
+("q" ?𑖘)
+("Q" ?𑖙)
+("`q" ?𑗘)
+("`Q" ?𑗙)
+("w" ?𑖚)
+("W" ?𑖛)
+("`w" ?𑗚)
+("`W" ?𑗛)
+("e" ?𑖸)
+("E" ?𑖹)
+("`e" ?𑖊)
+("`E" ?𑖋)
+("r" ?𑖨)
+("R" ?𑖴)
+("`r" ?𑖆)
+("t" ?𑖝)
+("T" ?𑖞)
+("`t" ?𑗜)
+("`T" ?𑗝)
+("y" ?𑖧)
+("u" ?𑖲)
+("U" ?𑖳)
+("`u" ?𑖄)
+("`U" ?𑖅)
+("i" ?𑖰)
+("I" ?𑖱)
+("`i" ?𑖂)
+("`I" ?𑖃)
+("o" ?𑖺)
+("O" ?𑖻)
+("`o" ?𑖌)
+("`O" ?𑖍)
+("p" ?𑖢)
+("P" ?𑖣)
+("a" ?𑖯)
+("A" ?𑖁)
+("`a" ?𑖀)
+("s" ?𑖭)
+("S" ?𑖫)
+("d" ?𑖟)
+("D" ?𑖠)
+("`d" ?𑗁)
+("f" ?𑖿)
+("F" ?𑖵)
+("`f" ?𑖇)
+("g" ?𑖐)
+("G" ?𑖑)
+("h" ?𑖮)
+("H" ?𑖾)
+("j" ?𑖕)
+("J" ?𑖖)
+("k" ?𑖎)
+("K" ?𑖏)
+("l" ?𑖩)
+("L" ?𑖈)
+("`l" ?𑖉)
+("z" ?𑖗)
+("Z" ?𑖒)
+("x" ?𑖬)
+("X" ?𑗀)
+("c" ?𑖓)
+("C" ?𑖔)
+("`c" #x200C) ; ZWNJ
+("v" ?𑖪)
+("b" ?𑖤)
+("B" ?𑖥)
+("n" ?𑖡)
+("N" ?𑖜)
+("m" ?𑖦)
+("M" ?𑖽)
+("`m" ?𑖼)
+)
+
+
+(quail-define-package
+ "syloti-nagri" "Syloti Nagri" "ꠍꠤ" t "Syloti Nagri phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("`~" ?৳)
+("1" ?১)
+("`1" ?1)
+("2" ?২)
+("`2" ?2)
+("3" ?৩)
+("`3" ?3)
+("4" ?৪)
+("`4" ?4)
+("5" ?৫)
+("`5" ?5)
+("6" ?৬)
+("`6" ?6)
+("7" ?৭)
+("`7" ?7)
+("8" ?৮)
+("`8" ?8)
+("9" ?৯)
+("`9" ?9)
+("0" ?০)
+("`0" ?0)
+("`\\" ?𑇅)
+("`|" ?𑇆)
+("`" ?ꠐ)
+("q" ?ꠐ)
+("Q" ?ꠑ)
+("`q" ?꠨)
+("`Q" ?꠩)
+("w" ?ꠒ)
+("W" ?ꠓ)
+("`w" ?꠪)
+("`W" ?꠫)
+("e" ?ꠦ)
+("E" ?ꠄ)
+("r" ?ꠞ)
+("R" ?ꠠ)
+("t" ?ꠔ)
+("T" ?ꠕ)
+("y" ?ꠂ)
+("u" ?ꠥ)
+("U" ?ꠃ)
+("i" ?ꠤ)
+("I" ?ꠁ)
+("o" ?ꠧ)
+("O" ?ꠅ)
+("p" ?ꠙ)
+("P" ?ꠚ)
+("a" ?ꠣ)
+("A" ?ꠀ)
+("s" ?ꠡ)
+("d" ?ꠖ)
+("D" ?ꠗ)
+("f" ?꠆)
+("F" ?꠬)
+("g" ?ꠉ)
+("G" ?ꠊ)
+("h" ?ꠢ)
+("j" ?ꠎ)
+("J" ?ꠏ)
+("k" ?ꠇ)
+("K" ?ꠈ)
+("l" ?ꠟ)
+("c" ?ꠌ)
+("C" ?ꠍ)
+("`c" #x200C) ; ZWNJ
+("b" ?ꠛ)
+("B" ?ꠜ)
+("n" ?ꠘ)
+("m" ?ꠝ)
+("M" ?ꠋ)
+)
+
+(quail-define-package
+ "modi" "Modi" "𑘦𑘻" t "Modi phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("1" ?𑙑)
+("`1" ?1)
+("2" ?𑙒)
+("`2" ?2)
+("3" ?𑙓)
+("`3" ?3)
+("4" ?𑙔)
+("`4" ?4)
+("5" ?𑙕)
+("`5" ?5)
+("6" ?𑙖)
+("`6" ?6)
+("7" ?𑙗)
+("`7" ?7)
+("8" ?𑙘)
+("`8" ?8)
+("9" ?𑙙)
+("`9" ?9)
+("0" ?𑙐)
+("`0" ?0)
+("`)" ?𑙃)
+("`\\" ?𑙁)
+("`|" ?𑙂)
+("`" ?𑘘)
+("q" ?𑘘)
+("Q" ?𑘙)
+("`q" ?𑙄)
+("w" ?𑘚)
+("W" ?𑘛)
+("e" ?𑘹)
+("E" ?𑘺)
+("`e" ?𑘊)
+("`E" ?𑘋)
+("r" ?𑘨)
+("R" ?𑘵)
+("`r" ?𑘆)
+("t" ?𑘝)
+("T" ?𑘞)
+("y" ?𑘧)
+("u" ?𑘳)
+("U" ?𑘴)
+("`u" ?𑘄)
+("`U" ?𑘅)
+("i" ?𑘱)
+("I" ?𑘲)
+("`i" ?𑘂)
+("`I" ?𑘃)
+("o" ?𑘻)
+("O" ?𑘼)
+("`o" ?𑘌)
+("`O" ?𑘍)
+("p" ?𑘢)
+("P" ?𑘣)
+("a" ?𑘰)
+("A" ?𑘁)
+("`a" ?𑘀)
+("s" ?𑘭)
+("S" ?𑘫)
+("d" ?𑘟)
+("D" ?𑘠)
+("f" ?𑘿)
+("F" ?𑘶)
+("`f" ?𑘇)
+("g" ?𑘐)
+("G" ?𑘑)
+("h" ?𑘮)
+("H" ?𑘾)
+("j" ?𑘕)
+("J" ?𑘖)
+("k" ?𑘎)
+("K" ?𑘏)
+("l" ?𑘩)
+("L" ?𑘯)
+("`l" ?𑘷)
+("`L" ?𑘈)
+("z" ?𑘗)
+("Z" ?𑘒)
+("`z" ?𑘸)
+("`Z" ?𑘉)
+("x" ?𑘬)
+("X" ?𑙀)
+("c" ?𑘓)
+("C" ?𑘔)
+("`c" #x200C) ; ZWNJ
+("v" ?𑘪)
+("b" ?𑘤)
+("B" ?𑘥)
+("n" ?𑘡)
+("N" ?𑘜)
+("m" ?𑘦)
+("M" ?𑘽)
+)
+
+(quail-define-package
+ "odia" "Odia" "ଓ" t "Odia phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("1" ?୧)
+("`1" ?1)
+("`!" ?୲)
+("2" ?୨)
+("`2" ?2)
+("`@" ?୳)
+("3" ?୩)
+("`3" ?3)
+("`#" ?୴)
+("4" ?୪)
+("`4" ?4)
+("`$" ?୵)
+("5" ?୫)
+("`5" ?5)
+("`%" ?୶)
+("6" ?୬)
+("`6" ?6)
+("`^" ?୷)
+("7" ?୭)
+("`7" ?7)
+("8" ?୮)
+("`8" ?8)
+("9" ?୯)
+("`9" ?9)
+("0" ?୦)
+("`0" ?0)
+("`\\" ?।)
+("`|" ?॥)
+("`" ?ଟ)
+("q" ?ଟ)
+("Q" ?ଠ)
+("`q" ?୰)
+("`Q" ?୕)
+("w" ?ଡ)
+("W" ?ଢ)
+("`w" ?ଡ଼)
+("`W" ?ଢ଼)
+("e" ?େ)
+("E" ?ୈ)
+("`e" ?ଏ)
+("`E" ?ଐ)
+("r" ?ର)
+("R" ?ୃ)
+("`r" ?ଋ)
+("t" ?ତ)
+("T" ?ଥ)
+("`t" ?ୖ)
+("`T" ?ୗ)
+("y" ?ଯ)
+("Y" ?ୟ)
+("u" ?ୁ)
+("U" ?ୂ)
+("`u" ?ଉ)
+("`U" ?ଊ)
+("i" ?ି)
+("I" ?ୀ)
+("`i" ?ଇ)
+("`I" ?ଈ)
+("o" ?ୋ)
+("O" ?ୌ)
+("`o" ?ଓ)
+("`O" ?ଔ)
+("p" ?ପ)
+("P" ?ଫ)
+("a" ?ା)
+("A" ?ଆ)
+("`a" ?ଅ)
+("s" ?ସ)
+("S" ?ଶ)
+("d" ?ଦ)
+("D" ?ଧ)
+("f" ?୍)
+("F" ?ୄ)
+("`f" ?ୠ)
+("g" ?ଗ)
+("G" ?ଘ)
+("h" ?ହ)
+("H" ?ଃ)
+("j" ?ଜ)
+("J" ?ଝ)
+("k" ?କ)
+("K" ?ଖ)
+("l" ?ଲ)
+("L" ?ଳ)
+("`l" ?ୢ)
+("`L" ?ଌ)
+("z" ?ଞ)
+("Z" ?ଙ)
+("`z" ?ୣ)
+("`Z" ?ୡ)
+("x" ?ଷ)
+("X" ?଼)
+("c" ?ଚ)
+("C" ?ଛ)
+("`c" #x200C) ; ZWNJ
+("`C" #x200D) ; ZWJ
+("v" ?ଵ)
+("V" ?ୱ)
+("b" ?ବ)
+("B" ?ଭ)
+("n" ?ନ)
+("N" ?ଣ)
+("m" ?ମ)
+("M" ?ଂ)
+("`m" ?ଁ)
+("`M" ?ଽ)
+)
+
+(quail-define-package
+ "limbu" "Limbu" "ᤕ" t "Limbu phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+("``" ?₹)
+("1" ?᥇)
+("`1" ?1)
+("`!" ?᥄)
+("2" ?᥈)
+("`2" ?2)
+("3" ?᥉)
+("`3" ?3)
+("4" ?᥊)
+("`4" ?4)
+("5" ?᥋)
+("`5" ?5)
+("6" ?᥌)
+("`6" ?6)
+("7" ?᥍)
+("`7" ?7)
+("8" ?᥎)
+("`8" ?8)
+("9" ?᥏)
+("`9" ?9)
+("0" ?᥆)
+("`0" ?0)
+("`\\" ?।)
+("`|" ?॥)
+("`" ?ᤘ)
+("q" ?ᤧ)
+("Q" ?ᤨ)
+("`q" ?᥀)
+("w" ?ᤘ)
+("W" ?ᤫ)
+("e" ?ᤣ)
+("E" ?ᤤ)
+("r" ?ᤖ)
+("R" ?ᤷ)
+("`r" ?ᤪ)
+("t" ?ᤋ)
+("T" ?ᤌ)
+("`t" ?ᤳ)
+("`T" ?ᤞ)
+("y" ?ᤕ)
+("Y" ?ᤩ)
+("u" ?ᤢ)
+("i" ?ᤡ)
+("o" ?ᤥ)
+("O" ?ᤦ)
+("p" ?ᤐ)
+("P" ?ᤑ)
+("`p" ?ᤵ)
+("a" ?ᤠ)
+("A" ?ᤀ)
+("s" ?ᤛ)
+("S" ?ᤙ)
+("d" ?ᤍ)
+("D" ?ᤎ)
+("f" ?᤻)
+("g" ?ᤃ)
+("G" ?ᤄ)
+("`g" ?ᤝ)
+("h" ?ᤜ)
+("j" ?ᤈ)
+("J" ?ᤉ)
+("k" ?ᤁ)
+("K" ?ᤂ)
+("`k" ?ᤰ)
+("l" ?ᤗ)
+("L" ?ᤸ)
+("z" ?ᤊ)
+("Z" ?ᤅ)
+("x" ?ᤚ)
+("X" ?᤹)
+("c" ?ᤆ)
+("C" ?ᤇ)
+("`c" #x200C) ; ZWNJ
+("v" ?᤺)
+("b" ?ᤒ)
+("B" ?ᤓ)
+("n" ?ᤏ)
+("N" ?ᤴ)
+("m" ?ᤔ)
+("M" ?ᤱ)
+("`m" ?ᤲ)
+("`?" ?᥅)
+)
+
+(quail-define-package
+ "grantha" "Grantha" "𑌗𑍍𑌰" t "Grantha phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("``" ?₹)
+ ("1" ?௧)
+ ("`1" ?1)
+ ("`!" ?𑍧)
+ ("2" ?௨)
+ ("`2" ?2)
+ ("`@" ?𑍨)
+ ("3" ?௩)
+ ("`3" ?3)
+ ("`#" ?𑍩)
+ ("4" ?௪)
+ ("`4" ?4)
+ ("`$" ?𑍪)
+ ("5" ?௫)
+ ("`5" ?5)
+ ("`%" ?𑍫)
+ ("6" ?௬)
+ ("`6" ?6)
+ ("`^" ?𑍬)
+ ("7" ?௭)
+ ("`7" ?7)
+ ("8" ?௮)
+ ("`8" ?8)
+ ("9" ?௯)
+ ("`9" ?9)
+ ("0" ?௦)
+ ("`0" ?0)
+ ("q" ?𑌟)
+ ("Q" ?𑌠)
+ ("`q" ?𑍐)
+ ("`Q" ?𑍝)
+ ("w" ?𑌡)
+ ("W" ?𑌢)
+ ("`w" ?𑍞)
+ ("`W" ?𑍟)
+ ("e" ?𑍇)
+ ("E" ?𑍈)
+ ("`e" ?𑌏)
+ ("`E" ?𑌐)
+ ("r" ?𑌰)
+ ("R" ?𑍃)
+ ("`r" ?𑌋)
+ ("t" ?𑌤)
+ ("T" ?𑌥)
+ ("`t" ?𑍗)
+ ("y" ?𑌯)
+ ("u" ?𑍁)
+ ("U" ?𑍂)
+ ("`u" ?𑌉)
+ ("`U" ?𑌊)
+ ("i" ?𑌿)
+ ("I" ?𑍀)
+ ("`i" ?𑌇)
+ ("`I" ?𑌈)
+ ("o" ?𑍋)
+ ("O" ?𑍌)
+ ("`o" ?𑌓)
+ ("`O" ?𑌔)
+ ("p" ?𑌪)
+ ("P" ?𑌫)
+ ("`p" ?𑍴)
+ ("a" ?𑌾)
+ ("A" ?𑌆)
+ ("`a" ?𑌅)
+ ("`A" ?𑍰)
+ ("s" ?𑌸)
+ ("S" ?𑌶)
+ ("d" ?𑌦)
+ ("D" ?𑌧)
+ ("f" ?𑍍)
+ ("F" ?𑍄)
+ ("`f" ?𑍠)
+ ("g" ?𑌗)
+ ("G" ?𑌘)
+ ("h" ?𑌹)
+ ("H" ?𑌃)
+ ("j" ?𑌜)
+ ("J" ?𑌝)
+ ("k" ?𑌕)
+ ("K" ?𑌖)
+ ("`k" ?𑍱)
+ ("l" ?𑌲)
+ ("L" ?𑌳)
+ ("`l" ?𑍢)
+ ("`L" ?𑌌)
+ ("z" ?𑌞)
+ ("Z" ?𑌙)
+ ("`z" ?𑍣)
+ ("`Z" ?𑍡)
+ ("x" ?𑌷)
+ ("X" ?𑌼)
+ ("`x" ?𑌻)
+ ("c" ?𑌚)
+ ("C" ?𑌛)
+ ("`c" #x200C) ; ZWNJ
+ ("v" ?𑌵)
+ ("V" ?𑌽)
+ ("`v" ?𑍳)
+ ("b" ?𑌬)
+ ("B" ?𑌭)
+ ("n" ?𑌨)
+ ("N" ?𑌣)
+ ("`n" ?𑍲)
+ ("m" ?𑌮)
+ ("M" ?𑌂)
+ ("`m" ?𑌁)
+ ("`M" ?𑌀))
+
+(quail-define-package
+ "lepcha" "Lepcha" "ᰛᰩᰵ" t "Lepcha phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("``" ?₹)
+ ("1" ?᱁)
+ ("`1" ?1)
+ ("2" ?᱂)
+ ("`2" ?2)
+ ("3" ?᱃)
+ ("`3" ?3)
+ ("4" ?᱄)
+ ("`4" ?4)
+ ("5" ?᱅)
+ ("`5" ?5)
+ ("6" ?᱆)
+ ("`6" ?6)
+ ("7" ?᱇)
+ ("`7" ?7)
+ ("8" ?᱈)
+ ("`8" ?8)
+ ("9" ?᱉)
+ ("`9" ?9)
+ ("0" ?᱀)
+ ("`0" ?0)
+ ("`\\" ?᰻)
+ ("`|" ?᰼)
+ ("`" ?ᱍ)
+ ("q" ?ᱍ)
+ ("Q" ?ᱎ)
+ ("`q" ?᰽)
+ ("`Q" ?᰾)
+ ("w" ?ᰢ)
+ ("W" ?ᱏ)
+ ("`w" ?᰿)
+ ("e" ?ᰬ)
+ ("r" ?ᰛ)
+ ("R" ?ᰥ)
+ ("`r" ?ᰲ)
+ ("t" ?ᰊ)
+ ("T" ?ᰋ)
+ ("`t" ?ᰳ)
+ ("y" ?ᰚ)
+ ("Y" ?ᰤ)
+ ("u" ?ᰪ)
+ ("U" ?ᰫ)
+ ("i" ?ᰧ)
+ ("o" ?ᰨ)
+ ("O" ?ᰩ)
+ ("p" ?ᰎ)
+ ("P" ?ᰏ)
+ ("`p" ?ᰐ)
+ ("`P" ?ᰱ)
+ ("a" ?ᰦ)
+ ("A" ?ᰣ)
+ ("s" ?ᰠ)
+ ("S" ?ᰡ)
+ ("d" ?ᰌ)
+ ("f" ?ᰑ)
+ ("F" ?ᰒ)
+ ("g" ?ᰃ)
+ ("G" ?ᰄ)
+ ("h" ?ᰝ)
+ ("H" ?ᰞ)
+ ("j" ?ᰈ)
+ ("k" ?ᰀ)
+ ("K" ?ᰁ)
+ ("`k" ?ᰂ)
+ ("`K" ?ᰭ)
+ ("l" ?ᰜ)
+ ("L" ?ᰯ)
+ ("z" ?ᰉ)
+ ("Z" ?ᰅ)
+ ("`z" ?ᰴ)
+ ("`Z" ?ᰵ)
+ ("x" ?ᰶ)
+ ("X" ?᰷)
+ ("c" ?ᰆ)
+ ("C" ?ᰇ)
+ ("`c" #x200C) ; ZWNJ
+ ("v" ?ᰟ)
+ ("b" ?ᰓ)
+ ("B" ?ᰔ)
+ ("n" ?ᰍ)
+ ("N" ?ᰰ)
+ ("m" ?ᰕ)
+ ("M" ?ᰖ)
+ ("`m" ?ᰮ))
+
+(quail-define-package
+ "meetei-mayek" "Meetei Mayek" "ꯃꯤ" t "Meetei Mayek phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("``" ?₹)
+ ("1" ?꯱)
+ ("`1" ?1)
+ ("2" ?꯲)
+ ("`2" ?2)
+ ("3" ?꯳)
+ ("`3" ?3)
+ ("4" ?꯴)
+ ("`4" ?4)
+ ("5" ?꯵)
+ ("`5" ?5)
+ ("6" ?꯶)
+ ("`6" ?6)
+ ("7" ?꯷)
+ ("`7" ?7)
+ ("8" ?꯸)
+ ("`8" ?8)
+ ("9" ?꯹)
+ ("`9" ?9)
+ ("0" ?꯰)
+ ("`0" ?0)
+ ("`\\" ?꫰)
+ ("`|" ?꯫)
+ ("`" ?ꫤ)
+ ("q" ?ꫤ)
+ ("Q" ?ꫥ)
+ ("w" ?ꯋ)
+ ("W" ?ꫦ)
+ ("`w" ?ꫧ)
+ ("e" ?ꯦ)
+ ("E" ?ꯩ)
+ ("`e" ?ꫠ)
+ ("r" ?ꯔ)
+ ("t" ?ꯇ)
+ ("T" ?ꯊ)
+ ("`t" ?ꯠ)
+ ("y" ?ꯌ)
+ ("u" ?ꯨ)
+ ("U" ?ꯎ)
+ ("`u" ?ꫬ)
+ ("i" ?ꯤ)
+ ("I" ?ꯏ)
+ ("`i" ?ꯢ)
+ ("`I" ?ꫫ)
+ ("o" ?ꯣ)
+ ("O" ?ꯧ)
+ ("`o" ?ꫡ)
+ ("`O" ?ꫮ)
+ ("p" ?ꯄ)
+ ("P" ?ꯐ)
+ ("`p" ?ꯞ)
+ ("a" ?ꯥ)
+ ("A" ?ꯑ)
+ ("`a" ?ꫭ)
+ ("`A" ?ꫯ)
+ ("s" ?ꯁ)
+ ("S" ?ꫩ)
+ ("`s" ?ꫪ)
+ ("d" ?ꯗ)
+ ("D" ?ꯙ)
+ ("f" ?꯭)
+ ("F" ?꫶)
+ ("g" ?ꯒ)
+ ("G" ?ꯘ)
+ ("h" ?ꯍ)
+ ("H" ?ꫵ)
+ ("j" ?ꯖ)
+ ("J" ?ꯓ)
+ ("k" ?ꯀ)
+ ("K" ?ꯈ)
+ ("`k" ?ꯛ)
+ ("l" ?ꯂ)
+ ("L" ?ꯜ)
+ ("z" ?ꯉ)
+ ("Z" ?ꯡ)
+ ("`z" ?ꫣ)
+ ("x" ?ꯪ)
+ ("c" ?ꯆ)
+ ("C" ?ꫢ)
+ ("v" ?꯬)
+ ("V" ?ꫳ)
+ ("`v" ?ꫴ)
+ ("b" ?ꯕ)
+ ("B" ?ꯚ)
+ ("n" ?ꯅ)
+ ("N" ?ꯟ)
+ ("`n" ?ꫨ)
+ ("m" ?ꯃ)
+ ("M" ?ꯝ)
+ ("`m" ?ꫲ)
+ ("`?" ?꫱))
+
+(provide 'indian)
;;; indian.el ends here
diff --git a/lisp/leim/quail/indonesian.el b/lisp/leim/quail/indonesian.el
new file mode 100644
index 00000000000..8d0d158076a
--- /dev/null
+++ b/lisp/leim/quail/indonesian.el
@@ -0,0 +1,557 @@
+;;; indonesian.el --- Quail package for inputting Indonesian characters -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: समीर सिंह Sameer Singh <lumarzeli30@gmail.com>
+;; Keywords: multilingual, input method, i18n, Indonesia
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Input methods for Indonesian languages.
+
+;;; Code:
+
+(require 'quail)
+
+;; This input method supports languages like Buginese, Balinese, Sundanese and
+;; Javanese.
+
+(quail-define-package
+ "balinese" "Balinese" "ᬩ" t "Balinese phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?᭑)
+ ("`1" ?1)
+ ("`!" ?᭫)
+ ("2" ?᭒)
+ ("`2" ?2)
+ ("`@" ?᭬)
+ ("3" ?᭓)
+ ("`3" ?3)
+ ("`#" ?᭭)
+ ("4" ?᭔)
+ ("`4" ?4)
+ ("`$" ?᭮)
+ ("5" ?᭕)
+ ("`5" ?5)
+ ("`%" ?᭯)
+ ("6" ?᭖)
+ ("`6" ?6)
+ ("`^" ?᭰)
+ ("7" ?᭗)
+ ("`7" ?7)
+ ("`&" ?᭱)
+ ("8" ?᭘)
+ ("`8" ?8)
+ ("`*" ?᭲)
+ ("9" ?᭙)
+ ("`9" ?9)
+ ("`(" ?᭳)
+ ("0" ?᭐)
+ ("`0" ?0)
+ ("`)" ?᭼)
+ ("`\\" ?᭞)
+ ("`|" ?᭟)
+ ("`" ?ᬝ)
+ ("q" ?ᬝ)
+ ("Q" ?ᬞ)
+ ("`q" ?᭚)
+ ("`Q" ?᭽)
+ ("w" ?ᬟ)
+ ("W" ?ᬠ)
+ ("`w" ?᭛)
+ ("`W" ?᭾)
+ ("e" ?ᬾ)
+ ("E" ?ᬿ)
+ ("`e" ?ᬏ)
+ ("`E" ?ᬐ)
+ ("r" ?ᬭ)
+ ("R" ?ᬃ)
+ ("`r" ?ᬺ)
+ ("`R" ?ᬋ)
+ ("t" ?ᬢ)
+ ("T" ?ᬣ)
+ ("`t" ?᭜)
+ ("`T" ?᭝)
+ ("y" ?ᬬ)
+ ("Y" ?ᭂ)
+ ("`y" ?ᭃ)
+ ("`Y" ?᭴)
+ ("u" ?ᬸ)
+ ("U" ?ᬹ)
+ ("`u" ?ᬉ)
+ ("`U" ?ᬊ)
+ ("i" ?ᬶ)
+ ("I" ?ᬷ)
+ ("`i" ?ᬇ)
+ ("`I" ?ᬈ)
+ ("o" ?ᭀ)
+ ("O" ?ᭁ)
+ ("`o" ?ᬑ)
+ ("`O" ?ᬒ)
+ ("p" ?ᬧ)
+ ("P" ?ᬨ)
+ ("`p" ?ᭈ)
+ ("`P" ?᭠)
+ ("a" ?ᬵ)
+ ("A" ?ᬆ)
+ ("`a" ?ᬅ)
+ ("`A" ?᭵)
+ ("s" ?ᬲ)
+ ("S" ?ᬰ)
+ ("`s" ?᭡)
+ ("`S" ?᭢)
+ ("d" ?ᬤ)
+ ("D" ?ᬥ)
+ ("`d" ?᭣)
+ ("`D" ?᭤)
+ ("f" ?᭄)
+ ("F" ?ᬻ)
+ ("`f" ?ᬌ)
+ ("`F" ?᭶)
+ ("g" ?ᬕ)
+ ("G" ?ᬖ)
+ ("`g" ?᭥)
+ ("`G" ?᭦)
+ ("h" ?ᬳ)
+ ("H" ?ᬄ)
+ ("`h" ?᭧)
+ ("`H" ?᭨)
+ ("j" ?ᬚ)
+ ("J" ?ᬛ)
+ ("`j" ?ᭌ)
+ ("`J" ?᭩)
+ ("k" ?ᬓ)
+ ("K" ?ᬔ)
+ ("`k" ?ᭅ)
+ ("`K" ?ᭆ)
+ ("l" ?ᬮ)
+ ("L" ?ᬼ)
+ ("`l" ?ᬍ)
+ ("`L" ?᭪)
+ ("z" ?ᭊ)
+ ("Z" ?ᬽ)
+ ("`z" ?ᬎ)
+ ("`Z" ?᭷)
+ ("x" ?ᬱ)
+ ("X" ?᬴)
+ ("`x" ?᭸)
+ ("c" ?ᬘ)
+ ("C" ?ᬙ)
+ ("`c" #x200C) ; ZWNJ
+ ("v" ?ᬯ)
+ ("V" ?ᭉ)
+ ("`v" ?᭹)
+ ("`V" ?᭺)
+ ("b" ?ᬩ)
+ ("B" ?ᬪ)
+ ("`b" ?᭻)
+ ("n" ?ᬦ)
+ ("N" ?ᬡ)
+ ("`n" ?ᬗ)
+ ("`N" ?ᬜ)
+ ("m" ?ᬫ)
+ ("M" ?ᬂ)
+ ("`m" ?ᬁ)
+ ("`M" ?ᬀ))
+
+(quail-define-package
+ "javanese" "Javanese" "ꦗ" t "Javanese phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?꧑)
+ ("`1" ?1)
+ ("`!" ?꧁)
+ ("2" ?꧒)
+ ("`2" ?2)
+ ("`@" ?꧂)
+ ("3" ?꧓)
+ ("`3" ?3)
+ ("`#" ?꧃)
+ ("4" ?꧔)
+ ("`4" ?4)
+ ("`$" ?꧄)
+ ("5" ?꧕)
+ ("`5" ?5)
+ ("`%" ?꧅)
+ ("6" ?꧖)
+ ("`6" ?6)
+ ("`^" ?꧆)
+ ("7" ?꧗)
+ ("`7" ?7)
+ ("`&" ?꧇)
+ ("8" ?꧘)
+ ("`8" ?8)
+ ("`*" ?꧈)
+ ("9" ?꧙)
+ ("`9" ?9)
+ ("`(" ?꧉)
+ ("0" ?꧐)
+ ("`0" ?0)
+ ("`)" ?꧞)
+ ("`\\" ?꧊)
+ ("`|" ?꧋)
+ ("`" ?ꦛ)
+ ("q" ?ꦛ)
+ ("Q" ?ꦜ)
+ ("`q" ?꧟)
+ ("`Q" ?ꧏ)
+ ("w" ?ꦝ)
+ ("W" ?ꦞ)
+ ("`w" ?꧌)
+ ("`W" ?꧍)
+ ("e" ?ꦺ)
+ ("E" ?ꦻ)
+ ("`e" ?ꦌ)
+ ("`E" ?ꦍ)
+ ("r" ?ꦫ)
+ ("R" ?ꦬ)
+ ("`r" ?ꦿ)
+ ("`R" ?ꦂ)
+ ("t" ?ꦠ)
+ ("T" ?ꦡ)
+ ("`t" ?ꦼ)
+ ("y" ?ꦪ)
+ ("Y" ?ꦾ)
+ ("u" ?ꦸ)
+ ("U" ?ꦹ)
+ ("`u" ?ꦈ)
+ ("`U" ?ꦅ)
+ ("i" ?ꦶ)
+ ("I" ?ꦷ)
+ ("`i" ?ꦆ)
+ ("`I" ?ꦇ)
+ ("o" ?ꦎ)
+ ("p" ?ꦥ)
+ ("P" ?ꦦ)
+ ("`p" ?ꦉ)
+ ("a" ?ꦴ)
+ ("A" ?ꦄ)
+ ("`a" ?ꦵ)
+ ("s" ?ꦱ)
+ ("S" ?ꦯ)
+ ("d" ?ꦢ)
+ ("D" ?ꦣ)
+ ("f" ?꧀)
+ ("F" ?ꦽ)
+ ("`f" ?ꦉ)
+ ("g" ?ꦒ)
+ ("G" ?ꦓ)
+ ("h" ?ꦲ)
+ ("H" ?ꦃ)
+ ("j" ?ꦗ)
+ ("J" ?ꦙ)
+ ("`j" ?ꦘ)
+ ("k" ?ꦏ)
+ ("K" ?ꦑ)
+ ("`k" ?ꦐ)
+ ("l" ?ꦭ)
+ ("L" ?ꦊ)
+ ("`l" ?ꦋ)
+ ("z" ?ꦚ)
+ ("Z" ?ꦔ)
+ ("x" ?ꦰ)
+ ("X" ?꦳)
+ ("c" ?ꦕ)
+ ("C" ?ꦖ)
+ ("`c" #x200C) ; ZWNJ
+ ("v" ?ꦮ)
+ ("V" ?ᭉ)
+ ("b" ?ꦧ)
+ ("B" ?ꦨ)
+ ("n" ?ꦤ)
+ ("N" ?ꦟ)
+ ("m" ?ꦩ)
+ ("M" ?ꦁ)
+ ("`m" ?ꦀ))
+
+(quail-define-package
+ "sundanese" "Sundanese" "ᮞᮥ" t "Sundanese phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?᮱)
+ ("`1" ?1)
+ ("`!" ?᳀)
+ ("2" ?᮲)
+ ("`2" ?2)
+ ("`@" ?᳁)
+ ("3" ?᮳)
+ ("`3" ?3)
+ ("`#" ?᳂)
+ ("4" ?᮴)
+ ("`4" ?4)
+ ("`$" ?᳃)
+ ("5" ?᮵)
+ ("`5" ?5)
+ ("6" ?᮶)
+ ("`6" ?6)
+ ("7" ?᮷)
+ ("`7" ?7)
+ ("8" ?᮸)
+ ("`8" ?8)
+ ("9" ?᮹)
+ ("`9" ?9)
+ ("0" ?᮰)
+ ("`0" ?0)
+ ("`" ?ᮒ)
+ ("q" ?ᮋ)
+ ("w" ?ᮝ)
+ ("W" ?ᮭ)
+ ("e" ?ᮨ)
+ ("E" ?ᮩ)
+ ("`e" ?ᮈ)
+ ("`E" ?ᮉ)
+ ("r" ?ᮛ)
+ ("R" ?ᮢ)
+ ("`r" ?ᮁ)
+ ("`R" ?ᮻ)
+ ("t" ?ᮒ)
+ ("y" ?ᮚ)
+ ("Y" ?ᮡ)
+ ("u" ?ᮥ)
+ ("U" ?ᮅ)
+ ("i" ?ᮤ)
+ ("I" ?ᮄ)
+ ("o" ?ᮧ)
+ ("O" ?ᮇ)
+ ("p" ?ᮕ)
+ ("P" ?ᮖ)
+ ("a" ?ᮃ)
+ ("A" ?ᮦ)
+ ("`a" ?ᮆ)
+ ("s" ?ᮞ)
+ ("S" ?ᮯ)
+ ("d" ?ᮓ)
+ ("D" ?᳆)
+ ("f" ?᮪)
+ ("F" ?᮫)
+ ("g" ?ᮌ)
+ ("h" ?ᮠ)
+ ("H" ?ᮂ)
+ ("j" ?ᮏ)
+ ("k" ?ᮊ)
+ ("K" ?ᮮ)
+ ("`k" ?ᮾ)
+ ("`K" ?᳅)
+ ("l" ?ᮜ)
+ ("L" ?ᮣ)
+ ("`l" ?ᮼ)
+ ("`L" ?᳄)
+ ("z" ?ᮐ)
+ ("x" ?ᮟ)
+ ("c" ?ᮎ)
+ ("`c" #x200C) ; ZWNJ
+ ("b" ?ᮘ)
+ ("B" ?ᮽ)
+ ("`b" ?ᮺ)
+ ("`B" ?᳇)
+ ("n" ?ᮔ)
+ ("N" ?ᮍ)
+ ("`n" ?ᮑ)
+ ("m" ?ᮙ)
+ ("M" ?ᮀ)
+ ("`m" ?ᮿ)
+ ("`M" ?ᮬ))
+
+(quail-define-package
+ "batak" "Batak" "ᯅ" t "Batak phonetic input method,
+ used by languages such as Karo, Toba, Pakpak, Mandailing
+ and Simalungun.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?᯼)
+ ("Q" ?᯽)
+ ("w" ?ᯋ)
+ ("W" ?ᯌ)
+ ("`w" ?ᯍ)
+ ("e" ?ᯧ)
+ ("E" ?ᯨ)
+ ("`e" ?ᯩ)
+ ("r" ?ᯒ)
+ ("R" ?ᯓ)
+ ("t" ?ᯖ)
+ ("T" ?ᯗ)
+ ("y" ?ᯛ)
+ ("Y" ?ᯜ)
+ ("u" ?ᯮ)
+ ("U" ?ᯥ)
+ ("`u" ?ᯯ)
+ ("i" ?ᯪ)
+ ("I" ?ᯫ)
+ ("`i" ?ᯤ)
+ ("o" ?ᯬ)
+ ("O" ?ᯭ)
+ ("p" ?ᯇ)
+ ("P" ?ᯈ)
+ ("a" ?ᯀ)
+ ("A" ?ᯁ)
+ ("s" ?ᯘ)
+ ("S" ?ᯙ)
+ ("`s" ?ᯚ)
+ ("d" ?ᯑ)
+ ("f" ?᯲)
+ ("F" ?᯳)
+ ("g" ?ᯎ)
+ ("G" ?ᯏ)
+ ("h" ?ᯂ)
+ ("H" ?ᯃ)
+ ("`h" ?ᯄ)
+ ("`H" ?ᯱ)
+ ("j" ?ᯐ)
+ ("k" ?᯦)
+ ("l" ?ᯞ)
+ ("L" ?ᯟ)
+ ("z" ?ᯝ)
+ ("Z" ?ᯰ)
+ ("x" ?ᯠ)
+ ("c" ?ᯡ)
+ ("v" ?᯾)
+ ("V" ?᯿)
+ ("b" ?ᯅ)
+ ("B" ?ᯆ)
+ ("n" ?ᯉ)
+ ("N" ?ᯊ)
+ ("`n" ?ᯢ)
+ ("m" ?ᯔ)
+ ("M" ?ᯕ)
+ ("`m" ?ᯣ))
+
+(quail-define-package
+ "rejang" "Rejang" "ꤽꥍ" nil "Rejang phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?꥟)
+ ("w" ?ꥀ)
+ ("e" ?ꥉ)
+ ("E" ?ꥊ)
+ ("r" ?ꤽ)
+ ("R" ?ꥑ)
+ ("t" ?ꤳ)
+ ("y" ?ꤿ)
+ ("u" ?ꥈ)
+ ("U" ?ꥍ)
+ ("i" ?ꥇ)
+ ("o" ?ꥋ)
+ ("O" ?ꥌ)
+ ("p" ?ꤶ)
+ ("a" ?ꥆ)
+ ("A" ?ꥎ)
+ ("s" ?ꤼ)
+ ("d" ?ꤴ)
+ ("D" ?ꥄ)
+ ("f" ?꥓)
+ ("F" ?ꥃ)
+ ("g" ?ꤱ)
+ ("h" ?ꥁ)
+ ("H" ?ꥒ)
+ ("j" ?ꤺ)
+ ("k" ?ꤰ)
+ ("l" ?ꤾ)
+ ("z" ?ꤲ)
+ ("Z" ?ꥏ)
+ ("x" ?ꤻ)
+ ("X" ?ꥅ)
+ ("c" ?ꤹ)
+ ("b" ?ꤷ)
+ ("n" ?ꤵ)
+ ("N" ?ꥐ)
+ ("m" ?ꤸ)
+ ("M" ?ꥂ))
+
+(quail-define-package
+ "makasar" "Makasar" "𑻪" nil "Makasar phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?𑻷)
+ ("Q" ?𑻸)
+ ("e" ?𑻵)
+ ("r" ?𑻭)
+ ("t" ?𑻦)
+ ("y" ?𑻬)
+ ("u" ?𑻴)
+ ("i" ?𑻳)
+ ("o" ?𑻶)
+ ("p" ?𑻣)
+ ("a" ?𑻱)
+ ("s" ?𑻰)
+ ("d" ?𑻧)
+ ("g" ?𑻡)
+ ("j" ?𑻪)
+ ("k" ?𑻠)
+ ("l" ?𑻮)
+ ("z" ?𑻢)
+ ("Z" ?𑻲)
+ ("x" ?𑻫)
+ ("c" ?𑻩)
+ ("v" ?𑻯)
+ ("b" ?𑻤)
+ ("n" ?𑻨)
+ ("m" ?𑻥))
+
+(quail-define-package
+ "lontara" "Lontara" "ᨒ" nil "Lontara phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?᨞)
+ ("Q" ?᨟)
+ ("e" ?ᨙ)
+ ("E" ?ᨛ)
+ ("r" ?ᨑ)
+ ("t" ?ᨈ)
+ ("y" ?ᨐ)
+ ("u" ?ᨘ)
+ ("i" ?ᨗ)
+ ("o" ?ᨚ)
+ ("p" ?ᨄ)
+ ("a" ?ᨕ)
+ ("s" ?ᨔ)
+ ("d" ?ᨉ)
+ ("g" ?ᨁ)
+ ("h" ?ᨖ)
+ ("j" ?ᨍ)
+ ("k" ?ᨀ)
+ ("l" ?ᨒ)
+ ("z" ?ᨂ)
+ ("Z" ?ᨃ)
+ ("x" ?ᨎ)
+ ("X" ?ᨏ)
+ ("c" ?ᨌ)
+ ("v" ?ᨓ)
+ ("b" ?ᨅ)
+ ("n" ?ᨊ)
+ ("N" ?ᨋ)
+ ("m" ?ᨆ)
+ ("M" ?ᨇ))
+
+(provide 'indonesian)
+;;; indonesian.el ends here
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
index 0ef6e383bd1..773dc31f9b7 100644
--- a/lisp/leim/quail/ipa.el
+++ b/lisp/leim/quail/ipa.el
@@ -269,7 +269,7 @@ QUAIL-KEYMAP is a cons that satisfies `quail-map-p'; TO-PREPEND is a
string."
(when (consp quail-keymap) (setq quail-keymap (cdr quail-keymap)))
(if (or (integerp quail-keymap)
- (and (fboundp 'characterp) (characterp quail-keymap)))
+ (characterp quail-keymap))
(setq quail-keymap (list (string quail-keymap)))
(if (stringp quail-keymap)
(setq quail-keymap (list quail-keymap))
@@ -278,10 +278,10 @@ string."
(list
(apply #'vector
(mapcar
- #'(lambda (entry)
- (cl-assert (char-or-string-p entry) t)
- (format "%s%s" to-prepend
- (if (integerp entry) (string entry) entry)))
+ (lambda (entry)
+ (cl-assert (char-or-string-p entry) t)
+ (format "%s%s" to-prepend
+ (if (integerp entry) (string entry) entry)))
quail-keymap))))
(defun ipa-x-sampa-underscore-implosive (input-string length)
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
index c18ed862d4e..76ddf3c2746 100644
--- a/lisp/leim/quail/latin-post.el
+++ b/lisp/leim/quail/latin-post.el
@@ -215,7 +215,15 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
others | / | s/ -> ß
Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
-" nil t nil nil nil nil nil nil nil nil t)
+"
+ '(("\C-?" . quail-delete-last-char)
+ (">" . quail-next-translation)
+ ("\C-f" . quail-next-translation)
+ ([right] . quail-next-translation)
+ ("<" . quail-prev-translation)
+ ("\C-b" . quail-prev-translation)
+ ([left] . quail-prev-translation))
+ t nil nil nil nil nil nil nil nil t)
(quail-define-rules
("A'" ?Á)
@@ -246,9 +254,9 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("R'" ?Ŕ)
("R~" ?Ř)
("S'" ?Ś)
- ("S," ?Ş)
+ ("S," "ŞȘ") ; the second variant is for Romanian
("S~" ?Š)
- ("T," ?Ţ)
+ ("T," "ŢȚ") ; the second variant is for Romanian
("T~" ?Ť)
("U'" ?Ú)
("U:" ?Ű)
@@ -286,10 +294,10 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("r'" ?ŕ)
("r~" ?ř)
("s'" ?ś)
- ("s," ?ş)
+ ("s," "şș") ; the second variant is for Romanian
("s/" ?ß)
("s~" ?š)
- ("t," ?ţ)
+ ("t," "ţț") ; the second variant is for Romanian
("t~" ?ť)
("u'" ?ú)
("u:" ?ű)
@@ -2231,6 +2239,7 @@ of characters from a single Latin-N charset.
tilde | ~ | a~ -> ã
cedilla | , | c, -> ç
ogonek | , | a, -> ą
+ macron | - | a- -> ā g- -> ḡ e/- -> ǣ -- -> ¯
breve | ~ | a~ -> ă
caron | ~ | c~ -> č
dbl. acute | : | o: -> ő
@@ -2238,14 +2247,45 @@ of characters from a single Latin-N charset.
dot | . | z. -> ż
stroke | / | d/ -> đ
nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ symbols | ^ | r^ -> ® t^ -> ™
+ super | ^ | 0^ -> ⁰ 1^ -> ¹ +^ -> ⁺ -^ -> ⁻
+ subscript | _ | 0_ -> ₀ 1_ -> ₁ +_ -> ₊ -_ -> ₋
others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> ° o/ -> œ
+ | / | 2/ -> ½ 3/ -> ¾ 4/ -> ?¼
| various | << -> « >> -> » o_ -> º a_ -> ª
Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
" nil t nil nil nil nil nil nil nil nil t)
-;; Fixme: ¦ § ¨ © ¬ ­ ® ¯ ± ² ³ ´ µ ¶ · ¸ ¹ ¼ ½ ¾ × ÷
+;; Fixme: ¦ § ¨ © ¬ ± ´ µ ¶ · ¸ × ÷
(quail-define-rules
+ ("2/" ?½)
+ ("3/" ?¾)
+ ("4/" ?¼)
+ ("0^" ?⁰)
+ ("1^" ?¹)
+ ("2^" ?²)
+ ("3^" ?³)
+ ("4^" ?⁴)
+ ("5^" ?⁵)
+ ("6^" ?⁶)
+ ("7^" ?⁷)
+ ("8^" ?⁸)
+ ("9^" ?⁹)
+ ("+^" ?⁺)
+ ("-^" ?⁻)
+ ("0_" ?₀)
+ ("1_" ?₁)
+ ("2_" ?₂)
+ ("3_" ?₃)
+ ("4_" ?₄)
+ ("5_" ?₅)
+ ("6_" ?₆)
+ ("7_" ?₇)
+ ("8_" ?₈)
+ ("9_" ?₉)
+ ("+_" ?₊)
+ ("-_" ?₋)
(" _" ? )
("!/" ?¡)
("//" ?°)
@@ -2276,11 +2316,13 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("E-" ?Ē)
("E." ?Ė)
("E/" ?Æ)
+ ("E/-" ?Ǣ)
("E\"" ?Ë)
("E^" ?Ê)
("E`" ?È)
("E~" ?Ě)
("G," ?Ģ)
+ ("G-" ?Ḡ)
("G." ?Ġ)
("G^" ?Ĝ)
("G~" ?Ğ)
@@ -2366,12 +2408,14 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("e-" ?ē)
("e." ?ė)
("e/" ?æ)
+ ("e/-" ?ǣ)
("e\"" ?ë)
("e^" ?ê)
("e`" ?è)
("e~" ?ě)
("e=" ?€)
("g," ?ģ)
+ ("g-" ?ḡ)
("g." ?ġ)
("g^" ?ĝ)
("g~" ?ğ)
@@ -2409,6 +2453,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("o~" ?õ)
("r'" ?ŕ)
("r," ?ŗ)
+ ("r^" ?®)
("r~" ?ř)
("s'" ?ś)
("s," ?ş)
@@ -2418,6 +2463,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("t," ?ţ)
("t/" ?þ)
("t/" ?ŧ)
+ ("t^" ?™)
("t~" ?ť)
("u'" ?ú)
("u," ?ų)
@@ -2434,7 +2480,35 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("z'" ?ź)
("z." ?ż)
("z~" ?ž)
-
+ ("--" ?¯)
+
+ ("2//" ["2/"])
+ ("3//" ["3/"])
+ ("4//" ["4/"])
+ ("0^^" ["0^"])
+ ("1^^" ["1^"])
+ ("2^^" ["2^"])
+ ("3^^" ["3^"])
+ ("4^^" ["4^"])
+ ("5^^" ["5^"])
+ ("6^^" ["6^"])
+ ("7^^" ["7^"])
+ ("8^^" ["8^"])
+ ("9^^" ["9^"])
+ ("+^^" ["+^"])
+ ("-^^" ["-^"])
+ ("0__" ["0_"])
+ ("1__" ["1_"])
+ ("2__" ["2_"])
+ ("3__" ["3_"])
+ ("4__" ["4_"])
+ ("5__" ["5_"])
+ ("6__" ["6_"])
+ ("7__" ["7_"])
+ ("8__" ["8_"])
+ ("9__" ["9_"])
+ ("+__" ["+_"])
+ ("-__" ["-_"])
(" __" [" _"])
("!//" ["!/"])
("///" ["//"])
@@ -2462,11 +2536,13 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("E--" ["E-"])
("E.." ["E."])
("E//" ["E/"])
+ ("E/--" ["E/-"])
("E\"\"" ["E\""])
("E^^" ["E^"])
("E``" ["E`"])
("E~~" ["E~"])
("G,," ["G,"])
+ ("G--" ["G-"])
("G.." ["G."])
("G^^" ["G^"])
("G~~" ["G~"])
@@ -2545,12 +2621,14 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("e--" ["e-"])
("e.." ["e."])
("e//" ["e/"])
+ ("e/--" ["e/-"])
("e\"\"" ["e\""])
("e^^" ["e^"])
("e``" ["e`"])
("e==" ["e="])
("e~~" ["e~"])
("g,," ["g,"])
+ ("g--" ["g-"])
("g.." ["g."])
("g^^" ["g^"])
("g~~" ["g~"])
@@ -2609,6 +2687,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("z''" ["z'"])
("z.." ["z."])
("z~~" ["z~"])
+ ("---" ["--"])
)
;; Derived from Slovenian.kmap from Yudit
diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el
index f6c63cb0552..48e0ce9efc9 100644
--- a/lisp/leim/quail/latin-pre.el
+++ b/lisp/leim/quail/latin-pre.el
@@ -497,7 +497,15 @@ Key translation rules are:
cedilla | \\=` | \\=`c -> ç \\=`e -> ?ę
misc | \\=' \\=` ~ | \\='d -> đ \\=`l -> ł \\=`z -> ż ~o -> ő ~u -> ű
symbol | ~ | \\=`. -> ˙ ~~ -> ˘ ~. -> ?¸
-" nil t nil nil nil nil nil nil nil nil t)
+"
+ '(("\C-?" . quail-delete-last-char)
+ (">" . quail-next-translation)
+ ("\C-f" . quail-next-translation)
+ ([right] . quail-next-translation)
+ ("<" . quail-prev-translation)
+ ("\C-b" . quail-prev-translation)
+ ([left] . quail-prev-translation))
+ t nil nil nil nil nil nil nil nil t)
(quail-define-rules
("'A" ?Á)
@@ -532,15 +540,15 @@ Key translation rules are:
("`C" ?Ç)
("`E" ?Ę)
("`L" ?Ł)
- ("`S" ?Ş)
- ("`T" ?Ţ)
+ ("`S" "ŞȘ")
+ ("`T" "ŢȚ") ; the second variant is for Romanian
("`Z" ?Ż)
("`a" ?ą)
("`l" ?ł)
("`c" ?ç)
("`e" ?ę)
- ("`s" ?ş)
- ("`t" ?ţ)
+ ("`s" "şș")
+ ("`t" "ţț") ; the second variant is for Romanian
("`z" ?ż)
("``" ?Ş)
("`." ?˙)
@@ -1096,14 +1104,32 @@ of characters from a single Latin-N charset.
cedilla | , ~ | ,c -> ç ~c -> ç
caron | ~ | ~c -> č ~g -> ğ
breve | ~ | ~a -> ă
+ macron | - | -a -> ā -/e -> ǣ -- -> ¯
dot above | / . | /g -> ġ .g -> ġ
misc | \" ~ / | \"s -> ß ~d -> ð ~t -> þ /a -> å /e -> æ /o -> ø
symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ ~~ -> ¸
symbol | _ / | _o -> º _a -> ª // -> ° /\\ -> × _y -> ¥
- symbol | ^ | ^r -> ® ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³
+ symbol | ^ | ^r -> ® ^t -> ™ ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
+ ("--" ?¯)
+ ("-A" ?Ā)
+ ("-a" ?ā)
+ ("-E" ?Ē)
+ ("-e" ?ē)
+ ("-/E" ?Ǣ)
+ ("-/e" ?ǣ)
+ ("-G" ?Ḡ)
+ ("-g" ?ḡ)
+ ("-I" ?Ī)
+ ("-i" ?ī)
+ ("-O" ?Ō)
+ ("-o" ?ō)
+ ("-U" ?Ū)
+ ("-u" ?ū)
+ ("-Y" ?Ȳ)
+ ("-y" ?ȳ)
("' " ?')
("''" ?´)
("'A" ?Á)
@@ -1189,9 +1215,16 @@ of characters from a single Latin-N charset.
("\"w" ?ẅ)
("\"y" ?ÿ)
("^ " ?^)
+ ("^0" ?⁰)
("^1" ?¹)
("^2" ?²)
("^3" ?³)
+ ("^4" ?⁴)
+ ("^5" ?⁵)
+ ("^6" ?⁶)
+ ("^7" ?⁷)
+ ("^8" ?⁸)
+ ("^9" ?⁹)
("^A" ?Â)
("^C" ?Ĉ)
("^E" ?Ê)
@@ -1216,9 +1249,24 @@ of characters from a single Latin-N charset.
("^o" ?ô)
("^r" ?®)
("^s" ?ŝ)
+ ("^t" ?™)
("^u" ?û)
("^w" ?ŵ)
("^y" ?ŷ)
+ ("^+" ?⁺)
+ ("^-" ?⁻)
+ ("_0" ?₀)
+ ("_1" ?₁)
+ ("_2" ?₂)
+ ("_3" ?₃)
+ ("_4" ?₄)
+ ("_5" ?₅)
+ ("_6" ?₆)
+ ("_7" ?₇)
+ ("_8" ?₈)
+ ("_9" ?₉)
+ ("_++" ?₊)
+ ("_-" ?₋)
("_+" ?±)
("_:" ?÷)
("_a" ?ª)
diff --git a/lisp/leim/quail/misc-lang.el b/lisp/leim/quail/misc-lang.el
new file mode 100644
index 00000000000..0c4a0d4ce40
--- /dev/null
+++ b/lisp/leim/quail/misc-lang.el
@@ -0,0 +1,1184 @@
+;;; misc-lang.el --- Quail package for inputting Miscellaneous characters -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: समीर सिंह Sameer Singh <lumarzeli30@gmail.com>
+;; Keywords: multilingual, input method, i18n, Miscellaneous
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Input methods for Miscellaneous languages.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "hanifi-rohingya" "Hanifi Rohingya" "𐴌𐴟" t "Hanifi Rohingya phonetic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?𐴱)
+ ("`1" ?1)
+ ("2" ?𐴲)
+ ("`2" ?2)
+ ("3" ?𐴳)
+ ("`3" ?3)
+ ("4" ?𐴴)
+ ("`4" ?4)
+ ("5" ?𐴵)
+ ("`5" ?5)
+ ("6" ?𐴶)
+ ("`6" ?6)
+ ("7" ?𐴷)
+ ("`7" ?7)
+ ("8" ?𐴸)
+ ("`8" ?8)
+ ("9" ?𐴹)
+ ("`9" ?9)
+ ("0" ?𐴰)
+ ("`0" ?0)
+ ("q" ?𐴄)
+ ("w" ?𐴋)
+ ("W" ?𐴍)
+ ("e" ?𐴠)
+ ("E" ?𐴤)
+ ("r" ?𐴌)
+ ("R" ?𐴥)
+ ("t" ?𐴃)
+ ("T" ?𐴦)
+ ("y" ?𐴘)
+ ("Y" ?𐴙)
+ ("u" ?𐴟)
+ ("U" ?𐴧)
+ ("i" ?𐴞)
+ ("o" ?𐴡)
+ ("p" ?𐴂)
+ ("a" ?𐴀)
+ ("A" ?𐴝)
+ ("s" ?𐴏)
+ ("S" ?𐴐)
+ ("d" ?𐴊)
+ ("f" ?𐴉)
+ ("F" ?𐴢)
+ ("g" ?𐴒)
+ ("h" ?𐴇)
+ ("j" ?𐴅)
+ ("k" ?𐴑)
+ ("K" ?𐴈)
+ ("l" ?𐴓)
+ ("z" ?𐴎)
+ ("c" ?𐴆)
+ ("C" #x200C) ; ZWNJ
+ ("v" ?𐴖)
+ ("V" ?𐴗)
+ ("`v" ?𐴜)
+ ("b" ?𐴁)
+ ("n" ?𐴕)
+ ("N" ?𐴚)
+ ("`n" ?𐴛)
+ ("`N" ?𐴣)
+ ("m" ?𐴔))
+
+;; The Kharoṣṭhī input method is based on the Kyoto-Harvard input
+;; conventions for Sanskrit, extended for Kharoṣṭhī special characters.
+;; Author: Stefan Baums <baums@gandhari.org>.
+(quail-define-package
+ "kharoshthi" "Kharoshthi" "𐨑" nil
+ "Kharoṣṭhī input method." nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("a" ["𐨀"])
+ ("i" ["𐨀𐨁"])
+ ("u" ["𐨀𐨂"])
+ ("R" ["𐨀𐨃"])
+ ("e" ["𐨀𐨅"])
+ ("o" ["𐨀𐨆"])
+
+ ("k" ["𐨐𐨿"])
+ ("ka" ["𐨐"])
+ ("ki" ["𐨐𐨁"])
+ ("ku" ["𐨐𐨂"])
+ ("kR" ["𐨐𐨃"])
+ ("ke" ["𐨐𐨅"])
+ ("ko" ["𐨐𐨆"])
+ ("k_" ["𐨐𐨹𐨿"])
+ ("k_a" ["𐨐𐨹"])
+ ("k_i" ["𐨐𐨹𐨁"])
+ ("k_u" ["𐨐𐨹𐨂"])
+ ("k_R" ["𐨐𐨹𐨃"])
+ ("k_e" ["𐨐𐨹𐨅"])
+ ("k_o" ["𐨐𐨹𐨆"])
+ ("k=" ["𐨐𐨿𐨸"])
+ ("k=a" ["𐨐𐨸"])
+ ("k=i" ["𐨐𐨸𐨁"])
+ ("k=u" ["𐨐𐨸𐨂"])
+ ("k=R" ["𐨐𐨸𐨃"])
+ ("k=e" ["𐨐𐨸𐨅"])
+ ("k=o" ["𐨐𐨸𐨆"])
+ ("k_=" ["𐨐𐨹𐨿𐨸"])
+ ("k_=a" ["𐨐𐨹𐨸"])
+ ("k_=i" ["𐨐𐨹𐨸𐨁"])
+ ("k_=u" ["𐨐𐨹𐨸𐨂"])
+ ("k_=R" ["𐨐𐨹𐨸𐨃"])
+ ("k_=e" ["𐨐𐨹𐨸𐨅"])
+ ("k_=o" ["𐨐𐨹𐨸𐨆"])
+
+ ("kh" ["𐨑𐨿"])
+ ("kha" ["𐨑"])
+ ("khi" ["𐨑𐨁"])
+ ("khu" ["𐨑𐨂"])
+ ("khR" ["𐨑𐨃"])
+ ("khe" ["𐨑𐨅"])
+ ("kho" ["𐨑𐨆"])
+ ("kh_" ["𐨑𐨹𐨿"])
+ ("kh_a" ["𐨑𐨹"])
+ ("kh_i" ["𐨑𐨹𐨁"])
+ ("kh_u" ["𐨑𐨹𐨂"])
+ ("kh_R" ["𐨑𐨹𐨃"])
+ ("kh_e" ["𐨑𐨹𐨅"])
+ ("kh_o" ["𐨑𐨹𐨆"])
+ ("kh=" ["𐨑𐨿𐨸"])
+ ("kh=a" ["𐨑𐨸"])
+ ("kh=i" ["𐨑𐨸𐨁"])
+ ("kh=u" ["𐨑𐨸𐨂"])
+ ("kh=R" ["𐨑𐨸𐨃"])
+ ("kh=e" ["𐨑𐨸𐨅"])
+ ("kh=o" ["𐨑𐨸𐨆"])
+ ("kh_=" ["𐨑𐨹𐨿𐨸"])
+ ("kh_=a" ["𐨑𐨹𐨸"])
+ ("kh_=i" ["𐨑𐨹𐨸𐨁"])
+ ("kh_=u" ["𐨑𐨹𐨸𐨂"])
+ ("kh_=R" ["𐨑𐨹𐨸𐨃"])
+ ("kh_=e" ["𐨑𐨹𐨸𐨅"])
+ ("kh_=o" ["𐨑𐨹𐨸𐨆"])
+
+ ("g" ["𐨒𐨿"])
+ ("ga" ["𐨒"])
+ ("gi" ["𐨒𐨁"])
+ ("gu" ["𐨒𐨂"])
+ ("gR" ["𐨒𐨃"])
+ ("ge" ["𐨒𐨅"])
+ ("go" ["𐨒𐨆"])
+ ("g_" ["𐨒𐨹𐨿"])
+ ("g_a" ["𐨒𐨹"])
+ ("g_i" ["𐨒𐨹𐨁"])
+ ("g_u" ["𐨒𐨹𐨂"])
+ ("g_R" ["𐨒𐨹𐨃"])
+ ("g_e" ["𐨒𐨹𐨅"])
+ ("g_o" ["𐨒𐨹𐨆"])
+ ("g=" ["𐨒𐨿𐨸"])
+ ("g=a" ["𐨒𐨸"])
+ ("g=i" ["𐨒𐨸𐨁"])
+ ("g=u" ["𐨒𐨸𐨂"])
+ ("g=R" ["𐨒𐨸𐨃"])
+ ("g=e" ["𐨒𐨸𐨅"])
+ ("g=o" ["𐨒𐨸𐨆"])
+ ("g_=" ["𐨒𐨹𐨿𐨸"])
+ ("g_=a" ["𐨒𐨹𐨸"])
+ ("g_=i" ["𐨒𐨹𐨸𐨁"])
+ ("g_=u" ["𐨒𐨹𐨸𐨂"])
+ ("g_=R" ["𐨒𐨹𐨸𐨃"])
+ ("g_=e" ["𐨒𐨹𐨸𐨅"])
+ ("g_=o" ["𐨒𐨹𐨸𐨆"])
+
+ ("gh" ["𐨓𐨿"])
+ ("gha" ["𐨓"])
+ ("ghi" ["𐨓𐨁"])
+ ("ghu" ["𐨓𐨂"])
+ ("ghR" ["𐨓𐨃"])
+ ("ghe" ["𐨓𐨅"])
+ ("gho" ["𐨓𐨆"])
+ ("gh_" ["𐨓𐨹𐨿"])
+ ("gh_a" ["𐨓𐨹"])
+ ("gh_i" ["𐨓𐨹𐨁"])
+ ("gh_u" ["𐨓𐨹𐨂"])
+ ("gh_R" ["𐨓𐨹𐨃"])
+ ("gh_e" ["𐨓𐨹𐨅"])
+ ("gh_o" ["𐨓𐨹𐨆"])
+ ("gh=" ["𐨓𐨿𐨸"])
+ ("gh=a" ["𐨓𐨸"])
+ ("gh=i" ["𐨓𐨸𐨁"])
+ ("gh=u" ["𐨓𐨸𐨂"])
+ ("gh=R" ["𐨓𐨸𐨃"])
+ ("gh=e" ["𐨓𐨸𐨅"])
+ ("gh=o" ["𐨓𐨸𐨆"])
+ ("gh_=" ["𐨓𐨹𐨿𐨸"])
+ ("gh_=a" ["𐨓𐨹𐨸"])
+ ("gh_=i" ["𐨓𐨹𐨸𐨁"])
+ ("gh_=u" ["𐨓𐨹𐨸𐨂"])
+ ("gh_=R" ["𐨓𐨹𐨸𐨃"])
+ ("gh_=e" ["𐨓𐨹𐨸𐨅"])
+ ("gh_=o" ["𐨓𐨹𐨸𐨆"])
+
+ ("c" ["𐨕𐨿"])
+ ("ca" ["𐨕"])
+ ("ci" ["𐨕𐨁"])
+ ("cu" ["𐨕𐨂"])
+ ("cR" ["𐨕𐨃"])
+ ("ce" ["𐨕𐨅"])
+ ("co" ["𐨕𐨆"])
+ ("c_" ["𐨕𐨹𐨿"])
+ ("c_a" ["𐨕𐨹"])
+ ("c_i" ["𐨕𐨹𐨁"])
+ ("c_u" ["𐨕𐨹𐨂"])
+ ("c_R" ["𐨕𐨹𐨃"])
+ ("c_e" ["𐨕𐨹𐨅"])
+ ("c_o" ["𐨕𐨹𐨆"])
+ ("c=" ["𐨕𐨿𐨸"])
+ ("c=a" ["𐨕𐨸"])
+ ("c=i" ["𐨕𐨸𐨁"])
+ ("c=u" ["𐨕𐨸𐨂"])
+ ("c=R" ["𐨕𐨸𐨃"])
+ ("c=e" ["𐨕𐨸𐨅"])
+ ("c=o" ["𐨕𐨸𐨆"])
+ ("c_=" ["𐨕𐨹𐨿𐨸"])
+ ("c_=a" ["𐨕𐨹𐨸"])
+ ("c_=i" ["𐨕𐨹𐨸𐨁"])
+ ("c_=u" ["𐨕𐨹𐨸𐨂"])
+ ("c_=R" ["𐨕𐨹𐨸𐨃"])
+ ("c_=e" ["𐨕𐨹𐨸𐨅"])
+ ("c_=o" ["𐨕𐨹𐨸𐨆"])
+
+ ("ch" ["𐨖𐨿"])
+ ("cha" ["𐨖"])
+ ("chi" ["𐨖𐨁"])
+ ("chu" ["𐨖𐨂"])
+ ("chR" ["𐨖𐨃"])
+ ("che" ["𐨖𐨅"])
+ ("cho" ["𐨖𐨆"])
+ ("ch_" ["𐨖𐨹𐨿"])
+ ("ch_a" ["𐨖𐨹"])
+ ("ch_i" ["𐨖𐨹𐨁"])
+ ("ch_u" ["𐨖𐨹𐨂"])
+ ("ch_R" ["𐨖𐨹𐨃"])
+ ("ch_e" ["𐨖𐨹𐨅"])
+ ("ch_o" ["𐨖𐨹𐨆"])
+ ("ch=" ["𐨖𐨿𐨸"])
+ ("ch=a" ["𐨖𐨸"])
+ ("ch=i" ["𐨖𐨸𐨁"])
+ ("ch=u" ["𐨖𐨸𐨂"])
+ ("ch=R" ["𐨖𐨸𐨃"])
+ ("ch=e" ["𐨖𐨸𐨅"])
+ ("ch=o" ["𐨖𐨸𐨆"])
+ ("ch_=" ["𐨖𐨹𐨿𐨸"])
+ ("ch_=a" ["𐨖𐨹𐨸"])
+ ("ch_=i" ["𐨖𐨹𐨸𐨁"])
+ ("ch_=u" ["𐨖𐨹𐨸𐨂"])
+ ("ch_=R" ["𐨖𐨹𐨸𐨃"])
+ ("ch_=e" ["𐨖𐨹𐨸𐨅"])
+ ("ch_=o" ["𐨖𐨹𐨸𐨆"])
+
+ ("j" ["𐨗𐨿"])
+ ("ja" ["𐨗"])
+ ("ji" ["𐨗𐨁"])
+ ("ju" ["𐨗𐨂"])
+ ("jR" ["𐨗𐨃"])
+ ("je" ["𐨗𐨅"])
+ ("jo" ["𐨗𐨆"])
+ ("j_" ["𐨗𐨹𐨿"])
+ ("j_a" ["𐨗𐨹"])
+ ("j_i" ["𐨗𐨹𐨁"])
+ ("j_u" ["𐨗𐨹𐨂"])
+ ("j_R" ["𐨗𐨹𐨃"])
+ ("j_e" ["𐨗𐨹𐨅"])
+ ("j_o" ["𐨗𐨹𐨆"])
+ ("j=" ["𐨗𐨿𐨸"])
+ ("j=a" ["𐨗𐨸"])
+ ("j=i" ["𐨗𐨸𐨁"])
+ ("j=u" ["𐨗𐨸𐨂"])
+ ("j=R" ["𐨗𐨸𐨃"])
+ ("j=e" ["𐨗𐨸𐨅"])
+ ("j=o" ["𐨗𐨸𐨆"])
+ ("j_=" ["𐨗𐨹𐨿𐨸"])
+ ("j_=a" ["𐨗𐨹𐨸"])
+ ("j_=i" ["𐨗𐨹𐨸𐨁"])
+ ("j_=u" ["𐨗𐨹𐨸𐨂"])
+ ("j_=R" ["𐨗𐨹𐨸𐨃"])
+ ("j_=e" ["𐨗𐨹𐨸𐨅"])
+ ("j_=o" ["𐨗𐨹𐨸𐨆"])
+
+ ("jh" ["𐨰𐨿"])
+ ("jha" ["𐨰"])
+ ("jhi" ["𐨰𐨁"])
+ ("jhu" ["𐨰𐨂"])
+ ("jhR" ["𐨰𐨃"])
+ ("jhe" ["𐨰𐨅"])
+ ("jho" ["𐨰𐨆"])
+ ("jh_" ["𐨰𐨹𐨿"])
+ ("jh_a" ["𐨰𐨹"])
+ ("jh_i" ["𐨰𐨹𐨁"])
+ ("jh_u" ["𐨰𐨹𐨂"])
+ ("jh_R" ["𐨰𐨹𐨃"])
+ ("jh_e" ["𐨰𐨹𐨅"])
+ ("jh_o" ["𐨰𐨹𐨆"])
+ ("jh=" ["𐨰𐨿𐨸"])
+ ("jh=a" ["𐨰𐨸"])
+ ("jh=i" ["𐨰𐨸𐨁"])
+ ("jh=u" ["𐨰𐨸𐨂"])
+ ("jh=R" ["𐨰𐨸𐨃"])
+ ("jh=e" ["𐨰𐨸𐨅"])
+ ("jh=o" ["𐨰𐨸𐨆"])
+ ("jh_=" ["𐨰𐨹𐨿𐨸"])
+ ("jh_=a" ["𐨰𐨹𐨸"])
+ ("jh_=i" ["𐨰𐨹𐨸𐨁"])
+ ("jh_=u" ["𐨰𐨹𐨸𐨂"])
+ ("jh_=R" ["𐨰𐨹𐨸𐨃"])
+ ("jh_=e" ["𐨰𐨹𐨸𐨅"])
+ ("jh_=o" ["𐨰𐨹𐨸𐨆"])
+
+ ("J" ["𐨙𐨿"])
+ ("Ja" ["𐨙"])
+ ("Ji" ["𐨙𐨁"])
+ ("Ju" ["𐨙𐨂"])
+ ("JR" ["𐨙𐨃"])
+ ("Je" ["𐨙𐨅"])
+ ("Jo" ["𐨙𐨆"])
+ ("J_" ["𐨙𐨹𐨿"])
+ ("J_a" ["𐨙𐨹"])
+ ("J_i" ["𐨙𐨹𐨁"])
+ ("J_u" ["𐨙𐨹𐨂"])
+ ("J_R" ["𐨙𐨹𐨃"])
+ ("J_e" ["𐨙𐨹𐨅"])
+ ("J_o" ["𐨙𐨹𐨆"])
+ ("J=" ["𐨙𐨿𐨸"])
+ ("J=a" ["𐨙𐨸"])
+ ("J=i" ["𐨙𐨸𐨁"])
+ ("J=u" ["𐨙𐨸𐨂"])
+ ("J=R" ["𐨙𐨸𐨃"])
+ ("J=e" ["𐨙𐨸𐨅"])
+ ("J=o" ["𐨙𐨸𐨆"])
+ ("J_=" ["𐨙𐨹𐨿𐨸"])
+ ("J_=a" ["𐨙𐨹𐨸"])
+ ("J_=i" ["𐨙𐨹𐨸𐨁"])
+ ("J_=u" ["𐨙𐨹𐨸𐨂"])
+ ("J_=R" ["𐨙𐨹𐨸𐨃"])
+ ("J_=e" ["𐨙𐨹𐨸𐨅"])
+ ("J_=o" ["𐨙𐨹𐨸𐨆"])
+
+ ("T" ["𐨚𐨿"])
+ ("Ta" ["𐨚"])
+ ("Ti" ["𐨚𐨁"])
+ ("Tu" ["𐨚𐨂"])
+ ("TR" ["𐨚𐨃"])
+ ("Te" ["𐨚𐨅"])
+ ("To" ["𐨚𐨆"])
+ ("T_" ["𐨚𐨹𐨿"])
+ ("T_a" ["𐨚𐨹"])
+ ("T_i" ["𐨚𐨹𐨁"])
+ ("T_u" ["𐨚𐨹𐨂"])
+ ("T_R" ["𐨚𐨹𐨃"])
+ ("T_e" ["𐨚𐨹𐨅"])
+ ("T_o" ["𐨚𐨹𐨆"])
+ ("T=" ["𐨚𐨿𐨸"])
+ ("T=a" ["𐨚𐨸"])
+ ("T=i" ["𐨚𐨸𐨁"])
+ ("T=u" ["𐨚𐨸𐨂"])
+ ("T=R" ["𐨚𐨸𐨃"])
+ ("T=e" ["𐨚𐨸𐨅"])
+ ("T=o" ["𐨚𐨸𐨆"])
+ ("T_=" ["𐨚𐨹𐨿𐨸"])
+ ("T_=a" ["𐨚𐨹𐨸"])
+ ("T_=i" ["𐨚𐨹𐨸𐨁"])
+ ("T_=u" ["𐨚𐨹𐨸𐨂"])
+ ("T_=R" ["𐨚𐨹𐨸𐨃"])
+ ("T_=e" ["𐨚𐨹𐨸𐨅"])
+ ("T_=o" ["𐨚𐨹𐨸𐨆"])
+
+ ("Th" ["𐨛𐨿"])
+ ("Tha" ["𐨛"])
+ ("Thi" ["𐨛𐨁"])
+ ("Thu" ["𐨛𐨂"])
+ ("ThR" ["𐨛𐨃"])
+ ("The" ["𐨛𐨅"])
+ ("Tho" ["𐨛𐨆"])
+ ("Th_" ["𐨛𐨹𐨿"])
+ ("Th_a" ["𐨛𐨹"])
+ ("Th_i" ["𐨛𐨹𐨁"])
+ ("Th_u" ["𐨛𐨹𐨂"])
+ ("Th_R" ["𐨛𐨹𐨃"])
+ ("Th_e" ["𐨛𐨹𐨅"])
+ ("Th_o" ["𐨛𐨹𐨆"])
+ ("Th=" ["𐨛𐨿𐨸"])
+ ("Th=a" ["𐨛𐨸"])
+ ("Th=i" ["𐨛𐨸𐨁"])
+ ("Th=u" ["𐨛𐨸𐨂"])
+ ("Th=R" ["𐨛𐨸𐨃"])
+ ("Th=e" ["𐨛𐨸𐨅"])
+ ("Th=o" ["𐨛𐨸𐨆"])
+ ("Th_=" ["𐨛𐨹𐨿𐨸"])
+ ("Th_=a" ["𐨛𐨹𐨸"])
+ ("Th_=i" ["𐨛𐨹𐨸𐨁"])
+ ("Th_=u" ["𐨛𐨹𐨸𐨂"])
+ ("Th_=R" ["𐨛𐨹𐨸𐨃"])
+ ("Th_=e" ["𐨛𐨹𐨸𐨅"])
+ ("Th_=o" ["𐨛𐨹𐨸𐨆"])
+
+ ("D" ["𐨜𐨿"])
+ ("Da" ["𐨜"])
+ ("Di" ["𐨜𐨁"])
+ ("Du" ["𐨜𐨂"])
+ ("DR" ["𐨜𐨃"])
+ ("De" ["𐨜𐨅"])
+ ("Do" ["𐨜𐨆"])
+ ("D_" ["𐨜𐨹𐨿"])
+ ("D_a" ["𐨜𐨹"])
+ ("D_i" ["𐨜𐨹𐨁"])
+ ("D_u" ["𐨜𐨹𐨂"])
+ ("D_R" ["𐨜𐨹𐨃"])
+ ("D_e" ["𐨜𐨹𐨅"])
+ ("D_o" ["𐨜𐨹𐨆"])
+ ("D=" ["𐨜𐨿𐨸"])
+ ("D=a" ["𐨜𐨸"])
+ ("D=i" ["𐨜𐨸𐨁"])
+ ("D=u" ["𐨜𐨸𐨂"])
+ ("D=R" ["𐨜𐨸𐨃"])
+ ("D=e" ["𐨜𐨸𐨅"])
+ ("D=o" ["𐨜𐨸𐨆"])
+ ("D_=" ["𐨜𐨹𐨿𐨸"])
+ ("D_=a" ["𐨜𐨹𐨸"])
+ ("D_=i" ["𐨜𐨹𐨸𐨁"])
+ ("D_=u" ["𐨜𐨹𐨸𐨂"])
+ ("D_=R" ["𐨜𐨹𐨸𐨃"])
+ ("D_=e" ["𐨜𐨹𐨸𐨅"])
+ ("D_=o" ["𐨜𐨹𐨸𐨆"])
+
+ ("Dh" ["𐨝𐨿"])
+ ("Dha" ["𐨝"])
+ ("Dhi" ["𐨝𐨁"])
+ ("Dhu" ["𐨝𐨂"])
+ ("DhR" ["𐨝𐨃"])
+ ("Dhe" ["𐨝𐨅"])
+ ("Dho" ["𐨝𐨆"])
+ ("Dh_" ["𐨝𐨹𐨿"])
+ ("Dh_a" ["𐨝𐨹"])
+ ("Dh_i" ["𐨝𐨹𐨁"])
+ ("Dh_u" ["𐨝𐨹𐨂"])
+ ("Dh_R" ["𐨝𐨹𐨃"])
+ ("Dh_e" ["𐨝𐨹𐨅"])
+ ("Dh_o" ["𐨝𐨹𐨆"])
+ ("Dh=" ["𐨝𐨿𐨸"])
+ ("Dh=a" ["𐨝𐨸"])
+ ("Dh=i" ["𐨝𐨸𐨁"])
+ ("Dh=u" ["𐨝𐨸𐨂"])
+ ("Dh=R" ["𐨝𐨸𐨃"])
+ ("Dh=e" ["𐨝𐨸𐨅"])
+ ("Dh=o" ["𐨝𐨸𐨆"])
+ ("Dh_=" ["𐨝𐨹𐨿𐨸"])
+ ("Dh_=a" ["𐨝𐨹𐨸"])
+ ("Dh_=i" ["𐨝𐨹𐨸𐨁"])
+ ("Dh_=u" ["𐨝𐨹𐨸𐨂"])
+ ("Dh_=R" ["𐨝𐨹𐨸𐨃"])
+ ("Dh_=e" ["𐨝𐨹𐨸𐨅"])
+ ("Dh_=o" ["𐨝𐨹𐨸𐨆"])
+
+ ("N" ["𐨞𐨿"])
+ ("Na" ["𐨞"])
+ ("Ni" ["𐨞𐨁"])
+ ("Nu" ["𐨞𐨂"])
+ ("NR" ["𐨞𐨃"])
+ ("Ne" ["𐨞𐨅"])
+ ("No" ["𐨞𐨆"])
+ ("N_" ["𐨞𐨹𐨿"])
+ ("N_a" ["𐨞𐨹"])
+ ("N_i" ["𐨞𐨹𐨁"])
+ ("N_u" ["𐨞𐨹𐨂"])
+ ("N_R" ["𐨞𐨹𐨃"])
+ ("N_e" ["𐨞𐨹𐨅"])
+ ("N_o" ["𐨞𐨹𐨆"])
+ ("N=" ["𐨞𐨿𐨸"])
+ ("N=a" ["𐨞𐨸"])
+ ("N=i" ["𐨞𐨸𐨁"])
+ ("N=u" ["𐨞𐨸𐨂"])
+ ("N=R" ["𐨞𐨸𐨃"])
+ ("N=e" ["𐨞𐨸𐨅"])
+ ("N=o" ["𐨞𐨸𐨆"])
+ ("N_=" ["𐨞𐨹𐨿𐨸"])
+ ("N_=a" ["𐨞𐨹𐨸"])
+ ("N_=i" ["𐨞𐨹𐨸𐨁"])
+ ("N_=u" ["𐨞𐨹𐨸𐨂"])
+ ("N_=R" ["𐨞𐨹𐨸𐨃"])
+ ("N_=e" ["𐨞𐨹𐨸𐨅"])
+ ("N_=o" ["𐨞𐨹𐨸𐨆"])
+
+ ("t" ["𐨟𐨿"])
+ ("ta" ["𐨟"])
+ ("ti" ["𐨟𐨁"])
+ ("tu" ["𐨟𐨂"])
+ ("tR" ["𐨟𐨃"])
+ ("te" ["𐨟𐨅"])
+ ("to" ["𐨟𐨆"])
+ ("t_" ["𐨟𐨹𐨿"])
+ ("t_a" ["𐨟𐨹"])
+ ("t_i" ["𐨟𐨹𐨁"])
+ ("t_u" ["𐨟𐨹𐨂"])
+ ("t_R" ["𐨟𐨹𐨃"])
+ ("t_e" ["𐨟𐨹𐨅"])
+ ("t_o" ["𐨟𐨹𐨆"])
+ ("t=" ["𐨟𐨿𐨸"])
+ ("t=a" ["𐨟𐨸"])
+ ("t=i" ["𐨟𐨸𐨁"])
+ ("t=u" ["𐨟𐨸𐨂"])
+ ("t=R" ["𐨟𐨸𐨃"])
+ ("t=e" ["𐨟𐨸𐨅"])
+ ("t=o" ["𐨟𐨸𐨆"])
+ ("t_=" ["𐨟𐨹𐨿𐨸"])
+ ("t_=a" ["𐨟𐨹𐨸"])
+ ("t_=i" ["𐨟𐨹𐨸𐨁"])
+ ("t_=u" ["𐨟𐨹𐨸𐨂"])
+ ("t_=R" ["𐨟𐨹𐨸𐨃"])
+ ("t_=e" ["𐨟𐨹𐨸𐨅"])
+ ("t_=o" ["𐨟𐨹𐨸𐨆"])
+
+ ("th" ["𐨠𐨿"])
+ ("tha" ["𐨠"])
+ ("thi" ["𐨠𐨁"])
+ ("thu" ["𐨠𐨂"])
+ ("thR" ["𐨠𐨃"])
+ ("the" ["𐨠𐨅"])
+ ("tho" ["𐨠𐨆"])
+ ("th_" ["𐨠𐨹𐨿"])
+ ("th_a" ["𐨠𐨹"])
+ ("th_i" ["𐨠𐨹𐨁"])
+ ("th_u" ["𐨠𐨹𐨂"])
+ ("th_R" ["𐨠𐨹𐨃"])
+ ("th_e" ["𐨠𐨹𐨅"])
+ ("th_o" ["𐨠𐨹𐨆"])
+ ("th=" ["𐨠𐨿𐨸"])
+ ("th=a" ["𐨠𐨸"])
+ ("th=i" ["𐨠𐨸𐨁"])
+ ("th=u" ["𐨠𐨸𐨂"])
+ ("th=R" ["𐨠𐨸𐨃"])
+ ("th=e" ["𐨠𐨸𐨅"])
+ ("th=o" ["𐨠𐨸𐨆"])
+ ("th_=" ["𐨠𐨹𐨿𐨸"])
+ ("th_=a" ["𐨠𐨹𐨸"])
+ ("th_=i" ["𐨠𐨹𐨸𐨁"])
+ ("th_=u" ["𐨠𐨹𐨸𐨂"])
+ ("th_=R" ["𐨠𐨹𐨸𐨃"])
+ ("th_=e" ["𐨠𐨹𐨸𐨅"])
+ ("th_=o" ["𐨠𐨹𐨸𐨆"])
+
+ ("d" ["𐨡𐨿"])
+ ("da" ["𐨡"])
+ ("di" ["𐨡𐨁"])
+ ("du" ["𐨡𐨂"])
+ ("dR" ["𐨡𐨃"])
+ ("de" ["𐨡𐨅"])
+ ("do" ["𐨡𐨆"])
+ ("d_" ["𐨡𐨹𐨿"])
+ ("d_a" ["𐨡𐨹"])
+ ("d_i" ["𐨡𐨹𐨁"])
+ ("d_u" ["𐨡𐨹𐨂"])
+ ("d_R" ["𐨡𐨹𐨃"])
+ ("d_e" ["𐨡𐨹𐨅"])
+ ("d_o" ["𐨡𐨹𐨆"])
+ ("d=" ["𐨡𐨿𐨸"])
+ ("d=a" ["𐨡𐨸"])
+ ("d=i" ["𐨡𐨸𐨁"])
+ ("d=u" ["𐨡𐨸𐨂"])
+ ("d=R" ["𐨡𐨸𐨃"])
+ ("d=e" ["𐨡𐨸𐨅"])
+ ("d=o" ["𐨡𐨸𐨆"])
+ ("d_=" ["𐨡𐨹𐨿𐨸"])
+ ("d_=a" ["𐨡𐨹𐨸"])
+ ("d_=i" ["𐨡𐨹𐨸𐨁"])
+ ("d_=u" ["𐨡𐨹𐨸𐨂"])
+ ("d_=R" ["𐨡𐨹𐨸𐨃"])
+ ("d_=e" ["𐨡𐨹𐨸𐨅"])
+ ("d_=o" ["𐨡𐨹𐨸𐨆"])
+
+ ("dh" ["𐨢𐨿"])
+ ("dha" ["𐨢"])
+ ("dhi" ["𐨢𐨁"])
+ ("dhu" ["𐨢𐨂"])
+ ("dhR" ["𐨢𐨃"])
+ ("dhe" ["𐨢𐨅"])
+ ("dho" ["𐨢𐨆"])
+ ("dh_" ["𐨢𐨹𐨿"])
+ ("dh_a" ["𐨢𐨹"])
+ ("dh_i" ["𐨢𐨹𐨁"])
+ ("dh_u" ["𐨢𐨹𐨂"])
+ ("dh_R" ["𐨢𐨹𐨃"])
+ ("dh_e" ["𐨢𐨹𐨅"])
+ ("dh_o" ["𐨢𐨹𐨆"])
+ ("dh=" ["𐨢𐨿𐨸"])
+ ("dh=a" ["𐨢𐨸"])
+ ("dh=i" ["𐨢𐨸𐨁"])
+ ("dh=u" ["𐨢𐨸𐨂"])
+ ("dh=R" ["𐨢𐨸𐨃"])
+ ("dh=e" ["𐨢𐨸𐨅"])
+ ("dh=o" ["𐨢𐨸𐨆"])
+ ("dh_=" ["𐨢𐨹𐨿𐨸"])
+ ("dh_=a" ["𐨢𐨹𐨸"])
+ ("dh_=i" ["𐨢𐨹𐨸𐨁"])
+ ("dh_=u" ["𐨢𐨹𐨸𐨂"])
+ ("dh_=R" ["𐨢𐨹𐨸𐨃"])
+ ("dh_=e" ["𐨢𐨹𐨸𐨅"])
+ ("dh_=o" ["𐨢𐨹𐨸𐨆"])
+
+ ("n" ["𐨣𐨿"])
+ ("na" ["𐨣"])
+ ("ni" ["𐨣𐨁"])
+ ("nu" ["𐨣𐨂"])
+ ("nR" ["𐨣𐨃"])
+ ("ne" ["𐨣𐨅"])
+ ("no" ["𐨣𐨆"])
+ ("n_" ["𐨣𐨹𐨿"])
+ ("n_a" ["𐨣𐨹"])
+ ("n_i" ["𐨣𐨹𐨁"])
+ ("n_u" ["𐨣𐨹𐨂"])
+ ("n_R" ["𐨣𐨹𐨃"])
+ ("n_e" ["𐨣𐨹𐨅"])
+ ("n_o" ["𐨣𐨹𐨆"])
+ ("n=" ["𐨣𐨿𐨸"])
+ ("n=a" ["𐨣𐨸"])
+ ("n=i" ["𐨣𐨸𐨁"])
+ ("n=u" ["𐨣𐨸𐨂"])
+ ("n=R" ["𐨣𐨸𐨃"])
+ ("n=e" ["𐨣𐨸𐨅"])
+ ("n=o" ["𐨣𐨸𐨆"])
+ ("n_=" ["𐨣𐨹𐨿𐨸"])
+ ("n_=a" ["𐨣𐨹𐨸"])
+ ("n_=i" ["𐨣𐨹𐨸𐨁"])
+ ("n_=u" ["𐨣𐨹𐨸𐨂"])
+ ("n_=R" ["𐨣𐨹𐨸𐨃"])
+ ("n_=e" ["𐨣𐨹𐨸𐨅"])
+ ("n_=o" ["𐨣𐨹𐨸𐨆"])
+
+ ("p" ["𐨤𐨿"])
+ ("pa" ["𐨤"])
+ ("pi" ["𐨤𐨁"])
+ ("pu" ["𐨤𐨂"])
+ ("pR" ["𐨤𐨃"])
+ ("pe" ["𐨤𐨅"])
+ ("po" ["𐨤𐨆"])
+ ("p_" ["𐨤𐨹𐨿"])
+ ("p_a" ["𐨤𐨹"])
+ ("p_i" ["𐨤𐨹𐨁"])
+ ("p_u" ["𐨤𐨹𐨂"])
+ ("p_R" ["𐨤𐨹𐨃"])
+ ("p_e" ["𐨤𐨹𐨅"])
+ ("p_o" ["𐨤𐨹𐨆"])
+ ("p=" ["𐨤𐨿𐨸"])
+ ("p=a" ["𐨤𐨸"])
+ ("p=i" ["𐨤𐨸𐨁"])
+ ("p=u" ["𐨤𐨸𐨂"])
+ ("p=R" ["𐨤𐨸𐨃"])
+ ("p=e" ["𐨤𐨸𐨅"])
+ ("p=o" ["𐨤𐨸𐨆"])
+ ("p_=" ["𐨤𐨹𐨿𐨸"])
+ ("p_=a" ["𐨤𐨹𐨸"])
+ ("p_=i" ["𐨤𐨹𐨸𐨁"])
+ ("p_=u" ["𐨤𐨹𐨸𐨂"])
+ ("p_=R" ["𐨤𐨹𐨸𐨃"])
+ ("p_=e" ["𐨤𐨹𐨸𐨅"])
+ ("p_=o" ["𐨤𐨹𐨸𐨆"])
+
+ ("ph" ["𐨥𐨿"])
+ ("pha" ["𐨥"])
+ ("phi" ["𐨥𐨁"])
+ ("phu" ["𐨥𐨂"])
+ ("phR" ["𐨥𐨃"])
+ ("phe" ["𐨥𐨅"])
+ ("pho" ["𐨥𐨆"])
+ ("ph_" ["𐨥𐨹𐨿"])
+ ("ph_a" ["𐨥𐨹"])
+ ("ph_i" ["𐨥𐨹𐨁"])
+ ("ph_u" ["𐨥𐨹𐨂"])
+ ("ph_R" ["𐨥𐨹𐨃"])
+ ("ph_e" ["𐨥𐨹𐨅"])
+ ("ph_o" ["𐨥𐨹𐨆"])
+ ("ph=" ["𐨥𐨿𐨸"])
+ ("ph=a" ["𐨥𐨸"])
+ ("ph=i" ["𐨥𐨸𐨁"])
+ ("ph=u" ["𐨥𐨸𐨂"])
+ ("ph=R" ["𐨥𐨸𐨃"])
+ ("ph=e" ["𐨥𐨸𐨅"])
+ ("ph=o" ["𐨥𐨸𐨆"])
+ ("ph_=" ["𐨥𐨹𐨿𐨸"])
+ ("ph_=a" ["𐨥𐨹𐨸"])
+ ("ph_=i" ["𐨥𐨹𐨸𐨁"])
+ ("ph_=u" ["𐨥𐨹𐨸𐨂"])
+ ("ph_=R" ["𐨥𐨹𐨸𐨃"])
+ ("ph_=e" ["𐨥𐨹𐨸𐨅"])
+ ("ph_=o" ["𐨥𐨹𐨸𐨆"])
+
+ ("b" ["𐨦𐨿"])
+ ("ba" ["𐨦"])
+ ("bi" ["𐨦𐨁"])
+ ("bu" ["𐨦𐨂"])
+ ("bR" ["𐨦𐨃"])
+ ("be" ["𐨦𐨅"])
+ ("bo" ["𐨦𐨆"])
+ ("b_" ["𐨦𐨹𐨿"])
+ ("b_a" ["𐨦𐨹"])
+ ("b_i" ["𐨦𐨹𐨁"])
+ ("b_u" ["𐨦𐨹𐨂"])
+ ("b_R" ["𐨦𐨹𐨃"])
+ ("b_e" ["𐨦𐨹𐨅"])
+ ("b_o" ["𐨦𐨹𐨆"])
+ ("b=" ["𐨦𐨿𐨸"])
+ ("b=a" ["𐨦𐨸"])
+ ("b=i" ["𐨦𐨸𐨁"])
+ ("b=u" ["𐨦𐨸𐨂"])
+ ("b=R" ["𐨦𐨸𐨃"])
+ ("b=e" ["𐨦𐨸𐨅"])
+ ("b=o" ["𐨦𐨸𐨆"])
+ ("b_=" ["𐨦𐨹𐨿𐨸"])
+ ("b_=a" ["𐨦𐨹𐨸"])
+ ("b_=i" ["𐨦𐨹𐨸𐨁"])
+ ("b_=u" ["𐨦𐨹𐨸𐨂"])
+ ("b_=R" ["𐨦𐨹𐨸𐨃"])
+ ("b_=e" ["𐨦𐨹𐨸𐨅"])
+ ("b_=o" ["𐨦𐨹𐨸𐨆"])
+
+ ("bh" ["𐨧𐨿"])
+ ("bha" ["𐨧"])
+ ("bhi" ["𐨧𐨁"])
+ ("bhu" ["𐨧𐨂"])
+ ("bhR" ["𐨧𐨃"])
+ ("bhe" ["𐨧𐨅"])
+ ("bho" ["𐨧𐨆"])
+ ("bh_" ["𐨧𐨹𐨿"])
+ ("bh_a" ["𐨧𐨹"])
+ ("bh_i" ["𐨧𐨹𐨁"])
+ ("bh_u" ["𐨧𐨹𐨂"])
+ ("bh_R" ["𐨧𐨹𐨃"])
+ ("bh_e" ["𐨧𐨹𐨅"])
+ ("bh_o" ["𐨧𐨹𐨆"])
+ ("bh=" ["𐨧𐨿𐨸"])
+ ("bh=a" ["𐨧𐨸"])
+ ("bh=i" ["𐨧𐨸𐨁"])
+ ("bh=u" ["𐨧𐨸𐨂"])
+ ("bh=R" ["𐨧𐨸𐨃"])
+ ("bh=e" ["𐨧𐨸𐨅"])
+ ("bh=o" ["𐨧𐨸𐨆"])
+ ("bh_=" ["𐨧𐨹𐨿𐨸"])
+ ("bh_=a" ["𐨧𐨹𐨸"])
+ ("bh_=i" ["𐨧𐨹𐨸𐨁"])
+ ("bh_=u" ["𐨧𐨹𐨸𐨂"])
+ ("bh_=R" ["𐨧𐨹𐨸𐨃"])
+ ("bh_=e" ["𐨧𐨹𐨸𐨅"])
+ ("bh_=o" ["𐨧𐨹𐨸𐨆"])
+
+ ("m" ["𐨨𐨿"])
+ ("ma" ["𐨨"])
+ ("mi" ["𐨨𐨁"])
+ ("mu" ["𐨨𐨂"])
+ ("mR" ["𐨨𐨃"])
+ ("me" ["𐨨𐨅"])
+ ("mo" ["𐨨𐨆"])
+ ("m_" ["𐨨𐨹𐨿"])
+ ("m_a" ["𐨨𐨹"])
+ ("m_i" ["𐨨𐨹𐨁"])
+ ("m_u" ["𐨨𐨹𐨂"])
+ ("m_R" ["𐨨𐨹𐨃"])
+ ("m_e" ["𐨨𐨹𐨅"])
+ ("m_o" ["𐨨𐨹𐨆"])
+ ("m=" ["𐨨𐨿𐨸"])
+ ("m=a" ["𐨨𐨸"])
+ ("m=i" ["𐨨𐨸𐨁"])
+ ("m=u" ["𐨨𐨸𐨂"])
+ ("m=R" ["𐨨𐨸𐨃"])
+ ("m=e" ["𐨨𐨸𐨅"])
+ ("m=o" ["𐨨𐨸𐨆"])
+ ("m_=" ["𐨨𐨹𐨿𐨸"])
+ ("m_=a" ["𐨨𐨹𐨸"])
+ ("m_=i" ["𐨨𐨹𐨸𐨁"])
+ ("m_=u" ["𐨨𐨹𐨸𐨂"])
+ ("m_=R" ["𐨨𐨹𐨸𐨃"])
+ ("m_=e" ["𐨨𐨹𐨸𐨅"])
+ ("m_=o" ["𐨨𐨹𐨸𐨆"])
+
+ ("y" ["𐨩𐨿"])
+ ("ya" ["𐨩"])
+ ("yi" ["𐨩𐨁"])
+ ("yu" ["𐨩𐨂"])
+ ("yR" ["𐨩𐨃"])
+ ("ye" ["𐨩𐨅"])
+ ("yo" ["𐨩𐨆"])
+ ("y_" ["𐨩𐨹𐨿"])
+ ("y_a" ["𐨩𐨹"])
+ ("y_i" ["𐨩𐨹𐨁"])
+ ("y_u" ["𐨩𐨹𐨂"])
+ ("y_R" ["𐨩𐨹𐨃"])
+ ("y_e" ["𐨩𐨹𐨅"])
+ ("y_o" ["𐨩𐨹𐨆"])
+ ("y=" ["𐨩𐨿𐨸"])
+ ("y=a" ["𐨩𐨸"])
+ ("y=i" ["𐨩𐨸𐨁"])
+ ("y=u" ["𐨩𐨸𐨂"])
+ ("y=R" ["𐨩𐨸𐨃"])
+ ("y=e" ["𐨩𐨸𐨅"])
+ ("y=o" ["𐨩𐨸𐨆"])
+ ("y_=" ["𐨩𐨹𐨿𐨸"])
+ ("y_=a" ["𐨩𐨹𐨸"])
+ ("y_=i" ["𐨩𐨹𐨸𐨁"])
+ ("y_=u" ["𐨩𐨹𐨸𐨂"])
+ ("y_=R" ["𐨩𐨹𐨸𐨃"])
+ ("y_=e" ["𐨩𐨹𐨸𐨅"])
+ ("y_=o" ["𐨩𐨹𐨸𐨆"])
+
+ ("r" ["𐨪𐨿"])
+ ("ra" ["𐨪"])
+ ("ri" ["𐨪𐨁"])
+ ("ru" ["𐨪𐨂"])
+ ("rR" ["𐨪𐨃"])
+ ("re" ["𐨪𐨅"])
+ ("ro" ["𐨪𐨆"])
+ ("r_" ["𐨪𐨹𐨿"])
+ ("r_a" ["𐨪𐨹"])
+ ("r_i" ["𐨪𐨹𐨁"])
+ ("r_u" ["𐨪𐨹𐨂"])
+ ("r_R" ["𐨪𐨹𐨃"])
+ ("r_e" ["𐨪𐨹𐨅"])
+ ("r_o" ["𐨪𐨹𐨆"])
+ ("r=" ["𐨪𐨿𐨸"])
+ ("r=a" ["𐨪𐨸"])
+ ("r=i" ["𐨪𐨸𐨁"])
+ ("r=u" ["𐨪𐨸𐨂"])
+ ("r=R" ["𐨪𐨸𐨃"])
+ ("r=e" ["𐨪𐨸𐨅"])
+ ("r=o" ["𐨪𐨸𐨆"])
+ ("r_=" ["𐨪𐨹𐨿𐨸"])
+ ("r_=a" ["𐨪𐨹𐨸"])
+ ("r_=i" ["𐨪𐨹𐨸𐨁"])
+ ("r_=u" ["𐨪𐨹𐨸𐨂"])
+ ("r_=R" ["𐨪𐨹𐨸𐨃"])
+ ("r_=e" ["𐨪𐨹𐨸𐨅"])
+ ("r_=o" ["𐨪𐨹𐨸𐨆"])
+
+ ("l" ["𐨫𐨿"])
+ ("la" ["𐨫"])
+ ("li" ["𐨫𐨁"])
+ ("lu" ["𐨫𐨂"])
+ ("lR" ["𐨫𐨃"])
+ ("le" ["𐨫𐨅"])
+ ("lo" ["𐨫𐨆"])
+ ("l_" ["𐨫𐨹𐨿"])
+ ("l_a" ["𐨫𐨹"])
+ ("l_i" ["𐨫𐨹𐨁"])
+ ("l_u" ["𐨫𐨹𐨂"])
+ ("l_R" ["𐨫𐨹𐨃"])
+ ("l_e" ["𐨫𐨹𐨅"])
+ ("l_o" ["𐨫𐨹𐨆"])
+ ("l=" ["𐨫𐨿𐨸"])
+ ("l=a" ["𐨫𐨸"])
+ ("l=i" ["𐨫𐨸𐨁"])
+ ("l=u" ["𐨫𐨸𐨂"])
+ ("l=R" ["𐨫𐨸𐨃"])
+ ("l=e" ["𐨫𐨸𐨅"])
+ ("l=o" ["𐨫𐨸𐨆"])
+ ("l_=" ["𐨫𐨹𐨿𐨸"])
+ ("l_=a" ["𐨫𐨹𐨸"])
+ ("l_=i" ["𐨫𐨹𐨸𐨁"])
+ ("l_=u" ["𐨫𐨹𐨸𐨂"])
+ ("l_=R" ["𐨫𐨹𐨸𐨃"])
+ ("l_=e" ["𐨫𐨹𐨸𐨅"])
+ ("l_=o" ["𐨫𐨹𐨸𐨆"])
+
+ ("v" ["𐨬𐨿"])
+ ("va" ["𐨬"])
+ ("vi" ["𐨬𐨁"])
+ ("vu" ["𐨬𐨂"])
+ ("vR" ["𐨬𐨃"])
+ ("ve" ["𐨬𐨅"])
+ ("vo" ["𐨬𐨆"])
+ ("v_" ["𐨬𐨹𐨿"])
+ ("v_a" ["𐨬𐨹"])
+ ("v_i" ["𐨬𐨹𐨁"])
+ ("v_u" ["𐨬𐨹𐨂"])
+ ("v_R" ["𐨬𐨹𐨃"])
+ ("v_e" ["𐨬𐨹𐨅"])
+ ("v_o" ["𐨬𐨹𐨆"])
+ ("v=" ["𐨬𐨿𐨸"])
+ ("v=a" ["𐨬𐨸"])
+ ("v=i" ["𐨬𐨸𐨁"])
+ ("v=u" ["𐨬𐨸𐨂"])
+ ("v=R" ["𐨬𐨸𐨃"])
+ ("v=e" ["𐨬𐨸𐨅"])
+ ("v=o" ["𐨬𐨸𐨆"])
+ ("v_=" ["𐨬𐨹𐨿𐨸"])
+ ("v_=a" ["𐨬𐨹𐨸"])
+ ("v_=i" ["𐨬𐨹𐨸𐨁"])
+ ("v_=u" ["𐨬𐨹𐨸𐨂"])
+ ("v_=R" ["𐨬𐨹𐨸𐨃"])
+ ("v_=e" ["𐨬𐨹𐨸𐨅"])
+ ("v_=o" ["𐨬𐨹𐨸𐨆"])
+
+ ("z" ["𐨭𐨿"])
+ ("za" ["𐨭"])
+ ("zi" ["𐨭𐨁"])
+ ("zu" ["𐨭𐨂"])
+ ("z" ["𐨭𐨃"])
+ ("ze" ["𐨭𐨅"])
+ ("zo" ["𐨭𐨆"])
+ ("z_" ["𐨭𐨹𐨿"])
+ ("z_a" ["𐨭𐨹"])
+ ("z_i" ["𐨭𐨹𐨁"])
+ ("z_u" ["𐨭𐨹𐨂"])
+ ("z_R" ["𐨭𐨹𐨃"])
+ ("z_e" ["𐨭𐨹𐨅"])
+ ("z_o" ["𐨭𐨹𐨆"])
+ ("z=" ["𐨭𐨿𐨸"])
+ ("z=a" ["𐨭𐨸"])
+ ("z=i" ["𐨭𐨸𐨁"])
+ ("z=u" ["𐨭𐨸𐨂"])
+ ("z=R" ["𐨭𐨸𐨃"])
+ ("z=e" ["𐨭𐨸𐨅"])
+ ("z=o" ["𐨭𐨸𐨆"])
+ ("z_=" ["𐨭𐨹𐨿𐨸"])
+ ("z_=a" ["𐨭𐨹𐨸"])
+ ("z_=i" ["𐨭𐨹𐨸𐨁"])
+ ("z_=u" ["𐨭𐨹𐨸𐨂"])
+ ("z_=R" ["𐨭𐨹𐨸𐨃"])
+ ("z_=e" ["𐨭𐨹𐨸𐨅"])
+ ("z_=o" ["𐨭𐨹𐨸𐨆"])
+
+ ("S" ["𐨮𐨿"])
+ ("Sa" ["𐨮"])
+ ("Si" ["𐨮𐨁"])
+ ("Su" ["𐨮𐨂"])
+ ("SR" ["𐨮𐨃"])
+ ("Se" ["𐨮𐨅"])
+ ("So" ["𐨮𐨆"])
+ ("S_" ["𐨮𐨹𐨿"])
+ ("S_a" ["𐨮𐨹"])
+ ("S_i" ["𐨮𐨹𐨁"])
+ ("S_u" ["𐨮𐨹𐨂"])
+ ("S_R" ["𐨮𐨹𐨃"])
+ ("S_e" ["𐨮𐨹𐨅"])
+ ("S_o" ["𐨮𐨹𐨆"])
+ ("S=" ["𐨮𐨿𐨸"])
+ ("S=a" ["𐨮𐨸"])
+ ("S=i" ["𐨮𐨸𐨁"])
+ ("S=u" ["𐨮𐨸𐨂"])
+ ("S=R" ["𐨮𐨸𐨃"])
+ ("S=e" ["𐨮𐨸𐨅"])
+ ("S=o" ["𐨮𐨸𐨆"])
+ ("S_=" ["𐨮𐨹𐨿𐨸"])
+ ("S_=a" ["𐨮𐨹𐨸"])
+ ("S_=i" ["𐨮𐨹𐨸𐨁"])
+ ("S_=u" ["𐨮𐨹𐨸𐨂"])
+ ("S_=R" ["𐨮𐨹𐨸𐨃"])
+ ("S_=e" ["𐨮𐨹𐨸𐨅"])
+ ("S_=o" ["𐨮𐨹𐨸𐨆"])
+
+ ("s" ["𐨯𐨿"])
+ ("sa" ["𐨯"])
+ ("si" ["𐨯𐨁"])
+ ("su" ["𐨯𐨂"])
+ ("sR" ["𐨯𐨃"])
+ ("se" ["𐨯𐨅"])
+ ("so" ["𐨯𐨆"])
+ ("s_" ["𐨯𐨹𐨿"])
+ ("s_a" ["𐨯𐨹"])
+ ("s_i" ["𐨯𐨹𐨁"])
+ ("s_u" ["𐨯𐨹𐨂"])
+ ("s_R" ["𐨯𐨹𐨃"])
+ ("s_e" ["𐨯𐨹𐨅"])
+ ("s_o" ["𐨯𐨹𐨆"])
+ ("s=" ["𐨯𐨿𐨸"])
+ ("s=a" ["𐨯𐨸"])
+ ("s=i" ["𐨯𐨸𐨁"])
+ ("s=u" ["𐨯𐨸𐨂"])
+ ("s=R" ["𐨯𐨸𐨃"])
+ ("s=e" ["𐨯𐨸𐨅"])
+ ("s=o" ["𐨯𐨸𐨆"])
+ ("s_=" ["𐨯𐨹𐨿𐨸"])
+ ("s_=a" ["𐨯𐨹𐨸"])
+ ("s_=i" ["𐨯𐨹𐨸𐨁"])
+ ("s_=u" ["𐨯𐨹𐨸𐨂"])
+ ("s_=R" ["𐨯𐨹𐨸𐨃"])
+ ("s_=e" ["𐨯𐨹𐨸𐨅"])
+ ("s_=o" ["𐨯𐨹𐨸𐨆"])
+
+ ("h" ["𐨱𐨿"])
+ ("ha" ["𐨱"])
+ ("hi" ["𐨱𐨁"])
+ ("hu" ["𐨱𐨂"])
+ ("hR" ["𐨱𐨃"])
+ ("he" ["𐨱𐨅"])
+ ("ho" ["𐨱𐨆"])
+ ("h_" ["𐨱𐨹𐨿"])
+ ("h_a" ["𐨱𐨹"])
+ ("h_i" ["𐨱𐨹𐨁"])
+ ("h_u" ["𐨱𐨹𐨂"])
+ ("h_R" ["𐨱𐨹𐨃"])
+ ("h_e" ["𐨱𐨹𐨅"])
+ ("h_o" ["𐨱𐨹𐨆"])
+ ("h=" ["𐨱𐨿𐨸"])
+ ("h=a" ["𐨱𐨸"])
+ ("h=i" ["𐨱𐨸𐨁"])
+ ("h=u" ["𐨱𐨸𐨂"])
+ ("h=R" ["𐨱𐨸𐨃"])
+ ("h=e" ["𐨱𐨸𐨅"])
+ ("h=o" ["𐨱𐨸𐨆"])
+ ("h_=" ["𐨱𐨹𐨿𐨸"])
+ ("h_=a" ["𐨱𐨹𐨸"])
+ ("h_=i" ["𐨱𐨹𐨸𐨁"])
+ ("h_=u" ["𐨱𐨹𐨸𐨂"])
+ ("h_=R" ["𐨱𐨹𐨸𐨃"])
+ ("h_=e" ["𐨱𐨹𐨸𐨅"])
+ ("h_=o" ["𐨱𐨹𐨸𐨆"])
+
+ ("k'" ["𐨲𐨿"])
+ ("k'a" ["𐨲"])
+ ("k'i" ["𐨲𐨁"])
+ ("k'u" ["𐨲𐨂"])
+ ("k'R" ["𐨲𐨃"])
+ ("k'e" ["𐨲𐨅"])
+ ("k'o" ["𐨲𐨆"])
+ ("k'_" ["𐨲𐨹𐨿"])
+ ("k'_a" ["𐨲𐨹"])
+ ("k'_i" ["𐨲𐨹𐨁"])
+ ("k'_u" ["𐨲𐨹𐨂"])
+ ("k'_R" ["𐨲𐨹𐨃"])
+ ("k'_e" ["𐨲𐨹𐨅"])
+ ("k'_o" ["𐨲𐨹𐨆"])
+ ("k'=" ["𐨲𐨿𐨸"])
+ ("k'=a" ["𐨲𐨸"])
+ ("k'=i" ["𐨲𐨸𐨁"])
+ ("k'=u" ["𐨲𐨸𐨂"])
+ ("k'=R" ["𐨲𐨸𐨃"])
+ ("k'=e" ["𐨲𐨸𐨅"])
+ ("k'=o" ["𐨲𐨸𐨆"])
+ ("k'_=" ["𐨲𐨹𐨿𐨸"])
+ ("k'_=a" ["𐨲𐨹𐨸"])
+ ("k'_=i" ["𐨲𐨹𐨸𐨁"])
+ ("k'_=u" ["𐨲𐨹𐨸𐨂"])
+ ("k'_=R" ["𐨲𐨹𐨸𐨃"])
+ ("k'_=e" ["𐨲𐨹𐨸𐨅"])
+ ("k'_=o" ["𐨲𐨹𐨸𐨆"])
+
+ ("T'" ["𐨴𐨿"])
+ ("T'a" ["𐨴"])
+ ("T'i" ["𐨴𐨁"])
+ ("T'u" ["𐨴𐨂"])
+ ("T'R" ["𐨴𐨃"])
+ ("T'e" ["𐨴𐨅"])
+ ("T'o" ["𐨴𐨆"])
+ ("T'_" ["𐨴𐨹𐨿"])
+ ("T'_a" ["𐨴𐨹"])
+ ("T'_i" ["𐨴𐨹𐨁"])
+ ("T'_u" ["𐨴𐨹𐨂"])
+ ("T'_R" ["𐨴𐨹𐨃"])
+ ("T'_e" ["𐨴𐨹𐨅"])
+ ("T'_o" ["𐨴𐨹𐨆"])
+ ("T'=" ["𐨴𐨿𐨸"])
+ ("T'=a" ["𐨴𐨸"])
+ ("T'=i" ["𐨴𐨸𐨁"])
+ ("T'=u" ["𐨴𐨸𐨂"])
+ ("T'=R" ["𐨴𐨸𐨃"])
+ ("T'=e" ["𐨴𐨸𐨅"])
+ ("T'=o" ["𐨴𐨸𐨆"])
+ ("T'_=" ["𐨴𐨹𐨿𐨸"])
+ ("T'_=a" ["𐨴𐨹𐨸"])
+ ("T'_=i" ["𐨴𐨹𐨸𐨁"])
+ ("T'_=u" ["𐨴𐨹𐨸𐨂"])
+ ("T'_=R" ["𐨴𐨹𐨸𐨃"])
+ ("T'_=e" ["𐨴𐨹𐨸𐨅"])
+ ("T'_=o" ["𐨴𐨹𐨸𐨆"])
+
+ ("Th'" ["𐨳𐨿"])
+ ("Th'a" ["𐨳"])
+ ("Th'i" ["𐨳𐨁"])
+ ("Th'u" ["𐨳𐨂"])
+ ("Th'R" ["𐨳𐨃"])
+ ("Th'e" ["𐨳𐨅"])
+ ("Th'o" ["𐨳𐨆"])
+ ("Th'_" ["𐨳𐨹𐨿"])
+ ("Th'_a" ["𐨳𐨹"])
+ ("Th'_i" ["𐨳𐨹𐨁"])
+ ("Th'_u" ["𐨳𐨹𐨂"])
+ ("Th'_R" ["𐨳𐨹𐨃"])
+ ("Th'_e" ["𐨳𐨹𐨅"])
+ ("Th'_o" ["𐨳𐨹𐨆"])
+ ("Th'=" ["𐨳𐨿𐨸"])
+ ("Th'=a" ["𐨳𐨸"])
+ ("Th'=i" ["𐨳𐨸𐨁"])
+ ("Th'=u" ["𐨳𐨸𐨂"])
+ ("Th'=R" ["𐨳𐨸𐨃"])
+ ("Th'=e" ["𐨳𐨸𐨅"])
+ ("Th'=o" ["𐨳𐨸𐨆"])
+ ("Th'_=" ["𐨳𐨹𐨿𐨸"])
+ ("Th'_=a" ["𐨳𐨹𐨸"])
+ ("Th'_=i" ["𐨳𐨹𐨸𐨁"])
+ ("Th'_=u" ["𐨳𐨹𐨸𐨂"])
+ ("Th'_=R" ["𐨳𐨹𐨸𐨃"])
+ ("Th'_=e" ["𐨳𐨹𐨸𐨅"])
+ ("Th'_=o" ["𐨳𐨹𐨸𐨆"])
+
+ ("vh" ["𐨵𐨿"])
+ ("vha" ["𐨵"])
+ ("vhi" ["𐨵𐨁"])
+ ("vhu" ["𐨵𐨂"])
+ ("vhR" ["𐨵𐨃"])
+ ("vhe" ["𐨵𐨅"])
+ ("vho" ["𐨵𐨆"])
+ ("vh_" ["𐨵𐨹𐨿"])
+ ("vh_a" ["𐨵𐨹"])
+ ("vh_i" ["𐨵𐨹𐨁"])
+ ("vh_u" ["𐨵𐨹𐨂"])
+ ("vh_R" ["𐨵𐨹𐨃"])
+ ("vh_e" ["𐨵𐨹𐨅"])
+ ("vh_o" ["𐨵𐨹𐨆"])
+ ("vh=" ["𐨵𐨿𐨸"])
+ ("vh=a" ["𐨵𐨸"])
+ ("vh=i" ["𐨵𐨸𐨁"])
+ ("vh=u" ["𐨵𐨸𐨂"])
+ ("vh=R" ["𐨵𐨸𐨃"])
+ ("vh=e" ["𐨵𐨸𐨅"])
+ ("vh=o" ["𐨵𐨸𐨆"])
+ ("vh_=" ["𐨵𐨹𐨿𐨸"])
+ ("vh_=a" ["𐨵𐨹𐨸"])
+ ("vh_=i" ["𐨵𐨹𐨸𐨁"])
+ ("vh_=u" ["𐨵𐨹𐨸𐨂"])
+ ("vh_=R" ["𐨵𐨹𐨸𐨃"])
+ ("vh_=e" ["𐨵𐨹𐨸𐨅"])
+ ("vh_=o" ["𐨵𐨹𐨸𐨆"])
+
+ ("M" ?𐨎)
+ ("H" ?𐨏)
+ ("\\" ?𐨌)
+ (";;" ?𐨍)
+
+ ("1" ?𐩀)
+ ("2" ?𐩁)
+ ("3" ?𐩂)
+ ("4" ?𐩃)
+ ("10" ?𐩄)
+ ("20" ?𐩅)
+ ("100" ?𐩆)
+ ("1000" ?𐩇)
+
+ (".." ?𐩐)
+ (".o" ?𐩑)
+ (".O" ?𐩒)
+ (".E" ?𐩓)
+ (".X" ?𐩔)
+ (".L" ?𐩕)
+ (".|" ?𐩖)
+ (".||" ?𐩗)
+ (".=" ?𐩘))
+
+(provide 'misc-lang)
+;;; misc-lang.el ends here
diff --git a/lisp/leim/quail/philippine.el b/lisp/leim/quail/philippine.el
new file mode 100644
index 00000000000..9afbdc354e3
--- /dev/null
+++ b/lisp/leim/quail/philippine.el
@@ -0,0 +1,152 @@
+;;; philippine.el --- Quail package for inputting Philippine characters -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: समीर सिंह Sameer Singh <lumarzeli30@gmail.com>
+;; Keywords: multilingual, input method, i18n, Philippines
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Input methods for Philippine languages.
+
+;;; Code:
+
+(require 'quail)
+
+;; This input method supports languages like Tagalog, Hanunoo, Buhid and
+;; Tagbanwa, using the Baybayin script.
+(quail-define-package
+ "tagalog" "Tagalog" "ᜊ" nil "Tagalog phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?₱)
+ ("w" ?ᜏ)
+ ("r" ?ᜍ)
+ ("R" ?ᜟ)
+ ("t" ?ᜆ)
+ ("y" ?ᜌ)
+ ("u" ?ᜓ)
+ ("U" ?ᜂ)
+ ("i" ?ᜒ)
+ ("I" ?ᜁ)
+ ("p" ?ᜉ)
+ ("a" ?ᜀ)
+ ("s" ?ᜐ)
+ ("d" ?ᜇ)
+ ("f" ?᜔)
+ ("g" ?ᜄ)
+ ("h" ?ᜑ)
+ ("j" ?᜵)
+ ("J" ?᜶)
+ ("k" ?ᜃ)
+ ("l" ?ᜎ)
+ ("v" ?᜕)
+ ("b" ?ᜊ)
+ ("n" ?ᜈ)
+ ("N" ?ᜅ)
+ ("m" ?ᜋ))
+
+(quail-define-package
+ "hanunoo" "Hanunoo" "ᜱ" nil "Hanunoo phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?₱)
+ ("w" ?ᜯ)
+ ("r" ?ᜭ)
+ ("t" ?ᜦ)
+ ("y" ?ᜬ)
+ ("u" ?ᜳ)
+ ("U" ?ᜢ)
+ ("i" ?ᜲ)
+ ("I" ?ᜡ)
+ ("p" ?ᜩ)
+ ("a" ?ᜠ)
+ ("s" ?ᜰ)
+ ("d" ?ᜧ)
+ ("f" ?᜴)
+ ("g" ?ᜤ)
+ ("h" ?ᜱ)
+ ("j" ?᜵)
+ ("J" ?᜶)
+ ("k" ?ᜣ)
+ ("l" ?ᜮ)
+ ("b" ?ᜪ)
+ ("n" ?ᜨ)
+ ("N" ?ᜥ)
+ ("m" ?ᜫ))
+
+(quail-define-package
+ "buhid" "Buhid" "ᝊᝓ" nil "Buhid phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?₱)
+ ("w" ?ᝏ)
+ ("r" ?ᝍ)
+ ("t" ?ᝆ)
+ ("y" ?ᝌ)
+ ("u" ?ᝓ)
+ ("U" ?ᝂ)
+ ("i" ?ᝒ)
+ ("I" ?ᝁ)
+ ("p" ?ᝉ)
+ ("a" ?ᝀ)
+ ("s" ?ᝐ)
+ ("d" ?ᝇ)
+ ("g" ?ᝄ)
+ ("h" ?ᝑ)
+ ("j" ?᜵)
+ ("J" ?᜶)
+ ("k" ?ᝃ)
+ ("l" ?ᝎ)
+ ("b" ?ᝊ)
+ ("n" ?ᝈ)
+ ("N" ?ᝅ)
+ ("m" ?ᝋ))
+
+(quail-define-package
+ "tagbanwa" "Tagbanwa" "ᝦ" nil "Tagbanwa phonetic input method."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?₱)
+ ("w" ?ᝯ)
+ ("t" ?ᝦ)
+ ("y" ?ᝬ)
+ ("u" ?ᝳ)
+ ("U" ?ᝢ)
+ ("i" ?ᝲ)
+ ("I" ?ᝡ)
+ ("p" ?ᝩ)
+ ("a" ?ᝠ)
+ ("s" ?ᝰ)
+ ("d" ?ᝧ)
+ ("g" ?ᝤ)
+ ("j" ?᜵)
+ ("J" ?᜶)
+ ("k" ?ᝣ)
+ ("l" ?ᝮ)
+ ("b" ?ᝪ)
+ ("n" ?ᝨ)
+ ("N" ?ᝥ)
+ ("m" ?ᝫ))
+
+(provide 'philippine)
+;;; philippine.el ends here
diff --git a/lisp/leim/quail/symbol-ksc.el b/lisp/leim/quail/symbol-ksc.el
index 042465697a1..d440058902a 100644
--- a/lisp/leim/quail/symbol-ksc.el
+++ b/lisp/leim/quail/symbol-ksc.el
@@ -39,7 +39,7 @@
"한글심벌입력표:
【(】괄호열기【arrow】화살【sex】♂♀【index】첨자 【accent】악센트
【)】괄호닫기【music】음악【dot】점 【quote】따옴표【xtext】§※¶¡¿
- 【Unit】℃Å¢℉【math】수학기호【pic】상형문자【line】선문자
+ 【Unit】℃Å¢℉【math】수학기호【pic】상형문자【line】선문자
【unit】단위 【frac】분수 【textline】­―∥\∼
【wn】㈜【ks】㉿【No】№【㏇】㏇ 【dag】† 【ddag】‡【percent】‰
【am】㏂【pm】㏘【™】™【Tel】℡【won】₩ 【yen】¥ 【pound】£
@@ -65,7 +65,7 @@
("dot" "·‥…¨ː")
("quote" "、。〃‘’“”°′″´˝")
("textline" "­―∥\∼")
- ("Unit" "℃Å¢℉")
+ ("Unit" "℃Å¢℉")
("sex" "♂♀")
("accent" "~ˇ˘˚˙¸˛")
("percent" "‰")
diff --git a/lisp/linum.el b/lisp/linum.el
index e121618b69f..d491da52066 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -74,6 +74,9 @@ and you have to scroll or press \\[recenter-top-bottom] to update the numbers."
;;;###autoload
(define-minor-mode linum-mode
"Toggle display of line numbers in the left margin (Linum mode).
+This mode has been largely replaced by `display-line-numbers-mode'
+(which is much faster and has fewer interaction problems with other
+modes).
Linum mode is a buffer-local minor mode."
:lighter "" ; for desktop.el
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 48058f40535..39481ab0684 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -157,38 +157,35 @@ documentation of `unload-feature' for details.")
;; mode, or proposed is not nil and not major-mode, and so we use it.
(funcall (or proposed 'fundamental-mode)))))))
+(defvar loadhist-unload-filename nil)
+
(cl-defgeneric loadhist-unload-element (x)
- "Unload an element from the `load-history'."
+ "Unload an element from the `load-history'.
+The variable `loadhist-unload-filename' holds the name of the file we're
+unloading."
(message "Unexpected element %S in load-history" x))
-;; In `load-history', the definition of a previously autoloaded
-;; function is represented by 2 entries: (t . SYMBOL) comes before
-;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when
-;; we undefine it.
-;; So we use this auxiliary variable to keep track of the last (t . SYMBOL)
-;; that occurred.
-(defvar loadhist--restore-autoload nil
- "If non-nil, is a symbol for which to try to restore a previous autoload.")
-
-(cl-defmethod loadhist-unload-element ((x (head t)))
- (setq loadhist--restore-autoload (cdr x)))
-
-(defun loadhist--unload-function (x)
- (let ((fun (cdr x)))
- (when (fboundp fun)
- (when (fboundp 'ad-unadvise)
- (ad-unadvise fun))
- (let ((aload (get fun 'autoload)))
- (defalias fun
- (if (and aload (eq fun loadhist--restore-autoload))
- (cons 'autoload aload)
- nil)))))
- (setq loadhist--restore-autoload nil))
-
(cl-defmethod loadhist-unload-element ((x (head defun)))
- (loadhist--unload-function x))
-(cl-defmethod loadhist-unload-element ((x (head autoload)))
- (loadhist--unload-function x))
+ (let* ((fun (cdr x))
+ (hist (get fun 'function-history)))
+ (cond
+ ((null hist)
+ (defalias fun nil)
+ ;; Override the change that `defalias' just recorded.
+ (put fun 'function-history nil))
+ ((equal (car hist) loadhist-unload-filename)
+ (defalias fun (cadr hist))
+ ;; Set the history afterwards, to override the change that
+ ;; `defalias' records otherwise.
+ (put fun 'function-history (cddr hist)))
+ (t
+ ;; Unloading a file whose definition is "inactive" (i.e. has been
+ ;; overridden by another file): just remove it from the history,
+ ;; so future unloading of that other file has a chance to DTRT.
+ (let* ((tmp (plist-member hist loadhist-unload-filename))
+ (pos (- (length hist) (length tmp))))
+ (cl-assert (> pos 1))
+ (setcdr (nthcdr (- pos 2) hist) (cdr tmp)))))))
(cl-defmethod loadhist-unload-element ((_ (head require))) nil)
(cl-defmethod loadhist-unload-element ((_ (head defface))) nil)
@@ -257,6 +254,7 @@ something strange, such as redefining an Emacs function."
(prin1-to-string dependents) file))))
(let* ((unload-function-defs-list (feature-symbols feature))
(file (pop unload-function-defs-list))
+ (loadhist-unload-filename file)
(name (symbol-name feature))
(unload-hook (intern-soft (concat name "-unload-hook")))
(unload-func (intern-soft (concat name "-unload-function"))))
diff --git a/lisp/loadup.el b/lisp/loadup.el
index f7b36445360..21a87dbd77b 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -128,9 +128,11 @@
(set-buffer "*scratch*")
(setq buffer-undo-list t)
+(load "emacs-lisp/debug-early")
(load "emacs-lisp/byte-run")
(load "emacs-lisp/backquote")
(load "subr")
+(load "keymap")
;; Do it after subr, since both after-load-functions and add-hook are
;; implemented in subr.el.
@@ -194,11 +196,10 @@
(setq definition-prefixes new))
(load "button") ;After loaddefs, because of define-minor-mode!
-(load "emacs-lisp/nadvice")
(load "emacs-lisp/cl-preloaded")
+(load "emacs-lisp/oclosure") ;Used by cl-generic
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
-(load "simple")
(load "help")
@@ -244,11 +245,16 @@
(load "language/khmer")
(load "language/burmese")
(load "language/cham")
+(load "language/philippine")
+(load "language/indonesian")
(load "indent")
(let ((max-specpdl-size (max max-specpdl-size 1800)))
;; A particularly demanding file to load; 1600 does not seem to be enough.
(load "emacs-lisp/cl-generic"))
+(load "simple")
+(load "emacs-lisp/seq")
+(load "emacs-lisp/nadvice")
(load "minibuffer") ;Needs cl-generic (and define-minor-mode).
(load "frame")
(load "startup")
@@ -302,6 +308,11 @@
(load "term/common-win")
(load "term/x-win")))
+(if (featurep 'haiku)
+ (progn
+ (load "term/common-win")
+ (load "term/haiku-win")))
+
(if (or (eq system-type 'windows-nt)
(featurep 'w32))
(progn
@@ -334,6 +345,11 @@
(load "international/mule-util")
(load "international/ucs-normalize")
(load "term/ns-win"))))
+(if (featurep 'pgtk)
+ (progn
+ (load "pgtk-dnd")
+ (load "term/common-win")
+ (load "term/pgtk-win")))
(if (fboundp 'x-create-frame)
;; Do it after loading term/foo-win.el since the value of the
;; mouse-wheel-*-event vars depends on those files being loaded or not.
@@ -381,6 +397,9 @@
(message "Warning: Change in load-path due to site-load will be \
lost after dumping")))
+;; Used by `kill-buffer', for instance.
+(load "emacs-lisp/rmc")
+
;; Make sure default-directory is unibyte when dumping. This is
;; because we cannot decode and encode it correctly (since the locale
;; environment is not, and should not be, set up). default-directory
@@ -559,6 +578,7 @@ lost after dumping")))
(delete-file output)))))
;; Recompute NAME now, so that it isn't set when we dump.
(if (not (or (eq system-type 'ms-dos)
+ (eq system-type 'haiku) ;; BFS doesn't support hard links
;; Don't bother adding another name if we're just
;; building bootstrap-emacs.
(member dump-mode '("pbootstrap" "bootstrap"))))
diff --git a/lisp/locate.el b/lisp/locate.el
index 95b66f275a1..20ef052184e 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -238,6 +238,8 @@ that is, with a prefix arg, you get the default behavior."
;; Functions
(defun locate-default-make-command-line (search-string)
+ (unless (executable-find locate-command)
+ (error "Can't find the %s command" locate-command))
(list locate-command search-string))
(defun locate-word-at-point ()
@@ -461,13 +463,11 @@ Specific `locate-mode' commands, such as \\[locate-find-directory],
do not work in subdirectories.
\\{locate-mode-map}"
- ;; Avoid clobbering this variable
- (make-local-variable 'dired-subdir-alist)
(setq default-directory "/"
buffer-read-only t)
(add-to-invisibility-spec '(dired . t))
(dired-alist-add-1 default-directory (point-min-marker))
- (setq-local dired-directory "/")
+ (setq dired-directory "/")
(setq-local dired-subdir-switches locate-ls-subdir-switches)
(setq dired-switches-alist nil)
;; This should support both Unix and Windoze style names
diff --git a/lisp/obsolete/longlines.el b/lisp/longlines.el
index 731f47794c9..4ad2cab2b23 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/longlines.el
@@ -6,7 +6,6 @@
;; Alex Schroeder <alex@gnu.org>
;; Chong Yidong <cyd@stupidchicken.com>
;; Maintainer: emacs-devel@gnu.org
-;; Obsolete-since: 24.4
;; Keywords: convenience, wp
;; This file is part of GNU Emacs.
@@ -73,6 +72,11 @@ You can also enable the display temporarily, using the command
This is used when `longlines-show-hard-newlines' is on."
:type 'string)
+(defcustom longlines-break-chars " ;,|"
+ "A bag of separator chars for longlines."
+ :version "29.1"
+ :type 'string)
+
;;; Internal variables
(defvar longlines-wrap-beg nil)
@@ -115,7 +119,6 @@ newlines are indicated with a symbol."
(add-to-list 'buffer-file-format 'longlines)
(add-hook 'change-major-mode-hook #'longlines-mode-off nil t)
(add-hook 'before-revert-hook #'longlines-before-revert-hook nil t)
- (make-local-variable 'buffer-substring-filters)
(make-local-variable 'longlines-auto-wrap)
(set (make-local-variable 'isearch-search-fun-function)
#'longlines-search-function)
@@ -123,7 +126,8 @@ newlines are indicated with a symbol."
#'longlines-search-forward)
(set (make-local-variable 'replace-re-search-function)
#'longlines-re-search-forward)
- (add-to-list 'buffer-substring-filters 'longlines-encode-string)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'longlines-encode-string)
(when longlines-wrap-follows-window-size
(let ((dw (if (and (integerp longlines-wrap-follows-window-size)
(>= longlines-wrap-follows-window-size 0)
@@ -140,7 +144,7 @@ newlines are indicated with a symbol."
(inhibit-modification-hooks t)
(mod (buffer-modified-p))
buffer-file-name buffer-file-truename)
- ;; Turning off undo is OK since (spaces + newlines) is
+ ;; Turning off undo is OK since (separators + newlines) is
;; conserved, except for a corner case in
;; longlines-wrap-lines that we'll never encounter from here
(save-restriction
@@ -199,7 +203,8 @@ newlines are indicated with a symbol."
(kill-local-variable 'replace-search-function)
(kill-local-variable 'replace-re-search-function)
(kill-local-variable 'require-final-newline)
- (kill-local-variable 'buffer-substring-filters)
+ (remove-function (local 'filter-buffer-substring-function)
+ #'longlines-encode-string)
(kill-local-variable 'use-hard-newlines)))
(defun longlines-mode-off ()
@@ -273,11 +278,8 @@ end of the buffer."
"If the current line needs to be wrapped, wrap it and return nil.
If wrapping is performed, point remains on the line. If the line does
not need to be wrapped, move point to the next line and return t."
- (if (longlines-set-breakpoint)
+ (if (longlines-set-breakpoint fill-column)
(progn (insert-before-markers-and-inherit ?\n)
- (backward-char 1)
- (delete-char -1)
- (forward-char 1)
nil)
(if (longlines-merge-lines-p)
(progn (end-of-line)
@@ -286,58 +288,60 @@ not need to be wrapped, move point to the next line and return t."
;; replace these two newlines by a single space. Unfortunately,
;; this breaks the conservation of (spaces + newlines), so we
;; have to fiddle with longlines-wrap-point.
- (if (or (prog1 (bolp) (forward-char 1)) (eolp))
- (progn
- (delete-char -1)
- (if (> longlines-wrap-point (point))
- (setq longlines-wrap-point
- (1- longlines-wrap-point))))
- (insert-before-markers-and-inherit ?\s)
- (backward-char 1)
- (delete-char -1)
- (forward-char 1))
+ (if (or (prog1 (bolp) (forward-char 1)) (eolp))
+ (progn
+ (delete-char -1)
+ (if (> longlines-wrap-point (point))
+ (setq longlines-wrap-point
+ (1- longlines-wrap-point))))
+ (delete-char -1))
nil)
(forward-line 1)
t)))
-(defun longlines-set-breakpoint ()
+(defun longlines-set-breakpoint (target-column)
"Place point where we should break the current line, and return t.
If the line should not be broken, return nil; point remains on the
line."
- (move-to-column fill-column)
- (if (and (re-search-forward "[^ ]" (line-end-position) 1)
- (> (current-column) fill-column))
- ;; This line is too long. Can we break it?
- (or (longlines-find-break-backward)
- (progn (move-to-column fill-column)
- (longlines-find-break-forward)))))
+ (move-to-column target-column)
+ (let ((non-break-re (format "[^%s]" longlines-break-chars)))
+ (if (and (re-search-forward non-break-re (line-end-position) t 1)
+ (> (current-column) target-column))
+ ;; This line is too long. Can we break it?
+ (or (longlines-find-break-backward)
+ (progn (move-to-column target-column)
+ (longlines-find-break-forward))))))
(defun longlines-find-break-backward ()
"Move point backward to the first available breakpoint and return t.
If no breakpoint is found, return nil."
- (and (search-backward " " (line-beginning-position) 1)
- (save-excursion
- (skip-chars-backward " " (line-beginning-position))
- (null (bolp)))
- (progn (forward-char 1)
- (if (and fill-nobreak-predicate
- (run-hook-with-args-until-success
- 'fill-nobreak-predicate))
- (progn (skip-chars-backward " " (line-beginning-position))
- (longlines-find-break-backward))
- t))))
+ (let ((break-re (format "[%s]" longlines-break-chars)))
+ (when (and (re-search-backward break-re (line-beginning-position) t 1)
+ (save-excursion
+ (skip-chars-backward longlines-break-chars
+ (line-beginning-position))
+ (null (bolp))))
+ (forward-char 1)
+ (if (and fill-nobreak-predicate
+ (run-hook-with-args-until-success 'fill-nobreak-predicate))
+ (progn
+ (skip-chars-backward longlines-break-chars
+ (line-beginning-position))
+ (longlines-find-break-backward))
+ t))))
(defun longlines-find-break-forward ()
"Move point forward to the first available breakpoint and return t.
If no break point is found, return nil."
- (and (search-forward " " (line-end-position) 1)
- (progn (skip-chars-forward " " (line-end-position))
- (null (eolp)))
- (if (and fill-nobreak-predicate
- (run-hook-with-args-until-success
- 'fill-nobreak-predicate))
- (longlines-find-break-forward)
- t)))
+ (let ((break-re (format "[%s]" longlines-break-chars)))
+ (and (re-search-forward break-re (line-end-position) t 1)
+ (progn
+ (skip-chars-forward longlines-break-chars (line-end-position))
+ (null (eolp)))
+ (if (and fill-nobreak-predicate
+ (run-hook-with-args-until-success 'fill-nobreak-predicate))
+ (longlines-find-break-forward)
+ t))))
(defun longlines-merge-lines-p ()
"Return t if part of the next line can fit onto the current line.
@@ -348,12 +352,7 @@ Otherwise, return nil. Text cannot be moved across hard newlines."
(null (get-text-property (point) 'hard))
(let ((space (- fill-column (current-column))))
(forward-line 1)
- (if (eq (char-after) ? )
- t ; We can always merge some spaces
- (<= (if (search-forward " " (line-end-position) 1)
- (current-column)
- (1+ (current-column)))
- space))))))
+ (longlines-set-breakpoint (max 0 (1- space)))))))
(defun longlines-decode-region (&optional beg end)
"Turn all newlines between BEG and END into hard newlines.
@@ -372,7 +371,7 @@ If BEG and END are nil, the point and mark are used."
(longlines-decode-region (point-min) (point-max)))
(defun longlines-encode-region (beg end &optional _buffer)
- "Replace each soft newline between BEG and END with exactly one space.
+ "Remove each soft newline between BEG and END.
Hard newlines are left intact. The optional argument BUFFER exists for
compatibility with `format-alist', and is ignored."
(save-excursion
@@ -382,23 +381,28 @@ compatibility with `format-alist', and is ignored."
(while (search-forward "\n" reg-max t)
(let ((pos (match-beginning 0)))
(unless (get-text-property pos 'hard)
- (goto-char (1+ pos))
- (insert-and-inherit " ")
- (delete-region pos (1+ pos))
- (remove-text-properties pos (1+ pos) '(hard nil)))))
+ (remove-text-properties pos (1+ pos) '(hard nil))
+ (delete-region pos (1+ pos)))))
(set-buffer-modified-p mod)
end)))
(defun longlines-encode-string (string)
- "Return a copy of STRING with each soft newline replaced by a space.
+ "Return a copy of STRING with each soft newline removed.
Hard newlines are left intact."
- (let* ((str (copy-sequence string))
- (pos (string-search "\n" str)))
- (while pos
- (if (null (get-text-property pos 'hard str))
- (aset str pos ? ))
- (setq pos (string-search "\n" str (1+ pos))))
- str))
+ (let ((start 0)
+ (result nil)
+ pos)
+ (while (setq pos (string-search "\n" string start))
+ (unless (= start pos)
+ (push (substring string start pos) result))
+ (when (get-text-property pos 'hard string)
+ (push (substring string pos (1+ pos)) result))
+ (setq start (1+ pos)))
+ (if (null result)
+ (copy-sequence string)
+ (unless (= start (length string))
+ (push (substring string start) result))
+ (apply #'concat (nreverse result)))))
;;; Auto wrap
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 01617ef912a..88b0607b119 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -125,7 +125,7 @@ and print the result."
(defcustom print-region-function
(if (memq system-type '(ms-dos windows-nt))
(progn
- (declare-function w32-direct-print-region-function "w32-fns")
+ (declare-function w32-direct-print-region-function "dos-w32")
#'w32-direct-print-region-function)
#'call-process-region)
"Function to call to print the region on a printer.
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 247b07627f3..6d1f449568a 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -337,18 +337,7 @@ are also supported; unsupported long options are silently ignored."
(ls-lisp-insert-directory
file switches (ls-lisp-time-index switches)
nil full-directory-p))
- (signal (car err) (cdr err)))))
- ;; Try to insert the amount of free space.
- (save-excursion
- (goto-char (point-min))
- ;; First find the line to put it on.
- (when (re-search-forward "^total" nil t)
- (let ((available (get-free-disk-space ".")))
- (when available
- ;; Replace "total" with "total used", to avoid confusion.
- (replace-match "total used in directory")
- (end-of-line)
- (insert " available " available)))))))))
+ (signal (car err) (cdr err)))))))))
(advice-add 'insert-directory :around #'ls-lisp--insert-directory)
(defun ls-lisp-insert-directory
@@ -632,14 +621,22 @@ in some standard C libraries does."
(sub2 (substring s2 ni2 e2))
;; "Fraction" is a numerical sequence with leading zeros.
(fr1 (string-match "\\`0+" sub1))
- (fr2 (string-match "\\`0+" sub2)))
+ (efr1 (match-end 0))
+ (fr2 (string-match "\\`0+" sub2))
+ (efr2 (match-end 0)))
(cond
- ((and fr1 fr2) ; two fractions, the shortest wins
- (setq val (- val (- (length sub1) (length sub2)))))
+ ;; Two fractions: the longer one is less than the other,
+ ;; but only if the "common prefix" is all-zeroes,
+ ;; otherwise fall back on numerical comparison.
+ ((and fr1 fr2)
+ (if (or (and (< efr1 (- e1 ni1)) (< efr2 (- e2 ni2))
+ (not (eq (aref sub1 efr1) (aref sub2 efr2))))
+ (= efr1 (- e1 ni1)) (= efr2 (- e2 ni2)))
+ (setq val (- val (- (length sub1) (length sub2))))))
(fr1 ; a fraction is always less than an integral
- (setq val (- ni1)))
+ (setq val (- 0 ni1 1))) ; make sure val is non-zero
(fr2
- (setq val ni2)))
+ (setq val (1+ ni2)))) ; make sure val is non-zero
(if (zerop val) ; fall back on numerical comparison
(setq val (- (string-to-number sub1)
(string-to-number sub2))))
@@ -795,7 +792,7 @@ SWITCHES and TIME-INDEX give the full switch list and time data."
;; In GNU ls, -h affects the size in blocks, displayed
;; by -s, as well.
(if (memq ?h switches)
- (format "%6s "
+ (format "%7s "
(file-size-human-readable
;; We use 1K as "block size", although
;; most Windows volumes use 4KB to 8KB
@@ -892,7 +889,7 @@ All ls time options, namely c, t and u, are handled."
ls-lisp-filesize-f-fmt
ls-lisp-filesize-d-fmt)
file-size)
- (format " %6s" (file-size-human-readable file-size))))
+ (format " %7s" (file-size-human-readable file-size))))
(defun ls-lisp-unload-function ()
"Unload ls-lisp library."
@@ -902,7 +899,7 @@ All ls time options, namely c, t and u, are handled."
nil)
(defun ls-lisp--sanitize-switches (switches)
- "Convert long options of GNU 'ls' to their short form.
+ "Convert long options of GNU \"ls\" to their short form.
Conversion is done only for flags supported by ls-lisp.
Long options not supported by ls-lisp are removed.
Supported options are: A a B C c F G g h i n R r S s t U u v X.
diff --git a/lisp/macros.el b/lisp/macros.el
index 4cb4e98d3fd..0baf3804332 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -46,6 +46,16 @@
" ")
?\]))
+(defun macro--string-to-vector (str)
+ "Convert an old-style string key sequence to the vector form."
+ (let ((vec (string-to-vector str)))
+ (unless (multibyte-string-p str)
+ (dotimes (i (length vec))
+ (let ((k (aref vec i)))
+ (when (> k 127)
+ (setf (aref vec i) (+ k ?\M-\C-@ -128))))))
+ vec))
+
;;;###autoload
(defun insert-kbd-macro (macroname &optional keys)
"Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
@@ -72,70 +82,36 @@ use this command, and then save the file."
(setq macroname 'last-kbd-macro definition last-kbd-macro)
(insert "(setq "))
(setq definition (symbol-function macroname))
- (insert "(fset '"))
+ ;; Prefer `defalias' over `fset' since it additionally keeps
+ ;; track of the file where the users added it, and it interacts
+ ;; better with `advice-add' (and hence things like ELP).
+ (insert "(defalias '"))
(prin1 macroname (current-buffer))
(insert "\n ")
- (if (stringp definition)
- (let ((beg (point)) end)
- (prin1 definition (current-buffer))
- (setq end (point-marker))
- (goto-char beg)
- (while (< (point) end)
- (let ((char (following-char)))
- (cond ((= char 0)
- (delete-region (point) (1+ (point)))
- (insert "\\C-@"))
- ((< char 27)
- (delete-region (point) (1+ (point)))
- (insert "\\C-" (+ 96 char)))
- ((= char ?\C-\\)
- (delete-region (point) (1+ (point)))
- (insert "\\C-\\\\"))
- ((< char 32)
- (delete-region (point) (1+ (point)))
- (insert "\\C-" (+ 64 char)))
- ((< char 127)
- (forward-char 1))
- ((= char 127)
- (delete-region (point) (1+ (point)))
- (insert "\\C-?"))
- ((= char 128)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-@"))
- ((= char (aref "\M-\C-\\" 0))
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-\\\\"))
- ((< char 155)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-" (- char 32)))
- ((< char 160)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-" (- char 64)))
- ((= char (aref "\M-\\" 0))
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\\\"))
- ((< char 255)
- (delete-region (point) (1+ (point)))
- (insert "\\M-" (- char 128)))
- ((= char 255)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-?"))))))
- (if (vectorp definition)
- (macros--insert-vector-macro definition)
- (pcase (kmacro-extract-lambda definition)
- (`(,vecdef ,counter ,format)
- (insert "(kmacro-lambda-form ")
- (macros--insert-vector-macro vecdef)
- (insert " ")
- (prin1 counter (current-buffer))
- (insert " ")
- (prin1 format (current-buffer))
- (insert ")"))
- (_ (prin1 definition (current-buffer))))))
+ (when (stringp definition)
+ (setq definition (macro--string-to-vector definition)))
+ (if (vectorp definition)
+ (setq definition (kmacro definition)))
+ (if (kmacro-p definition)
+ (let ((vecdef (kmacro--keys definition))
+ (counter (kmacro--counter definition))
+ (format (kmacro--format definition)))
+ (insert "(kmacro ")
+ (prin1 (key-description vecdef) (current-buffer))
+ ;; FIXME: Do we really want to store the counter?
+ (unless (and (equal counter 0) (equal format "%d"))
+ (insert " ")
+ (prin1 counter (current-buffer))
+ (insert " ")
+ (prin1 format (current-buffer)))
+ (insert ")"))
+ ;; FIXME: Shouldn't this signal an error?
+ (prin1 definition (current-buffer)))
(insert ")\n")
(if keys
- (let ((keys (or (where-is-internal (symbol-function macroname)
- '(keymap))
+ (let ((keys (or (and (symbol-function macroname)
+ (where-is-internal (symbol-function macroname)
+ '(keymap)))
(where-is-internal macroname '(keymap)))))
(while keys
(insert "(global-set-key ")
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 1bda609d105..d743802eade 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -1,7 +1,6 @@
;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list -*- lexical-binding: t; -*-
-;; Copyright (C) 1985, 1994, 1997-1998, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
@@ -30,6 +29,9 @@
;; to complete the process. Alternatively, compose the bug report in
;; Emacs then paste it into your normal mail client.
+;; `M-x submit-emacs-patch' can be used to send a patch to the Emacs
+;; maintainers.
+
;;; Code:
(require 'sendmail)
@@ -40,9 +42,6 @@
:group 'maint
:group 'mail)
-(define-obsolete-variable-alias 'report-emacs-bug-pretest-address
- 'report-emacs-bug-address "24.1")
-
(defcustom report-emacs-bug-no-confirmation nil
"If non-nil, suppress the confirmations asked for the sake of novice users."
:type 'boolean)
@@ -348,10 +347,10 @@ usually do not have translators for other languages.\n\n")))
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
- (define-key (current-local-map) "\C-c\C-i" #'info-emacs-bug)
+ (keymap-set (current-local-map) "C-c C-i" #'info-emacs-bug)
(if can-insert-mail
- (define-key (current-local-map) "\C-c\M-i"
- #'report-emacs-bug-insert-to-mailer))
+ (keymap-set (current-local-map) "C-c M-i"
+ #'report-emacs-bug-insert-to-mailer))
(setq report-emacs-bug-send-command (get mail-user-agent 'sendfunc)
report-emacs-bug-send-hook (get mail-user-agent 'hookvar))
(if report-emacs-bug-send-command
@@ -360,20 +359,23 @@ usually do not have translators for other languages.\n\n")))
(unless report-emacs-bug-no-explanations
(with-output-to-temp-buffer "*Bug Help*"
(princ "While in the mail buffer:\n\n")
- (if report-emacs-bug-send-command
- (princ (substitute-command-keys
- (format " Type \\[%s] to send the bug report.\n"
- report-emacs-bug-send-command))))
- (princ (substitute-command-keys
- " Type \\[kill-buffer] RET to cancel (don't send it).\n"))
- (if can-insert-mail
- (princ (substitute-command-keys
- " Type \\[report-emacs-bug-insert-to-mailer] to copy text to your preferred mail program.\n")))
- (terpri)
- (princ (substitute-command-keys
- " Type \\[info-emacs-bug] to visit in Info the Emacs Manual section
+ (let ((help
+ (substitute-command-keys
+ (format "%s%s%s%s"
+ (if report-emacs-bug-send-command
+ (format " Type \\[%s] to send the bug report.\n"
+ report-emacs-bug-send-command)
+ "")
+ " Type \\[kill-buffer] \\`RET' to cancel (don't send it).\n"
+ (if can-insert-mail
+ " Type \\[report-emacs-bug-insert-to-mailer] to \
+copy text to your preferred mail program.\n"
+ "")
+ " Type \\[info-emacs-bug] to visit in Info the Emacs Manual section
about when and how to write a bug report, and what
- information you should include to help fix the bug.")))
+ information you should include to help fix the bug."))))
+ (with-current-buffer "*Bug Help*"
+ (insert help))))
(shrink-window-if-larger-than-buffer (get-buffer-window "*Bug Help*")))
;; Make it less likely people will send empty messages.
(if report-emacs-bug-send-hook
@@ -488,15 +490,23 @@ and send the mail again%s."
Interactively, you will be prompted for SUBJECT and a patch FILE
name (which will be attached to the mail). You will end up in a
Message buffer where you can explain more about the patch."
- (interactive "sThis patch is about: \nfPatch file name: ")
+ (interactive
+ (let* ((file (read-file-name "Patch file name: "))
+ (guess (with-temp-buffer
+ (insert-file-contents file)
+ (mail-fetch-field "Subject"))))
+ (list (read-string (format-prompt "This patch is about" guess)
+ nil nil guess)
+ file)))
(switch-to-buffer "*Patch Help*")
(let ((inhibit-read-only t))
(erase-buffer)
(insert "Thank you for considering submitting a patch to the Emacs project.\n\n"
"Please describe what the patch fixes (or, if it's a new feature, what it\n"
- "implements) in the mail buffer below. When done, use the `C-c C-c' command\n"
+ "implements) in the mail buffer below. When done, use the "
+ (substitute-command-keys "\\<message-mode-map>\\[message-send-and-exit] command\n")
"to send the patch as an email to the Emacs issue tracker.\n\n"
- "If this is the first time you've submitted an Emacs patch, please\n"
+ "If this is the first time you're submitting an Emacs patch, please\n"
"read the ")
(insert-text-button
"CONTRIBUTE"
@@ -509,11 +519,13 @@ Message buffer where you can explain more about the patch."
(view-mode 1)
(button-mode 1))
(message-mail-other-window report-emacs-bug-address subject)
+ (message-goto-body)
(insert "\n\n\n")
(emacs-bug--system-description)
(mml-attach-file file "text/patch" nil "attachment")
(message-goto-body)
- (message "Write a description of the patch and use `C-c C-c' to send it")
+ (message "Write a description of the patch and use %s to send it"
+ (substitute-command-keys "\\[message-send-and-exit]"))
(add-hook 'message-send-hook
(lambda ()
(message-goto-body)
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index fe686cb6f86..af12417f706 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -1317,7 +1317,7 @@ feedmail-queue-buffer-file-name is restored to nil.
Example advice for mail-send:
- (advice-add 'mail-send :around #'my-feedmail-mail-send-advice)
+ (advice-add \\='mail-send :around #\\='my-feedmail-mail-send-advice)
(defun my-feedmail-mail-send-advice (orig-fun &rest args)
(let ((feedmail-queue-buffer-file-name buffer-file-name)
(buffer-file-name nil))
@@ -1619,7 +1619,8 @@ local gurus."
(if (null mail-interactive) '("-oem" "-odb")))))
(declare-function smtpmail-via-smtp "smtpmail"
- (recipient smtpmail-text-buffer &optional ask-for-password))
+ (recipient smtpmail-text-buffer &optional ask-for-password
+ send-attempts))
(defvar smtpmail-smtp-server)
;; provided by jam@austin.asc.slb.com (James A. McLaughlin);
@@ -1742,7 +1743,7 @@ applied to a file after you've just read it from disk: for example, a
feedmail FQM message file from a queue. You could use something like
this:
- (add-to-list 'auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))"
+ (add-to-list \\='auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))"
(feedmail-say-debug ">in-> feedmail-vm-mail-mode")
(let ((the-buf (current-buffer)))
(vm-mail)
@@ -2336,19 +2337,14 @@ mapped to mostly alphanumerics for safety."
;; from a similar function in mail-utils.el
(defun feedmail-rfc822-time-zone (time)
+ (declare (obsolete format-time-string "29.1"))
(feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time)
- (let* ((sec (or (car (current-time-zone time)) 0))
- (absmin (/ (abs sec) 60)))
- (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
+ (format-time-string "%z" time))
(defun feedmail-rfc822-date (arg-time)
(feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time)
- (let ((time (or arg-time (current-time)))
- (system-time-locale "C"))
- (concat
- (format-time-string "%a, %e %b %Y %T " time)
- (feedmail-rfc822-time-zone time)
- )))
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %e %b %Y %T %z" arg-time)))
(defun feedmail-send-it-immediately-wrapper ()
"Wrapper to catch skip-me-i."
@@ -2847,10 +2843,9 @@ probably not appropriate for you."
(if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file)
(setq date-time (file-attribute-modification-time
(file-attributes maybe-file))))
- (format "<%d-%s%s%s>"
+ (format "<%d-%s%s>"
(mod (random) 10000)
- (format-time-string "%a%d%b%Y%H%M%S" date-time)
- (feedmail-rfc822-time-zone date-time)
+ (format-time-string "%a%d%b%Y%H%M%S%z" date-time)
end-stuff))
)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 626fc1982d5..29e16c419be 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -898,7 +898,7 @@ play around with the following keys:
(make-local-variable 'footnote-end-tag)
(make-local-variable 'adaptive-fill-function)
- ;; Filladapt was an XEmacs package which is now in GNU ELPA.
+ ;; Filladapt is a GNU ELPA package.
(when (boundp 'filladapt-token-table)
;; add tokens to filladapt to match footnotes
;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index b343a017e34..8d274d9cac4 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -57,7 +57,7 @@
"The default number of bits to pay to unknown users.
If this is zero, no payment header will be generated.
See `hashcash-payment-alist'."
- :type 'integer
+ :type 'natnum
:group 'hashcash)
(defcustom hashcash-payment-alist '()
@@ -77,7 +77,7 @@ present, is the string to be hashed; if not present ADDR will be used."
(defcustom hashcash-default-accept-payment 20
"The default minimum number of bits to accept on incoming payments."
- :type 'integer
+ :type 'natnum
:group 'hashcash)
(defcustom hashcash-accept-resources `((,user-mail-address nil))
diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el
new file mode 100644
index 00000000000..ddef7f11b66
--- /dev/null
+++ b/lisp/mail/ietf-drums-date.el
@@ -0,0 +1,274 @@
+;;; ietf-drums-date.el --- parse time/date for ietf-drums.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Bob Rogers <rogers@rgrjr.com>
+;; Keywords: mail, util
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 'ietf-drums-parse-date-string' parses a time and/or date in a
+;; string and returns a list of values, just like `decode-time', where
+;; unspecified elements in the string are returned as nil (except
+;; unspecified DST is returned as -1). `encode-time' may be applied
+;; on these values to obtain an internal time value.
+
+;; Historically, `parse-time-string' was used for this purpose, but it
+;; was gradually but imperfectly extended to handle other date
+;; formats. 'ietf-drums-parse-date-string' is compatible in that it
+;; uses the same return value format and parses the same email date
+;; formats by default, but can be made stricter if desired.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'parse-time)
+
+(define-error 'date-parse-error "Date/time parse error" 'error)
+
+(defconst ietf-drums-date--slot-names
+ '(second minute hour day month year weekday dst zone)
+ "Names of return value slots, for better error messages
+See the decoded-time defstruct.")
+
+(defconst ietf-drums-date--slot-ranges
+ '((0 60) (0 59) (0 23) (1 31) (1 12) (1 9999))
+ "Numeric slot ranges, for bounds checking.
+Note that RFC5322 explicitly requires that seconds go up to 60,
+to allow for leap seconds (see Mills, D., \"Network Time
+Protocol\", STD 12, RFC 1119, September 1989).")
+
+(defsubst ietf-drums-date--ignore-char-p (char)
+ ;; Ignore whitespace and commas.
+ (memq char '(?\s ?\t ?\r ?\n ?,)))
+
+(defun ietf-drums-date--tokenize-string (string &optional comment-eof)
+ "Turn STRING into tokens, separated only by whitespace and commas.
+Multiple commas are ignored. Pure digit sequences are turned
+into integers. If COMMENT-EOF is true, then a comment as
+defined by RFC5322 (strictly, the CFWS production that also
+accepts comments) is treated as an end-of-file, and no further
+tokens are recognized, otherwise we strip out all comments and
+treat them as whitespace (per RFC822)."
+ (let ((index 0)
+ (end (length string))
+ (list ()))
+ (cl-flet ((skip-ignored ()
+ ;; Skip ignored characters at index (the scan
+ ;; position). Skip RFC822 comments in matched parens,
+ ;; but do not complain about unterminated comments.
+ (let ((char nil)
+ (nest 0))
+ (while (and (< index end)
+ (setq char (aref string index))
+ (or (> nest 0)
+ (ietf-drums-date--ignore-char-p char)
+ (and (not comment-eof) (eql char ?\())))
+ (cl-incf index)
+ ;; FWS bookkeeping.
+ (cond ((and (eq char ?\\)
+ (< (1+ index) end))
+ ;; Move to the next char but don't check
+ ;; it to see if it might be a paren.
+ (cl-incf index))
+ ((eq char ?\() (cl-incf nest))
+ ((eq char ?\)) (cl-decf nest)))))))
+ (skip-ignored) ;; Skip leading whitespace.
+ (while (and (< index end)
+ (not (and comment-eof
+ (eq (aref string index) ?\())))
+ (let* ((start index)
+ (char (aref string index))
+ (all-digits (<= ?0 char ?9)))
+ ;; char is valid; look for more valid characters.
+ (when (and (eq char ?\\)
+ (< (1+ index) end))
+ ;; Escaped character, which might be a "(". If so, we are
+ ;; correct to include it in the token, even though the
+ ;; caller is sure to barf. If not, we violate RFC2?822 by
+ ;; not removing the backslash, but no characters in valid
+ ;; RFC2?822 dates need escaping anyway, so it shouldn't
+ ;; matter that this is not done strictly correctly. --
+ ;; rgr, 24-Dec-21.
+ (cl-incf index))
+ (while (and (< (cl-incf index) end)
+ (setq char (aref string index))
+ (not (or (ietf-drums-date--ignore-char-p char)
+ (eq char ?\())))
+ (unless (<= ?0 char ?9)
+ (setq all-digits nil))
+ (when (and (eq char ?\\)
+ (< (1+ index) end))
+ ;; Escaped character, see above.
+ (cl-incf index)))
+ (push (if all-digits
+ (cl-parse-integer string :start start :end index)
+ (substring string start index))
+ list)
+ (skip-ignored)))
+ (nreverse list))))
+
+(defun ietf-drums-parse-date-string (time-string &optional error no-822)
+ "Parse an RFC5322 or RFC822 date, passed as TIME-STRING.
+The optional ERROR parameter causes syntax errors to be flagged
+by signalling an instance of the date-parse-error condition. The
+optional NO-822 parameter disables the more lax RFC822 syntax,
+which is permitted by default.
+
+The result is a list of (SEC MIN HOUR DAY MON YEAR DOW DST TZ),
+which can be accessed as a decoded-time defstruct (q.v.),
+e.g. `decoded-time-year' to extract the year, and turned into an
+Emacs timestamp by `encode-time'.
+
+The strict syntax for RFC5322 is as follows:
+
+ [ day-of-week \",\" ] day FWS month-name FWS year FWS time [CFWS]
+
+where the \"time\" production is:
+
+ 2DIGIT \":\" 2DIGIT [ \":\" 2DIGIT ] FWS ( \"+\" / \"-\" ) 4DIGIT
+
+and FWS is \"folding white space,\" and CFWS is \"comments and/or
+folding white space\", where comments are included in nesting
+parentheses and are equivalent to white space. RFC822 also
+accepts comments in random places (all of which is handled by
+ietf-drums-date--tokenize-string) and two-digit years. For
+two-digit years, 50 and up are interpreted as 1950 through 1999
+and 00 through 49 as 200 through 2049.
+
+We are somewhat more lax in what we accept (specifically, the
+hours don't have to be two digits, and the TZ and the comma after
+the DOW are optional), but we do insist that the items that are
+present do appear in this order. Unspecified/unrecognized
+elements in the string are returned as nil (except unspecified
+DST is returned as -1)."
+ (let ((tokens (ietf-drums-date--tokenize-string (downcase time-string)
+ no-822))
+ (time (list nil nil nil nil nil nil nil -1 nil)))
+ (cl-labels ((set-matched-slot (slot index token)
+ ;; Assign a slot value from match data if index is
+ ;; non-nil, else from token, signalling an error if
+ ;; enabled and it's out of range.
+ (let ((value (if index
+ (cl-parse-integer (match-string index token))
+ token)))
+ (when error
+ (let ((range (nth slot ietf-drums-date--slot-ranges)))
+ (when (and range
+ (not (<= (car range) value (cadr range))))
+ (signal 'date-parse-error
+ (list "Slot out of range"
+ (nth slot ietf-drums-date--slot-names)
+ token (car range) (cadr range))))))
+ (setf (nth slot time) value)))
+ (set-numeric (slot token)
+ ;; Only assign the slot if the token is a number.
+ (cond ((natnump token)
+ (set-matched-slot slot nil token))
+ (error
+ (signal 'date-parse-error
+ (list "Not a number"
+ (nth slot ietf-drums-date--slot-names)
+ token))))))
+ ;; Check for weekday.
+ (let ((dow (assoc (car tokens) parse-time-weekdays)))
+ (when dow
+ ;; Day of the week.
+ (set-matched-slot 6 nil (cdr dow))
+ (pop tokens)))
+ ;; Day.
+ (set-numeric 3 (pop tokens))
+ ;; Alphabetic month.
+ (let* ((month (pop tokens))
+ (match (assoc month parse-time-months)))
+ (cond (match
+ (set-matched-slot 4 nil (cdr match)))
+ (error
+ (signal 'date-parse-error
+ (list "Expected an alphabetic month" month)))
+ (t
+ (push month tokens))))
+ ;; Year.
+ (let ((year (pop tokens)))
+ ;; Check the year for the right number of digits.
+ (cond ((not (natnump year))
+ (when error
+ (signal 'date-parse-error
+ (list "Expected a year" year)))
+ (push year tokens))
+ ((>= year 1000)
+ (set-numeric 5 year))
+ ((or no-822
+ (>= year 100))
+ (when error
+ (signal 'date-parse-error
+ (list "Four-digit years are required" year)))
+ (push year tokens))
+ ((>= year 50)
+ ;; second half of the 20th century.
+ (set-numeric 5 (+ 1900 year)))
+ (t
+ ;; first half of the 21st century.
+ (set-numeric 5 (+ 2000 year)))))
+ ;; Time.
+ (let ((time (pop tokens)))
+ (cond ((or (null time) (natnump time))
+ (when error
+ (signal 'date-parse-error
+ (list "Expected a time" time)))
+ (push time tokens))
+ ((string-match
+ "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$"
+ time)
+ (set-matched-slot 2 1 time)
+ (set-matched-slot 1 2 time)
+ (set-matched-slot 0 3 time))
+ ((string-match "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\)$" time)
+ ;; Time without seconds.
+ (set-matched-slot 2 1 time)
+ (set-matched-slot 1 2 time)
+ (set-matched-slot 0 nil 0))
+ (error
+ (signal 'date-parse-error
+ (list "Expected a time" time)))))
+ ;; Timezone.
+ (let* ((zone (pop tokens))
+ (match (assoc zone parse-time-zoneinfo)))
+ (cond (match
+ (set-matched-slot 8 nil (cadr match))
+ (set-matched-slot 7 nil (caddr match)))
+ ((and (stringp zone)
+ (string-match "^[-+][0-9][0-9][0-9][0-9]$" zone))
+ ;; Numeric time zone.
+ (set-matched-slot
+ 8 nil
+ (* 60
+ (+ (cl-parse-integer zone :start 3 :end 5)
+ (* 60 (cl-parse-integer zone :start 1 :end 3)))
+ (if (= (aref zone 0) ?-) -1 1))))
+ ((and zone error)
+ (signal 'date-parse-error
+ (list "Expected a timezone" zone)))))
+ (when (and tokens error)
+ (signal 'date-parse-error
+ (list "Extra token(s)" (car tokens)))))
+ time))
+
+(provide 'ietf-drums-date)
+
+;;; ietf-drums-date.el ends here
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 51c3e63e044..d1ad671b160 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -25,16 +25,6 @@
;; library is based on draft-ietf-drums-msg-fmt-05.txt, released on
;; 1998-08-05.
-;; Pending a real regression self test suite, Simon Josefsson added
-;; various self test expressions snipped from bug reports, and their
-;; expected value, below. I you believe it could be useful, please
-;; add your own test cases, or write a real self test suite, or just
-;; remove this.
-
-;; <m3oekvfd50.fsf@whitebox.m5r.de>
-;; (ietf-drums-parse-address "'foo' <foo@example.com>")
-;; => ("foo@example.com" . "'foo'")
-
;;; Code:
(eval-when-compile (require 'cl-lib))
@@ -75,6 +65,21 @@ backslash and doublequote.")
(modify-syntax-entry ?\' "_" table)
table))
+(defvar ietf-drums-comment-syntax-table
+ (let ((table (copy-syntax-table ietf-drums-syntax-table)))
+ (modify-syntax-entry ?\" "w" table)
+ table)
+ "In comments, DQUOTE is normal and does not start a string.")
+
+(defun ietf-drums--skip-comment ()
+ ;; From just before the start of a comment, go to the end. Returns
+ ;; point. If the comment is unterminated, go to point-max.
+ (condition-case ()
+ (with-syntax-table ietf-drums-comment-syntax-table
+ (forward-sexp 1))
+ (scan-error (goto-char (point-max))))
+ (point))
+
(defun ietf-drums-token-to-list (token)
"Translate TOKEN into a list of characters."
(let ((i 0)
@@ -119,14 +124,7 @@ backslash and doublequote.")
(forward-sexp 1)
(error (goto-char (point-max)))))
((eq c ?\()
- (delete-region
- (point)
- (condition-case nil
- (with-syntax-table (copy-syntax-table ietf-drums-syntax-table)
- (modify-syntax-entry ?\" "w")
- (forward-sexp 1)
- (point))
- (error (point-max)))))
+ (delete-region (point) (ietf-drums--skip-comment)))
(t
(forward-char 1))))
(buffer-string))))
@@ -140,9 +138,11 @@ backslash and doublequote.")
(setq c (char-after))
(cond
((eq c ?\")
- (forward-sexp 1))
+ (condition-case ()
+ (forward-sexp 1)
+ (scan-error (goto-char (point-max)))))
((eq c ?\()
- (forward-sexp 1))
+ (ietf-drums--skip-comment))
((memq c '(?\ ?\t ?\n ?\r))
(delete-char 1))
(t
@@ -191,6 +191,8 @@ the Content-Transfer-Encoding header of a mail."
"Parse STRING and return a MAILBOX / DISPLAY-NAME pair.
If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(that's the \"=?utf...q...=?\") stuff."
+ (when decode
+ (require 'rfc2047))
(with-temp-buffer
(let (display-name mailbox c display-string)
(ietf-drums-init string)
@@ -240,7 +242,7 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(cons
(mapconcat #'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
- (cons mailbox (if decode
+ (cons mailbox (if (and decode display-string)
(rfc2047-decode-string display-string)
display-string))))))
@@ -292,9 +294,13 @@ a list of address strings."
(replace-match " " t t))
(goto-char (point-min)))
+(declare-function ietf-drums-parse-date-string "ietf-drums-date"
+ (time-string &optional error? no-822?))
+
(defun ietf-drums-parse-date (string)
"Return an Emacs time spec from STRING."
- (encode-time (parse-time-string string)))
+ (require 'ietf-drums-date)
+ (encode-time (ietf-drums-parse-date-string string)))
(defun ietf-drums-narrow-to-header ()
"Narrow to the header section in the current buffer."
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 50ba04ccc1e..25ce4ea9025 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,7 +1,6 @@
;;; mail-extr.el --- extract full name and address from email header -*- lexical-binding: t; -*-
-;; Copyright (C) 1991-1994, 1997, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@cs.bu.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -240,8 +239,7 @@ we will act as though we couldn't find a full name in the address."
;; Matches a leading title that is not part of the name (does not
;; contribute to uniquely identifying the person).
(defcustom mail-extr-full-name-prefixes
- (purecopy
- "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
+ "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]"
"Matches prefixes to the full name that identify a person's position.
These are stripped from the full name because they do not contribute to
uniquely identifying the person."
@@ -279,45 +277,42 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Yes, there are weird people with digits in their names.
;; You will also notice the consideration for the
;; Swedish/Finnish/Norwegian character set.
-(defconst mail-extr-all-letters-but-separators
- (purecopy "][[:alnum:]{|}'~`"))
+(defconst mail-extr-all-letters-but-separators "][[:alnum:]{|}'~`")
;; Any character that can occur in a name in an RFC 822 (or later)
;; address including the separator (hyphen and possibly period) for
;; multipart names.
;; #### should . be in here?
(defconst mail-extr-all-letters
- (purecopy (concat mail-extr-all-letters-but-separators "-")))
+ (concat mail-extr-all-letters-but-separators "-"))
;; Any character that can start a name.
;; Keep this set as minimal as possible.
-(defconst mail-extr-first-letters (purecopy "[:alpha:]"))
+(defconst mail-extr-first-letters "[:alpha:]")
;; Any character that can end a name.
;; Keep this set as minimal as possible.
-(defconst mail-extr-last-letters (purecopy "[:alpha:]`'."))
+(defconst mail-extr-last-letters "[:alpha:]`'.")
(defconst mail-extr-leading-garbage "\\W+")
;; (defconst mail-extr-non-begin-name-chars
-;; (purecopy (concat "^" mail-extr-first-letters)))
+;; (concat "^" mail-extr-first-letters))
;; (defconst mail-extr-non-end-name-chars
-;; (purecopy (concat "^" mail-extr-last-letters)))
+;; (concat "^" mail-extr-last-letters))
;; Matches periods used instead of spaces. Must not match the period
;; following an initial.
(defconst mail-extr-bad-dot-pattern
- (purecopy
- (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
- mail-extr-all-letters
- mail-extr-last-letters
- mail-extr-first-letters)))
+ (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
+ mail-extr-all-letters
+ mail-extr-last-letters
+ mail-extr-first-letters))
;; Matches an embedded or leading nickname that should be removed.
;; (defconst mail-extr-nickname-pattern
-;; (purecopy
-;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] "
-;; mail-extr-all-letters)))
+;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] "
+;; mail-extr-all-letters))
;; Matches the occurrence of a generational name suffix, and the last
;; character of the preceding name. This is important because we want to
@@ -325,59 +320,56 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; *** Perhaps this should be a user-customizable variable. However, the
;; *** regular expression is fairly tricky to alter, so maybe not.
(defconst mail-extr-full-name-suffix-pattern
- (purecopy
- (format
- "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
- mail-extr-all-letters mail-extr-all-letters)))
+ (format
+ "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
+ mail-extr-all-letters mail-extr-all-letters))
-(defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b"))
+(defconst mail-extr-roman-numeral-pattern "V?I+V?\\b")
;; Matches a trailing uppercase (with other characters possible) acronym.
;; Must not match a trailing uppercase last name or trailing initial
(defconst mail-extr-weird-acronym-pattern
- (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)"))
+ "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)")
;; Matches a mixed-case or lowercase name (not an initial).
;; #### Match Latin1 lower case letters here too?
;; (defconst mail-extr-mixed-case-name-pattern
-;; (purecopy
-;; (format
-;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
-;; mail-extr-all-letters mail-extr-last-letters
-;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
-;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters)))
+;; (format
+;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
+;; mail-extr-all-letters mail-extr-last-letters
+;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
+;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters))
;; Matches a trailing alternative address.
;; #### Match Latin1 letters here too?
;; #### Match _ before @ here too?
(defconst mail-extr-alternative-address-pattern
- (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
+ "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]")
;; Matches a variety of trailing comments not including comma-delimited
;; comments.
(defconst mail-extr-trailing-comment-start-pattern
- (purecopy " [-{]\\|--\\|[+@#></;]"))
+ " [-{]\\|--\\|[+@#></;]")
;; Matches a name (not an initial).
;; This doesn't force a word boundary at the end because sometimes a
;; comment is separated by a `-' with no preceding space.
(defconst mail-extr-name-pattern
- (purecopy (format "\\b[%s][%s]*[%s]"
- mail-extr-first-letters
- mail-extr-all-letters
- mail-extr-last-letters)))
+ (format "\\b[%s][%s]*[%s]"
+ mail-extr-first-letters
+ mail-extr-all-letters
+ mail-extr-last-letters))
(defconst mail-extr-initial-pattern
- (purecopy (format "\\b[%s]\\([. ]\\|\\b\\)" mail-extr-first-letters)))
+ (format "\\b[%s]\\([. ]\\|\\b\\)" mail-extr-first-letters))
;; Matches a single name before a comma.
;; (defconst mail-extr-last-name-first-pattern
-;; (purecopy (concat "\\`" mail-extr-name-pattern ",")))
+;; (concat "\\`" mail-extr-name-pattern ","))
;; Matches telephone extensions.
(defconst mail-extr-telephone-extension-pattern
- (purecopy
- "\\(\\([Ee]xt\\|[Tt]ph\\|[Tt]el\\|[Xx]\\)\\.?\\)? *\\+?[0-9][- 0-9]+"))
+ "\\(\\([Ee]xt\\|[Tt]ph\\|[Tt]el\\|[Xx]\\)\\.?\\)? *\\+?[0-9][- 0-9]+")
;; Matches ham radio call signs.
;; Help from: Mat Maessen N2NJZ <maessm@rpi.edu>, Mark Feit
@@ -386,7 +378,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH
;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO
(defconst mail-extr-ham-call-sign-pattern
- (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)"))
+ "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)")
;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?"
;; /KT == Temporary Technician (has CSC but not "real" license)
@@ -400,31 +392,29 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Matches normal single-part name
(defconst mail-extr-normal-name-pattern
- (purecopy (format "\\b[%s][%s]+[%s]"
- mail-extr-first-letters
- mail-extr-all-letters-but-separators
- mail-extr-last-letters)))
+ (format "\\b[%s][%s]+[%s]"
+ mail-extr-first-letters
+ mail-extr-all-letters-but-separators
+ mail-extr-last-letters))
;; Matches a single word name.
;; (defconst mail-extr-one-name-pattern
-;; (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))
+;; (concat "\\`" mail-extr-normal-name-pattern "\\'"))
;; Matches normal two names with missing middle initial
;; The first name is not allowed to have a hyphen because this can cause
;; false matches where the "middle initial" is actually the first letter
;; of the second part of the first name.
(defconst mail-extr-two-name-pattern
- (purecopy
- (concat "\\`\\(" mail-extr-normal-name-pattern
- "\\|" mail-extr-initial-pattern
- "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)")))
+ (concat "\\`\\(" mail-extr-normal-name-pattern
+ "\\|" mail-extr-initial-pattern
+ "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)"))
(defconst mail-extr-listserv-list-name-pattern
- (purecopy "Multiple recipients of list \\([-A-Z]+\\)"))
+ "Multiple recipients of list \\([-A-Z]+\\)")
(defconst mail-extr-stupid-vms-date-stamp-pattern
- (purecopy
- "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *"))
+ "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *")
;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol
;;
@@ -443,25 +433,23 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}'
;; ($7E7D) is outside the defined GB range.)
(defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern
- (purecopy "~{\\([^~].\\|~[^}]\\)+~}"))
+ "~{\\([^~].\\|~[^}]\\)+~}")
;; The leading optional lowercase letters are for a bastardized version of
;; the encoding, as is the optional nature of the final slash.
(defconst mail-extr-x400-encoded-address-pattern
- (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'"))
+ "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'")
(defconst mail-extr-x400-encoded-address-field-pattern-format
- (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)"))
+ "/%s=\\([^/]+\\)\\(/\\|\\'\\)")
(defconst mail-extr-x400-encoded-address-surname-pattern
;; S stands for Surname (family name).
- (purecopy
- (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]")))
+ (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]"))
(defconst mail-extr-x400-encoded-address-given-name-pattern
;; G stands for Given name.
- (purecopy
- (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]")))
+ (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]"))
(defconst mail-extr-x400-encoded-address-full-name-pattern
;; PN stands for Personal Name. When used it represents the combination
@@ -469,8 +457,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; "The one system I used having this field asked it with the prompt
;; `Personal Name'. But they mapped it into G and S on outgoing real
;; X.400 addresses. As they mapped G and S into PN on incoming..."
- (purecopy
- (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]")))
+ (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]"))
@@ -716,7 +703,6 @@ to the results."
value-list)
(with-current-buffer (get-buffer-create extraction-buffer)
- (fundamental-mode)
(buffer-disable-undo extraction-buffer)
(set-syntax-table mail-extr-address-syntax-table)
(widen)
@@ -738,7 +724,6 @@ to the results."
(set-text-properties (point-min) (point-max) nil)
(with-current-buffer (get-buffer-create canonicalization-buffer)
- (fundamental-mode)
(buffer-disable-undo canonicalization-buffer)
(setq case-fold-search nil))
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index e02d4218dd2..a13f9de1740 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -80,7 +80,7 @@ previous/next input.")
(defcustom mail-hist-history-size (or kill-ring-max 1729)
"The maximum number of elements in a mail field's history.
Oldest elements are dumped first."
- :type 'integer)
+ :type 'natnum)
;;;###autoload
(defcustom mail-hist-keep-history t
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index 23894e59b77..ec719850e2e 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -76,7 +76,8 @@
The return value is a list with mail/name pairs."
(delq nil
(mapcar (lambda (elem)
- (or (mail-header-parse-address elem)
+ (or (ignore-errors
+ (mail-header-parse-address elem))
(mail-header-parse-address-lax elem)))
(mail-header-parse-addresses string t))))
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 9711dc7db12..63752f953a7 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -59,7 +59,7 @@ also the To field, unless this would leave an empty To field."
(defun mail-string-delete (string start end)
"Return a string containing all of STRING except the part
from START (inclusive) to END (exclusive)."
- ;; FIXME: This is not used anywhere. Make obsolete?
+ (declare (obsolete substring "29.1"))
(if (null end) (substring string 0 start)
(concat (substring string 0 start)
(substring string end nil))))
@@ -239,12 +239,8 @@ comma-separated list, and return the pruned list."
;; Or just set the default directly in the defcustom.
(if (null mail-dont-reply-to-names)
(setq mail-dont-reply-to-names
- ;; `rmail-default-dont-reply-to-names' is obsolete.
- (let ((a (bound-and-true-p rmail-default-dont-reply-to-names))
- (b (if (> (length user-mail-address) 0)
- (concat "\\`" (regexp-quote user-mail-address) "\\'"))))
- (cond ((and a b) (concat a "\\|" b))
- ((or a b))))))
+ (if (> (length user-mail-address) 0)
+ (concat "\\`" (regexp-quote user-mail-address) "\\'"))))
;; Split up DESTINATIONS and match each element separately.
(let ((start-pos 0) (cur-pos 0)
(case-fold-search t))
@@ -281,9 +277,6 @@ comma-separated list, and return the pruned list."
(substring destinations (match-end 0))
destinations))
-;; Legacy name
-(define-obsolete-function-alias 'rmail-dont-reply-to #'mail-dont-reply-to "24.1")
-
;;;###autoload
(defun mail-fetch-field (field-name &optional last all list delete)
@@ -368,19 +361,12 @@ matches may be returned from the message body."
labels)
(defun mail-rfc822-time-zone (time)
- (let* ((sec (or (car (current-time-zone time)) 0))
- (absmin (/ (abs sec) 60)))
- (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
+ (declare (obsolete format-time-string "29.1"))
+ (format-time-string "%z" time))
(defun mail-rfc822-date ()
- (let* ((time (current-time))
- (s (current-time-string time)))
- (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s)
- (concat (substring s (match-beginning 2) (match-end 2)) " "
- (substring s (match-beginning 1) (match-end 1)) " "
- (substring s (match-beginning 4) (match-end 4)) " "
- (substring s (match-beginning 3) (match-end 3)) " "
- (mail-rfc822-time-zone time))))
+ (let ((system-time-locale "C"))
+ (format-time-string "%-d %b %Y %T %z")))
(defun mail-mbox-from ()
"Return an mbox \"From \" line for the current message.
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index ba7cf58d383..57fb1117b60 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -72,11 +72,10 @@ When t this still needs to be initialized.")
)
"Alist of header field and expression to return alist for completion.
The expression may reference the variable `pattern'
-which will hold the string being completed.
-If not on matching header, `mail-complete-function' gets called instead."
+which will hold the string being completed."
:type 'alist
+ :risky t
:group 'mailalias)
-(put 'mail-complete-alist 'risky-local-variable t)
;;;###autoload
(defcustom mail-complete-style 'angles
@@ -90,13 +89,6 @@ If `angles', they look like:
:type '(choice (const angles) (const parens) (const nil))
:group 'mailalias)
-(defcustom mail-complete-function 'ispell-complete-word
- "Function to call when completing outside `mail-complete-alist'-header."
- :type '(choice function (const nil))
- :group 'mailalias)
-(make-obsolete-variable 'mail-complete-function
- 'completion-at-point-functions "24.1")
-
(defcustom mail-directory-function nil
"Function to get completions from directory service or nil for none.
See `mail-directory-requery'."
@@ -129,8 +121,8 @@ or like this:
(remote-shell-program \"HOST\" \"-n\" \"COMMAND \\='^\" pattern \"\\='\")"
:type 'sexp
+ :risky t
:group 'mailalias)
-(put 'mail-directory-process 'risky-local-variable t)
(defcustom mail-directory-stream nil
"List of (HOST SERVICE) for stream connection to mail directory."
@@ -140,8 +132,8 @@ or like this:
(string :tag "Service name"))
(plist :inline t
:tag "Additional open-network-stream parameters")))
+ :risky t
:group 'mailalias)
-(put 'mail-directory-stream 'risky-local-variable t)
(defcustom mail-directory-parser nil
"How to interpret the output of `mail-directory-function'.
@@ -151,8 +143,8 @@ Three types of values are possible:
- regexp means first \\(grouping\\) in successive matches is name
- function called at beginning of buffer that returns an alist of names"
:type '(choice (const nil) regexp function)
+ :risky t
:group 'mailalias)
-(put 'mail-directory-parser 'risky-local-variable t)
;; Internal variables.
@@ -433,25 +425,6 @@ For use on `completion-at-point-functions'."
(let ((pattern prefix)) (eval list-exp))))))
(list beg end table)))))
-;;;###autoload
-(defun mail-complete (arg)
- "Perform completion on header field or word preceding point.
-Completable headers are according to `mail-complete-alist'. If none matches
-current header, calls `mail-complete-function' and passes prefix ARG if any."
- (declare (obsolete mail-completion-at-point-function "24.1"))
- (interactive "P")
- ;; Read the defaults first, if we have not done so.
- (sendmail-sync-aliases)
- (if (eq mail-aliases t)
- (progn
- (setq mail-aliases nil)
- (if (file-exists-p mail-personal-alias-file)
- (build-mail-aliases))))
- (let ((data (mail-completion-at-point-function)))
- (if data
- (apply #'completion-in-region data)
- (funcall mail-complete-function arg))))
-
(defun mail-completion-expand (table)
"Build new completion table that expands aliases.
Completes like TABLE except that if the completion is a valid alias,
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index b3c45100f6d..bb0d646346c 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -46,7 +46,7 @@
("Followup-To" . nil)
("Message-ID" . nil)
("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\
-\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
+\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\|Disposition-Notification-To\\)" . address-mime)
(t . mime))
"Header/encoding method alist.
The list is traversed sequentially. The keys can either be
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 49eaeb560e0..71eda7cd2b0 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -41,8 +41,6 @@
(require 'rfc2047)
(require 'auth-source)
-(require 'rmail-loaddefs)
-
(declare-function compilation--message->loc "compile" (cl-x) t)
(declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset))
@@ -317,20 +315,6 @@ Setting this variable has an effect only before reading a mail."
:version "21.1")
;;;###autoload
-(define-obsolete-variable-alias 'rmail-dont-reply-to-names
- 'mail-dont-reply-to-names "24.1")
-
-;; Prior to 24.1, this used to contain "\\`info-".
-;;;###autoload
-(defvar rmail-default-dont-reply-to-names nil
- "Regexp specifying part of the default value of `mail-dont-reply-to-names'.
-This is used when the user does not set `mail-dont-reply-to-names'
-explicitly.")
-;;;###autoload
-(make-obsolete-variable 'rmail-default-dont-reply-to-names
- 'mail-dont-reply-to-names "24.1")
-
-;;;###autoload
(defcustom rmail-ignored-headers
(purecopy
(concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:"
@@ -390,7 +374,7 @@ If nil, display all header fields except those matched by
;;;###autoload
(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:")
"Headers that should be stripped when retrying a failed message."
- :type '(choice regexp (const nil :tag "None"))
+ :type '(choice regexp (const :value nil :tag "None"))
:group 'rmail-headers
:version "23.2") ; added x-detected-operating-system, x-spam
@@ -464,8 +448,8 @@ as argument, to ask the user that question."
(const :tag "Confirm with y-or-n-p" y-or-n-p)
(const :tag "Confirm with yes-or-no-p" yes-or-no-p))
:version "21.1"
+ :risky t
:group 'rmail-files)
-(put 'rmail-confirm-expunge 'risky-local-variable t)
;;;###autoload
(defvar rmail-mode-hook nil
@@ -539,7 +523,7 @@ Examples:
;; Note: this is matched with case-fold-search bound to t.
(defcustom rmail-re-abbrevs
"\\(RE\\|رد\\|回复\\|回覆\\|SV\\|Antw\\|VS\\|REF\\|AW\\|ΑΠ\\|ΣΧΕΤ\\|השב\\|Vá\\|R\\|RIF\\|BLS\\|RES\\|Odp\\|YNT\\|ATB\\)"
- "Regexp with localized 'Re:' abbreviations in various languages."
+ "Regexp with localized \"Re:\" abbreviations in various languages."
:version "28.1"
:type 'regexp)
@@ -1467,7 +1451,6 @@ If so restore the actual mbox message collection."
(setq-local font-lock-defaults
'(rmail-font-lock-keywords
t t nil nil
- (font-lock-maximum-size . nil)
(font-lock-dont-widen . t)
(font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
(setq-local require-final-newline nil)
@@ -4125,10 +4108,8 @@ typically for purposes of moderating a list."
"A regexp that matches the separator before the text of a failed message.")
(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"
- "A regexp that matches the header of a MIME body part with a failed message.")
+ "A regexp that matches the header of a MIME body part with a failed message.")
-;; This is a cut-down version of rmail-clear-headers from Emacs 22.
-;; It doesn't have the same functionality, hence the name change.
(defun rmail-delete-headers (regexp)
"Delete any mail headers matching REGEXP.
The message should be narrowed to just the headers."
@@ -4136,10 +4117,6 @@ The message should be narrowed to just the headers."
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(beginning-of-line)
- ;; This code from Emacs 22 doesn't seem right, since r-n-h is
- ;; just for display.
-;;; (if (looking-at rmail-nonignored-headers)
-;;; (forward-line 1)
(delete-region (point)
(save-excursion
(if (re-search-forward "\n[^ \t]" nil t)
@@ -4497,10 +4474,7 @@ password."
:max 1 :user user :host host
:require '(:secret)))))
(if found
- (let ((secret (plist-get found :secret)))
- (if (functionp secret)
- (funcall secret)
- secret))
+ (auth-info-password found)
(read-passwd (if imap
"IMAP password: "
"POP password: "))))))
@@ -4603,8 +4577,6 @@ Argument MIME is non-nil if this is a mime message."
armor-end-regexp
(buffer-substring armor-start (- (point-max) after-end)))))
-(declare-function rmail-mime-entity-truncated "rmailmm" (entity))
-
;; Should this have a key-binding, or be in a menu?
;; There doesn't really seem to be an appropriate menu.
;; Eg the edit command is not in a menu either.
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index d6eee405dd1..79bd02fd67e 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -484,8 +484,4 @@ HEADER-DIFF should be a return value from `rmail-edit-diff-headers'."
(provide 'rmailedit)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailedit.el ends here
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index f2b80b689f1..6535d68456b 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -74,12 +74,9 @@ according to the choice made, and returns a symbol."
(rmail-summary-exists)
(and (setq old (rmail-get-keywords))
(mapc #'rmail-make-label (split-string old ", "))))
- (completing-read (concat prompt
- (if rmail-last-label
- (concat " (default "
- (symbol-name rmail-last-label)
- "): ")
- ": "))
+ (completing-read (format-prompt prompt
+ (and rmail-last-label
+ (symbol-name rmail-last-label)))
rmail-label-obarray
nil
nil))))
@@ -191,8 +188,4 @@ With prefix argument N moves forward N messages with these labels."
(provide 'rmailkwd)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailkwd.el ends here
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 0d0e83f2a58..79f421bdcd6 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -254,7 +254,7 @@ TRUNCATED is non-nil if the text of this entity was truncated."))
(unless (y-or-n-p "This entity is truncated; save anyway? ")
(error "Aborted")))
(setq filename (expand-file-name
- (read-file-name (format "Save as (default: %s): " filename)
+ (read-file-name (format-prompt "Save as" filename)
directory
(expand-file-name filename directory))
directory))
@@ -796,17 +796,14 @@ directly."
((string-match "text/" content-type)
(setq type 'text))
((string-match "image/\\(.*\\)" content-type)
- (setq type (image-type-from-file-name
+ (setq type (image-supported-file-p
(concat "." (match-string 1 content-type))))
- (if (and (boundp 'image-types)
- (memq type image-types)
- (image-type-available-p type))
- (if (and rmail-mime-show-images
- (not (eq rmail-mime-show-images 'button))
- (or (not (numberp rmail-mime-show-images))
- (< size rmail-mime-show-images)))
- (setq to-show t))
- (setq type nil))))
+ (when (and type
+ rmail-mime-show-images
+ (not (eq rmail-mime-show-images 'button))
+ (or (not (numberp rmail-mime-show-images))
+ (< size rmail-mime-show-images)))
+ (setq to-show t))))
(setcar bulk-data size)
(setcdr bulk-data type)
to-show))
@@ -1569,8 +1566,4 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'."
(provide 'rmailmm)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailmm.el ends here
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index 26bf651f22d..93463af46cf 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -54,8 +54,4 @@ This applies only to the current session."
(setq rmail-inbox-list inbox-list)))
(rmail-show-message-1 rmail-current-message))
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailmsc.el ends here
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 0d996e65403..c1371308d4f 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -107,9 +107,8 @@ error: %S\n"
(read-file
(expand-file-name
(read-file-name
- (concat "Output message to mail file (default "
- (file-name-nondirectory default-file)
- "): ")
+ (format-prompt "Output message to mail file"
+ (file-name-nondirectory default-file))
(file-name-directory default-file)
(abbreviate-file-name default-file))
(file-name-directory default-file))))
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index d6fe312efe3..c203cf858e5 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -250,8 +250,4 @@ Numeric keys are sorted numerically, all others as strings."
(provide 'rmailsort)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailsort.el ends here
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 54dce3c4673..b23fbc3f600 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1475,18 +1475,16 @@ argument says to read a file name and use that file as the inbox."
(forward-line -1))
(declare-function rmail-abort-edit "rmailedit" ())
-(declare-function rmail-cease-edit "rmailedit"())
+(declare-function rmail-cease-edit "rmailedit" (&optional abort))
(declare-function rmail-set-label "rmailkwd" (l state &optional n))
(declare-function rmail-output-read-file-name "rmailout" ())
(declare-function mail-send-and-exit "sendmail" (&optional arg))
-(defvar rmail-summary-edit-map nil)
-(if rmail-summary-edit-map
- nil
- (setq rmail-summary-edit-map
- (nconc (make-sparse-keymap) text-mode-map))
- (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit)
- (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit))
+(defvar rmail-summary-edit-map
+ (let ((map (nconc (make-sparse-keymap) text-mode-map)))
+ (define-key map "\C-c\C-c" #'rmail-cease-edit)
+ (define-key map "\C-c\C-]" #'rmail-abort-edit)
+ map))
(defun rmail-summary-edit-current-message ()
"Edit the contents of this message."
@@ -1879,8 +1877,4 @@ the summary is only showing a subset of messages."
(provide 'rmailsum)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailsum.el ends here
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index ccb112cda6f..8cb079f7fbe 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -372,8 +372,8 @@ and should insert whatever you want to insert."
:type '(choice (const :tag "None" nil)
(const :tag "Use `.signature' file" t)
(string :tag "String to insert")
- (sexp :tag "Expression to evaluate")))
-(put 'mail-signature 'risky-local-variable t)
+ (sexp :tag "Expression to evaluate"))
+ :risky t)
;;;###autoload
(defcustom mail-signature-file (purecopy "~/.signature")
@@ -430,20 +430,6 @@ support Delivery Status Notification."
(const :tag "Success" success)))
:version "22.1")
-;; Note: could use /usr/ucb/mail instead of sendmail;
-;; options -t, and -v if not interactive.
-(defvar mail-mailer-swallows-blank-line nil
- "Set this non-nil if the system's mailer runs the header and body together.
-The actual value should be an expression to evaluate that returns
-non-nil if the problem will actually occur.
-\(As far as we know, this is not an issue on any system still supported
-by Emacs.)")
-
-(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled
-(make-obsolete-variable 'mail-mailer-swallows-blank-line
- "no need to set this on any modern system."
- "24.1" 'set)
-
(defvar mail-mode-syntax-table
;; define-derived-mode will make it inherit from text-mode-syntax-table.
(let ((st (make-syntax-table)))
@@ -877,7 +863,7 @@ The variable is used to trigger insertion of the \"Mail-Followup-To\"
header when sending a message to a mailing list."
:type '(repeat string))
-(declare-function mml-to-mime "mml" ())
+(declare-function mm-long-lines-p "mm-bodies" (length))
(defun mail-send ()
"Send the message in the current buffer.
@@ -955,7 +941,11 @@ the user from the mailer."
(error "Invalid header line (maybe a continuation line lacks initial whitespace)"))
(forward-line 1)))
(goto-char opoint)
- (when mail-encode-mml
+ (require 'mml)
+ (when (or mail-encode-mml
+ ;; When we have long lines, we have to MIME encode
+ ;; to get line folding.
+ (mm-long-lines-p 1000))
(mml-to-mime)
(setq mail-encode-mml nil))
(run-hooks 'mail-send-hook)
@@ -1305,8 +1295,6 @@ external program defined by `sendmail-program'."
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (if (eval mail-mailer-swallows-blank-line)
- (newline))
;; Find and handle any Fcc fields.
(goto-char (point-min))
(if (re-search-forward "^Fcc:" delimline t)
@@ -1391,8 +1379,7 @@ just append to the file, in Babyl format if necessary."
(unless (markerp header-end)
(error "Value of `header-end' must be a marker"))
(let (fcc-list
- (mailbuf (current-buffer))
- (time (current-time)))
+ (mailbuf (current-buffer)))
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t))
@@ -1408,14 +1395,11 @@ just append to the file, in Babyl format if necessary."
(with-temp-buffer
;; This initial newline is not written out if we create a new
;; file (see below).
- (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n")
- ;; Insert the time zone before the year.
- (forward-char -1)
- (forward-word-strictly -1)
(require 'mail-utils)
- (insert (mail-rfc822-time-zone time) " ")
- (goto-char (point-max))
- (insert "Date: " (message-make-date) "\n")
+ (insert "\nFrom " (user-login-name) " "
+ (let ((system-time-locale "C"))
+ (format-time-string "%a %b %e %T %z %Y"))
+ "\nDate: " (message-make-date) "\n")
(insert-buffer-substring mailbuf)
;; Make sure messages are separated.
(goto-char (point-max))
@@ -1495,28 +1479,6 @@ just append to the file, in Babyl format if necessary."
(with-current-buffer buffer
(set-visited-file-modtime)))))))))
-(defun mail-sent-via ()
- "Make a Sent-via header line from each To or Cc header line."
- (declare (obsolete "nobody can remember what it is for." "24.1"))
- (interactive)
- (save-excursion
- ;; put a marker at the end of the header
- (let ((end (copy-marker (mail-header-end)))
- (case-fold-search t))
- (goto-char (point-min))
- ;; search for the To: lines and make Sent-via: lines from them
- ;; search for the next To: line
- (while (re-search-forward "^\\(to\\|cc\\):" end t)
- ;; Grab this line plus all its continuations, sans the `to:'.
- (let ((to-line
- (buffer-substring (point)
- (progn
- (if (re-search-forward "^[^ \t\n]" end t)
- (backward-char 1)
- (goto-char end))
- (point)))))
- ;; Insert a copy, with altered header field name.
- (insert-before-markers "Sent-via:" to-line))))))
(defun mail-to ()
"Move point to end of To field, creating it if necessary."
@@ -1839,8 +1801,6 @@ If the current line has `mail-yank-prefix', insert it on the new line."
(or (bolp) (newline))
(goto-char start))))
-(define-obsolete-function-alias 'mail-attach-file #'mail-insert-file "24.1")
-
(declare-function mml-attach-file "mml"
(file &optional type description disposition))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 8ac0cd7e7c0..8cba2b14e14 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -171,7 +171,7 @@ attempt."
"The number of times smtpmail will retry sending when getting transient errors.
These are errors with a code of 4xx from the SMTP server, which
mean \"try again\"."
- :type 'integer
+ :type 'natnum
:version "27.1")
(defcustom smtpmail-store-queue-variables nil
@@ -342,8 +342,6 @@ for `smtpmail-try-auth-method'.")
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (if (eval mail-mailer-swallows-blank-line t)
- (newline))
;; Find and handle any Fcc fields.
(goto-char (point-min))
(if (re-search-forward "^Fcc:" delimline t)
@@ -554,11 +552,9 @@ for `smtpmail-try-auth-method'.")
:create ask-for-password)))
(mech (or (plist-get auth-info :smtp-auth) (car mechs)))
(user (plist-get auth-info :user))
- (password (plist-get auth-info :secret))
+ (password (auth-info-password auth-info))
(save-function (and ask-for-password
(plist-get auth-info :save-function))))
- (when (functionp password)
- (setq password (funcall password)))
(when (and user
(not password))
;; The user has stored the user name, but not the password, so
@@ -573,9 +569,7 @@ for `smtpmail-try-auth-method'.")
:user smtpmail-smtp-user
:require '(:user :secret)
:create t))
- password (plist-get auth-info :secret)))
- (when (functionp password)
- (setq password (funcall password)))
+ password (auth-info-password auth-info)))
(let ((result (catch 'done
(if (and mech user password)
(smtpmail-try-auth-method process mech user password)
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index b56ceed2cc0..f320246f2de 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -146,8 +146,8 @@ a variable whose value is a citation frame."
:type '(repeat (list symbol (repeat (cons regexp
(choice (repeat (repeat sexp))
symbol)))))
+ :risky t
:group 'supercite-frames)
-(put 'sc-cite-frame-alist 'risky-local-variable t)
(defcustom sc-uncite-frame-alist '()
"Alist for frame selection during unciting.
@@ -155,8 +155,8 @@ See the variable `sc-cite-frame-alist' for details."
:type '(repeat (list symbol (repeat (cons regexp
(choice (repeat (repeat sexp))
symbol)))))
+ :risky t
:group 'supercite-frames)
-(put 'sc-uncite-frame-alist 'risky-local-variable t)
(defcustom sc-recite-frame-alist '()
"Alist for frame selection during reciting.
@@ -164,8 +164,8 @@ See the variable `sc-cite-frame-alist' for details."
:type '(repeat (list symbol (repeat (cons regexp
(choice (repeat (repeat sexp))
symbol)))))
+ :risky t
:group 'supercite-frames)
-(put 'sc-recite-frame-alist 'risky-local-variable t)
(defcustom sc-default-cite-frame
'(;; initialize fill state and temporary variables when entering
@@ -211,8 +211,8 @@ See the variable `sc-cite-frame-alist' for details."
(end (sc-fill-if-different "")))
"Default REGI frame for citing a region."
:type '(repeat (repeat sexp))
+ :risky t
:group 'supercite-frames)
-(put 'sc-default-cite-frame 'risky-local-variable t)
(defcustom sc-default-uncite-frame
'(;; do nothing on a blank line
@@ -221,8 +221,8 @@ See the variable `sc-cite-frame-alist' for details."
((sc-cite-regexp) (sc-uncite-line)))
"Default REGI frame for unciting a region."
:type '(repeat (repeat sexp))
+ :risky t
:group 'supercite-frames)
-(put 'sc-default-uncite-frame 'risky-local-variable t)
(defcustom sc-default-recite-frame
'(;; initialize fill state when entering frame
@@ -237,8 +237,8 @@ See the variable `sc-cite-frame-alist' for details."
(end (sc-fill-if-different "")))
"Default REGI frame for reciting a region."
:type '(repeat (repeat sexp))
+ :risky t
:group 'supercite-frames)
-(put 'sc-default-recite-frame 'risky-local-variable t)
(defcustom sc-cite-region-limit t
"This variable controls automatic citation of yanked text.
@@ -428,8 +428,8 @@ to be consulted during attribution selection."
(repeat (cons regexp
(choice (sexp :tag "List to eval")
string)))))
+ :risky t
:group 'supercite-attr)
-(put 'sc-attrib-selection-list 'risky-local-variable t)
(defcustom sc-attribs-preselect-hook nil
"Hook to run before selecting an attribution."
@@ -483,8 +483,8 @@ The variable `sc-preferred-header-style' controls which function in
this list is chosen for automatic reference header insertions.
Electric reference mode will cycle through this list of functions."
:type '(repeat sexp)
+ :risky t
:group 'supercite)
-(put 'sc-rewrite-header-list 'risky-local-variable t)
(defcustom sc-titlecue-regexp "\\s +-+\\s +"
"Regular expression describing the separator between names and titles.
@@ -1767,7 +1767,7 @@ is determined non-interactively. The value is queried for in the
minibuffer exactly the same way that `set-variable' does it.
You can see the current value of the variable when the minibuffer is
-querying you by typing `C-h'. Note that the format is changed
+querying you by typing \\`C-h'. Note that the format is changed
slightly from that used by `set-variable' -- the current value is
printed just after the variable's name instead of at the bottom of the
help window."
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 03e77a83ce3..cdb1bec4788 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -41,7 +41,8 @@ You may need to customize it for local needs."
(defconst rmail-digest-methods
- '(rmail-digest-parse-mime
+ '(rmail-digest-parse-mixed-mime
+ rmail-digest-parse-mime
rmail-digest-parse-rfc1153strict
rmail-digest-parse-rfc1153sloppy
rmail-digest-parse-rfc934)
@@ -52,6 +53,53 @@ A function returns nil if it cannot parse the digest. If it can, it
returns a list of cons pairs containing the start and end positions of
each undigestified message as markers.")
+(defun rmail-content-type-boundary (type)
+ "If Content-type is of type TYPE, return its boundary; otherwise, return nil."
+ (goto-char (point-min))
+ (let ((head-end (save-excursion (search-forward "\n\n" nil t) (point))))
+ (when (re-search-forward
+ (concat "^Content-type: " type ";"
+ "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]")
+ head-end t)
+ (match-string 1))))
+
+(defun rmail-digest-parse-mixed-mime ()
+ "Like `rmail-digest-parse-mime', but for multipart/mixed messages."
+ (when-let ((boundary (rmail-content-type-boundary "multipart/mixed")))
+ (let ((global-sep (concat "\n--" boundary))
+ (digest (concat "^Content-type: multipart/digest;"
+ "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]"))
+ result)
+ (search-forward global-sep nil t)
+ (while (not (or result (eobp)))
+ ;; For each part, see if it is a multipart/digest.
+ (let* ((limit (save-excursion (search-forward global-sep nil 'move)
+ (point)))
+ (beg (and (re-search-forward digest limit t)
+ (match-beginning 0)))
+ digest-sep)
+ (when (and beg
+ (setq digest-sep (concat "\n--" (match-string 1)))
+ ;; Search for 1st sep.
+ (search-forward digest-sep nil t))
+ ;; Skip body part headers.
+ (search-forward "\n\n" nil t)
+ ;; Push the 1st message.
+ (push (cons (copy-marker beg) (copy-marker (point-marker) t))
+ result)
+ ;; Push the rest of the messages.
+ (let ((start (make-marker))
+ done)
+ (while (and (search-forward digest-sep limit 'move) (not done))
+ (move-marker start (match-beginning 0))
+ (and (looking-at "--$") (setq done t))
+ (search-forward "\n\n")
+ (push (cons (copy-marker start)
+ (copy-marker (point-marker) t))
+ result))))
+ (goto-char limit)))
+ (nreverse result))))
+
(defun rmail-digest-parse-mime ()
(goto-char (point-min))
(when (let ((head-end (progn (search-forward "\n\n" nil t) (point))))
@@ -330,8 +378,4 @@ forwarded with `rmail-enable-mime-composing' set to nil."
(provide 'undigest)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; undigest.el ends here
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index 8ce5afa9622..9e7194e4a02 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -208,7 +208,7 @@ The variable `unrmail-mbox-format' controls which mbox format to use."
(setq mail-from (or (let ((from (mail-fetch-field "Mail-From")))
;; mail-mbox-from (below) returns a
;; string that ends in a newline, but
- ;; but mail-fetch-field does not, so
+ ;; mail-fetch-field does not, so
;; we append a newline here.
(if from
(format "%s\n" from)))
diff --git a/lisp/man.el b/lisp/man.el
index a5ff2371494..951e0ef9add 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1334,7 +1334,7 @@ default type, `Man-xref-man-page' is used for the buttons."
(defun Man-highlight-references0 (start-section regexp button-pos target type)
;; Based on `Man-build-references-alist'
- (when (or (null start-section) ;; Search regardless of sections.
+ (when (or (null start-section) ;; Search regardless of sections.
;; Section header is in this chunk.
(Man-find-section start-section))
(let ((end (if start-section
@@ -1347,18 +1347,24 @@ default type, `Man-xref-man-page' is used for the buttons."
(goto-char (point-min))
nil)))
(while (re-search-forward regexp end t)
- ;; An overlay button is preferable because the underlying text
- ;; may have text property highlights (Bug#7881).
- (make-button
- (match-beginning button-pos)
- (match-end button-pos)
- 'type type
- 'Man-target-string (cond
- ((numberp target)
- (match-string target))
- ((functionp target)
- target)
- (t nil)))))))
+ (let ((b (match-beginning button-pos))
+ (e (match-end button-pos))
+ (match (match-string button-pos)))
+ ;; Some lists of references end with ", and ...". Chop the
+ ;; "and" bit off before making a button.
+ (when (string-match "\\`and +" match)
+ (setq b (+ b (- (match-end 0) (match-beginning 0)))))
+ ;; An overlay button is preferable because the underlying text
+ ;; may have text property highlights (Bug#7881).
+ (make-button
+ b e
+ 'type type
+ 'Man-target-string (cond
+ ((numberp target)
+ (match-string target))
+ ((functionp target)
+ target)
+ (t nil))))))))
(defun Man-cleanup-manpage (&optional interactive)
"Remove overstriking and underlining from the current buffer.
@@ -1786,7 +1792,7 @@ Returns t if section is found, nil otherwise."
Man--last-section
(car Man--sections)))
(completion-ignore-case t)
- (prompt (concat "Go to section (default " default "): "))
+ (prompt (format-prompt "Go to section" default))
(chosen (completing-read prompt Man--sections
nil nil nil nil default)))
(list chosen))
@@ -1850,7 +1856,7 @@ Specify which REFERENCE to use; default is based on word at point."
(defaults
(mapcar 'substring-no-properties
(cons default Man--refpages)))
- (prompt (concat "Refer to (default " default "): "))
+ (prompt (format-prompt "Refer to" default))
(chosen (completing-read prompt Man--refpages
nil nil nil nil defaults)))
chosen)))
@@ -1970,6 +1976,34 @@ Uses `Man-name-local-regexp'."
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))
+(put 'Man-bookmark-jump 'bookmark-handler-type "Man")
+
+;;; Mouse support
+(defun Man-at-mouse (e)
+ "Open man manual at point."
+ (interactive "e")
+ (save-excursion
+ (mouse-set-point e)
+ (man (Man-default-man-entry))))
+
+;;;###autoload
+(defun Man-context-menu (menu click)
+ "Populate MENU with commands that open a man page at point."
+ (save-excursion
+ (mouse-set-point click)
+ (when (save-excursion
+ (skip-syntax-backward "^ ")
+ (and (looking-at
+ "[[:space:]]*\\([[:alnum:]_-]+([[:alnum:]]+)\\)")
+ (match-string 1)))
+ (define-key-after menu [man-separator] menu-bar-separator
+ 'middle-separator)
+ (define-key-after menu [man-at-mouse]
+ '(menu-item "Open man page" Man-at-mouse
+ :help "Open man page around mouse click")
+ 'man-separator)))
+ menu)
+
;; Init the man package variables, if not already done.
(Man-init-defvars)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 849d400be6f..12a0b4d328f 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -96,18 +96,28 @@
(bindings--define-key menu [separator-print]
menu-bar-separator)
- (unless (featurep 'ns)
- (bindings--define-key menu [close-tab]
- '(menu-item "Close Tab" tab-close
- :visible (fboundp 'tab-close)
- :help "Close currently selected tab"))
- (bindings--define-key menu [make-tab]
- '(menu-item "New Tab" tab-new
- :visible (fboundp 'tab-new)
- :help "Open a new tab"))
-
- (bindings--define-key menu [separator-tab]
- menu-bar-separator))
+ (bindings--define-key menu [close-tab]
+ '(menu-item "Close Tab" tab-close
+ :visible (fboundp 'tab-close)
+ :help "Close currently selected tab"))
+ (bindings--define-key menu [make-tab]
+ '(menu-item "New Tab" tab-new
+ :visible (fboundp 'tab-new)
+ :help "Open a new tab"))
+
+ (bindings--define-key menu [separator-tab]
+ menu-bar-separator)
+
+ (bindings--define-key menu [undelete-frame-mode]
+ '(menu-item "Allow Undeleting Frames" undelete-frame-mode
+ :help "Allow frames to be restored after deletion"
+ :button (:toggle . undelete-frame-mode)))
+
+ (bindings--define-key menu [undelete-last-deleted-frame]
+ '(menu-item "Undelete Frame" undelete-frame
+ :enable (and undelete-frame-mode
+ (car undelete-frame--deleted-frames))
+ :help "Undelete the most recently deleted frame"))
;; Don't use delete-frame as event name because that is a special
;; event.
@@ -121,9 +131,9 @@
:visible (fboundp 'make-frame-on-monitor)
:help "Open a new frame on another monitor"))
(bindings--define-key menu [make-frame-on-display]
- '(menu-item "New Frame on Display..." make-frame-on-display
+ '(menu-item "New Frame on Display Server..." make-frame-on-display
:visible (fboundp 'make-frame-on-display)
- :help "Open a new frame on another display"))
+ :help "Open a new frame on a display server"))
(bindings--define-key menu [make-frame]
'(menu-item "New Frame" make-frame-command
:visible (fboundp 'make-frame-command)
@@ -168,17 +178,23 @@
t))
:help "Recover edits from a crashed session"))
(bindings--define-key menu [revert-buffer]
- '(menu-item "Revert Buffer" revert-buffer
- :enable (or (not (eq revert-buffer-function
- 'revert-buffer--default))
- (not (eq
- revert-buffer-insert-file-contents-function
- 'revert-buffer-insert-file-contents--default-function))
- (and buffer-file-number
- (or (buffer-modified-p)
- (not (verify-visited-file-modtime
- (current-buffer))))))
- :help "Re-read current buffer from its file"))
+ '(menu-item
+ "Revert Buffer" revert-buffer
+ :enable
+ (or (not (eq revert-buffer-function
+ 'revert-buffer--default))
+ (not (eq
+ revert-buffer-insert-file-contents-function
+ 'revert-buffer-insert-file-contents--default-function))
+ (and buffer-file-number
+ (or (buffer-modified-p)
+ (not (verify-visited-file-modtime
+ (current-buffer)))
+ ;; Enable if the buffer has a different
+ ;; writeability than the file.
+ (not (eq (not buffer-read-only)
+ (file-writable-p buffer-file-name))))))
+ :help "Re-read current buffer from its file"))
(bindings--define-key menu [write-file]
'(menu-item "Save As..." write-file
:enable (and (menu-bar-menu-frame-live-and-visible-p)
@@ -295,7 +311,7 @@
(isearch-update-ring string t)
(re-search-backward string)))
-;; The Edit->Search->Incremental Search menu
+;; The Edit->Incremental Search menu
(defvar menu-bar-i-search-menu
(let ((menu (make-sparse-keymap "Incremental Search")))
(bindings--define-key menu [isearch-forward-symbol-at-point]
@@ -323,12 +339,6 @@
(defvar menu-bar-search-menu
(let ((menu (make-sparse-keymap "Search")))
-
- (bindings--define-key menu [i-search]
- `(menu-item "Incremental Search" ,menu-bar-i-search-menu))
- (bindings--define-key menu [separator-tag-isearch]
- menu-bar-separator)
-
(bindings--define-key menu [tags-continue]
'(menu-item "Continue Tags Search" fileloop-continue
:enable (and (featurep 'fileloop)
@@ -413,8 +423,14 @@
(bindings--define-key menu [separator-tag-file]
'(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p)))
+ (bindings--define-key menu [xref-forward]
+ '(menu-item "Forward" xref-go-forward
+ :visible (and (featurep 'xref)
+ (not (xref-forward-history-empty-p)))
+ :help "Forward to the position gone Back from"))
+
(bindings--define-key menu [xref-pop]
- '(menu-item "Back" xref-pop-marker-stack
+ '(menu-item "Back" xref-go-back
:visible (and (featurep 'xref)
(not (xref-marker-stack-empty-p)))
:help "Back to the position of the last search"))
@@ -479,6 +495,9 @@
(bindings--define-key menu [replace]
`(menu-item "Replace" ,menu-bar-replace-menu))
+ (bindings--define-key menu [i-search]
+ `(menu-item "Incremental Search" ,menu-bar-i-search-menu))
+
(bindings--define-key menu [search]
`(menu-item "Search" ,menu-bar-search-menu))
@@ -514,7 +533,11 @@
(cdr yank-menu)
kill-ring))
(not buffer-read-only))))
- :help "Paste (yank) text most recently cut/copied"))
+ :help "Paste (yank) text most recently cut/copied"
+ :keys ,(lambda ()
+ (if cua-mode
+ "\\[cua-paste]"
+ "\\[yank]"))))
(bindings--define-key menu [copy]
;; ns-win.el said: Substitute a Copy function that works better
;; under X (for GNUstep).
@@ -523,14 +546,23 @@
'kill-ring-save)
:enable mark-active
:help "Copy text in region between mark and current position"
- :keys ,(if (featurep 'ns)
- "\\[ns-copy-including-secondary]"
- "\\[kill-ring-save]")))
+ :keys ,(lambda ()
+ (cond
+ ((featurep 'ns)
+ "\\[ns-copy-including-secondary]")
+ ((and cua-mode mark-active)
+ "\\[cua-copy-handler]")
+ (t
+ "\\[kill-ring-save]")))))
(bindings--define-key menu [cut]
- '(menu-item "Cut" kill-region
+ `(menu-item "Cut" kill-region
:enable (and mark-active (not buffer-read-only))
:help
- "Cut (kill) text in region between mark and current position"))
+ "Cut (kill) text in region between mark and current position"
+ :keys ,(lambda ()
+ (if (and cua-mode mark-active)
+ "\\[cua-cut-handler]"
+ "\\[kill-region]"))))
;; ns-win.el said: Separate undo from cut/paste section.
(if (featurep 'ns)
(bindings--define-key menu [separator-undo] menu-bar-separator))
@@ -552,9 +584,6 @@
menu))
-(define-obsolete-function-alias
- 'menu-bar-kill-ring-save 'kill-ring-save "24.1")
-
;; These are alternative definitions for the cut, paste and copy
;; menu items. Use them if your system expects these to use the clipboard.
@@ -571,7 +600,8 @@
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
(let ((select-enable-clipboard t)
- ;; Ensure that we defeat the DWIM login in `gui-selection-value'.
+ ;; Ensure that we defeat the DWIM logic in `gui-selection-value'
+ ;; (i.e., that gui--clipboard-selection-unchanged-p returns nil).
(gui--last-selected-text-clipboard nil))
(yank)))
@@ -716,7 +746,11 @@ by \"Save Options\" in Custom buffers.")
;; interactively, because the purpose is to mark the variable as a
;; candidate for `Save Options', and we do not want to save options that
;; the user has already set explicitly in the init file.
- (when interactively (customize-mark-as-set ',variable)))
+ (when interactively
+ (customize-mark-as-set ',variable))
+ ;; Toggle menu items must make sure that the menu is updated so
+ ;; that toggle marks are drawn in the right state.
+ (force-mode-line-update t))
'(menu-item ,item-name ,command :help ,help
:button (:toggle . (and (default-boundp ',variable)
(default-value ',variable)))
@@ -759,6 +793,7 @@ The selected font will be the default on both the existing and future frames."
(dolist (elt '(scroll-bar-mode
debug-on-quit debug-on-error
;; Somehow this works, when tool-bar and menu-bar don't.
+ desktop-save-mode
tooltip-mode window-divider-mode
save-place-mode uniquify-buffer-name-style fringe-mode
indicate-empty-lines indicate-buffer-boundaries
@@ -1328,14 +1363,13 @@ mail status in mode line"))
(frame-parameter (menu-bar-frame-for-menubar)
'menu-bar-lines)))))
- (unless (featurep 'ns)
- (bindings--define-key menu [showhide-tab-bar]
- '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame
- :help "Turn tab bar on/off"
- :button
- (:toggle . (menu-bar-positive-p
- (frame-parameter (menu-bar-frame-for-menubar)
- 'tab-bar-lines))))))
+ (bindings--define-key menu [showhide-tab-bar]
+ '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame
+ :help "Turn tab bar on/off"
+ :button
+ (:toggle . (menu-bar-positive-p
+ (frame-parameter (menu-bar-frame-for-menubar)
+ 'tab-bar-lines)))))
(if (and (boundp 'menu-bar-showhide-tool-bar-menu)
(keymapp menu-bar-showhide-tool-bar-menu))
@@ -1918,10 +1952,7 @@ key, a click, or a menu-item"))
(let* ((default (thing-at-point 'sexp))
(topic
(read-from-minibuffer
- (format "Subject to look up%s: "
- (if default
- (format " (default \"%s\")" default)
- ""))
+ (format-prompt "Subject to look up" default)
nil nil nil nil default)))
(list (if (zerop (length topic))
default
@@ -2160,9 +2191,15 @@ otherwise it could decide to silently do nothing."
(defcustom yank-menu-length 20
"Text of items in `yank-menu' longer than this will be truncated."
- :type 'integer
+ :type 'natnum
:group 'menu)
+(defcustom yank-menu-max-items 60
+ "Maximum number of entries to display in the `yank-menu'."
+ :type 'natnum
+ :group 'menu
+ :version "29.1")
+
(defun menu-bar-update-yank-menu (string old)
(let ((front (car (cdr yank-menu)))
(menu-string (if (<= (length string) yank-menu-length)
@@ -2186,8 +2223,9 @@ otherwise it could decide to silently do nothing."
(cons
(cons string (cons menu-string 'menu-bar-select-yank))
(cdr yank-menu)))))
- (if (> (length (cdr yank-menu)) kill-ring-max)
- (setcdr (nthcdr kill-ring-max yank-menu) nil)))
+ (let ((max-items (min yank-menu-max-items kill-ring-max)))
+ (if (> (length (cdr yank-menu)) max-items)
+ (setcdr (nthcdr max-items yank-menu) nil))))
(put 'menu-bar-select-yank 'apropos-inhibit t)
(defun menu-bar-select-yank ()
@@ -2284,8 +2322,29 @@ Buffers menu is regenerated."
(cdr elt)))
buf)))
-;; Used to cache the menu entries for commands in the Buffers menu
-(defvar menu-bar-buffers-menu-command-entries nil)
+(defvar menu-bar-buffers-menu-command-entries
+ (list '(command-separator "--")
+ (list 'next-buffer
+ 'menu-item
+ "Next Buffer"
+ 'next-buffer
+ :help "Switch to the \"next\" buffer in a cyclic order")
+ (list 'previous-buffer
+ 'menu-item
+ "Previous Buffer"
+ 'previous-buffer
+ :help "Switch to the \"previous\" buffer in a cyclic order")
+ (list 'select-named-buffer
+ 'menu-item
+ "Select Named Buffer..."
+ 'switch-to-buffer
+ :help "Prompt for a buffer name, and select that buffer in the current window")
+ (list 'list-all-buffers
+ 'menu-item
+ "List All Buffers"
+ 'list-buffers
+ :help "Pop up a window listing all Emacs buffers"))
+ "Entries to be included at the end of the \"Buffers\" menu.")
(defvar menu-bar-select-buffer-function 'switch-to-buffer
"Function to select the buffer chosen from the `Buffers' menu-bar menu.
@@ -2310,9 +2369,13 @@ It must accept a buffer as its only required argument.")
(and (lookup-key (current-global-map) [menu-bar buffer])
(or force (frame-or-buffer-changed-p))
(let ((buffers (buffer-list))
- (frames (frame-list))
- buffers-menu)
-
+ frames buffers-menu)
+ ;; Ignore the initial frame if present. It can happen if
+ ;; Emacs was started as a daemon. (bug#53740)
+ (dolist (frame (frame-list))
+ (unless (equal (terminal-name (frame-terminal frame))
+ "initial_terminal")
+ (push frame frames)))
;; Make the menu of buffers proper.
(setq buffers-menu
(let ((i 0)
@@ -2366,35 +2429,7 @@ It must accept a buffer as its only required argument.")
`((frames-separator "--")
(frames menu-item "Frames" ,frames-menu))))))
- ;; Add in some normal commands at the end of the menu. We use
- ;; the copy cached in `menu-bar-buffers-menu-command-entries'
- ;; if it's been set already. Note that we can't use constant
- ;; lists for the menu-entries, because the low-level menu-code
- ;; modifies them.
- (unless menu-bar-buffers-menu-command-entries
- (setq menu-bar-buffers-menu-command-entries
- (list '(command-separator "--")
- (list 'next-buffer
- 'menu-item
- "Next Buffer"
- 'next-buffer
- :help "Switch to the \"next\" buffer in a cyclic order")
- (list 'previous-buffer
- 'menu-item
- "Previous Buffer"
- 'previous-buffer
- :help "Switch to the \"previous\" buffer in a cyclic order")
- (list 'select-named-buffer
- 'menu-item
- "Select Named Buffer..."
- 'switch-to-buffer
- :help "Prompt for a buffer name, and select that buffer in the current window")
- (list 'list-all-buffers
- 'menu-item
- "List All Buffers"
- 'list-buffers
- :help "Pop up a window listing all Emacs buffers"
- ))))
+ ;; Add in some normal commands at the end of the menu.
(setq buffers-menu
(nconc buffers-menu menu-bar-buffers-menu-command-entries))
@@ -2505,7 +2540,7 @@ Use \\[menu-bar-mode] to make the menu bar appear."))))
(put 'menu-bar-mode 'standard-value '(t))
(defun toggle-menu-bar-mode-from-frame (&optional arg)
- "Toggle display of the menu bar of the current frame.
+ "Toggle display of the menu bar.
See `menu-bar-mode' for more information."
(interactive (list (or current-prefix-arg 'toggle)))
(if (eq arg 'toggle)
@@ -2517,6 +2552,8 @@ See `menu-bar-mode' for more information."
(declare-function x-menu-bar-open "term/x-win" (&optional frame))
(declare-function w32-menu-bar-open "term/w32-win" (&optional frame))
+(declare-function pgtk-menu-bar-open "term/pgtk-win" (&optional frame))
+(declare-function haiku-menu-bar-open "haikumenu.c" (&optional frame))
(defun lookup-key-ignore-too-long (map key)
"Call `lookup-key' and convert numeric values to nil."
@@ -2595,8 +2632,11 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus."
;; `setup-specified-language-environment', for instance,
;; expects this to be set from a menu keymap.
(setq last-command-event (car (last event)))
- ;; mouse-major-mode-menu was using `command-execute' instead.
- (call-interactively cmd))))
+ (setq from--tty-menu-p nil)
+ ;; Signal use-dialog-box-p this command was invoked from a menu.
+ (let ((from--tty-menu-p t))
+ ;; mouse-major-mode-menu was using `command-execute' instead.
+ (call-interactively cmd)))))
(defun popup-menu-normalize-position (position)
"Convert the POSITION to the form which `popup-menu' expects internally.
@@ -2642,9 +2682,10 @@ first TTY menu-bar menu to be dropped down. Interactively,
this is the numeric argument to the command.
This function decides which method to use to access the menu
depending on FRAME's terminal device. On X displays, it calls
-`x-menu-bar-open'; on Windows, `w32-menu-bar-open'; otherwise it
-calls either `popup-menu' or `tmm-menubar' depending on whether
-`tty-menu-open-use-tmm' is nil or not.
+`x-menu-bar-open'; on Windows, `w32-menu-bar-open'; on Haiku,
+`haiku-menu-bar-open'; otherwise it calls either `popup-menu'
+or `tmm-menubar' depending on whether `tty-menu-open-use-tmm'
+is nil or not.
If FRAME is nil or not given, use the selected frame."
(interactive
@@ -2653,6 +2694,8 @@ If FRAME is nil or not given, use the selected frame."
(cond
((eq type 'x) (x-menu-bar-open frame))
((eq type 'w32) (w32-menu-bar-open frame))
+ ((eq type 'haiku) (haiku-menu-bar-open frame))
+ ((eq type 'pgtk) (pgtk-menu-bar-open frame))
((and (null tty-menu-open-use-tmm)
(not (zerop (or (frame-parameter nil 'menu-bar-lines) 0))))
;; Make sure the menu bar is up to date. One situation where
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index f49a5fbab25..805b0820b03 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -47,19 +47,20 @@
;;;###mh-autoload
(defmacro mh-do-in-gnu-emacs (&rest body)
"Execute BODY if in GNU Emacs."
- (declare (debug t) (indent defun))
+ (declare (obsolete progn "29.1") (debug t) (indent defun))
(unless (featurep 'xemacs) `(progn ,@body)))
;;;###mh-autoload
(defmacro mh-do-in-xemacs (&rest body)
"Execute BODY if in XEmacs."
- (declare (debug t) (indent defun))
+ (declare (obsolete ignore "29.1") (debug t) (indent defun))
(when (featurep 'xemacs) `(progn ,@body)))
;;;###mh-autoload
(defmacro mh-funcall-if-exists (function &rest args)
"Call FUNCTION with ARGS as parameters if it exists."
- (declare (debug (symbolp body)))
+ (declare (obsolete "use `(when (fboundp 'foo) (foo))' instead." "29.1")
+ (debug (symbolp body)))
;; FIXME: Not clear when this should be used. If the function happens
;; not to exist at compile-time (e.g. because the corresponding package
;; wasn't loaded), then it won't ever be used :-(
@@ -72,7 +73,8 @@
"Create function NAME.
If FUNCTION exists, then NAME becomes an alias for FUNCTION.
Otherwise, create function NAME with ARG-LIST and BODY."
- (declare (indent defun) (doc-string 4)
+ (declare (obsolete defun "29.1")
+ (indent defun) (doc-string 4)
(debug (&define name symbolp sexp def-body)))
`(defalias ',name
(if (fboundp ',function)
@@ -84,7 +86,8 @@ Otherwise, create function NAME with ARG-LIST and BODY."
"Create macro NAME.
If MACRO exists, then NAME becomes an alias for MACRO.
Otherwise, create macro NAME with ARG-LIST and BODY."
- (declare (indent defun) (doc-string 4)
+ (declare (obsolete defmacro "29.1")
+ (indent defun) (doc-string 4)
(debug (&define name symbolp sexp def-body)))
(let ((defined-p (fboundp macro)))
(if defined-p
@@ -99,22 +102,20 @@ Otherwise, create macro NAME with ARG-LIST and BODY."
"Make HOOK local if needed.
XEmacs and versions of GNU Emacs before 21.1 require
`make-local-hook' to be called."
+ (declare (obsolete nil "29.1"))
(when (and (fboundp 'make-local-hook)
(not (get 'make-local-hook 'byte-obsolete-info)))
`(make-local-hook ,hook)))
;;;###mh-autoload
(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
- "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
-In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then
-check if variable `transient-mark-mode' is active."
- (cond ((featurep 'xemacs) ;XEmacs
- '(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
- ((not check-transient-mark-mode-flag) ;GNU Emacs
- '(and (boundp 'mark-active) mark-active))
- (t ;GNU Emacs
- '(and (boundp 'transient-mark-mode) transient-mark-mode
- (boundp 'mark-active) mark-active))))
+ "If CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
+variable `transient-mark-mode' is active."
+ (declare (obsolete nil "29.1"))
+ (cond ((not check-transient-mark-mode-flag)
+ 'mark-active)
+ (t
+ '(and transient-mark-mode mark-active))))
;;;###mh-autoload
(defmacro with-mh-folder-updating (save-modification-flag &rest body)
@@ -164,12 +165,8 @@ preserved."
(original-position (make-symbol "original-position"))
(modified-flag (make-symbol "modified-flag")))
`(save-excursion
- (let* ((,event-window
- (or (mh-funcall-if-exists posn-window (event-start ,event))
- (mh-funcall-if-exists event-window ,event)))
- (,event-position
- (or (mh-funcall-if-exists posn-point (event-start ,event))
- (mh-funcall-if-exists event-closest-point ,event)))
+ (let* ((,event-window (posn-window (event-start ,event)))
+ (,event-position (posn-point (event-start ,event)))
(,original-window (selected-window))
(,original-position (progn
(set-buffer (window-buffer ,event-window))
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 2a11aa979c0..f39caac893d 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -67,8 +67,7 @@ Return t if any file listed in the Aliasfile MH profile component has
been modified since the timestamp.
If ARG is non-nil, set timestamp with the current time."
(if arg
- (let ((time (current-time)))
- (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
+ (setq mh-alias-tstamp (current-time))
(let ((stamp))
(car (memq t (mapcar
(lambda (file)
@@ -112,10 +111,10 @@ COMMA-SEPARATOR is non-nil."
(setq res (match-string 1 res)))
;; Replace "&" with capitalized username
(if (string-search "&" res)
- (setq res (mh-replace-regexp-in-string "&" (capitalize username) res)))
+ (setq res (replace-regexp-in-string "&" (capitalize username) res)))
;; Remove " character
(if (string-search "\"" res)
- (setq res (mh-replace-regexp-in-string "\"" "" res)))
+ (setq res (replace-regexp-in-string "\"" "" res)))
;; If empty string, use username instead
(if (string-equal "" res)
(setq res username))
@@ -155,7 +154,7 @@ Exclude all aliases already in `mh-alias-alist' from \"ali\""
(if (string-equal username realname)
(concat "<" username ">")
(concat realname " <" username ">"))))
- (when (not (mh-assoc-string alias-name mh-alias-alist t))
+ (when (not (assoc-string alias-name mh-alias-alist t))
(setq passwd-alist (cons (list alias-name alias-translation)
passwd-alist)))))))
(forward-line 1)))
@@ -184,12 +183,12 @@ been loaded."
(cond
((looking-at "^[ \t]")) ;Continuation line
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
- (when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t))
+ (when (not (assoc-string (match-string 1) mh-alias-blind-alist t))
(setq mh-alias-blind-alist
(cons (list (match-string 1)) mh-alias-blind-alist))
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
((looking-at "\\(.+\\): .*$") ; A new MH alias
- (when (not (mh-assoc-string (match-string 1) mh-alias-alist t))
+ (when (not (assoc-string (match-string 1) mh-alias-alist t))
(setq mh-alias-alist
(cons (list (match-string 1)) mh-alias-alist)))))
(forward-line 1)))
@@ -200,7 +199,7 @@ been loaded."
user)
(while local-users
(setq user (car local-users))
- (if (not (mh-assoc-string (car user) mh-alias-alist t))
+ (if (not (assoc-string (car user) mh-alias-alist t))
(setq mh-alias-alist (append mh-alias-alist (list user))))
(setq local-users (cdr local-users)))))
(run-hooks 'mh-alias-reloaded-hook)
@@ -239,16 +238,16 @@ done here."
"Return expansion for ALIAS.
Blind aliases or users from /etc/passwd are not expanded."
(cond
- ((mh-assoc-string alias mh-alias-blind-alist t)
+ ((assoc-string alias mh-alias-blind-alist t)
alias) ; Don't expand a blind alias
- ((mh-assoc-string alias mh-alias-passwd-alist t)
- (cadr (mh-assoc-string alias mh-alias-passwd-alist t)))
+ ((assoc-string alias mh-alias-passwd-alist t)
+ (cadr (assoc-string alias mh-alias-passwd-alist t)))
(t
(mh-alias-ali alias))))
(eval-and-compile
- (mh-require 'crm nil t) ; completing-read-multiple
- (mh-require 'multi-prompt nil t))
+ (require 'crm nil t) ; completing-read-multiple
+ (require 'multi-prompt nil t))
;;;###mh-autoload
(defun mh-read-address (prompt)
@@ -258,15 +257,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(read-string prompt)
(let* ((minibuffer-local-completion-map mh-alias-read-address-map)
(completion-ignore-case mh-alias-completion-ignore-case-flag)
- (the-answer
- (cond ((fboundp 'completing-read-multiple)
- (mh-funcall-if-exists
- completing-read-multiple prompt mh-alias-alist nil nil))
- ((featurep 'multi-prompt)
- (mh-funcall-if-exists
- multi-prompt "," nil prompt mh-alias-alist nil nil))
- (t (split-string
- (completing-read prompt mh-alias-alist nil nil) ",")))))
+ (the-answer (completing-read-multiple prompt mh-alias-alist nil nil)))
(if (not mh-alias-expand-aliases-flag)
(mapconcat #'identity the-answer ", ")
;; Loop over all elements, checking if in passwd alias or blind first
@@ -281,7 +272,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(let* ((case-fold-search t)
(beg (mh-beginning-of-word))
(the-name (buffer-substring-no-properties beg (point))))
- (if (mh-assoc-string the-name mh-alias-alist t)
+ (if (assoc-string the-name mh-alias-alist t)
(message "%s -> %s" the-name (mh-alias-expand the-name))
;; Check if it was a single word likely to be an alias
(if (and (equal mh-alias-flash-on-comma 1)
@@ -313,7 +304,7 @@ Blind aliases or users from /etc/passwd are not expanded."
res)
res)))
((t) (all-completions string mh-alias-alist pred))
- ((lambda) (mh-test-completion string mh-alias-alist pred)))))))))
+ ((lambda) (test-completion string mh-alias-alist pred)))))))))
;;; Alias File Updating
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 0c9b72c51d3..a9f6274e9d4 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -177,9 +177,8 @@ Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.")
"Messages annotated, either a sequence name or a list of message numbers.
This variable can be used by `mh-annotate-msg-hook'.")
-(defvar mh-insert-auto-fields-done-local nil
+(defvar-local mh-insert-auto-fields-done-local nil
"Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
-(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
@@ -304,21 +303,7 @@ message and scan line."
(let ((draft-buffer (current-buffer))
(file-name buffer-file-name)
(config mh-previous-window-config)
- ;; FIXME this is subtly different to select-message-coding-system.
- (coding-system-for-write
- (if (fboundp 'select-message-coding-system)
- (select-message-coding-system) ; Emacs has this since at least 21.1
- (if (and (local-variable-p 'buffer-file-coding-system
- (current-buffer)) ;XEmacs needs two args
- ;; We're not sure why, but buffer-file-coding-system
- ;; tends to get set to undecided-unix.
- (not (memq buffer-file-coding-system
- '(undecided undecided-unix undecided-dos))))
- buffer-file-coding-system
- (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
- (and (default-boundp 'buffer-file-coding-system)
- (default-value 'buffer-file-coding-system))
- 'utf-8)))))
+ (coding-system-for-write (select-message-coding-system)))
;; Older versions of spost do not support -msgid and -mime.
(unless mh-send-uses-spost-flag
;; Adding a Message-ID field looks good, makes it easier to search for
@@ -433,7 +418,7 @@ See also `mh-send'."
(mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
(mh-insert-header-separator)
;; Merge in components
- (mh-mapc
+ (mapc
(lambda (header-field)
(let ((field (car header-field))
(value (cdr header-field))
@@ -593,11 +578,12 @@ See also `mh-compose-forward-as-mime-flag',
(goto-char (point-min))
;; Set the local value of mh-mail-header-separator according to what is
;; present in the buffer...
- (set (make-local-variable 'mh-mail-header-separator)
- (save-excursion
- (goto-char (mh-mail-header-end))
- (buffer-substring-no-properties (point) (mh-line-end-position))))
- (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) ;override sendmail.el
+ (setq-local mh-mail-header-separator
+ (save-excursion
+ (goto-char (mh-mail-header-end))
+ (buffer-substring-no-properties (point)
+ (line-end-position))))
+ (setq-local mail-header-separator mh-mail-header-separator) ;override sendmail.el
;; If using MML, translate MH-style directive
(if (equal mh-compose-insertion 'mml)
(save-excursion
@@ -699,7 +685,7 @@ message and scan line."
;; For "From", the first value wins, with the identity's "From"
;; trumping anything in the distcomps file.
(let ((components-file (mh-bare-components mh-dist-formfile)))
- (mh-mapc
+ (mapc
(lambda (header-field)
(let ((field (car header-field))
(value (cdr header-field))
@@ -1079,7 +1065,6 @@ letter."
;; Insert identity.
(mh-insert-identity mh-identity-default t)
(mh-identity-make-menu)
- (mh-identity-add-menu)
;; Cleanup possibly RFC2047 encoded subject header
(mh-decode-message-subject)
@@ -1098,7 +1083,6 @@ letter."
(setq mh-previous-window-config config)
(setq mode-line-buffer-identification (list " {%b}"))
(mh-logo-display)
- (mh-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook #'mh-tidy-draft-buffer nil t)
(run-hook-with-args 'mh-compose-letter-function to subject cc))
@@ -1109,18 +1093,8 @@ The versions of MH-E, Emacs, and MH are shown."
;; Lazily initialize mh-x-mailer-string.
(when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
(setq mh-x-mailer-string
- (format "MH-E %s; %s; %sEmacs %s"
- mh-version mh-variant-in-use
- (if (featurep 'xemacs) "X" "GNU ")
- (cond ((not (featurep 'xemacs))
- (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?"
- emacs-version)
- (match-string 0 emacs-version))
- ((string-match "[0-9.]*\\( +([ a-z]+[0-9]+)\\)?"
- emacs-version)
- (match-string 0 emacs-version))
- (t (format "%s.%s" emacs-major-version
- emacs-minor-version))))))
+ (format "MH-E %s; %s; Emacs %s"
+ mh-version mh-variant-in-use emacs-version)))
;; Insert X-Mailer, but only if it doesn't already exist.
(save-excursion
(when (and mh-insert-x-mailer-flag
@@ -1247,7 +1221,7 @@ discarded."
(cond ((and overwrite-flag
(mh-goto-header-field (concat field ":")))
(insert " " value)
- (delete-region (point) (mh-line-end-position)))
+ (delete-region (point) (line-end-position)))
((and (not overwrite-flag)
(mh-regexp-in-field-p (concat "\\b" (regexp-quote value) "\\b") field))
;; Already there, do nothing.
@@ -1290,11 +1264,8 @@ discarded."
(set-syntax-table old-syntax-table))))
(defun mh-ascii-buffer-p ()
- "Check if current buffer is entirely composed of ASCII.
-The function doesn't work for XEmacs since `find-charset-region'
-doesn't exist there."
- (cl-loop for charset in (mh-funcall-if-exists
- find-charset-region (point-min) (point-max))
+ "Check if current buffer is entirely composed of ASCII."
+ (cl-loop for charset in (find-charset-region (point-min) (point-max))
unless (eq charset 'ascii) return nil
finally return t))
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index ab585409184..7a09429e4ef 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -34,53 +34,21 @@
;; Please use mh-gnus.el when providing compatibility with different
;; versions of Gnus.
-;; Items are listed alphabetically (except for mh-require which is
-;; needed sooner it would normally appear).
+;; Items are listed alphabetically.
(eval-when-compile (require 'mh-acros))
-(mh-do-in-gnu-emacs
- (defalias 'mh-require #'require))
-
-(mh-do-in-xemacs
- (defun mh-require (feature &optional filename noerror)
- "If feature FEATURE is not loaded, load it from FILENAME.
-If FEATURE is not a member of the list `features', then the feature
-is not loaded; so load the file FILENAME.
-If FILENAME is omitted, the printname of FEATURE is used as the file name.
-If the optional third argument NOERROR is non-nil,
-then return nil if the file is not found instead of signaling an error.
-
-Simulate NOERROR argument in XEmacs which lacks it."
- (if (not (featurep feature))
- (if filename
- (load filename noerror t)
- (load (format "%s" feature) noerror t)))))
-
-(defun-mh mh-assoc-string assoc-string (key list case-fold)
- "Like `assoc' but specifically for strings.
-Case is ignored if CASE-FOLD is non-nil.
-This function is used by Emacs versions that lack `assoc-string',
-introduced in Emacs 22."
- ;; Test for fboundp is solely to silence compiler for Emacs >= 22.1.
- (if (and case-fold (fboundp 'assoc-ignore-case))
- (assoc-ignore-case key list)
- (assoc key list)))
-
-;; For XEmacs.
-(defalias 'mh-cancel-timer
- (if (fboundp 'cancel-timer)
- 'cancel-timer
- 'delete-itimer))
+(define-obsolete-function-alias 'mh-require #'require "29.1")
+(define-obsolete-function-alias 'mh-assoc-string #'assoc-string "29.1")
+(define-obsolete-function-alias 'mh-cancel-timer #'cancel-timer "29.1")
;; Emacs 24 made flet obsolete and suggested either cl-flet or
;; cl-letf. This macro is based upon gmm-flet from Gnus.
(defmacro mh-flet (bindings &rest body)
"Make temporary overriding function definitions.
-This is an analogue of a dynamically scoped `let' that operates on
-the function cell of FUNCs rather than their value cell.
-
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+That is, temporarily rebind the functions listed in BINDINGS and then
+execute BODY. BINDINGS is a list containing one or more lists of the
+form (FUNCNAME ARGLIST BODY...), similar to defun."
(declare (indent 1) (debug ((&rest (sexp sexp &rest form)) &rest form)))
(if (fboundp 'cl-letf)
`(cl-letf ,(mapcar (lambda (binding)
@@ -90,17 +58,8 @@ the function cell of FUNCs rather than their value cell.
,@body)
`(flet ,bindings ,@body)))
-(defun mh-display-color-cells (&optional display)
- "Return the number of color cells supported by DISPLAY.
-This function is used by XEmacs to return 2 when `device-color-cells'
-or `display-color-cells' returns nil. This happens when compiling or
-running on a tty and causes errors since `display-color-cells' is
-expected to return an integer."
- (cond ((fboundp 'display-color-cells) ; GNU Emacs, XEmacs 21.5b28
- (or (display-color-cells display) 2))
- ((fboundp 'device-color-cells) ; XEmacs 21.4
- (or (device-color-cells display) 2))
- (t 2)))
+(define-obsolete-function-alias 'mh-display-color-cells
+ #'display-color-cells "29.1")
(defmacro mh-display-completion-list (completions &optional common-substring)
"Display the list of COMPLETIONS.
@@ -110,209 +69,54 @@ The optional argument COMMON-SUBSTRING, if non-nil, should be a string
specifying a common substring for adding the faces
`completions-first-difference' and `completions-common-part' to
the completions."
- (cond ((< emacs-major-version 22) `(display-completion-list ,completions))
- ((fboundp 'completion-hilit-commonality) ; Emacs 23.1 and later
- `(display-completion-list
- (completion-hilit-commonality ,completions
- ,(length common-substring) nil)))
- (t ; Emacs 22
- `(display-completion-list ,completions ,common-substring))))
-
-(defmacro mh-face-foreground (face &optional frame inherit)
- "Return the foreground color name of FACE, or nil if unspecified.
-See documentation for `face-foreground' for a description of the
-arguments FACE, FRAME, and perhaps INHERIT.
-This macro is used by Emacs versions that lack an INHERIT argument,
-introduced in Emacs 22."
- (if (< emacs-major-version 22)
- `(face-foreground ,face ,frame)
- `(face-foreground ,face ,frame ,inherit)))
-
-(defmacro mh-face-background (face &optional frame inherit)
- "Return the background color name of face, or nil if unspecified.
-See documentation for `face-background' for a description of the
-arguments FACE, FRAME, and INHERIT.
-This macro is used by Emacs versions that lack an INHERIT argument,
-introduced in Emacs 22."
- (if (< emacs-major-version 22)
- `(face-background ,face ,frame)
- `(face-background ,face ,frame ,inherit)))
-
-(defun-mh mh-font-lock-add-keywords font-lock-add-keywords
- (_mode _keywords &optional _how)
- "XEmacs does not have `font-lock-add-keywords'.
-This function returns nil on that system.")
-
-(defun-mh mh-image-load-path-for-library
- image-load-path-for-library (library image &optional path no-error)
- "Return a suitable search path for images used by LIBRARY.
-
-It searches for IMAGE in `image-load-path' (excluding
-\"`data-directory'/images\") and `load-path', followed by a path
-suitable for LIBRARY, which includes \"../../etc/images\" and
-\"../etc/images\" relative to the library file itself, and then
-in \"`data-directory'/images\".
-
-Then this function returns a list of directories which contains
-first the directory in which IMAGE was found, followed by the
-value of `load-path'. If PATH is given, it is used instead of
-`load-path'.
-
-If NO-ERROR is non-nil and a suitable path can't be found, don't
-signal an error. Instead, return a list of directories as before,
-except that nil appears in place of the image directory.
-
-Here is an example that uses a common idiom to provide
-compatibility with versions of Emacs that lack the variable
-`image-load-path':
-
- ;; Shush compiler.
- (defvar image-load-path)
-
- (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
- (image-load-path (cons (car load-path)
- (when (boundp \\='image-load-path)
- image-load-path))))
- (mh-tool-bar-folder-buttons-init))"
- (unless library (error "No library specified"))
- (unless image (error "No image specified"))
- (let (image-directory image-directory-load-path)
- ;; Check for images in image-load-path or load-path.
- (let ((img image)
- (dir (or
- ;; Images in image-load-path.
- (mh-image-search-load-path image)
- ;; Images in load-path.
- (locate-library image)))
- parent)
- ;; Since the image might be in a nested directory (for
- ;; example, mail/attach.pbm), adjust `image-directory'
- ;; accordingly.
- (when dir
- (setq dir (file-name-directory dir))
- (while (setq parent (file-name-directory img))
- (setq img (directory-file-name parent)
- dir (expand-file-name "../" dir))))
- (setq image-directory-load-path dir))
-
- ;; If `image-directory-load-path' isn't Emacs's image directory,
- ;; it's probably a user preference, so use it. Then use a
- ;; relative setting if possible; otherwise, use
- ;; `image-directory-load-path'.
- (cond
- ;; User-modified image-load-path?
- ((and image-directory-load-path
- (not (equal image-directory-load-path
- (file-name-as-directory
- (expand-file-name "images" data-directory)))))
- (setq image-directory image-directory-load-path))
- ;; Try relative setting.
- ((let (library-name d1ei d2ei)
- ;; First, find library in the load-path.
- (setq library-name (locate-library library))
- (if (not library-name)
- (error "Cannot find library %s in load-path" library))
- ;; And then set image-directory relative to that.
- (setq
- ;; Go down 2 levels.
- d2ei (file-name-as-directory
- (expand-file-name
- (concat (file-name-directory library-name) "../../etc/images")))
- ;; Go down 1 level.
- d1ei (file-name-as-directory
- (expand-file-name
- (concat (file-name-directory library-name) "../etc/images"))))
- (setq image-directory
- ;; Set it to nil if image is not found.
- (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
- ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
- ;; Use Emacs's image directory.
- (image-directory-load-path
- (setq image-directory image-directory-load-path))
- (no-error
- (message "Could not find image %s for library %s" image library))
- (t
- (error "Could not find image %s for library %s" image library)))
-
- ;; Return an augmented `path' or `load-path'.
- (nconc (list image-directory)
- (delete image-directory (copy-sequence (or path load-path))))))
-
-(defun-mh mh-image-search-load-path
- image-search-load-path (_file &optional _path)
- "Emacs 21 and XEmacs don't have `image-search-load-path'.
-This function returns nil on those systems."
- nil)
-
-;; For XEmacs.
-(defalias 'mh-line-beginning-position
- (if (fboundp 'line-beginning-position)
- 'line-beginning-position
- 'point-at-bol))
-
-;; For XEmacs.
-(defalias 'mh-line-end-position
- (if (fboundp 'line-end-position)
- 'line-end-position
- 'point-at-eol))
-
-(mh-require 'mailabbrev nil t)
-(defun-mh mh-mail-abbrev-make-syntax-table
- mail-abbrev-make-syntax-table ()
- "Emacs 21 and XEmacs don't have `mail-abbrev-make-syntax-table'.
-This function returns nil on those systems."
- nil)
-
-(defmacro mh-define-obsolete-variable-alias
- (obsolete-name current-name &optional when docstring)
- "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
-See documentation for `define-obsolete-variable-alias' for a description
-of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
-and DOCSTRING. This macro is used by XEmacs that lacks WHEN and
-DOCSTRING arguments."
- (if (featurep 'xemacs)
- `(define-obsolete-variable-alias ,obsolete-name ,current-name)
- `(define-obsolete-variable-alias ,obsolete-name ,current-name ,when ,docstring)))
-
-(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type)
- "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
-See documentation for `make-obsolete-variable' for a description
-of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
-and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and
-ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE,
-introduced in Emacs 24."
- (if (featurep 'xemacs)
- `(make-obsolete-variable ,obsolete-name ,current-name)
- (if (< emacs-major-version 24)
- `(make-obsolete-variable ,obsolete-name ,current-name ,when)
- `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))))
-
-(defun-mh mh-match-string-no-properties
- match-string-no-properties (num &optional _string)
- "Return string of text matched by last search, without text properties.
-This function is used by XEmacs that lacks `match-string-no-properties'.
-The function `buffer-substring-no-properties' is used instead.
-The argument STRING is ignored."
- (buffer-substring-no-properties
- (match-beginning num) (match-end num)))
-
-(defun-mh mh-replace-regexp-in-string replace-regexp-in-string
- (regexp rep string &optional _fixedcase literal _subexp _start)
- "Replace REGEXP with REP everywhere in STRING and return result.
-This function is used by XEmacs that lacks `replace-regexp-in-string'.
-The function `replace-in-string' is used instead.
-The arguments FIXEDCASE, SUBEXP, and START, used by
-`replace-in-string' are ignored."
- (if (featurep 'xemacs) ; silence Emacs compiler
- (replace-in-string string regexp rep literal)))
-
-(defun-mh mh-test-completion
- test-completion (_string _collection &optional _predicate)
- "Return non-nil if STRING is a valid completion.
-XEmacs does not have `test-completion'. This function returns nil
-on that system." nil)
-
-;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
+ `(display-completion-list
+ (completion-hilit-commonality ,completions
+ ,(length common-substring) nil)))
+
+(define-obsolete-function-alias 'mh-face-foreground
+ #'face-foreground "29.1")
+
+(define-obsolete-function-alias 'mh-face-background
+ #'face-background "29.1")
+
+(define-obsolete-function-alias 'mh-font-lock-add-keywords
+ #'font-lock-add-keywords "29.1")
+
+;; Not preloaded in without-x builds.
+(declare-function image-load-path-for-library "image")
+(define-obsolete-function-alias 'mh-image-load-path-for-library
+ #'image-load-path-for-library "29.1")
+
+;; Not preloaded in without-x builds.
+(declare-function image-search-load-path "image")
+(define-obsolete-function-alias 'mh-image-search-load-path
+ #'image-search-load-path "29.1")
+
+(define-obsolete-function-alias 'mh-line-beginning-position
+ #'line-beginning-position "29.1")
+
+(define-obsolete-function-alias 'mh-line-end-position
+ #'line-end-position "29.1")
+
+(require 'mailabbrev nil t)
+(define-obsolete-function-alias 'mh-mail-abbrev-make-syntax-table
+ #'mail-abbrev-make-syntax-table "29.1")
+
+(define-obsolete-function-alias 'mh-define-obsolete-variable-alias
+ #'define-obsolete-variable-alias "29.1")
+
+(define-obsolete-function-alias 'mh-make-obsolete-variable
+ #'make-obsolete-variable "29.1")
+
+(define-obsolete-function-alias 'mh-match-string-no-properties
+ #'match-string-no-properties "29.1")
+
+(define-obsolete-function-alias 'mh-replace-regexp-in-string
+ #'replace-regexp-in-string "29.1")
+
+(define-obsolete-function-alias 'mh-test-completion
+ #'test-completion "29.1")
+
(defconst mh-url-unreserved-chars
'(
?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
@@ -321,51 +125,21 @@ on that system." nil)
?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
"A list of characters that are _NOT_ reserved in the URL spec.
This is taken from RFC 2396.")
+(make-obsolete-variable 'mh-url-unreserved-chars 'url-unreserved-chars "29.1")
+
+(define-obsolete-function-alias 'mh-url-hexify-string
+ #'url-hexify-string "29.1")
+
+(define-obsolete-function-alias 'mh-view-mode-enter
+ #'view-mode-enter "29.1")
-(defun-mh mh-url-hexify-string url-hexify-string (str)
- "Escape characters in a string.
-This is a copy of `url-hexify-string' from url-util.el in Emacs
-22; needed by Emacs 21."
- (mapconcat
- (lambda (char)
- ;; Fixme: use a char table instead.
- (if (not (memq char mh-url-unreserved-chars))
- (if (> char 255)
- (error "Hexifying multibyte character %s" str)
- (format "%%%02X" char))
- (char-to-string char)))
- str ""))
-
-(defun-mh mh-view-mode-enter
- view-mode-enter (&optional return-to exit-action)
- "Enter View mode.
-This function is used by XEmacs that lacks `view-mode-enter'.
-The function `view-mode' is used instead.
-The arguments RETURN-TO and EXIT-ACTION are ignored."
- ;; Shush compiler.
- (if return-to nil)
- (if exit-action nil)
- (view-mode 1))
-
-(defun-mh mh-window-full-height-p
- window-full-height-p (&optional _window)
- "Return non-nil if WINDOW is not the result of a vertical split.
-This function is defined in XEmacs as it lacks
-`window-full-height-p'. The values of the functions
-`window-height' and `frame-height' are compared instead. The
-argument WINDOW is ignored."
- (= (1+ (window-height))
- (frame-height)))
+(define-obsolete-function-alias 'mh-window-full-height-p
+ #'window-full-height-p "29.1")
(defmacro mh-write-file-functions ()
- "Return `write-file-functions' if it exists.
-Otherwise return `local-write-file-hooks'.
-This macro exists purely for compatibility. The former symbol is used
-in Emacs 22 onward while the latter is used in previous versions and
-XEmacs."
- (if (boundp 'write-file-functions)
- ''write-file-functions ;Emacs 22 on
- ''local-write-file-hooks)) ;XEmacs
+ "Return `write-file-functions'."
+ (declare (obsolete nil "29.1"))
+ ''write-file-functions)
(provide 'mh-compat)
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 059a8e08813..872f0d79d29 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -88,29 +88,6 @@
(require 'mh-buffers)
(require 'mh-compat)
-(mh-do-in-xemacs
- (require 'mh-xemacs))
-
-(mh-font-lock-add-keywords
- 'emacs-lisp-mode
- (eval-when-compile
- `((,(concat "(\\("
- ;; Function declarations (use font-lock-function-name-face).
- "\\(def\\(un\\|macro\\)-mh\\)\\|"
- ;; Variable declarations (use font-lock-variable-name-face).
- "\\(def\\(custom\\|face\\)-mh\\)\\|"
- ;; Group declarations (use font-lock-type-face).
- "\\(defgroup-mh\\)"
- "\\)\\>"
- ;; Any whitespace and defined object.
- "[ \t'(]*"
- "\\(setf[ \t]+\\sw+)\\|\\sw+\\)?")
- (1 font-lock-keyword-face)
- (7 (cond ((match-beginning 2) font-lock-function-name-face)
- ((match-beginning 4) font-lock-variable-name-face)
- (t font-lock-type-face))
- nil t)))))
-
;;; Global Variables
@@ -368,15 +345,13 @@ when searching for a separator.")
"This regular expression matches the signature separator.
See `mh-signature-separator'.")
-(defvar mh-thread-scan-line-map nil
+(defvar-local mh-thread-scan-line-map nil
"Map of message index to various parts of the scan line.")
-(make-variable-buffer-local 'mh-thread-scan-line-map)
-(defvar mh-thread-scan-line-map-stack nil
+(defvar-local mh-thread-scan-line-map-stack nil
"Old map of message index to various parts of the scan line.
This is the original map that is stored when the folder is
narrowed.")
-(make-variable-buffer-local 'mh-thread-scan-line-map-stack)
(defcustom mh-x-mailer-string nil
"String containing the contents of the X-Mailer header field.
@@ -486,7 +461,7 @@ all the strings have been used."
(count 0))
(while (and (not (eobp)) (< count mh-index-max-cmdline-args))
(push (buffer-substring-no-properties (point)
- (mh-line-end-position))
+ (line-end-position))
arg-list)
(cl-incf count)
(forward-line))
@@ -619,23 +594,18 @@ Output is expected to be shown to user, not parsed by MH-E."
;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4.
(mh-exchange-point-and-mark-preserving-active-mark))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar mark-active))
-
(defun mh-exchange-point-and-mark-preserving-active-mark ()
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active, and
preserves whether the mark is active or not."
(interactive nil)
- (let ((is-active (and (boundp 'mark-active) mark-active)))
+ (let ((is-active mark-active))
(let ((omark (mark t)))
(if (null omark)
(error "No mark set in this buffer"))
(set-mark (point))
(goto-char omark)
- (if (boundp 'mark-active)
- (setq mark-active is-active))
+ (setq mark-active is-active)
nil)))
(defun mh-exec-lib-cmd-output (command &rest args)
@@ -663,56 +633,39 @@ Set mark after inserted text."
;;; MH-E Customization Support Routines
-;; Shush compiler (Emacs 21 and XEmacs).
-(defvar customize-package-emacs-version-alist)
-
;; Temporary function and data structure used customization.
;; These will be unbound after the options are defined.
(defmacro mh-strip-package-version (args)
- "Strip :package-version keyword and its value from ARGS.
-In Emacs versions that support the :package-version keyword,
-ARGS is returned unchanged."
- `(if (boundp 'customize-package-emacs-version-alist)
- ,args
- (let (seen)
- (cl-loop for keyword in ,args
- if (cond ((eq keyword ':package-version) (setq seen t) nil)
- (seen (setq seen nil) nil)
- (t t))
- collect keyword))))
+ "ARGS is returned unchanged."
+ (declare (obsolete identity "29.1"))
+ args)
(defmacro defgroup-mh (symbol members doc &rest args)
"Declare SYMBOL as a customization group containing MEMBERS.
See documentation for `defgroup' for a description of the arguments
-SYMBOL, MEMBERS, DOC and ARGS.
-This macro is used by Emacs versions that lack the :package-version
-keyword, introduced in Emacs 22."
- (declare (doc-string 3) (indent defun))
- `(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args)))
+SYMBOL, MEMBERS, DOC and ARGS."
+ (declare (obsolete defgroup "29.1") (doc-string 3) (indent defun))
+ `(defgroup ,symbol ,members ,doc ,args))
(defmacro defcustom-mh (symbol value doc &rest args)
"Declare SYMBOL as a customizable variable that defaults to VALUE.
See documentation for `defcustom' for a description of the arguments
-SYMBOL, VALUE, DOC and ARGS.
-This macro is used by Emacs versions that lack the :package-version
-keyword, introduced in Emacs 22."
- (declare (doc-string 3) (indent defun))
- `(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args)))
+SYMBOL, VALUE, DOC and ARGS."
+ (declare (obsolete defcustom "29.1") (doc-string 3) (indent defun))
+ `(defcustom ,symbol ,value ,doc ,args))
(defmacro defface-mh (face spec doc &rest args)
"Declare FACE as a customizable face that defaults to SPEC.
See documentation for `defface' for a description of the arguments
-FACE, SPEC, DOC and ARGS.
-This macro is used by Emacs versions that lack the :package-version
-keyword, introduced in Emacs 22."
- (declare (doc-string 3) (indent defun))
- `(defface ,face ,spec ,doc ,@(mh-strip-package-version args)))
+FACE, SPEC, DOC and ARGS."
+ (declare (obsolete defface "29.1") (doc-string 3) (indent defun))
+ `(defface ,face ,spec ,doc ,args))
;;; Variant Support
-(defcustom-mh mh-path nil
+(defcustom mh-path nil
"Additional list of directories to search for MH.
See `mh-variant'."
:group 'mh-e
@@ -947,7 +900,7 @@ finally GNU mailutils MH."
(mapconcat (lambda (x) (format "%s" (car x)))
(mh-variants) " or "))))))
-(defcustom-mh mh-variant 'autodetect
+(defcustom mh-variant 'autodetect
"Specifies the variant used by MH-E.
The default setting of this option is \"Auto-detect\" which means
@@ -1023,19 +976,18 @@ windows in the frame are removed."
(when delete-other-windows-flag
(delete-other-windows)))
-(if (boundp 'customize-package-emacs-version-alist)
- (add-to-list 'customize-package-emacs-version-alist
- '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1")
- ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1")
- ("7.4" . "22.1") ("8.0" . "22.1") ("8.1" . "23.1")
- ("8.2" . "23.1") ("8.3" . "24.1") ("8.4" . "24.4")
- ("8.5" . "24.4") ("8.6" . "24.4"))))
+(add-to-list 'customize-package-emacs-version-alist
+ '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1")
+ ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1")
+ ("7.4" . "22.1") ("8.0" . "22.1") ("8.1" . "23.1")
+ ("8.2" . "23.1") ("8.3" . "24.1") ("8.4" . "24.4")
+ ("8.5" . "24.4") ("8.6" . "24.4")))
;;; MH-E Customization Groups
-(defgroup-mh mh-e nil
+(defgroup mh-e nil
"Emacs interface to the MH mail system.
MH is the Rand Mail Handler. Other implementations include nmh
and GNU mailutils."
@@ -1043,126 +995,126 @@ and GNU mailutils."
:group 'mail
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-alias nil
+(defgroup mh-alias nil
"Aliases."
:link '(custom-manual "(mh-e)Aliases")
:prefix "mh-alias-"
:group 'mh-e
:package-version '(MH-E . "7.1"))
-(defgroup-mh mh-folder nil
+(defgroup mh-folder nil
"Organizing your mail with folders."
:prefix "mh-"
:link '(custom-manual "(mh-e)Folders")
:group 'mh-e
:package-version '(MH-E . "7.1"))
-(defgroup-mh mh-folder-selection nil
+(defgroup mh-folder-selection nil
"Folder selection."
:prefix "mh-"
:link '(custom-manual "(mh-e)Folder Selection")
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-identity nil
+(defgroup mh-identity nil
"Identities."
:link '(custom-manual "(mh-e)Identities")
:prefix "mh-identity-"
:group 'mh-e
:package-version '(MH-E . "7.1"))
-(defgroup-mh mh-inc nil
+(defgroup mh-inc nil
"Incorporating your mail."
:prefix "mh-inc-"
:link '(custom-manual "(mh-e)Incorporating Mail")
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-junk nil
+(defgroup mh-junk nil
"Dealing with junk mail."
:link '(custom-manual "(mh-e)Junk")
:prefix "mh-junk-"
:group 'mh-e
:package-version '(MH-E . "7.3"))
-(defgroup-mh mh-letter nil
+(defgroup mh-letter nil
"Editing a draft."
:prefix "mh-"
:link '(custom-manual "(mh-e)Editing Drafts")
:group 'mh-e
:package-version '(MH-E . "7.1"))
-(defgroup-mh mh-ranges nil
+(defgroup mh-ranges nil
"Ranges."
:prefix "mh-"
:link '(custom-manual "(mh-e)Ranges")
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-scan-line-formats nil
+(defgroup mh-scan-line-formats nil
"Scan line formats."
:link '(custom-manual "(mh-e)Scan Line Formats")
:prefix "mh-"
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-search nil
+(defgroup mh-search nil
"Searching."
:link '(custom-manual "(mh-e)Searching")
:prefix "mh-search-"
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-sending-mail nil
+(defgroup mh-sending-mail nil
"Sending mail."
:prefix "mh-"
:link '(custom-manual "(mh-e)Sending Mail")
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-sequences nil
+(defgroup mh-sequences nil
"Sequences."
:prefix "mh-"
:link '(custom-manual "(mh-e)Sequences")
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-show nil
+(defgroup mh-show nil
"Reading your mail."
:prefix "mh-"
:link '(custom-manual "(mh-e)Reading Mail")
:group 'mh-e
:package-version '(MH-E . "7.1"))
-(defgroup-mh mh-speedbar nil
+(defgroup mh-speedbar nil
"The speedbar."
:prefix "mh-speed-"
:link '(custom-manual "(mh-e)Speedbar")
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-thread nil
+(defgroup mh-thread nil
"Threading."
:prefix "mh-thread-"
:link '(custom-manual "(mh-e)Threading")
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-tool-bar nil
+(defgroup mh-tool-bar nil
"The tool bar"
:link '(custom-manual "(mh-e)Tool Bar")
:prefix "mh-"
:group 'mh-e
:package-version '(MH-E . "8.0"))
-(defgroup-mh mh-hooks nil
+(defgroup mh-hooks nil
"MH-E hooks."
:link '(custom-manual "(mh-e)Top")
:prefix "mh-"
:group 'mh-e
:package-version '(MH-E . "7.1"))
-(defgroup-mh mh-faces nil
+(defgroup mh-faces nil
"Faces used in MH-E."
:link '(custom-manual "(mh-e)Top")
:prefix "mh-"
@@ -1178,7 +1130,7 @@ and GNU mailutils."
;;; Aliases (:group 'mh-alias)
-(defcustom-mh mh-alias-completion-ignore-case-flag t
+(defcustom mh-alias-completion-ignore-case-flag t
"Non-nil means don't consider case significant in MH alias completion.
As MH ignores case in the aliases, so too does MH-E. However, you
@@ -1189,7 +1141,7 @@ lowercase for mailing lists and uppercase for people."
:group 'mh-alias
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-alias-expand-aliases-flag nil
+(defcustom mh-alias-expand-aliases-flag nil
"Non-nil means to expand aliases entered in the minibuffer.
In other words, aliases entered in the minibuffer will be
@@ -1199,7 +1151,7 @@ this expansion is not performed."
:group 'mh-alias
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-alias-flash-on-comma t
+(defcustom mh-alias-flash-on-comma t
"Specify whether to flash address or warn on translation.
This option controls the behavior when a [comma] is pressed while
@@ -1212,7 +1164,7 @@ does not display a warning if the alias is not found."
:group 'mh-alias
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-alias-insert-file nil
+(defcustom mh-alias-insert-file nil
"Filename used to store a new MH-E alias.
The default setting of this option is \"Use Aliasfile Profile
@@ -1226,7 +1178,7 @@ name, MH-E will prompt for one of them when MH-E adds an alias."
:group 'mh-alias
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-alias-insertion-location 'sorted
+(defcustom mh-alias-insertion-location 'sorted
"Specifies where new aliases are entered in alias files.
This option is set to \"Alphabetical\" by default. If you organize
@@ -1238,7 +1190,7 @@ or \"Bottom\" of your alias file might be more appropriate."
:group 'mh-alias
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-alias-local-users t
+(defcustom mh-alias-local-users t
"Non-nil means local users are added to alias completion.
Aliases are created from \"/etc/passwd\" entries with a user ID
@@ -1259,7 +1211,7 @@ NIS password file."
:group 'mh-alias
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-alias-local-users-prefix "local."
+(defcustom mh-alias-local-users-prefix "local."
"String prefixed to the real names of users from the password file.
This option can also be set to \"Use Login\".
@@ -1281,7 +1233,7 @@ turned off."
:group 'mh-alias
:package-version '(MH-E . "7.4"))
-(defcustom-mh mh-alias-passwd-gecos-comma-separator-flag t
+(defcustom mh-alias-passwd-gecos-comma-separator-flag t
"Non-nil means the gecos field in the password file uses a comma separator.
In the example in `mh-alias-local-users-prefix', commas are used
@@ -1295,7 +1247,7 @@ whose contents may contain commas, you can turn this option off."
;;; Organizing Your Mail with Folders (:group 'mh-folder)
-(defcustom-mh mh-new-messages-folders t
+(defcustom mh-new-messages-folders t
"Folders searched for the \"unseen\" sequence.
Set this option to \"Inbox\" to search the \"+inbox\" folder or
@@ -1310,7 +1262,7 @@ See also `mh-recursive-folders-flag'."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-ticked-messages-folders t
+(defcustom mh-ticked-messages-folders t
"Folders searched for `mh-tick-seq'.
Set this option to \"Inbox\" to search the \"+inbox\" folder or
@@ -1325,7 +1277,7 @@ See also `mh-recursive-folders-flag'."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-large-folder 200
+(defcustom mh-large-folder 200
"The number of messages that indicates a large folder.
If a folder is deemed to be large, that is the number of messages
@@ -1337,7 +1289,7 @@ folders are treated as if they are small."
:group 'mh-folder
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-recenter-summary-flag nil
+(defcustom mh-recenter-summary-flag nil
"Non-nil means to recenter the summary window.
If this option is turned on, recenter the summary window when the
@@ -1346,13 +1298,13 @@ show window is toggled off."
:group 'mh-folder
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-recursive-folders-flag nil
+(defcustom mh-recursive-folders-flag nil
"Non-nil means that commands which operate on folders do so recursively."
:type 'boolean
:group 'mh-folder
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-sortm-args nil
+(defcustom mh-sortm-args nil
"Additional arguments for \"sortm\"\\<mh-folder-mode-map>.
This option is consulted when a prefix argument is used with
@@ -1366,7 +1318,7 @@ an alternate view. For example, (\"-nolimit\" \"-textfield\"
;;; Folder Selection (:group 'mh-folder-selection)
-(defcustom-mh mh-default-folder-for-message-function nil
+(defcustom mh-default-folder-for-message-function nil
"Function to select a default folder for refiling or \"Fcc:\".
When this function is called, the current buffer contains the message
@@ -1378,7 +1330,7 @@ the default, or an empty string to suppress the default entirely."
:group 'mh-folder-selection
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-default-folder-list nil
+(defcustom mh-default-folder-list nil
"List of addresses and folders.
The folder name associated with the first address found in this
@@ -1396,7 +1348,7 @@ for more information."
:group 'mh-folder-selection
:package-version '(MH-E . "7.2"))
-(defcustom-mh mh-default-folder-must-exist-flag t
+(defcustom mh-default-folder-must-exist-flag t
"Non-nil means guessed folder name must exist to be used.
If the derived folder does not exist, and this option is on, then
@@ -1410,7 +1362,7 @@ for more information."
:group 'mh-folder-selection
:package-version '(MH-E . "7.2"))
-(defcustom-mh mh-default-folder-prefix ""
+(defcustom mh-default-folder-prefix ""
"Prefix used for folder names generated from aliases.
The prefix is used to prevent clutter in your mail directory.
@@ -1429,7 +1381,7 @@ for more information."
Real definition will take effect when mh-identity is loaded."
nil)))
-(defcustom-mh mh-identity-list nil
+(defcustom mh-identity-list nil
"List of identities.
To customize this option, click on the \"INS\" button and enter a label
@@ -1498,7 +1450,7 @@ fashion."
:group 'mh-identity
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-auto-fields-list nil
+(defcustom mh-auto-fields-list nil
"List of recipients for which header lines are automatically inserted.
This option can be used to set the identity depending on the
@@ -1559,14 +1511,14 @@ as the result is undefined."
:group 'mh-identity
:package-version '(MH-E . "7.3"))
-(defcustom-mh mh-auto-fields-prompt-flag t
+(defcustom mh-auto-fields-prompt-flag t
"Non-nil means to prompt before sending if fields inserted.
See `mh-auto-fields-list'."
:type 'boolean
:group 'mh-identity
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-identity-default nil
+(defcustom mh-identity-default nil
"Default identity to use when `mh-letter-mode' is called.
See `mh-identity-list'."
:type (append
@@ -1577,7 +1529,7 @@ See `mh-identity-list'."
:group 'mh-identity
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-identity-handlers
+(defcustom mh-identity-handlers
'(("From" . mh-identity-handler-top)
(":default" . mh-identity-handler-bottom)
(":attribution-verb" . mh-identity-handler-attribution-verb)
@@ -1613,7 +1565,7 @@ containing the VALUE for the field is given."
;;; Incorporating Your Mail (:group 'mh-inc)
-(defcustom-mh mh-inc-prog "inc"
+(defcustom mh-inc-prog "inc"
"Program to incorporate new mail into a folder.
This program generates a one-line summary for each of the new
@@ -1632,7 +1584,7 @@ several scan line format variables appropriately."
Real definition will take effect when mh-inc is loaded."
nil)))
-(defcustom-mh mh-inc-spool-list nil
+(defcustom mh-inc-spool-list nil
"Alternate spool files.
You can use the `mh-inc-spool-list' variable to direct MH-E to
@@ -1655,17 +1607,14 @@ on the \"INS\" button. Enter a \"Spool File\" of \"~/mail/mh-e\", a
\"Folder\" of \"mh-e\", and a \"Key Binding\" of \"m\".
You can use \"xbuffy\" to automate the incorporation of this mail
-using the Emacs 22 command \"emacsclient\" as follows:
+using \"emacsclient\" as follows:
box ~/mail/mh-e
title mh-e
origMode
polltime 10
headertime 0
- command emacsclient --eval \\='(mh-inc-spool-mh-e)\\='
-
-In XEmacs, the command \"gnuclient\" is used in a similar
-fashion."
+ command emacsclient --eval \\='(mh-inc-spool-mh-e)\\='"
:type '(repeat (list (file :tag "Spool File")
(string :tag "Folder")
(character :tag "Key Binding")))
@@ -1705,7 +1654,7 @@ The function is always called with SYMBOL bound to
until (executable-find (symbol-name (car element)))
finally return (car element)))))
-(defcustom-mh mh-junk-background nil
+(defcustom mh-junk-background nil
"If on, spam programs are run in background.
By default, the programs are run in the foreground, but this can
@@ -1723,14 +1672,14 @@ may be useful for debugging."
:group 'mh-junk
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-junk-disposition nil
+(defcustom mh-junk-disposition nil
"Disposition of junk mail."
:type '(choice (const :tag "Delete Spam" nil)
(string :tag "Spam Folder"))
:group 'mh-junk
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-junk-program nil
+(defcustom mh-junk-program nil
"Spam program that MH-E should use.
The default setting of this option is \"Auto-detect\" which means
@@ -1748,7 +1697,7 @@ bogofilter, then you can set this option to \"Bogofilter\"."
;;; Editing a Draft (:group 'mh-letter)
-(defcustom-mh mh-compose-insertion (if (locate-library "mml") 'mml 'mh)
+(defcustom mh-compose-insertion (if (locate-library "mml") 'mml 'mh)
"Type of tags used when composing MIME messages.
In addition to MH-style directives, MH-E also supports MML (MIME
@@ -1762,7 +1711,7 @@ MH-style directives are preferred."
:group 'mh-letter
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-compose-skipped-header-fields
+(defcustom mh-compose-skipped-header-fields
'("From" "Organization" "References" "In-Reply-To"
"X-Face" "Face" "X-Image-URL" "X-Mailer")
"List of header fields to skip over when navigating in draft."
@@ -1770,13 +1719,13 @@ MH-style directives are preferred."
:group 'mh-letter
:package-version '(MH-E . "7.4"))
-(defcustom-mh mh-compose-space-does-completion-flag nil
+(defcustom mh-compose-space-does-completion-flag nil
"Non-nil means \\<mh-letter-mode-map>\\[mh-letter-complete-or-space] does completion in message header."
:type 'boolean
:group 'mh-letter
:package-version '(MH-E . "7.4"))
-(defcustom-mh mh-delete-yanked-msg-window-flag nil
+(defcustom mh-delete-yanked-msg-window-flag nil
"Non-nil means delete any window displaying the message.
This deletes the window containing the original message after
@@ -1786,7 +1735,7 @@ more room on your screen for your reply."
:group 'mh-letter
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-extract-from-attribution-verb "wrote:"
+(defcustom mh-extract-from-attribution-verb "wrote:"
"Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
The attribution consists of the sender's name and email address
@@ -1800,7 +1749,7 @@ followed by the content of this option. This option can be set to
:group 'mh-letter
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-ins-buf-prefix "> "
+(defcustom mh-ins-buf-prefix "> "
"String to put before each line of a yanked or inserted message.
The prefix \"> \" is the default setting of this option. I
@@ -1816,17 +1765,17 @@ flavors of `mh-yank-behavior' or you have added a
:group 'mh-letter
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-letter-complete-function 'ispell-complete-word
+(defcustom mh-letter-complete-function 'ispell-complete-word
"Function to call when completing outside of address or folder fields.
In the body of the message,
-\\<mh-letter-mode-map>\\[mh-letter-complete] runs this function,
+\\<mh-letter-mode-map>\\[completion-at-point] runs this function,
which is set to \"ispell-complete-word\" by default."
:type '(choice function (const nil))
:group 'mh-letter
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-letter-fill-column 72
+(defcustom mh-letter-fill-column 72
"Fill column to use in MH Letter mode.
By default, this option is 72 to allow others to quote your
@@ -1835,7 +1784,7 @@ message without line wrapping."
:group 'mh-letter
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none")
+(defcustom mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none")
"Default method to use in security tags.
This option is used to select between a variety of mail security
@@ -1858,7 +1807,7 @@ you write!"
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-signature-file-name "~/.signature"
+(defcustom mh-signature-file-name "~/.signature"
"Source of user's signature.
By default, the text of your signature is taken from the file
@@ -1881,7 +1830,7 @@ The signature is inserted into your message with the command
:group 'mh-letter
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-signature-separator-flag t
+(defcustom mh-signature-separator-flag t
"Non-nil means a signature separator should be inserted.
It is not recommended that you change this option since various
@@ -1892,7 +1841,7 @@ replying or yanking a letter into a draft."
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-x-face-file "~/.face"
+(defcustom mh-x-face-file "~/.face"
"File containing face header field to insert in outgoing mail.
If the file starts with either of the strings \"X-Face:\", \"Face:\"
@@ -1921,7 +1870,7 @@ this option doesn't exist."
:group 'mh-letter
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-yank-behavior 'attribution
+(defcustom mh-yank-behavior 'attribution
"Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
To include the entire message, including the entire header, use
@@ -1968,7 +1917,7 @@ inserted."
;;; Ranges (:group 'mh-ranges)
-(defcustom-mh mh-interpret-number-as-range-flag t
+(defcustom mh-interpret-number-as-range-flag t
"Non-nil means interpret a number as a range.
Since one of the most frequent ranges used is \"last:N\", MH-E
@@ -1988,7 +1937,7 @@ message 200, then use the range \"200:200\"."
Real definition, below, uses variables that aren't defined yet."
(set-default symbol value))))
-(defcustom-mh mh-adaptive-cmd-note-flag t
+(defcustom mh-adaptive-cmd-note-flag t
"Non-nil means that the message number width is determined dynamically.
If you've created your own format to handle long message numbers,
@@ -2017,7 +1966,7 @@ set SYMBOL to VALUE."
"unless you use \"Use MH-E scan Format\"")
(set-default symbol value)))
-(defcustom-mh mh-scan-format-file t
+(defcustom mh-scan-format-file t
"Specifies the format file to pass to the scan program.
The default setting for this option is \"Use MH-E scan Format\". This
@@ -2056,7 +2005,7 @@ Otherwise, set SYMBOL to VALUE."
"is set to \"Use MH-E scan Format\"")
(set-default symbol value)))
-(defcustom-mh mh-scan-prog "scan"
+(defcustom mh-scan-prog "scan"
"Program used to scan messages.
The name of the program that generates a listing of one line per
@@ -2071,7 +2020,7 @@ directory. You may link another program to `scan' (see
;;; Searching (:group 'mh-search)
-(defcustom-mh mh-search-program nil
+(defcustom mh-search-program nil
"Search program that MH-E shall use.
The default setting of this option is \"Auto-detect\" which means
@@ -2094,7 +2043,7 @@ MH-E can be found in the documentation of `mh-search'."
;;; Sending Mail (:group 'mh-sending-mail)
-(defcustom-mh mh-compose-forward-as-mime-flag t
+(defcustom mh-compose-forward-as-mime-flag t
"Non-nil means that messages are forwarded as attachments.
By default, this option is on which means that the forwarded
@@ -2110,7 +2059,7 @@ regardless of the settings of this option."
:group 'mh-sending-mail
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-compose-letter-function nil
+(defcustom mh-compose-letter-function nil
"Invoked when starting a new draft.
However, it is the last function called before you edit your
@@ -2122,13 +2071,13 @@ fields."
:group 'mh-sending-mail
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-compose-prompt-flag nil
+(defcustom mh-compose-prompt-flag nil
"Non-nil means prompt for header fields when composing a new draft."
:type 'boolean
:group 'mh-sending-mail
:package-version '(MH-E . "7.4"))
-(defcustom-mh mh-forward-subject-format "%s: %s"
+(defcustom mh-forward-subject-format "%s: %s"
"Format string for forwarded message subject.
This option is a string which includes two escapes (\"%s\"). The
@@ -2138,7 +2087,7 @@ and the second one is replaced with the original \"Subject:\"."
:group 'mh-sending-mail
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-insert-x-mailer-flag t
+(defcustom mh-insert-x-mailer-flag t
"Non-nil means append an \"X-Mailer:\" header field to the header.
This header field includes the version of MH-E and Emacs that you
@@ -2148,7 +2097,7 @@ can turn this option off."
:group 'mh-sending-mail
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-redist-full-contents-flag nil
+(defcustom mh-redist-full-contents-flag nil
"Non-nil means the \"dist\" command needs entire letter for redistribution.
This option must be turned on if \"dist\" requires the whole
@@ -2160,7 +2109,7 @@ has been redistributed before, turn off this option."
:group 'mh-sending-mail
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-reply-default-reply-to nil
+(defcustom mh-reply-default-reply-to nil
"Sets the person or persons to whom a reply will be sent.
This option is set to \"Prompt\" by default so that you are
@@ -2176,7 +2125,7 @@ this option to \"cc\". Other choices include \"from\", \"to\", or
:group 'mh-sending-mail
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-reply-show-message-flag t
+(defcustom mh-reply-show-message-flag t
"Non-nil means the MH-Show buffer is displayed when replying.
If you include the message automatically, you can hide the
@@ -2193,7 +2142,7 @@ See also `mh-reply'."
;; the docstring: "Additional sequences that should not to be preserved can be
;; specified by setting `mh-unpropagated-sequences' appropriately." XXX
-(defcustom-mh mh-refile-preserves-sequences-flag t
+(defcustom mh-refile-preserves-sequences-flag t
"Non-nil means that sequences are preserved when messages are refiled.
If a message is in any sequence (except \"Previous-Sequence:\"
@@ -2204,7 +2153,7 @@ desired, then turn off this option."
:group 'mh-sequences
:package-version '(MH-E . "7.4"))
-(defcustom-mh mh-tick-seq 'tick
+(defcustom mh-tick-seq 'tick
"The name of the MH sequence for ticked messages.
You can customize this option if you already use the \"tick\"
@@ -2216,7 +2165,7 @@ there isn't much advantage to that."
:group 'mh-sequences
:package-version '(MH-E . "7.3"))
-(defcustom-mh mh-update-sequences-after-mh-show-flag t
+(defcustom mh-update-sequences-after-mh-show-flag t
"Non-nil means flush MH sequences to disk after message is shown\\<mh-folder-mode-map>.
Three sequences are maintained internally by MH-E and pushed out
@@ -2231,7 +2180,7 @@ commands."
:group 'mh-sequences
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-allowlist-preserves-sequences-flag t
+(defcustom mh-allowlist-preserves-sequences-flag t
"Non-nil means that sequences are preserved when messages are allowlisted.
If a message is in any sequence (except \"Previous-Sequence:\"
@@ -2244,7 +2193,7 @@ not desired, then turn off this option."
;;; Reading Your Mail (:group 'mh-show)
-(defcustom-mh mh-bury-show-buffer-flag t
+(defcustom mh-bury-show-buffer-flag t
"Non-nil means show buffer is buried.
One advantage of not burying the show buffer is that one can
@@ -2255,7 +2204,7 @@ running \\[electric-buffer-list] to see what I mean."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-clean-message-header-flag t
+(defcustom mh-clean-message-header-flag t
"Non-nil means remove extraneous header fields.
See also `mh-invisible-header-fields-default' and
@@ -2264,7 +2213,7 @@ See also `mh-invisible-header-fields-default' and
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-decode-mime-flag (not (not (locate-library "mm-decode")))
+(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode")))
"Non-nil means attachments are handled\\<mh-folder-mode-map>.
MH-E can handle attachments as well if the Gnus `mm-decode'
@@ -2282,7 +2231,7 @@ messages and other graphical widgets. See the options
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-display-buttons-for-alternatives-flag nil
+(defcustom mh-display-buttons-for-alternatives-flag nil
"Non-nil means display buttons for all alternative attachments.
Sometimes, a mail program will produce multiple alternatives of
@@ -2294,7 +2243,7 @@ inline and buttons are shown for each of the other alternatives."
:group 'mh-show
:package-version '(MH-E . "7.4"))
-(defcustom-mh mh-display-buttons-for-inline-parts-flag nil
+(defcustom mh-display-buttons-for-inline-parts-flag nil
"Non-nil means display buttons for all inline attachments\\<mh-folder-mode-map>.
The sender can request that attachments should be viewed inline so
@@ -2317,7 +2266,7 @@ text (including HTML) and images."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-do-not-confirm-flag nil
+(defcustom mh-do-not-confirm-flag nil
"Non-nil means non-reversible commands do not prompt for confirmation.
Commands such as `mh-pack-folder' prompt to confirm whether to
@@ -2329,7 +2278,7 @@ retracted--without question."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-fetch-x-image-url nil
+(defcustom mh-fetch-x-image-url nil
"Control fetching of \"X-Image-URL:\" header field image.
This option controls the fetching of the \"X-Image-URL:\" header
@@ -2365,7 +2314,7 @@ turned on."
:group 'mh-show
:package-version '(MH-E . "7.3"))
-(defcustom-mh mh-graphical-smileys-flag t
+(defcustom mh-graphical-smileys-flag t
"Non-nil means graphical smileys are displayed.
It is a long standing custom to inject body language using a
@@ -2380,7 +2329,7 @@ turned off."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-graphical-emphasis-flag t
+(defcustom mh-graphical-emphasis-flag t
"Non-nil means graphical emphasis is displayed.
A few typesetting features are indicated in ASCII text with
@@ -2397,7 +2346,7 @@ turned off."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-highlight-citation-style 'gnus
+(defcustom mh-highlight-citation-style 'gnus
"Style for highlighting citations.
If the sender of the message has cited other messages in his
@@ -2819,7 +2768,7 @@ Because the function `mh-invisible-headers' uses both
`mh-invisible-header-fields' and `mh-invisible-header-fields', it
cannot be run until both variables have been initialized.")
-(defcustom-mh mh-invisible-header-fields nil
+(defcustom mh-invisible-header-fields nil
"Additional header fields to hide.
Header fields that you would like to hide that aren't listed in
@@ -2842,7 +2791,7 @@ See also `mh-clean-message-header-flag'."
:group 'mh-show
:package-version '(MH-E . "7.1"))
-(defcustom-mh mh-invisible-header-fields-default nil
+(defcustom mh-invisible-header-fields-default nil
"List of hidden header fields.
The header fields listed in this option are hidden, although you
@@ -2899,7 +2848,7 @@ removed and entries from `mh-invisible-header-fields' are added."
;; Compile invisible header fields.
(mh-invisible-headers)
-(defcustom-mh mh-lpr-command-format "lpr -J '%s'"
+(defcustom mh-lpr-command-format "lpr -J '%s'"
"Command used to print\\<mh-folder-mode-map>.
This option contains the Unix command line which performs the
@@ -2916,7 +2865,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or
:group 'mh-show
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-max-inline-image-height nil
+(defcustom mh-max-inline-image-height nil
"Maximum inline image height if \"Content-Disposition:\" is not present.
Some older mail programs do not insert this needed plumbing to
@@ -2932,7 +2881,7 @@ these numbers."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-max-inline-image-width nil
+(defcustom mh-max-inline-image-width nil
"Maximum inline image width if \"Content-Disposition:\" is not present.
Some older mail programs do not insert this needed plumbing to
@@ -2948,7 +2897,7 @@ these numbers."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-mhl-format-file nil
+(defcustom mh-mhl-format-file nil
"Specifies the format file to pass to the \"mhl\" program.
Normally MH-E takes care of displaying messages itself (rather than
@@ -2972,7 +2921,7 @@ file."
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-mime-save-parts-default-directory t
+(defcustom mh-mime-save-parts-default-directory t
"Default directory to use for \\<mh-folder-mode-map>\\[mh-mime-save-parts].
The default value for this option is \"Prompt Always\" so that
@@ -2988,7 +2937,7 @@ directory's name."
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-print-background-flag nil
+(defcustom mh-print-background-flag nil
"Non-nil means messages should be printed in the background\\<mh-folder-mode-map>.
Normally messages are printed in the foreground. If this is slow on
@@ -3004,7 +2953,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-show-maximum-size 0
+(defcustom mh-show-maximum-size 0
"Maximum size of message (in bytes) to display automatically.
This option provides an opportunity to skip over large messages
@@ -3014,7 +2963,7 @@ message are shown regardless of size."
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-show-use-xface-flag (>= emacs-major-version 21)
+(defcustom mh-show-use-xface-flag (>= emacs-major-version 21)
"Non-nil means display face images in MH-show buffers.
MH-E can display the content of \"Face:\", \"X-Face:\", and
@@ -3029,15 +2978,12 @@ and off. This feature will be turned on by default if your system
supports it.
The first header field used, if present, is the Gnus-specific
-\"Face:\" field. The \"Face:\" field appeared in GNU Emacs 21 and
-XEmacs. For more information, see URL
+\"Face:\" field. The \"Face:\" field appeared in Emacs 21.
+For more information, see URL
`https://quimby.gnus.org/circus/face/'. Next is the traditional
\"X-Face:\" header field. The display of this field requires the
\"uncompface\" program (see URL
-`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent
-versions of XEmacs have internal support for \"X-Face:\" images. If
-your version of XEmacs does not, then you'll need both \"uncompface\"
-and the x-face package (see URL `https://www.jpl.org/ftp/pub/elisp/').
+`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z').
Finally, MH-E will display images referenced by the \"X-Image-URL:\"
header field if neither the \"Face:\" nor the \"X-Face:\" fields are
@@ -3054,7 +3000,7 @@ The option `mh-fetch-x-image-url' controls the fetching of the
:group 'mh-show
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-store-default-directory nil
+(defcustom mh-store-default-directory nil
"Default directory for \\<mh-folder-mode-map>\\[mh-store-msg].
If you would like to change the initial default directory,
@@ -3066,7 +3012,7 @@ the content of these messages."
:group 'mh-show
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-summary-height nil
+(defcustom mh-summary-height nil
"Number of lines in MH-Folder buffer (including the mode line).
The default value of this option is \"Automatic\" which means
@@ -3081,7 +3027,7 @@ lines you'd like to see."
;;; The Speedbar (:group 'mh-speedbar)
-(defcustom-mh mh-speed-update-interval 60
+(defcustom mh-speed-update-interval 60
"Time between speedbar updates in seconds.
Set to 0 to disable automatic update."
:type 'integer
@@ -3090,7 +3036,7 @@ Set to 0 to disable automatic update."
;;; Threading (:group 'mh-thread)
-(defcustom-mh mh-show-threads-flag nil
+(defcustom mh-show-threads-flag nil
"Non-nil means new folders start in threaded mode.
Threading large number of messages can be time consuming so this
@@ -3106,7 +3052,7 @@ threaded is less than `mh-large-folder'."
;; mh-tool-bar-folder-buttons and mh-tool-bar-letter-buttons defined
;; dynamically in mh-tool-bar.el.
-(defcustom-mh mh-tool-bar-search-function 'mh-search
+(defcustom mh-tool-bar-search-function 'mh-search
"Function called by the tool bar search button.
By default, this is set to `mh-search'. You can also choose
@@ -3117,47 +3063,11 @@ of your own choosing."
:group 'mh-tool-bar
:package-version '(MH-E . "7.0"))
-;; XEmacs has a couple of extra customizations...
-(mh-do-in-xemacs
- (defcustom-mh mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag
- "If non-nil, use tool bar.
-
-This option controls whether to show the MH-E icons at all. By
-default, this option is turned on if the window system supports
-tool bars. If your system doesn't support tool bars, then you
-won't be able to turn on this option."
- :type 'boolean
- :group 'mh-tool-bar
- :set (lambda (symbol value)
- (if (and (eq value t)
- (not mh-xemacs-has-tool-bar-flag))
- (error "Tool bar not supported"))
- (set-default symbol value))
- :package-version '(MH-E . "7.3"))
-
- (defcustom-mh mh-xemacs-tool-bar-position nil
- "Tool bar location.
-
-This option controls the placement of the tool bar along the four
-edges of the frame. You can choose from one of \"Same As Default
-Tool Bar\", \"Top\", \"Bottom\", \"Left\", or \"Right\". If this
-variable is set to anything other than \"Same As Default Tool
-Bar\" and the default tool bar is in a different location, then
-two tool bars will be displayed: the MH-E tool bar and the
-default tool bar."
- :type '(radio (const :tag "Same As Default Tool Bar" :value nil)
- (const :tag "Top" :value top)
- (const :tag "Bottom" :value bottom)
- (const :tag "Left" :value left)
- (const :tag "Right" :value right))
- :group 'mh-tool-bar
- :package-version '(MH-E . "7.3")))
-
;;; Hooks (:group 'mh-hooks + group where hook described)
-(defcustom-mh mh-after-commands-processed-hook nil
+(defcustom mh-after-commands-processed-hook nil
"Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] after performing outstanding refile and delete requests.
Variables that are useful in this hook include
@@ -3169,14 +3079,14 @@ folder, which is also available in `mh-current-folder'."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-alias-reloaded-hook nil
+(defcustom mh-alias-reloaded-hook nil
"Hook run by `mh-alias-reload' after loading aliases."
:type 'hook
:group 'mh-hooks
:group 'mh-alias
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-annotate-msg-hook nil
+(defcustom mh-annotate-msg-hook nil
"Hook run when a message is sent and after annotating the scan lines and message.
Hook functions can access the current folder name with
`mh-current-folder' and obtain the message numbers of the
@@ -3186,7 +3096,7 @@ annotated messages with `mh-annotate-list'."
:group 'mh-sending-mail
:package-version '(MH-E . "8.1"))
-(defcustom-mh mh-before-commands-processed-hook nil
+(defcustom mh-before-commands-processed-hook nil
"Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests.
Variables that are useful in this hook include `mh-delete-list',
@@ -3198,7 +3108,7 @@ used to see which changes will be made to the current folder,
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-before-quit-hook nil
+(defcustom mh-before-quit-hook nil
"Hook run by \\<mh-folder-mode-map>\\[mh-quit] before quitting MH-E.
This hook is called before the quit occurs, so you might use it
@@ -3211,7 +3121,7 @@ See also `mh-quit-hook'."
:group 'mh-folder
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-before-send-letter-hook nil
+(defcustom mh-before-send-letter-hook nil
"Hook run at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command.
For example, if you want to check your spelling in your message
@@ -3222,14 +3132,14 @@ before sending, add the `ispell-message' function."
:group 'mh-letter
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-blocklist-msg-hook nil
+(defcustom mh-blocklist-msg-hook nil
"Hook run by \\<mh-letter-mode-map>\\[mh-junk-blocklist] after marking each message for blocklisting."
:type 'hook
:group 'mh-hooks
:group 'mh-show
:package-version '(MH-E . "8.4"))
-(defcustom-mh mh-delete-msg-hook nil
+(defcustom mh-delete-msg-hook nil
"Hook run by \\<mh-letter-mode-map>\\[mh-delete-msg] after marking each message for deletion.
For example, a past maintainer of MH-E used this once when he
@@ -3239,7 +3149,7 @@ kept statistics on his mail usage."
:group 'mh-show
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-find-path-hook nil
+(defcustom mh-find-path-hook nil
"Hook run by `mh-find-path' after reading the user's MH profile.
This hook can be used the change the value of the variables that
@@ -3250,28 +3160,28 @@ between MH and MH-E."
:group 'mh-e
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-folder-mode-hook nil
+(defcustom mh-folder-mode-hook nil
"Hook run by `mh-folder-mode' when visiting a new folder."
:type 'hook
:group 'mh-hooks
:group 'mh-folder
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-forward-hook nil
+(defcustom mh-forward-hook nil
"Hook run by `mh-forward' on a forwarded letter."
:type 'hook
:group 'mh-hooks
:group 'mh-sending-mail
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-inc-folder-hook nil
+(defcustom mh-inc-folder-hook nil
"Hook run by \\<mh-folder-mode-map>\\[mh-inc-folder] after incorporating mail into a folder."
:type 'hook
:group 'mh-hooks
:group 'mh-inc
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-insert-signature-hook nil
+(defcustom mh-insert-signature-hook nil
"Hook run by \\<mh-letter-mode-map>\\[mh-insert-signature] after signature has been inserted.
Hook functions may access the actual name of the file or the
@@ -3282,9 +3192,9 @@ function used to insert the signature with
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(mh-define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
+(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
'mh-kill-folder-suppress-prompt-functions "24.3")
-(defcustom-mh mh-kill-folder-suppress-prompt-functions '(mh-search-p)
+(defcustom mh-kill-folder-suppress-prompt-functions '(mh-search-p)
"Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder].
The hook functions are called with no arguments and should return
@@ -3302,7 +3212,7 @@ accident in the \"+inbox\" folder, you will not be happy."
:group 'mh-folder
:package-version '(MH-E . "7.4"))
-(defcustom-mh mh-letter-mode-hook nil
+(defcustom mh-letter-mode-hook nil
"Hook run by `mh-letter-mode' on a new letter.
This hook allows you to do some processing before editing a
@@ -3315,14 +3225,14 @@ go."
:group 'mh-sending-mail
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-mh-to-mime-hook nil
+(defcustom mh-mh-to-mime-hook nil
"Hook run on the formatted letter by \\<mh-letter-mode-map>\\[mh-mh-to-mime]."
:type 'hook
:group 'mh-hooks
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-search-mode-hook nil
+(defcustom mh-search-mode-hook nil
"Hook run upon entry to `mh-search-mode'\\<mh-folder-mode-map>.
If you find that you do the same thing over and over when editing
@@ -3334,7 +3244,7 @@ This can be done with this hook which is called when
:group 'mh-search
:package-version '(MH-E . "8.0"))
-(defcustom-mh mh-pack-folder-hook nil
+(defcustom mh-pack-folder-hook nil
"Hook run by \\<mh-folder-mode-map>\\[mh-pack-folder] after renumbering the messages.
Hook functions can access the current folder name with `mh-current-folder'."
:type 'hook
@@ -3342,7 +3252,7 @@ Hook functions can access the current folder name with `mh-current-folder'."
:group 'mh-folder
:package-version '(MH-E . "8.2"))
-(defcustom-mh mh-quit-hook nil
+(defcustom mh-quit-hook nil
"Hook run by \\<mh-folder-mode-map>\\[mh-quit] after quitting MH-E.
This hook is not run in an MH-E context, so you might use it to
@@ -3354,14 +3264,14 @@ See also `mh-before-quit-hook'."
:group 'mh-folder
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-refile-msg-hook nil
+(defcustom mh-refile-msg-hook nil
"Hook run by \\<mh-folder-mode-map>\\[mh-refile-msg] after marking each message for refiling."
:type 'hook
:group 'mh-hooks
:group 'mh-folder
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-show-hook nil
+(defcustom mh-show-hook nil
"Hook run after \\<mh-folder-mode-map>\\[mh-show] shows a message.
It is the last thing called after messages are displayed. It's
@@ -3372,7 +3282,7 @@ used to affect the behavior of MH-E in general or when
:group 'mh-show
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-show-mode-hook nil
+(defcustom mh-show-mode-hook nil
"Hook run upon entry to `mh-show-mode'.
This hook is called early on in the process of the message display,
@@ -3384,7 +3294,7 @@ buffer itself. See also `mh-show-hook'."
:group 'mh-show
:package-version '(MH-E . "8.7"))
-(defcustom-mh mh-unseen-updated-hook nil
+(defcustom mh-unseen-updated-hook nil
"Hook run after the unseen sequence has been updated.
The variable `mh-seen-list' can be used by this hook to obtain
@@ -3395,7 +3305,7 @@ sequence."
:group 'mh-sequences
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-allowlist-msg-hook nil
+(defcustom mh-allowlist-msg-hook nil
"Hook run by \\<mh-letter-mode-map>\\[mh-junk-allowlist] after marking each message for allowlisting."
:type 'hook
:group 'mh-hooks
@@ -3406,15 +3316,10 @@ sequence."
;;; Faces (:group 'mh-faces + group where faces described)
-(if (boundp 'facemenu-unlisted-faces)
- ;; This variable was removed in Emacs 22.1.
- (add-to-list 'facemenu-unlisted-faces "^mh-"))
-
;; To add a new face:
;; 1. Add entry to variable mh-face-data.
-;; 2. Create face using defface-mh (which removes min-color spec and
-;; :package-version keyword where these are not supported),
-;; accessing face data with function mh-face-data.
+;; 2. Create face using defface, accessing face data with function
+;; mh-face-data.
;; 3. Add inherit argument to function mh-face-data if applicable.
(defvar mh-face-data
'((mh-folder-followup
@@ -3561,18 +3466,17 @@ sequence."
(:underline t)))))
"MH-E face data.
Used by function `mh-face-data' which returns spec that is
-consumed by `defface-mh'.")
+consumed by `defface'.")
(require 'cus-face)
-(defvar mh-inherit-face-flag (assq :inherit custom-face-attributes)
- "Non-nil means that the `defface' :inherit keyword is available.
-The :inherit keyword is available on all supported versions of
-GNU Emacs and XEmacs from at least 21.5.23 on.")
+(defvar mh-inherit-face-flag t
+ "Non-nil means that the `defface' :inherit keyword is available.")
+(make-obsolete-variable 'mh-inherit-face-flag nil "29.1")
-(defvar mh-min-colors-defined-flag (and (not (featurep 'xemacs))
- (>= emacs-major-version 22))
+(defvar mh-min-colors-defined-flag t
"Non-nil means `defface' supports min-colors display requirement.")
+(make-obsolete-variable 'mh-min-colors-defined-flag nil "29.1")
(defun mh-face-data (face &optional inherit)
"Return spec for FACE.
@@ -3583,53 +3487,26 @@ keyword, return INHERIT literally; otherwise, return spec for
FACE from the variable `mh-face-data'. This isn't a perfect
implementation. In the case that the :inherit keyword is not
supported, any additional attributes in the inherit parameter are
-not added to the returned spec.
-
-Furthermore, when `mh-min-colors-defined-flag' is nil, this
-function finds display entries with \"min-colors\" requirements
-and either removes the \"min-colors\" requirement or strips the
-display entirely if the display does not support the number of
-specified colors."
- (let ((spec
- (if (and inherit mh-inherit-face-flag)
- inherit
- (or (cadr (assq face mh-face-data))
- (error "Could not find %s in mh-face-data" face)))))
-
- (if mh-min-colors-defined-flag
- spec
- (let ((cells (mh-display-color-cells))
- new-spec)
- ;; Remove entries with min-colors, or delete them if we have
- ;; fewer colors than they specify.
- (cl-loop
- for entry in (reverse spec) do
- (let ((requirement (if (eq (car entry) t)
- nil
- (assq 'min-colors (car entry)))))
- (if requirement
- (when (>= cells (nth 1 requirement))
- (setq new-spec (cons (cons (delq requirement (car entry))
- (cdr entry))
- new-spec)))
- (setq new-spec (cons entry new-spec)))))
- new-spec))))
-
-(defface-mh mh-folder-address
+not added to the returned spec."
+ (or inherit
+ (cadr (assq face mh-face-data))
+ (error "Could not find %s in mh-face-data" face)))
+
+(defface mh-folder-address
(mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject))))
"Recipient face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-blocklisted
+(defface mh-folder-blocklisted
(mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number))))
"Blocklisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
-(defface-mh mh-folder-body
+(defface mh-folder-body
(mh-face-data 'mh-folder-msg-number
'((((class color))
(:inherit mh-folder-msg-number))
@@ -3640,7 +3517,7 @@ specified colors."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-cur-msg-number
+(defface mh-folder-cur-msg-number
(mh-face-data 'mh-folder-msg-number
'((t (:inherit mh-folder-msg-number :bold t))))
"Current message number face."
@@ -3648,39 +3525,39 @@ specified colors."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-date
+(defface mh-folder-date
(mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number))))
"Date face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-deleted
+(defface mh-folder-deleted
(mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number))))
"Deleted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-followup (mh-face-data 'mh-folder-followup)
+(defface mh-folder-followup (mh-face-data 'mh-folder-followup)
"\"Re:\" face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-msg-number (mh-face-data 'mh-folder-msg-number)
+(defface mh-folder-msg-number (mh-face-data 'mh-folder-msg-number)
"Message number face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-refiled (mh-face-data 'mh-folder-refiled)
+(defface mh-folder-refiled (mh-face-data 'mh-folder-refiled)
"Refiled message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-sent-to-me-hint
+(defface mh-folder-sent-to-me-hint
(mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-date))))
"Fontification hint face in messages sent directly to us.
The detection of messages sent to us is governed by the scan
@@ -3690,7 +3567,7 @@ format `mh-scan-format-nmh' and the regular expression
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-sent-to-me-sender
+(defface mh-folder-sent-to-me-sender
(mh-face-data 'mh-folder-followup '((t (:inherit mh-folder-followup))))
"Sender face in messages sent directly to us.
The detection of messages sent to us is governed by the scan
@@ -3700,105 +3577,105 @@ format `mh-scan-format-nmh' and the regular expression
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-subject (mh-face-data 'mh-folder-subject)
+(defface mh-folder-subject (mh-face-data 'mh-folder-subject)
"Subject face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-tick (mh-face-data 'mh-folder-tick)
+(defface mh-folder-tick (mh-face-data 'mh-folder-tick)
"Ticked message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-to (mh-face-data 'mh-folder-to)
+(defface mh-folder-to (mh-face-data 'mh-folder-to)
"\"To:\" face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-allowlisted
+(defface mh-folder-allowlisted
(mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled))))
"Allowlisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
-(defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field)
+(defface mh-letter-header-field (mh-face-data 'mh-letter-header-field)
"Editable header field value face in draft buffers."
:group 'mh-faces
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(defface-mh mh-search-folder (mh-face-data 'mh-search-folder)
+(defface mh-search-folder (mh-face-data 'mh-search-folder)
"Folder heading face in MH-Folder buffers created by searches."
:group 'mh-faces
:group 'mh-search
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-cc (mh-face-data 'mh-show-cc)
+(defface mh-show-cc (mh-face-data 'mh-show-cc)
"Face used to highlight \"cc:\" header fields."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-date (mh-face-data 'mh-show-date)
+(defface mh-show-date (mh-face-data 'mh-show-date)
"Face used to highlight \"Date:\" header fields."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-from (mh-face-data 'mh-show-from)
+(defface mh-show-from (mh-face-data 'mh-show-from)
"Face used to highlight \"From:\" header fields."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-header (mh-face-data 'mh-show-header)
+(defface mh-show-header (mh-face-data 'mh-show-header)
"Face used to deemphasize less interesting header fields."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad)
+(defface mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad)
"Bad PGG signature face."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-pgg-good (mh-face-data 'mh-show-pgg-good)
+(defface mh-show-pgg-good (mh-face-data 'mh-show-pgg-good)
"Good PGG signature face."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown)
+(defface mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown)
"Unknown or untrusted PGG signature face."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-signature (mh-face-data 'mh-show-signature)
+(defface mh-show-signature (mh-face-data 'mh-show-signature)
"Signature face."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-subject
+(defface mh-show-subject
(mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject))))
"Face used to highlight \"Subject:\" header fields."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-to (mh-face-data 'mh-show-to)
+(defface mh-show-to (mh-face-data 'mh-show-to)
"Face used to highlight \"To:\" header fields."
:group 'mh-faces
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-show-xface
+(defface mh-show-xface
(mh-face-data 'mh-show-from '((t (:inherit (mh-show-from highlight)))))
"X-Face image face.
The background and foreground are used in the image."
@@ -3806,13 +3683,13 @@ The background and foreground are used in the image."
:group 'mh-show
:package-version '(MH-E . "8.0"))
-(defface-mh mh-speedbar-folder (mh-face-data 'mh-speedbar-folder)
+(defface mh-speedbar-folder (mh-face-data 'mh-speedbar-folder)
"Basic folder face."
:group 'mh-faces
:group 'mh-speedbar
:package-version '(MH-E . "8.0"))
-(defface-mh mh-speedbar-folder-with-unseen-messages
+(defface mh-speedbar-folder-with-unseen-messages
(mh-face-data 'mh-speedbar-folder
'((t (:inherit mh-speedbar-folder :bold t))))
"Folder face when folder contains unread messages."
@@ -3820,14 +3697,14 @@ The background and foreground are used in the image."
:group 'mh-speedbar
:package-version '(MH-E . "8.0"))
-(defface-mh mh-speedbar-selected-folder
+(defface mh-speedbar-selected-folder
(mh-face-data 'mh-speedbar-selected-folder)
"Selected folder face."
:group 'mh-faces
:group 'mh-speedbar
:package-version '(MH-E . "8.0"))
-(defface-mh mh-speedbar-selected-folder-with-unseen-messages
+(defface mh-speedbar-selected-folder-with-unseen-messages
(mh-face-data 'mh-speedbar-selected-folder
'((t (:inherit mh-speedbar-selected-folder :bold t))))
"Selected folder face when folder contains unread messages."
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 1388f393b09..09df0465eda 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -72,10 +72,8 @@ the MH mail system."
;;; Desktop Integration
-;; desktop-buffer-mode-handlers appeared in Emacs 22.
-(if (boundp 'desktop-buffer-mode-handlers)
- (add-to-list 'desktop-buffer-mode-handlers
- '(mh-folder-mode . mh-restore-desktop-buffer)))
+(add-to-list 'desktop-buffer-mode-handlers
+ '(mh-folder-mode . mh-restore-desktop-buffer))
(defun mh-restore-desktop-buffer (_file-name name _misc)
"Restore an MH folder buffer specified in a desktop file.
@@ -213,141 +211,137 @@ annotation.")
(defalias 'mh-alt-visit-folder #'mh-visit-folder)
;; Save the "b" binding for a future `back'. Maybe?
-(gnus-define-keys mh-folder-mode-map
- " " mh-page-msg
- "!" mh-refile-or-write-again
- "'" mh-toggle-tick
- "," mh-header-display
- "." mh-alt-show
- ":" mh-show-preferred-alternative
- ";" mh-toggle-mh-decode-mime-flag
- ">" mh-write-msg-to-file
- "?" mh-help
- "E" mh-extract-rejected-mail
- "M" mh-modify
- "\177" mh-previous-page
- "\C-d" mh-delete-msg-no-motion
- "\t" mh-index-next-folder
- [backtab] mh-index-previous-folder
- "\M-\t" mh-index-previous-folder
- "\e<" mh-first-msg
- "\e>" mh-last-msg
- "\ed" mh-redistribute
- "\r" mh-show
- "^" mh-alt-refile-msg
- "c" mh-copy-msg
- "d" mh-delete-msg
- "e" mh-edit-again
- "f" mh-forward
- "g" mh-goto-msg
- "i" mh-inc-folder
- "k" mh-delete-subject-or-thread
- "m" mh-alt-send
- "n" mh-next-undeleted-msg
- "\M-n" mh-next-unread-msg
- "o" mh-refile-msg
- "p" mh-previous-undeleted-msg
- "\M-p" mh-previous-unread-msg
- "q" mh-quit
- "r" mh-reply
- "s" mh-send
- "t" mh-toggle-showing
- "u" mh-undo
- "v" mh-index-visit-folder
- "x" mh-execute-commands
- "|" mh-pipe-msg)
-
-(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
- "?" mh-prefix-help
- "'" mh-index-ticked-messages
- "S" mh-sort-folder
- "c" mh-catchup
- "f" mh-alt-visit-folder
- "k" mh-kill-folder
- "l" mh-list-folders
- "n" mh-index-new-messages
- "o" mh-alt-visit-folder
- "p" mh-pack-folder
- "q" mh-index-sequenced-messages
- "r" mh-rescan-folder
- "s" mh-search
- "u" mh-undo-folder
- "v" mh-visit-folder)
-
-(define-key mh-folder-mode-map "I" mh-inc-spool-map)
-
-(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
- "?" mh-prefix-help
- "a" mh-junk-allowlist
- "b" mh-junk-blocklist
- "w" mh-junk-whitelist)
-
-(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
- "?" mh-prefix-help
- "C" mh-ps-print-toggle-color
- "F" mh-ps-print-toggle-faces
- "f" mh-ps-print-msg-file
- "l" mh-print-msg
- "p" mh-ps-print-msg)
-
-(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
- "'" mh-narrow-to-tick
- "?" mh-prefix-help
- "d" mh-delete-msg-from-seq
- "k" mh-delete-seq
- "l" mh-list-sequences
- "n" mh-narrow-to-seq
- "p" mh-put-msg-in-seq
- "s" mh-msg-is-in-seq
- "w" mh-widen)
-
-(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
- "?" mh-prefix-help
- "u" mh-thread-ancestor
- "p" mh-thread-previous-sibling
- "n" mh-thread-next-sibling
- "t" mh-toggle-threads
- "d" mh-thread-delete
- "o" mh-thread-refile)
-
-(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
- "'" mh-narrow-to-tick
- "?" mh-prefix-help
- "c" mh-narrow-to-cc
- "g" mh-narrow-to-range
- "m" mh-narrow-to-from
- "s" mh-narrow-to-subject
- "t" mh-narrow-to-to
- "w" mh-widen)
-
-(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
- "?" mh-prefix-help
- "s" mh-store-msg ;shar
- "u" mh-store-msg) ;uuencode
-
-(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
- " " mh-page-digest
- "?" mh-prefix-help
- "\177" mh-page-digest-backwards
- "b" mh-burst-digest)
-
-(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
- "?" mh-prefix-help
- "a" mh-mime-save-parts
- "e" mh-display-with-external-viewer
- "i" mh-folder-inline-mime-part
- "o" mh-folder-save-mime-part
- "t" mh-toggle-mime-buttons
- "v" mh-folder-toggle-mime-part
- "\t" mh-next-button
- [backtab] mh-prev-button
- "\M-\t" mh-prev-button)
-
-(cond
- ((featurep 'xemacs)
- (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
- (t
- (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
+(define-keymap :keymap mh-folder-mode-map
+ "SPC" #'mh-page-msg
+ "!" #'mh-refile-or-write-again
+ "'" #'mh-toggle-tick
+ "," #'mh-header-display
+ "." #'mh-alt-show
+ ":" #'mh-show-preferred-alternative
+ ";" #'mh-toggle-mh-decode-mime-flag
+ ">" #'mh-write-msg-to-file
+ "?" #'mh-help
+ "E" #'mh-extract-rejected-mail
+ "M" #'mh-modify
+ "DEL" #'mh-previous-page
+ "C-d" #'mh-delete-msg-no-motion
+ "TAB" #'mh-index-next-folder
+ "<backtab>" #'mh-index-previous-folder
+ "C-M-i" #'mh-index-previous-folder
+ "ESC <" #'mh-first-msg
+ "ESC >" #'mh-last-msg
+ "ESC d" #'mh-redistribute
+ "RET" #'mh-show
+ "^" #'mh-alt-refile-msg
+ "c" #'mh-copy-msg
+ "d" #'mh-delete-msg
+ "e" #'mh-edit-again
+ "f" #'mh-forward
+ "g" #'mh-goto-msg
+ "i" #'mh-inc-folder
+ "k" #'mh-delete-subject-or-thread
+ "m" #'mh-alt-send
+ "n" #'mh-next-undeleted-msg
+ "M-n" #'mh-next-unread-msg
+ "o" #'mh-refile-msg
+ "p" #'mh-previous-undeleted-msg
+ "M-p" #'mh-previous-unread-msg
+ "q" #'mh-quit
+ "r" #'mh-reply
+ "s" #'mh-send
+ "t" #'mh-toggle-showing
+ "u" #'mh-undo
+ "v" #'mh-index-visit-folder
+ "x" #'mh-execute-commands
+ "|" #'mh-pipe-msg
+
+ "F" (define-keymap :prefix 'mh-folder-map
+ "?" #'mh-prefix-help
+ "'" #'mh-index-ticked-messages
+ "S" #'mh-sort-folder
+ "c" #'mh-catchup
+ "f" #'mh-alt-visit-folder
+ "k" #'mh-kill-folder
+ "l" #'mh-list-folders
+ "n" #'mh-index-new-messages
+ "o" #'mh-alt-visit-folder
+ "p" #'mh-pack-folder
+ "q" #'mh-index-sequenced-messages
+ "r" #'mh-rescan-folder
+ "s" #'mh-search
+ "u" #'mh-undo-folder
+ "v" #'mh-visit-folder)
+
+ "I" mh-inc-spool-map
+
+ "J" (define-keymap :prefix 'mh-junk-map
+ "?" #'mh-prefix-help
+ "a" #'mh-junk-allowlist
+ "b" #'mh-junk-blocklist
+ "w" #'mh-junk-whitelist)
+
+ "P" (define-keymap :prefix 'mh-ps-print-map
+ "?" #'mh-prefix-help
+ "C" #'mh-ps-print-toggle-color
+ "F" #'mh-ps-print-toggle-faces
+ "f" #'mh-ps-print-msg-file
+ "l" #'mh-print-msg
+ "p" #'mh-ps-print-msg)
+
+ "S" (define-keymap :prefix 'mh-sequence-map
+ "'" #'mh-narrow-to-tick
+ "?" #'mh-prefix-help
+ "d" #'mh-delete-msg-from-seq
+ "k" #'mh-delete-seq
+ "l" #'mh-list-sequences
+ "n" #'mh-narrow-to-seq
+ "p" #'mh-put-msg-in-seq
+ "s" #'mh-msg-is-in-seq
+ "w" #'mh-widen)
+
+ "T" (define-keymap :prefix 'mh-thread-map
+ "?" #'mh-prefix-help
+ "u" #'mh-thread-ancestor
+ "p" #'mh-thread-previous-sibling
+ "n" #'mh-thread-next-sibling
+ "t" #'mh-toggle-threads
+ "d" #'mh-thread-delete
+ "o" #'mh-thread-refile)
+
+ "/" (define-keymap :prefix 'mh-limit-map
+ "'" #'mh-narrow-to-tick
+ "?" #'mh-prefix-help
+ "c" #'mh-narrow-to-cc
+ "g" #'mh-narrow-to-range
+ "m" #'mh-narrow-to-from
+ "s" #'mh-narrow-to-subject
+ "t" #'mh-narrow-to-to
+ "w" #'mh-widen)
+
+ "X" (define-keymap :prefix 'mh-extract-map
+ "?" #'mh-prefix-help
+ "s" #'mh-store-msg ;shar
+ "u" #'mh-store-msg) ;uuencode
+
+ "D" (define-keymap :prefix 'mh-digest-map
+ "SPC" #'mh-page-digest
+ "?" #'mh-prefix-help
+ "DEL" #'mh-page-digest-backwards
+ "b" #'mh-burst-digest)
+
+ "K" (define-keymap :prefix 'mh-mime-map
+ "?" #'mh-prefix-help
+ "a" #'mh-mime-save-parts
+ "e" #'mh-display-with-external-viewer
+ "i" #'mh-folder-inline-mime-part
+ "o" #'mh-folder-save-mime-part
+ "t" #'mh-toggle-mime-buttons
+ "v" #'mh-folder-toggle-mime-part
+ "TAB" #'mh-next-button
+ "<backtab>" #'mh-prev-button
+ "C-M-i" #'mh-prev-button)
+
+ "<mouse-2>" #'mh-show-mouse)
;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
@@ -512,24 +506,14 @@ font-lock is done highlighting.")
;;; MH-Folder Mode
(defmacro mh-remove-xemacs-horizontal-scrollbar ()
- "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
- (when (featurep 'xemacs)
- '(if (and (featurep 'scrollbar)
- (fboundp 'set-specifier))
- (set-specifier horizontal-scrollbar-visible-p nil
- (cons (current-buffer) nil)))))
+ (declare (obsolete nil "29.1"))
+ nil)
;; Register mh-folder-mode as supporting which-function-mode...
-(eval-and-compile (mh-require 'which-func nil t))
+(eval-and-compile (require 'which-func nil t))
(when (and (boundp 'which-func-modes) (listp which-func-modes))
(add-to-list 'which-func-modes 'mh-folder-mode))
-;; Shush compiler.
-(defvar desktop-save-buffer)
-(defvar font-lock-auto-fontify)
-(mh-do-in-xemacs
- (defvar font-lock-defaults))
-
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-folder-mode 'mode-class 'special)
@@ -590,80 +574,68 @@ region in the MH-Folder buffer, then the MH-E command will
perform the operation on all messages in that region.
\\{mh-folder-mode-map}"
- (mh-do-in-gnu-emacs
- (unless mh-folder-tool-bar-map
- (mh-tool-bar-folder-buttons-init))
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)))
- (mh-do-in-xemacs
- (mh-tool-bar-init :folder))
+ (unless mh-folder-tool-bar-map
+ (mh-tool-bar-folder-buttons-init))
+ (if (boundp 'tool-bar-map)
+ (setq-local tool-bar-map mh-folder-tool-bar-map))
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(mh-folder-font-lock-keywords t))
(make-local-variable 'desktop-save-buffer)
(setq desktop-save-buffer t)
- (mh-make-local-vars
- 'mh-colors-available-flag (mh-colors-available-p)
+ (setq-local
+ mh-colors-available-flag (mh-colors-available-p)
; Do we have colors available
- 'mh-current-folder (buffer-name) ; Name of folder, a string
- 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
- 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
+ mh-current-folder (buffer-name) ; Name of folder, a string
+ mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
+ mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
(file-name-as-directory (mh-expand-file-name (buffer-name)))
- 'mh-display-buttons-for-inline-parts-flag
+ mh-display-buttons-for-inline-parts-flag
mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
; be toggled.
- 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
- 'overlay-arrow-position nil ; Allow for simultaneous display in
- 'overlay-arrow-string ">" ; different MH-E buffers.
- 'mh-showing-mode nil ; Show message also?
- 'mh-refile-list nil ; List of folder names in mh-seq-list
- 'mh-delete-list nil ; List of msgs nums to delete
- 'mh-blocklist nil ; List of messages to process as spam
- 'mh-allowlist nil ; List of messages to process as ham
- 'mh-seq-list nil ; Alist of (seq . msgs) nums
- 'mh-seen-list nil ; List of displayed messages
- 'mh-next-direction 'forward ; Direction to move to next message
- 'mh-view-ops () ; Stack that keeps track of the order
+ mh-arrow-marker (make-marker) ; Marker where arrow is displayed
+ overlay-arrow-position nil ; Allow for simultaneous display in
+ overlay-arrow-string ">" ; different MH-E buffers.
+ mh-showing-mode nil ; Show message also?
+ mh-refile-list nil ; List of folder names in mh-seq-list
+ mh-delete-list nil ; List of msgs nums to delete
+ mh-blocklist nil ; List of messages to process as spam
+ mh-allowlist nil ; List of messages to process as ham
+ mh-seq-list nil ; Alist of (seq . msgs) nums
+ mh-seen-list nil ; List of displayed messages
+ mh-next-direction 'forward ; Direction to move to next message
+ mh-view-ops () ; Stack that keeps track of the order
; in which narrowing/threading has been
; carried out.
- 'mh-folder-view-stack () ; Stack of previous views of the
+ mh-folder-view-stack () ; Stack of previous views of the
; folder.
- 'mh-index-data nil ; If the folder was created by a call
+ mh-index-data nil ; If the folder was created by a call
; to mh-search, this contains info
; about the search results.
- 'mh-index-previous-search nil ; folder, indexer, search-regexp
- 'mh-index-msg-checksum-map nil ; msg -> checksum map
- 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
- 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
- 'mh-first-msg-num nil ; Number of first msg in buffer
- 'mh-last-msg-num nil ; Number of last msg in buffer
- 'mh-msg-count nil ; Number of msgs in buffer
- 'mh-mode-line-annotation nil ; Indicates message range
- 'mh-sequence-notation-history (make-hash-table)
+ mh-index-previous-search nil ; folder, indexer, search-regexp
+ mh-index-msg-checksum-map nil ; msg -> checksum map
+ mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
+ mh-index-sequence-search-flag nil ; folder resulted from sequence search
+ mh-first-msg-num nil ; Number of first msg in buffer
+ mh-last-msg-num nil ; Number of last msg in buffer
+ mh-msg-count nil ; Number of msgs in buffer
+ mh-mode-line-annotation nil ; Indicates message range
+ mh-sequence-notation-history (make-hash-table)
; Remember what is overwritten by
; mh-note-seq.
- 'imenu-create-index-function 'mh-index-create-imenu-index
+ imenu-create-index-function 'mh-index-create-imenu-index
; Setup imenu support
- 'mh-previous-window-config nil) ; Previous window configuration
- (mh-remove-xemacs-horizontal-scrollbar)
+ mh-previous-window-config nil) ; Previous window configuration
(setq truncate-lines t)
(auto-save-mode -1)
(setq buffer-offer-save t)
- (mh-make-local-hook (mh-write-file-functions))
- (add-hook (mh-write-file-functions) #'mh-execute-commands nil t)
+ (add-hook 'write-file-functions #'mh-execute-commands nil t)
(make-local-variable 'revert-buffer-function)
(make-local-variable 'hl-line-mode) ; avoid pollution
- (mh-funcall-if-exists hl-line-mode 1)
+ (hl-line-mode 1)
(setq revert-buffer-function #'mh-undo-folder)
(add-to-list 'minor-mode-alist '(mh-showing-mode " Show"))
- (mh-do-in-xemacs
- (easy-menu-add mh-folder-sequence-menu)
- (easy-menu-add mh-folder-message-menu)
- (easy-menu-add mh-folder-folder-menu))
(mh-inc-spool-make)
- (mh-set-help mh-folder-mode-help-messages)
- (if (and (featurep 'xemacs)
- font-lock-auto-fontify)
- (turn-on-font-lock))) ; Force font-lock in XEmacs.
+ (mh-set-help mh-folder-mode-help-messages))
@@ -1571,35 +1543,35 @@ after the commands are processed."
(append folders-changed (mh-index-execute-commands))))
;; Then refile messages
- (mh-mapc #'(lambda (folder-msg-list)
- (let* ((dest-folder (symbol-name (car folder-msg-list)))
- (last (car (mh-translate-range dest-folder "last")))
- (msgs (cdr folder-msg-list)))
- (push dest-folder folders-changed)
- (setq redraw-needed-flag t)
- (apply #'mh-exec-cmd
- "refile" "-src" folder dest-folder
- (mh-coalesce-msg-list msgs))
- (mh-delete-scan-msgs msgs)
- ;; Preserve sequences in destination folder...
- (when mh-refile-preserves-sequences-flag
- (clrhash dest-map)
- (cl-loop
- for i from (1+ (or last 0))
- for msg in (sort (copy-sequence msgs) #'<)
- do (cl-loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name dest-map))))
- (maphash
- #'(lambda (seq msgs)
- ;; Can't be run in the background, since the
- ;; current folder is changed by mark this could
- ;; lead to a race condition with the next refile.
- (apply #'mh-exec-cmd "mark"
- "-sequence" (symbol-name seq) dest-folder
- "-add" (mapcar #'(lambda (x) (format "%s" x))
- (mh-coalesce-msg-list msgs))))
- dest-map))))
- mh-refile-list)
+ (mapc (lambda (folder-msg-list)
+ (let* ((dest-folder (symbol-name (car folder-msg-list)))
+ (last (car (mh-translate-range dest-folder "last")))
+ (msgs (cdr folder-msg-list)))
+ (push dest-folder folders-changed)
+ (setq redraw-needed-flag t)
+ (apply #'mh-exec-cmd
+ "refile" "-src" folder dest-folder
+ (mh-coalesce-msg-list msgs))
+ (mh-delete-scan-msgs msgs)
+ ;; Preserve sequences in destination folder...
+ (when mh-refile-preserves-sequences-flag
+ (clrhash dest-map)
+ (cl-loop
+ for i from (1+ (or last 0))
+ for msg in (sort (copy-sequence msgs) #'<)
+ do (cl-loop for seq-name in (gethash msg seq-map)
+ do (push i (gethash seq-name dest-map))))
+ (maphash
+ #'(lambda (seq msgs)
+ ;; Can't be run in the background, since the
+ ;; current folder is changed by mark this could
+ ;; lead to a race condition with the next refile.
+ (apply #'mh-exec-cmd "mark"
+ "-sequence" (symbol-name seq) dest-folder
+ "-add" (mapcar #'(lambda (x) (format "%s" x))
+ (mh-coalesce-msg-list msgs))))
+ dest-map))))
+ mh-refile-list)
(setq mh-refile-list ())
;; Now delete messages
@@ -1642,14 +1614,14 @@ after the commands are processed."
do (cl-loop for seq-name in (gethash msg seq-map)
do (push i (gethash seq-name allow-map))))
(maphash
- #'(lambda (seq msgs)
- ;; Can't be run in background, since the current
- ;; folder is changed by mark this could lead to a
- ;; race condition with the next refile/allowlist.
- (apply #'mh-exec-cmd "mark"
- "-sequence" (symbol-name seq) mh-inbox
- "-add" (mapcar #'(lambda(x) (format "%s" x))
- (mh-coalesce-msg-list msgs))))
+ (lambda (seq msgs)
+ ;; Can't be run in background, since the current
+ ;; folder is changed by mark this could lead to a
+ ;; race condition with the next refile/allowlist.
+ (apply #'mh-exec-cmd "mark"
+ "-sequence" (symbol-name seq) mh-inbox
+ "-add" (mapcar #'(lambda(x) (format "%s" x))
+ (mh-coalesce-msg-list msgs))))
allow-map))
(setq mh-allowlist nil)))
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index ccb1688510c..f011ea47f80 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -147,7 +147,7 @@ Display the results only if something went wrong."
"-recurse"
"-norecurse"))
(goto-char (point-min))
- (mh-view-mode-enter)
+ (view-mode-enter)
(setq view-exit-action 'kill-buffer)
(message "Listing folders...done")))))
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index 5b587a2b805..c341b096834 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -29,110 +29,49 @@
(require 'mh-e)
(eval-and-compile
- (mh-require 'gnus-util nil t)
- (mh-require 'mm-bodies nil t)
- (mh-require 'mm-decode nil t)
- (mh-require 'mm-view nil t)
- (mh-require 'mml nil t))
-
-;; Copy of function from gnus-util.el.
-;; TODO This is not in Gnus 5.11.
-(defun-mh mh-gnus-local-map-property gnus-local-map-property (map)
+ (require 'gnus-util nil t)
+ (require 'mm-bodies nil t)
+ (require 'mm-decode nil t)
+ (require 'mm-view nil t)
+ (require 'mml nil t))
+
+(defun mh-gnus-local-map-property (map)
"Return a list suitable for a text property list specifying keymap MAP."
- (cond ((featurep 'xemacs) (list 'keymap map))
- ((>= emacs-major-version 21) (list 'keymap map))
- (t (list 'local-map map))))
-
-;; Copy of function from mm-decode.el.
-(defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2)
- (append
- (if (listp (car handles1))
- handles1
- (list handles1))
- (if (listp (car handles2))
- handles2
- (list handles2))))
-
-;; Copy of function from mm-decode.el.
-(defun-mh mh-mm-set-handle-multipart-parameter
- mm-set-handle-multipart-parameter (handle parameter value)
- ;; HANDLE could be a CTL.
- (when handle
- (put-text-property 0 (length (car handle)) parameter value
- (car handle))))
-
-;; Copy of function from mm-view.el.
-(defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle)
- (let ((inhibit-read-only t))
- (mm-insert-inline
- handle
- (concat "\n-- \n"
- (ignore-errors
- (if (fboundp 'vcard-pretty-print)
- (vcard-pretty-print (mm-get-part handle))
- (vcard-format-string
- (vcard-parse-string (mm-get-part handle)
- 'vcard-standard-filter))))))))
-
-;; Function from mm-decode.el used in PGP messages. Just define it with older
-;; Gnus to avoid compiler warning.
-(defun-mh mh-mm-possibly-verify-or-decrypt
- mm-possibly-verify-or-decrypt (_parts _ctl)
- nil)
-
-;; Copy of macro in mm-decode.el.
-(defmacro-mh mh-mm-handle-multipart-ctl-parameter
- mm-handle-multipart-ctl-parameter (handle parameter)
- `(get-text-property 0 ,parameter (car ,handle)))
-
-;; Copy of function in mm-decode.el.
-(defun-mh mh-mm-readable-p mm-readable-p (handle)
- "Say whether the content of HANDLE is readable."
- (and (< (with-current-buffer (mm-handle-buffer handle)
- (buffer-size)) 10000)
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (and (eq (mm-body-7-or-8) '7bit)
- (not (mh-mm-long-lines-p 76))))))
-
-;; Copy of function in mm-bodies.el.
-(defun-mh mh-mm-long-lines-p mm-long-lines-p (length)
- "Say whether any of the lines in the buffer is longer than LENGTH."
- (save-excursion
- (goto-char (point-min))
- (end-of-line)
- (while (and (not (eobp))
- (not (> (current-column) length)))
- (forward-line 1)
- (end-of-line))
- (and (> (current-column) length)
- (current-column))))
-
-(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (_handle)
- ;; Released Gnus doesn't keep handles associated with externally displayed
- ;; MIME parts. So this will always return nil.
- nil)
-
-(defun-mh mh-mm-destroy-parts mm-destroy-parts (_list)
- "Older versions of Emacs don't have this function."
- nil)
-
-(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (_handles)
- "Emacs 21 and XEmacs don't have this function."
- nil)
-
-;; Copy of function in mml.el.
-(defun-mh mh-mml-minibuffer-read-disposition
- mml-minibuffer-read-disposition (type &optional default filename)
- (unless default
- (setq default (mml-content-disposition type filename)))
- (let ((disposition (completing-read
- (format-prompt "Disposition" default)
- '(("attachment") ("inline") (""))
- nil t nil nil default)))
- (if (not (equal disposition ""))
- disposition
- default)))
+ (declare (obsolete nil "29.1"))
+ (list 'keymap map))
+
+(define-obsolete-function-alias 'mh-mm-merge-handles
+ #'mm-merge-handles "29.1")
+
+(define-obsolete-function-alias 'mh-mm-set-handle-multipart-parameter
+ #'mm-set-handle-multipart-parameter "29.1")
+
+(define-obsolete-function-alias 'mh-mm-inline-text-vcard
+ #'mm-inline-text-vcard "29.1")
+
+(define-obsolete-function-alias 'mh-mm-possibly-verify-or-decrypt
+ #'mm-possibly-verify-or-decrypt "29.1")
+
+(define-obsolete-function-alias 'mh-mm-handle-multipart-ctl-parameter
+ #'mm-handle-multipart-ctl-parameter "29.1")
+
+(define-obsolete-function-alias 'mh-mm-readable-p
+ #'mm-readable-p "29.1")
+
+(define-obsolete-function-alias 'mh-mm-long-lines-p
+ #'mm-long-lines-p "29.1")
+
+(define-obsolete-function-alias 'mh-mm-keep-viewer-alive-p
+ #'mm-keep-viewer-alive-p "29.1")
+
+(define-obsolete-function-alias 'mh-mm-destroy-parts
+ #'mm-destroy-parts "29.1")
+
+(define-obsolete-function-alias 'mh-mm-uu-dissect-text-parts
+ #'mm-uu-dissect-text-parts "29.1")
+
+(define-obsolete-function-alias 'mh-mml-minibuffer-read-disposition
+ #'mml-minibuffer-read-disposition "29.1")
;; This is mm-save-part from Gnus 5.11 since that function in Emacs
;; 21.2 is buggy (the args to read-file-name are incorrect) and the
@@ -163,8 +102,8 @@ PROMPT overrides the default one used to ask user for a file name."
(defun mh-mm-text-html-renderer ()
"Find the renderer Gnus is using to display text/html MIME parts."
- (or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer)
- (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))
+ (declare (obsolete mm-text-html-renderer "29.1"))
+ mm-text-html-renderer)
(provide 'mh-gnus)
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index 63a2d98129c..43eaeb7aa0f 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -39,11 +39,10 @@
(autoload 'mml-insert-tag "mml")
-(defvar mh-identity-pgg-default-user-id nil
+(defvar-local mh-identity-pgg-default-user-id nil
"Holds the GPG key ID to be used by pgg.el.
This is normally set as part of an Identity in
`mh-identity-list'.")
-(make-variable-buffer-local 'mh-identity-pgg-default-user-id)
(defvar mh-identity-menu nil
"The Identity menu.")
@@ -54,8 +53,7 @@ This is normally set as part of an Identity in
(defun mh-identity-make-menu ()
"Build the Identity menu.
This should be called any time `mh-identity-list' or
-`mh-auto-fields-list' change.
-See `mh-identity-add-menu'."
+`mh-auto-fields-list' change."
(easy-menu-define mh-identity-menu mh-letter-mode-map
"MH-E identity menu"
(append
@@ -88,12 +86,11 @@ See `mh-identity-add-menu'."
(defun mh-identity-add-menu ()
"Add the current Identity menu.
See `mh-identity-make-menu'."
- (if mh-identity-menu
- (mh-do-in-xemacs (easy-menu-add mh-identity-menu))))
+ (declare (obsolete nil "29.1"))
+ nil)
-(defvar mh-identity-local nil
+(defvar-local mh-identity-local nil
"Buffer-local variable that holds the identity currently in use.")
-(make-variable-buffer-local 'mh-identity-local)
(defun mh-header-field-delete (field value-only)
"Delete header FIELD, or only its value if VALUE-ONLY is t.
@@ -122,7 +119,7 @@ The field name is downcased. If the FIELD begins with the
character \":\", then it must have a special handler defined in
`mh-identity-handlers', else return an error since it is not a
valid header field."
- (or (cdr (mh-assoc-string field mh-identity-handlers t))
+ (or (cdr (assoc-string field mh-identity-handlers t))
(and (eq (aref field 0) ?:)
(error "Field %s not found in `mh-identity-handlers'" field))
(cdr (assoc ":default" mh-identity-handlers))
@@ -235,11 +232,9 @@ added."
(if (null value)
(mh-insert-signature)
(mh-insert-signature value))
- (set (make-local-variable 'mh-identity-signature-start)
- (point-min-marker))
+ (setq-local mh-identity-signature-start (point-min-marker))
(set-marker-insertion-type mh-identity-signature-start t)
- (set (make-local-variable 'mh-identity-signature-end)
- (point-max-marker)))))))
+ (setq-local mh-identity-signature-end (point-max-marker)))))))
(defvar mh-identity-attribution-verb-start nil
"Marker for the beginning of the attribution verb.")
@@ -271,11 +266,9 @@ If VALUE is nil, use `mh-extract-from-attribution-verb'."
(if (null value)
(insert mh-extract-from-attribution-verb)
(insert value))
- (set (make-local-variable 'mh-identity-attribution-verb-start)
- (point-min-marker))
+ (setq-local mh-identity-attribution-verb-start (point-min-marker))
(set-marker-insertion-type mh-identity-attribution-verb-start t)
- (set (make-local-variable 'mh-identity-attribution-verb-end)
- (point-max-marker))))
+ (setq-local mh-identity-attribution-verb-end (point-max-marker))))
(defun mh-identity-handler-default (field action top &optional value)
"Process header FIELD.
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index 0a71e6b67a3..4e3e1012315 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -114,68 +114,68 @@
;;; MH-Letter Keys
;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
-(gnus-define-keys mh-letter-mode-map
- " " mh-letter-complete-or-space
- "," mh-letter-confirm-address
- "\C-c?" mh-help
- "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
- "\C-c\C-^" mh-insert-signature ;if no C-s
- "\C-c\C-c" mh-send-letter
- "\C-c\C-d" mh-insert-identity
- "\C-c\C-e" mh-mh-to-mime
- "\C-c\C-f\C-a" mh-to-field
- "\C-c\C-f\C-b" mh-to-field
- "\C-c\C-f\C-c" mh-to-field
- "\C-c\C-f\C-d" mh-to-field
- "\C-c\C-f\C-f" mh-to-fcc
- "\C-c\C-f\C-l" mh-to-field
- "\C-c\C-f\C-m" mh-to-field
- "\C-c\C-f\C-r" mh-to-field
- "\C-c\C-f\C-s" mh-to-field
- "\C-c\C-f\C-t" mh-to-field
- "\C-c\C-fa" mh-to-field
- "\C-c\C-fb" mh-to-field
- "\C-c\C-fc" mh-to-field
- "\C-c\C-fd" mh-to-field
- "\C-c\C-ff" mh-to-fcc
- "\C-c\C-fl" mh-to-field
- "\C-c\C-fm" mh-to-field
- "\C-c\C-fr" mh-to-field
- "\C-c\C-fs" mh-to-field
- "\C-c\C-ft" mh-to-field
- "\C-c\C-i" mh-insert-letter
- "\C-c\C-m\C-e" mh-mml-secure-message-encrypt
- "\C-c\C-m\C-f" mh-compose-forward
- "\C-c\C-m\C-g" mh-mh-compose-anon-ftp
- "\C-c\C-m\C-i" mh-compose-insertion
- "\C-c\C-m\C-m" mh-mml-to-mime
- "\C-c\C-m\C-n" mh-mml-unsecure-message
- "\C-c\C-m\C-s" mh-mml-secure-message-sign
- "\C-c\C-m\C-t" mh-mh-compose-external-compressed-tar
- "\C-c\C-m\C-u" mh-mh-to-mime-undo
- "\C-c\C-m\C-x" mh-mh-compose-external-type
- "\C-c\C-mee" mh-mml-secure-message-encrypt
- "\C-c\C-mes" mh-mml-secure-message-signencrypt
- "\C-c\C-mf" mh-compose-forward
- "\C-c\C-mg" mh-mh-compose-anon-ftp
- "\C-c\C-mi" mh-compose-insertion
- "\C-c\C-mm" mh-mml-to-mime
- "\C-c\C-mn" mh-mml-unsecure-message
- "\C-c\C-mse" mh-mml-secure-message-signencrypt
- "\C-c\C-mss" mh-mml-secure-message-sign
- "\C-c\C-mt" mh-mh-compose-external-compressed-tar
- "\C-c\C-mu" mh-mh-to-mime-undo
- "\C-c\C-mx" mh-mh-compose-external-type
- "\C-c\C-o" mh-open-line
- "\C-c\C-q" mh-fully-kill-draft
- "\C-c\C-s" mh-insert-signature
- "\C-c\C-t" mh-letter-toggle-header-field-display
- "\C-c\C-w" mh-check-whom
- "\C-c\C-y" mh-yank-cur-msg
- "\C-c\M-d" mh-insert-auto-fields
- "\M-\t" mh-letter-complete
- "\t" mh-letter-next-header-field-or-indent
- [backtab] mh-letter-previous-header-field)
+(define-keymap :keymap mh-letter-mode-map
+ "SPC" #'mh-letter-complete-or-space
+ "," #'mh-letter-confirm-address
+ "C-c ?" #'mh-help
+ "C-c C-\\" #'mh-fully-kill-draft ;if no C-q
+ "C-c C-^" #'mh-insert-signature ;if no C-s
+ "C-c C-c" #'mh-send-letter
+ "C-c C-d" #'mh-insert-identity
+ "C-c C-e" #'mh-mh-to-mime
+ "C-c C-f C-a" #'mh-to-field
+ "C-c C-f C-b" #'mh-to-field
+ "C-c C-f C-c" #'mh-to-field
+ "C-c C-f C-d" #'mh-to-field
+ "C-c C-f C-f" #'mh-to-fcc
+ "C-c C-f C-l" #'mh-to-field
+ "C-c C-f C-m" #'mh-to-field
+ "C-c C-f C-r" #'mh-to-field
+ "C-c C-f C-s" #'mh-to-field
+ "C-c C-f C-t" #'mh-to-field
+ "C-c C-f a" #'mh-to-field
+ "C-c C-f b" #'mh-to-field
+ "C-c C-f c" #'mh-to-field
+ "C-c C-f d" #'mh-to-field
+ "C-c C-f f" #'mh-to-fcc
+ "C-c C-f l" #'mh-to-field
+ "C-c C-f m" #'mh-to-field
+ "C-c C-f r" #'mh-to-field
+ "C-c C-f s" #'mh-to-field
+ "C-c C-f t" #'mh-to-field
+ "C-c C-i" #'mh-insert-letter
+ "C-c C-m C-e" #'mh-mml-secure-message-encrypt
+ "C-c C-m C-f" #'mh-compose-forward
+ "C-c C-m C-g" #'mh-mh-compose-anon-ftp
+ "C-c C-m TAB" #'mh-compose-insertion
+ "C-c C-m C-m" #'mh-mml-to-mime
+ "C-c C-m C-n" #'mh-mml-unsecure-message
+ "C-c C-m C-s" #'mh-mml-secure-message-sign
+ "C-c C-m C-t" #'mh-mh-compose-external-compressed-tar
+ "C-c C-m C-u" #'mh-mh-to-mime-undo
+ "C-c C-m C-x" #'mh-mh-compose-external-type
+ "C-c C-m e e" #'mh-mml-secure-message-encrypt
+ "C-c C-m e s" #'mh-mml-secure-message-signencrypt
+ "C-c C-m f" #'mh-compose-forward
+ "C-c C-m g" #'mh-mh-compose-anon-ftp
+ "C-c C-m i" #'mh-compose-insertion
+ "C-c C-m m" #'mh-mml-to-mime
+ "C-c C-m n" #'mh-mml-unsecure-message
+ "C-c C-m s e" #'mh-mml-secure-message-signencrypt
+ "C-c C-m s s" #'mh-mml-secure-message-sign
+ "C-c C-m t" #'mh-mh-compose-external-compressed-tar
+ "C-c C-m u" #'mh-mh-to-mime-undo
+ "C-c C-m x" #'mh-mh-compose-external-type
+ "C-c C-o" #'mh-open-line
+ "C-c C-q" #'mh-fully-kill-draft
+ "C-c C-s" #'mh-insert-signature
+ "C-c C-t" #'mh-letter-toggle-header-field-display
+ "C-c C-w" #'mh-check-whom
+ "C-c C-y" #'mh-yank-cur-msg
+ "C-c M-d" #'mh-insert-auto-fields
+ "C-M-i" #'completion-at-point
+ "TAB" #'mh-letter-next-header-field-or-indent
+ "<backtab>" #'mh-letter-previous-header-field)
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
@@ -253,17 +253,13 @@ searching for `mh-mail-header-separator' in the buffer."
(goto-char (point-min))
(cond ((equal mh-mail-header-separator "") (point-min))
((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
- (mh-line-beginning-position 0))
+ (line-beginning-position 0))
(t (point-min)))))
;;; MH-Letter Mode
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar font-lock-defaults))
-
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-letter-mode 'mode-class 'special)
@@ -295,24 +291,21 @@ order).
(make-local-variable 'mh-previous-window-config)
(make-local-variable 'mh-sent-from-folder)
(make-local-variable 'mh-sent-from-msg)
- (mh-do-in-gnu-emacs
- (unless mh-letter-tool-bar-map
- (mh-tool-bar-letter-buttons-init))
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)))
- (mh-do-in-xemacs
- (mh-tool-bar-init :letter))
+ (unless mh-letter-tool-bar-map
+ (mh-tool-bar-letter-buttons-init))
+ (if (boundp 'tool-bar-map)
+ (setq-local tool-bar-map mh-letter-tool-bar-map))
;; Set the local value of mh-mail-header-separator according to what is
;; present in the buffer...
- (set (make-local-variable 'mh-mail-header-separator)
- (save-excursion
- (goto-char (mh-mail-header-end))
- (buffer-substring-no-properties (point) (mh-line-end-position))))
+ (setq-local mh-mail-header-separator
+ (save-excursion
+ (goto-char (mh-mail-header-end))
+ (buffer-substring-no-properties (point) (line-end-position))))
(make-local-variable 'mail-header-separator)
(setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
(mh-set-help mh-letter-mode-help-messages)
(setq buffer-invisibility-spec '((vanish . t) t))
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local line-move-ignore-invisible t)
;; Enable undo since a show-mode buffer might have been reused.
(buffer-enable-undo)
@@ -328,12 +321,10 @@ order).
(t
;; ...or the header only
(setq font-lock-defaults '((mh-show-font-lock-keywords) t))))
- (mh-do-in-xemacs (easy-menu-add mh-letter-menu))
;; Maybe we want to use the existing Mail menu from mail-mode in
;; 9.0; in the mean time, let's remove it since the redundancy will
;; only produce confusion.
(define-key mh-letter-mode-map [menu-bar mail] #'undefined)
- (mh-do-in-xemacs (easy-menu-remove mail-menubar-menu))
(setq fill-column mh-letter-fill-column)
(add-hook 'completion-at-point-functions
#'mh-letter-completion-at-point nil 'local)
@@ -488,29 +479,8 @@ This provides alias and folder completion in header fields according to
(or (funcall func) #'ignore)
mh-letter-complete-function)))
-;; TODO Now that completion-at-point performs the task of
-;; mh-letter-complete, perhaps mh-letter-complete along with
-;; mh-complete-word should be rewritten as a more general function for
-;; XEmacs, renamed to mh-completion-at-point, and moved to
-;; mh-compat.el.
-(defun-mh mh-letter-complete completion-at-point ()
- "Perform completion on header field or word preceding point.
-
-If the field contains addresses (for example, \"To:\" or \"Cc:\")
-or folders (for example, \"Fcc:\") then this command will provide
-alias completion. In the body of the message, this command runs
-`mh-letter-complete-function' instead, which is set to
-`ispell-complete-word' by default."
- (interactive)
- (let ((data (mh-letter-completion-at-point)))
- (cond
- ((functionp data) (funcall data))
- ((consp data)
- (let ((start (nth 0 data))
- (end (nth 1 data))
- (table (nth 2 data)))
- (mh-complete-word (buffer-substring-no-properties start end)
- table start end))))))
+(define-obsolete-function-alias 'mh-letter-complete
+ #'completion-at-point "29.1")
(defun mh-letter-complete-or-space (arg)
"Perform completion or insert space.
@@ -530,7 +500,7 @@ one space."
((> (point) end-of-prev) (self-insert-command arg))
((let ((mh-letter-complete-function nil))
(mh-letter-completion-at-point))
- (mh-letter-complete))
+ (completion-at-point))
(t (self-insert-command arg)))))
(defun mh-letter-confirm-address ()
@@ -722,7 +692,7 @@ and `mh-ins-buf-prefix' is not inserted."
;; Find displayed message
(with-current-buffer show-buffer
(let* ((from-attr (mh-extract-from-attribution))
- (yank-region (mh-mark-active-p nil))
+ (yank-region mark-active)
(mh-ins-str
(cond ((and yank-region
(or (eq 'supercite mh-yank-behavior)
@@ -834,7 +804,7 @@ body."
((< (point) (progn
(beginning-of-line)
(re-search-forward mh-letter-header-field-regexp
- (mh-line-end-position) t)
+ (line-end-position) t)
(point)))
(beginning-of-line))
(t (end-of-line)))
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index edb0df83208..3e731e22a1f 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -124,7 +124,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(setq pick-expr
(let ((case-fold-search t))
(cl-loop for s in pick-expr
- collect (mh-replace-regexp-in-string "re: *" "" s))))
+ collect (replace-regexp-in-string "re: *" "" s))))
(mh-narrow-to-header-field 'subject pick-expr))
;;;###mh-autoload
@@ -143,7 +143,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
;;; Support Routines
(defun mh-subject-to-sequence (all)
- "Put all following messages with same subject in sequence 'subject.
+ "Put all following messages with same subject in sequence `subject'.
If arg ALL is t, move to beginning of folder buffer to collect all
messages.
If arg ALL is nil, collect only messages from current one on forward.
@@ -161,7 +161,7 @@ Return number of messages put in the sequence:
(mh-subject-to-sequence-unthreaded all)))
(defun mh-subject-to-sequence-threaded (all)
- "Put all messages with the same subject in the 'subject sequence.
+ "Put all messages with the same subject in the `subject' sequence.
This function works when the folder is threaded. In this
situation the subject could get truncated and so the normal
@@ -192,7 +192,7 @@ are taken into account."
It would be desirable to avoid hard-coding this.")
(defun mh-subject-to-sequence-unthreaded (all)
- "Put all following messages with same subject in sequence 'subject.
+ "Put all following messages with same subject in sequence `subject'.
This function only works with an unthreaded folder. If arg ALL is
t, move to beginning of folder buffer to collect all messages. If
@@ -214,7 +214,7 @@ Return number of messages put in the sequence:
(string-equal "" (match-string 3)))
(progn (message "No subject line")
nil)
- (let ((subject (mh-match-string-no-properties 3))
+ (let ((subject (match-string-no-properties 3))
(list))
(if (> (length subject) mh-limit-max-subject-size)
(setq subject (substring subject 0 mh-limit-max-subject-size)))
@@ -222,7 +222,7 @@ Return number of messages put in the sequence:
(if all
(goto-char (point-min)))
(while (re-search-forward mh-scan-subject-regexp nil t)
- (let ((this-subject (mh-match-string-no-properties 3)))
+ (let ((this-subject (match-string-no-properties 3)))
(if (> (length this-subject) mh-limit-max-subject-size)
(setq this-subject (substring this-subject
0 mh-limit-max-subject-size)))
@@ -313,7 +313,7 @@ The MH command pick is used to do the match."
(while (not (eobp))
(let ((num (ignore-errors
(string-to-number
- (buffer-substring (point) (mh-line-end-position))))))
+ (buffer-substring (point) (line-end-position))))))
(when num (push num msg-list))
(forward-line))))
(if (null msg-list)
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 0630fa92b1f..b93f7d8c412 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -39,6 +39,7 @@
;;; Code:
(require 'mh-e)
+(require 'mh-acros)
(require 'mh-gnus) ;needed because mh-gnus.el not compiled
(require 'font-lock)
@@ -135,13 +136,11 @@
("application/emacs-lisp" mm-display-elisp-inline identity)
("application/x-emacs-lisp" mm-display-elisp-inline identity)
("text/html"
- ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text)
+ mm-inline-text-html
(lambda (handle)
- (or (and (boundp 'mm-inline-text-html-renderer)
- mm-inline-text-html-renderer)
- (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))))
+ mm-text-html-renderer))
("text/x-vcard"
- mh-mm-inline-text-vcard
+ mm-inline-text-vcard
(lambda (handle)
(or (featurep 'vcard)
(locate-library "vcard"))))
@@ -171,7 +170,7 @@
("audio/.*" ignore ignore)
("image/.*" ignore ignore)
;; Default to displaying as text
- (".*" mm-inline-text mh-mm-readable-p))
+ (".*" mm-inline-text mm-readable-p))
"Alist of media types/tests saying whether types can be displayed inline.")
(defvar mh-mime-save-parts-directory nil
@@ -184,13 +183,7 @@ Set from last use.")
'((mh-press-button "\r" "Toggle Display")))
(defvar mh-mime-button-map
(let ((map (make-sparse-keymap)))
- (unless (>= (string-to-number emacs-version) 21)
- ;; XEmacs doesn't care.
- (set-keymap-parent map mh-show-mode-map))
- (mh-do-in-gnu-emacs
- (define-key map [mouse-2] #'mh-push-button))
- (mh-do-in-xemacs
- (define-key map '(button2) #'mh-push-button))
+ (define-key map [mouse-2] #'mh-push-button)
(dolist (c mh-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
@@ -210,13 +203,8 @@ Set from last use.")
(?D pressed-details ?s)))
(defvar mh-mime-security-button-map
(let ((map (make-sparse-keymap)))
- (unless (>= (string-to-number emacs-version) 21)
- (set-keymap-parent map mh-show-mode-map))
(define-key map "\r" #'mh-press-button)
- (mh-do-in-gnu-emacs
- (define-key map [mouse-2] #'mh-push-button))
- (mh-do-in-xemacs
- (define-key map '(button2) #'mh-push-button))
+ (define-key map [mouse-2] #'mh-push-button)
map))
@@ -251,24 +239,24 @@ usually reads the file \"/etc/mailcap\"."
(when (consp part-index) (setq part-index (car part-index)))
(mh-folder-mime-action
part-index
- #'(lambda ()
- (let* ((part (get-text-property (point) 'mh-data))
- (type (mm-handle-media-type part))
- (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
- (mailcap-mime-info type 'all)))
- (def (caar methods))
- (prompt (format-prompt "Viewer" def))
- (method (completing-read prompt methods nil nil nil nil def))
- (folder mh-show-folder-buffer)
- (buffer-read-only nil))
- (when (string-match "^[^% \t]+$" method)
- (setq method (concat method " %s")))
- (mh-flet
- ((mm-handle-set-external-undisplayer
- (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- (unwind-protect (mm-display-external part method)
- (set-buffer-modified-p nil)))))
+ (lambda ()
+ (let* ((part (get-text-property (point) 'mh-data))
+ (type (mm-handle-media-type part))
+ (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
+ (mailcap-mime-info type 'all)))
+ (def (caar methods))
+ (prompt (format-prompt "Viewer" def))
+ (method (completing-read prompt methods nil nil nil nil def))
+ (folder mh-show-folder-buffer)
+ (buffer-read-only nil))
+ (when (string-match "^[^% \t]+$" method)
+ (setq method (concat method " %s")))
+ (mh-flet
+ ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (unwind-protect (mm-display-external part method)
+ (set-buffer-modified-p nil)))))
nil))
;;;###mh-autoload
@@ -299,14 +287,14 @@ the attachment labeled with that number."
start end)
(cond ((and data (not inserted-flag) (not displayed-flag))
(let ((contents (mm-get-part data)))
- (add-text-properties (mh-line-beginning-position)
- (mh-line-end-position) '(mh-mime-inserted t))
+ (add-text-properties (line-beginning-position)
+ (line-end-position) '(mh-mime-inserted t))
(setq start (point-marker))
(forward-line 1)
(mm-insert-inline data contents)
(setq end (point-marker))
(add-text-properties
- start (progn (goto-char start) (mh-line-end-position))
+ start (progn (goto-char start) (line-end-position))
`(mh-region (,start . ,end)))))
((and data (or inserted-flag displayed-flag))
(mh-press-button)
@@ -458,10 +446,10 @@ decoding the same message multiple times."
(setf (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
(let ((handles (mm-dissect-buffer nil)))
(if handles
- (mh-mm-uu-dissect-text-parts handles)
+ (mm-uu-dissect-text-parts handles)
(setq handles (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
- (mh-mm-merge-handles
+ (mm-merge-handles
handles (mh-mime-handles (mh-buffer-data))))
handles))))
@@ -532,10 +520,10 @@ parsed and then displayed."
(if pre-dissected-handles
(setq handles pre-dissected-handles)
(if (setq handles (mm-dissect-buffer nil))
- (mh-mm-uu-dissect-text-parts handles)
+ (mm-uu-dissect-text-parts handles)
(setq handles (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
- (mh-mm-merge-handles handles
+ (mm-merge-handles handles
(mh-mime-handles (mh-buffer-data))))
(unless handles
(mh-decode-message-body)))
@@ -641,7 +629,7 @@ buttons for alternative parts that are usually suppressed."
(let ((mh-mime-security-button-line-format
mh-mime-security-button-end-line-format))
(mh-insert-mime-security-button handle))
- (mh-mm-set-handle-multipart-parameter
+ (mm-set-handle-multipart-parameter
handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
(defun mh-mime-display-single (handle)
@@ -713,8 +701,7 @@ buttons for alternative parts that are usually suppressed."
;; Delete the button and displayed part (if any)
(let ((region (get-text-property point 'mh-region)))
(when region
- (mh-funcall-if-exists
- remove-images (car region) (cdr region)))
+ (remove-images (car region) (cdr region)))
(mm-display-part handle)
(when region
(delete-region (car region) (cdr region))))
@@ -752,8 +739,8 @@ buttons for alternative parts that are usually suppressed."
(mh-insert-mime-button handle id (mm-handle-displayed-p handle))
(goto-char point)
(when region
- (add-text-properties (mh-line-beginning-position)
- (mh-line-end-position)
+ (add-text-properties (line-beginning-position)
+ (line-end-position)
`(mh-region ,region)))))))
(defun mh-mime-part-index (handle)
@@ -777,20 +764,12 @@ This is only useful if a Content-Disposition header is not present."
; this only tells us if the image is
; something that emacs can display
(let ((image (mm-get-image handle)))
- (or (mh-do-in-xemacs
- (and (mh-funcall-if-exists glyphp image)
- (< (glyph-width image)
- (or mh-max-inline-image-width (window-pixel-width)))
- (< (glyph-height image)
- (or mh-max-inline-image-height
- (window-pixel-height)))))
- (mh-do-in-gnu-emacs
- (let ((size (and (fboundp 'image-size) (image-size image))))
- (and size
- (< (cdr size) (or mh-max-inline-image-height
- (1- (window-height))))
- (< (car size) (or mh-max-inline-image-width
- (window-width)))))))))))
+ (let ((size (and (fboundp 'image-size) (image-size image))))
+ (and size
+ (< (cdr size) (or mh-max-inline-image-height
+ (1- (window-height))))
+ (< (car size) (or mh-max-inline-image-width
+ (window-width)))))))))
(defun mh-inline-vcard-p (handle)
"Decide if HANDLE is a vcard that must be displayed inline."
@@ -813,27 +792,19 @@ being used to highlight the signature in a MIME part."
((not (and (equal (mm-handle-media-supertype handle) "text")
(equal (mm-handle-media-subtype handle) "html")))
"^-- $")
- ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$")
+ ((eq mm-text-html-renderer 'lynx) "^ --$")
(t "^--$"))))
(save-excursion
(goto-char (point-max))
(when (re-search-backward regexp nil t)
- (mh-do-in-gnu-emacs
- (let ((ov (make-overlay (point) (point-max))))
- (overlay-put ov 'face 'mh-show-signature)
- (overlay-put ov 'evaporate t)))
- (mh-do-in-xemacs
- (set-extent-property (make-extent (point) (point-max))
- 'face 'mh-show-signature))))))
+ (let ((ov (make-overlay (point) (point-max))))
+ (overlay-put ov 'face 'mh-show-signature)
+ (overlay-put ov 'evaporate t))))))
;;; Button Display
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar ov))
-
(defun mh-insert-mime-button (handle index displayed)
"Insert MIME button for HANDLE.
INDEX is the part number that will be DISPLAYED. It is also used
@@ -865,10 +836,10 @@ by commands like \"K v\" which operate on individual MIME parts."
(setq begin (point))
(gnus-eval-format
mh-mime-button-line-format mh-mime-button-line-format-alist
- `(,@(mh-gnus-local-map-property mh-mime-button-map)
- mh-callback mh-mm-display-part
- mh-part ,index
- mh-data ,handle)))
+ `(keymap ,mh-mime-button-map
+ mh-callback mh-mm-display-part
+ mh-part ,index
+ mh-data ,handle)))
(setq end (point))
(widget-convert-button
'link begin end
@@ -877,16 +848,12 @@ by commands like \"K v\" which operate on individual MIME parts."
:button-keymap mh-mime-button-map
:help-echo
"Mouse-2 click or press RET (in show buffer) to toggle display")
- (dolist (ov (mh-funcall-if-exists overlays-in begin end))
- (mh-funcall-if-exists overlay-put ov 'evaporate t))))
-
-;; Shush compiler.
-(defvar mm-verify-function-alist) ; < Emacs 22
-(defvar mm-decrypt-function-alist) ; < Emacs 22
+ (dolist (ov (overlays-in begin end))
+ (overlay-put ov 'evaporate t))))
(defun mh-insert-mime-security-button (handle)
"Display buttons for PGP message, HANDLE."
- (let* ((protocol (mh-mm-handle-multipart-ctl-parameter handle 'protocol))
+ (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
(crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
(nth 2 (assoc protocol mm-decrypt-function-alist))
"Unknown"))
@@ -897,10 +864,10 @@ by commands like \"K v\" which operate on individual MIME parts."
(if (equal (car handle) "multipart/signed")
" Signed" " Encrypted")
" Part"))
- (info (or (mh-mm-handle-multipart-ctl-parameter
+ (info (or (mm-handle-multipart-ctl-parameter
handle 'gnus-info)
"Undecided"))
- (details (mh-mm-handle-multipart-ctl-parameter
+ (details (mm-handle-multipart-ctl-parameter
handle 'gnus-details))
pressed-details)
(setq details (if details (concat "\n" details) ""))
@@ -911,11 +878,11 @@ by commands like \"K v\" which operate on individual MIME parts."
(gnus-eval-format
mh-mime-security-button-line-format
mh-mime-security-button-line-format-alist
- `(,@(mh-gnus-local-map-property mh-mime-security-button-map)
- mh-button-pressed ,mh-mime-security-button-pressed
- mh-callback mh-mime-security-press-button
- mh-line-format ,mh-mime-security-button-line-format
- mh-data ,handle))
+ `(keymap ,mh-mime-security-button-map
+ mh-button-pressed ,mh-mime-security-button-pressed
+ mh-callback mh-mime-security-press-button
+ mh-line-format ,mh-mime-security-button-line-format
+ mh-data ,handle))
(setq end (point))
(widget-convert-button 'link begin end
:mime-handle handle
@@ -923,8 +890,8 @@ by commands like \"K v\" which operate on individual MIME parts."
:button-keymap mh-mime-security-button-map
:button-face face
:help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
- (dolist (ov (mh-funcall-if-exists overlays-in begin end))
- (mh-funcall-if-exists overlay-put ov 'evaporate t))
+ (dolist (ov (overlays-in begin end))
+ (overlay-put ov 'evaporate t))
(when (equal info "Failed")
(let* ((type (if (equal (car handle) "multipart/signed")
"verification" "decryption"))
@@ -1081,7 +1048,7 @@ This is only called in recent versions of Gnus. The MIME handles
are stored in data structures corresponding to MH-E folder buffer
FOLDER instead of in Gnus (as in the original). The MIME part,
HANDLE is associated with the undisplayer FUNCTION."
- (if (mh-mm-keep-viewer-alive-p handle)
+ (if (mm-keep-viewer-alive-p handle)
(let ((new-handle (copy-sequence handle)))
(mm-handle-set-undisplayer new-handle function)
(mm-handle-set-undisplayer handle nil)
@@ -1091,19 +1058,19 @@ HANDLE is associated with the undisplayer FUNCTION."
(defun mh-mime-security-press-button (handle)
"Callback from security button for part HANDLE."
- (if (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
(mh-mime-security-show-details handle)
- (let ((region (mh-mm-handle-multipart-ctl-parameter handle 'mh-region))
+ (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
point)
(setq point (point))
(goto-char (car region))
(delete-region (car region) (cdr region))
- (with-current-buffer (mh-mm-handle-multipart-ctl-parameter handle 'buffer)
+ (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
(let* ((mm-verify-option 'known)
(mm-decrypt-option 'known)
- (new (mh-mm-possibly-verify-or-decrypt (cdr handle) handle)))
+ (new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
(unless (eq new (cdr handle))
- (mh-mm-destroy-parts (cdr handle))
+ (mm-destroy-parts (cdr handle))
(setcdr handle new))))
(mh-mime-display-security handle)
(goto-char point))))
@@ -1113,7 +1080,7 @@ HANDLE is associated with the undisplayer FUNCTION."
;; to be no way of getting rid of the inserted text.
(defun mh-mime-security-show-details (handle)
"Toggle display of detailed security info for HANDLE."
- (let ((details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details)))
+ (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
(when details
(let ((mh-mime-security-button-pressed
(not (get-text-property (point) 'mh-button-pressed)))
@@ -1158,7 +1125,7 @@ this ;-)"
(defun mh-display-smileys ()
"Display smileys."
(when (and mh-graphical-smileys-flag (mh-small-show-buffer-p))
- (mh-funcall-if-exists smiley-region (point-min) (point-max))))
+ (smiley-region (point-min) (point-max))))
;;;###mh-autoload
(defun mh-display-emphasis ()
@@ -1174,14 +1141,7 @@ this ;-)"
"Check if show buffer is small.
This is used to decide if smileys and graphical emphasis should be
displayed."
- (let ((max nil))
- (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size)
- (cond ((numberp font-lock-maximum-size)
- (setq max font-lock-maximum-size))
- ((listp font-lock-maximum-size)
- (setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size)
- (assoc t font-lock-maximum-size)))))))
- (or (not (numberp max)) (>= (/ max 8) (buffer-size)))))
+ (>= 64000 (buffer-size)))
@@ -1303,7 +1263,7 @@ automatically."
(type (mh-minibuffer-read-type file))
(description (mml-minibuffer-read-description))
(dispos (or disposition
- (mh-mml-minibuffer-read-disposition type))))
+ (mml-minibuffer-read-disposition type))))
(mml-insert-empty-tag 'part 'type type 'filename file
'disposition dispos 'description description)))
@@ -1507,9 +1467,9 @@ This function will quote all such characters."
(goto-char (point-min))
(while (re-search-forward "^#" nil t)
(beginning-of-line)
- (unless (mh-mh-directive-present-p (point) (mh-line-end-position))
+ (unless (mh-mh-directive-present-p (point) (line-end-position))
(insert "#"))
- (goto-char (mh-line-end-position)))))
+ (goto-char (line-end-position)))))
;;;###mh-autoload
(defun mh-mh-to-mime-undo (noconfirm)
@@ -1695,7 +1655,7 @@ buffer, while END defaults to the end of the buffer."
(goto-char begin)
(while (re-search-forward "^#" end t)
(let ((s (buffer-substring-no-properties
- (point) (mh-line-end-position))))
+ (point) (line-end-position))))
(cond ((equal s ""))
((string-match "^forw[ \t\n]+" s)
(cl-return-from search-for-mh-directive t))
@@ -1796,11 +1756,10 @@ initialized. Always use the command `mh-have-file-command'.")
;;;###mh-autoload
(defun mh-have-file-command ()
"Return t if `file' command is on the system.
-'file -i' is used to get MIME type of composition insertion."
+\"file -i\" is used to get MIME type of composition insertion."
(when (eq mh-have-file-command 'undefined)
(setq mh-have-file-command
- (and (fboundp 'executable-find)
- (executable-find "file") ; file command exists
+ (and (executable-find "file") ; file command exists
; and accepts -i and -b args.
(zerop (call-process "file" nil nil nil "-i" "-b"
(expand-file-name "inc" mh-progs))))))
@@ -1814,10 +1773,9 @@ initialized. Always use the command `mh-have-file-command'.")
(defun mh-mime-cleanup ()
"Free the decoded MIME parts."
(let ((mime-data (gethash (current-buffer) mh-globals-hash)))
- ;; This is for Emacs, what about XEmacs?
- (mh-funcall-if-exists remove-images (point-min) (point-max))
+ (remove-images (point-min) (point-max))
(when mime-data
- (mh-mm-destroy-parts (mh-mime-handles mime-data))
+ (mm-destroy-parts (mh-mime-handles mime-data))
(remhash (current-buffer) mh-globals-hash))))
;;;###mh-autoload
@@ -1825,7 +1783,7 @@ initialized. Always use the command `mh-have-file-command'.")
"Free MIME data for externally displayed MIME parts."
(let ((mime-data (mh-buffer-data)))
(when mime-data
- (mh-mm-destroy-parts (mh-mime-handles mime-data)))
+ (mm-destroy-parts (mh-mime-handles mime-data)))
(remhash (current-buffer) mh-globals-hash)))
(provide 'mh-mime)
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index c2affb10d99..06381a2e0ed 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -315,7 +315,7 @@ produced by \"inc\".")
;;; Widths, Offsets and Columns
-(defvar mh-cmd-note 4
+(defvar-local mh-cmd-note 4
"Column for notations.
This variable should be set with the function `mh-set-cmd-note'.
@@ -323,12 +323,15 @@ This variable may be updated dynamically if
`mh-adaptive-cmd-note-flag' is on.
Note that columns in Emacs start with 0.")
-(make-variable-buffer-local 'mh-cmd-note)
(defvar mh-scan-cmd-note-width 1
"Number of columns consumed by the cmd-note field in `mh-scan-format'.
-This column will have one of the values: \" \", \"^\", \"D\", \"B\", \"A\", \"+\", where
+This column will have one of the values:
+
+ \" \", \"^\", \"D\", \"B\", \"A\", \"+\"
+
+where
\" \" is the default value,
\"^\" is the `mh-note-refiled' character,
@@ -510,7 +513,7 @@ with `mh-scan-msg-format-string'."
Note that columns in Emacs start with 0.
If `mh-scan-format-file' is set to \"Use MH-E scan Format\" this
-means that either `mh-scan-format-mh' or `mh-scan-format-nmh' are
+means that either `mh-scan-format-mh' or `mh-scan-format-nmh' is
in use. This function therefore assumes that the first column is
empty (to provide room for the cursor), the following WIDTH
columns contain the message number, and the column for notations
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index c078c9f91b0..c5519eba0ac 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -42,6 +42,7 @@
;;; Code:
(require 'mh-e)
+(require 'mh-letter)
(require 'gnus-util)
(require 'imenu)
@@ -318,10 +319,6 @@ folder containing the index search results."
(cl-loop for msg-hash being the hash-values of mh-index-data
count (> (hash-table-count msg-hash) 0)))))))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar pick-folder)) ;FIXME: Why?
-
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
@@ -336,8 +333,8 @@ configuration and is used when the search folder is dismissed."
(not (y-or-n-p "Reuse pattern? ")))
(mh-make-pick-template)
(message ""))
- (mh-make-local-vars 'mh-current-folder folder
- 'mh-previous-window-config window-config)
+ (setq-local mh-current-folder folder
+ mh-previous-window-config window-config)
(message "%s" (substitute-command-keys
(concat "Type \\[mh-index-do-search] to search messages, "
"\\[mh-pick-do-search] to use pick, "
@@ -356,13 +353,13 @@ configuration and is used when the search folder is dismissed."
(goto-char (point-min))
(dotimes (_ 5)
(add-text-properties (point) (1+ (point)) '(front-sticky t))
- (add-text-properties (- (mh-line-end-position) 2)
- (1- (mh-line-end-position))
+ (add-text-properties (- (line-end-position) 2)
+ (1- (line-end-position))
'(rear-nonsticky t))
- (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t))
+ (add-text-properties (point) (1- (line-end-position)) '(read-only t))
(forward-line))
(add-text-properties (point) (1+ (point)) '(front-sticky t))
- (add-text-properties (point) (1- (mh-line-end-position)) '(read-only t))
+ (add-text-properties (point) (1- (line-end-position)) '(read-only t))
(goto-char (point-max)))
;; Sequence Searches
@@ -522,10 +519,10 @@ group of results."
(cond ((and (bolp) (eolp))
(ignore-errors (forward-line -1))
(setq msg (mh-get-msg-num t)))
- ((equal (char-after (mh-line-beginning-position)) ?+)
+ ((equal (char-after (line-beginning-position)) ?+)
(setq folder (buffer-substring-no-properties
- (mh-line-beginning-position)
- (mh-line-end-position))))
+ (line-beginning-position)
+ (line-end-position))))
(t (setq msg (mh-get-msg-num t)))))
(when (not folder)
(setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
@@ -552,20 +549,20 @@ group of results."
;;; MH-Search Keys
;; If this changes, modify mh-search-mode-help-messages accordingly, below.
-(gnus-define-keys mh-search-mode-map
- "\C-c?" mh-help
- "\C-c\C-c" mh-index-do-search
- "\C-c\C-p" mh-pick-do-search
- "\C-c\C-f\C-b" mh-to-field
- "\C-c\C-f\C-c" mh-to-field
- "\C-c\C-f\C-m" mh-to-field
- "\C-c\C-f\C-s" mh-to-field
- "\C-c\C-f\C-t" mh-to-field
- "\C-c\C-fb" mh-to-field
- "\C-c\C-fc" mh-to-field
- "\C-c\C-fm" mh-to-field
- "\C-c\C-fs" mh-to-field
- "\C-c\C-ft" mh-to-field)
+(define-keymap :keymap mh-search-mode-map
+ "C-c ?" #'mh-help
+ "C-c C-c" #'mh-index-do-search
+ "C-c C-p" #'mh-pick-do-search
+ "C-c C-f C-b" #'mh-to-field
+ "C-c C-f C-c" #'mh-to-field
+ "C-c C-f C-m" #'mh-to-field
+ "C-c C-f C-s" #'mh-to-field
+ "C-c C-f C-t" #'mh-to-field
+ "C-c C-f b" #'mh-to-field
+ "C-c C-f c" #'mh-to-field
+ "C-c C-f m" #'mh-to-field
+ "C-c C-f s" #'mh-to-field
+ "C-c C-f t" #'mh-to-field)
@@ -616,7 +613,6 @@ The hook `mh-search-mode-hook' is called upon entry to this mode.
\\{mh-search-mode-map}"
- (mh-do-in-xemacs (easy-menu-add mh-pick-menu))
(mh-set-help mh-search-mode-help-messages))
@@ -653,13 +649,13 @@ The cdr of the element is the pattern to search."
start begin)
(goto-char (point-min))
(while (not (eobp))
- (if (search-forward "--------" (mh-line-end-position) t)
+ (if (search-forward "--------" (line-end-position) t)
(setq in-body-flag t)
(beginning-of-line)
(setq begin (point))
(setq start (if in-body-flag
(point)
- (search-forward ":" (mh-line-end-position) t)
+ (search-forward ":" (line-end-position) t)
(point)))
(push (cons (and (not in-body-flag)
(intern (downcase
@@ -667,7 +663,7 @@ The cdr of the element is the pattern to search."
begin (1- start)))))
(mh-index-parse-search-regexp
(buffer-substring-no-properties
- start (mh-line-end-position))))
+ start (line-end-position))))
pattern-list))
(forward-line))
pattern-list)))
@@ -977,8 +973,8 @@ is used to search."
(cl-return nil))
(when (equal (char-after (point)) ?#)
(cl-return 'error))
- (let* ((start (search-forward " " (mh-line-end-position) t))
- (end (search-forward " " (mh-line-end-position) t)))
+ (let* ((start (search-forward " " (line-end-position) t))
+ (end (search-forward " " (line-end-position) t)))
(unless (and start end)
(cl-return 'error))
(setq end (1- end))
@@ -1056,7 +1052,7 @@ SEARCH-REGEXP-LIST is used to search."
(cl-return 'error))
(let ((start (point))
end msg-start)
- (setq end (mh-line-end-position))
+ (setq end (line-end-position))
(unless (search-forward mh-mairix-folder end t)
(cl-return 'error))
(goto-char (match-beginning 0))
@@ -1197,7 +1193,7 @@ is used to search."
(cl-block nil
(when (eobp) (cl-return nil))
(let ((file-name (buffer-substring-no-properties
- (point) (mh-line-end-position))))
+ (point) (line-end-position))))
(unless (equal (string-match mh-namazu-folder file-name) 0)
(cl-return 'error))
(unless (file-exists-p file-name)
@@ -1245,17 +1241,17 @@ is used to search."
(prog1
(cl-block nil
(when (eobp) (cl-return nil))
- (when (search-forward-regexp "^\\+" (mh-line-end-position) t)
+ (when (search-forward-regexp "^\\+" (line-end-position) t)
(setq mh-index-pick-folder
- (buffer-substring-no-properties (mh-line-beginning-position)
- (mh-line-end-position)))
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position)))
(cl-return 'error))
- (unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position) t)
+ (unless (search-forward-regexp "^[1-9][0-9]*$" (line-end-position) t)
(cl-return 'error))
(list mh-index-pick-folder
(string-to-number
- (buffer-substring-no-properties (mh-line-beginning-position)
- (mh-line-end-position)))
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position)))
nil))
(forward-line)))
@@ -1332,8 +1328,8 @@ record is invalid return `error'."
(cl-block nil
(when (eobp)
(cl-return nil))
- (let ((eol-pos (mh-line-end-position))
- (bol-pos (mh-line-beginning-position))
+ (let ((eol-pos (line-end-position))
+ (bol-pos (line-beginning-position))
folder-start msg-end)
(goto-char bol-pos)
(unless (search-forward mh-user-path eol-pos t)
@@ -1415,10 +1411,7 @@ being the list of messages originally from that folder."
(when cur-msg (mh-goto-msg cur-msg t t))
(set-buffer-modified-p old-buffer-modified-flag)))
-(eval-and-compile (mh-require 'which-func nil t))
-
-;; Shush compiler.
-(defvar which-func-mode) ; < Emacs 22, XEmacs
+(eval-and-compile (require 'which-func nil t))
;;;###mh-autoload
(defun mh-index-create-imenu-index ()
@@ -1432,7 +1425,7 @@ being the list of messages originally from that folder."
(save-excursion
(beginning-of-line)
(push (cons (buffer-substring-no-properties
- (point) (mh-line-end-position))
+ (point) (line-end-position))
(point-marker))
alist)))
(setq imenu--index-alist (nreverse alist)))))
@@ -1717,7 +1710,7 @@ folder, is removed from `mh-index-data'."
"-format" "%{x-mhe-checksum}\n" folder msg)
(goto-char (point-min))
(string-equal (buffer-substring-no-properties
- (point) (mh-line-end-position))
+ (point) (line-end-position))
checksum)))
@@ -1826,8 +1819,8 @@ PROC is used to convert the value to actual data."
(defun mh-md5sum-parser ()
"Parse md5sum output."
- (let ((begin (mh-line-beginning-position))
- (end (mh-line-end-position))
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
first-space last-slash)
(setq first-space (search-forward " " end t))
(goto-char end)
@@ -1840,8 +1833,8 @@ PROC is used to convert the value to actual data."
(defun mh-openssl-parser ()
"Parse openssl output."
- (let ((begin (mh-line-beginning-position))
- (end (mh-line-end-position))
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
last-space last-slash)
(goto-char end)
(setq last-space (search-backward " " begin t))
@@ -1874,7 +1867,7 @@ origin-index) map is updated too."
(let (msg checksum)
(while (not (eobp))
(setq msg (buffer-substring-no-properties
- (point) (mh-line-end-position)))
+ (point) (line-end-position)))
(forward-line)
(save-excursion
(cond ((not (string-match "^[0-9]*$" msg)))
@@ -1885,7 +1878,7 @@ origin-index) map is updated too."
(t
;; update maps
(setq checksum (buffer-substring-no-properties
- (point) (mh-line-end-position)))
+ (point) (line-end-position)))
(let ((msg (string-to-number msg)))
(set-buffer folder)
(mh-index-update-single-msg msg checksum origin-map)))))
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index f87aaa5f15e..a95c7c03d17 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -38,9 +38,8 @@
(defvar mh-last-seq-used nil
"Name of seq to which a msg was last added.")
-(defvar mh-non-seq-mode-line-annotation nil
+(defvar-local mh-non-seq-mode-line-annotation nil
"Saved value of `mh-mode-line-annotation' when narrowed to a seq.")
-(make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
(defvar mh-internal-seqs '(answered cur deleted forwarded printed))
@@ -167,7 +166,7 @@ The list appears in a buffer named \"*MH-E Sequences*\"."
(insert "\n"))
(setq seq-list (cdr seq-list)))
(goto-char (point-min))
- (mh-view-mode-enter)
+ (view-mode-enter)
(setq view-exit-action 'kill-buffer)
(message "Listing sequences...done")))))
@@ -193,11 +192,6 @@ MESSAGE appears."
(mh-list-to-string (mh-seq-containing-msg message t))
" "))))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar tool-bar-mode))
-(defvar tool-bar-map)
-
;;;###mh-autoload
(defun mh-narrow-to-seq (sequence)
"Restrict display to messages in SEQUENCE.
@@ -229,12 +223,12 @@ When you want to widen the view to all your messages again, use
(mh-make-folder-mode-line)
(mh-recenter nil)
(when (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map)
- mh-folder-seq-tool-bar-map)
+ (setq-local tool-bar-map
+ mh-folder-seq-tool-bar-map)
(when (buffer-live-p (get-buffer mh-show-buffer))
(with-current-buffer mh-show-buffer
- (set (make-local-variable 'tool-bar-map)
- mh-show-seq-tool-bar-map))))
+ (setq-local tool-bar-map
+ mh-show-seq-tool-bar-map))))
(push 'widen mh-view-ops)))
(t
(error "No messages in sequence %s" (symbol-name sequence))))))
@@ -362,10 +356,10 @@ remove all limits and sequence restrictions."
(mh-notate-cur)
(mh-recenter nil)))
(when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
+ (setq-local tool-bar-map mh-folder-tool-bar-map)
(when (buffer-live-p (get-buffer mh-show-buffer))
(with-current-buffer mh-show-buffer
- (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)))))
+ (setq-local tool-bar-map mh-show-tool-bar-map)))))
@@ -582,7 +576,7 @@ Otherwise, the message number at point is returned.
This function is usually used with `mh-iterate-on-range' in order to
provide a uniform interface to MH-E functions."
- (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
+ (cond ((and transient-mark-mode mark-active) (cons (region-beginning) (region-end)))
(current-prefix-arg (mh-read-range range-prompt nil nil t t))
(default default)
(t (mh-get-msg-num t))))
@@ -736,7 +730,7 @@ completion is over."
(cl-multiple-value-bind (folder unseen total)
(cl-values-list
(mh-parse-flist-output-line
- (buffer-substring (point) (mh-line-end-position))))
+ (buffer-substring (point) (line-end-position))))
(list total unseen folder))))
(defun mh-folder-size-folder (folder)
@@ -764,7 +758,7 @@ folders whose names end with a `+' character."
(when (search-backward " out of " (point-min) t)
(setq total (string-to-number
(buffer-substring-no-properties
- (match-end 0) (mh-line-end-position))))
+ (match-end 0) (line-end-position))))
(when (search-backward " in sequence " (point-min) t)
(setq p (point))
(when (search-backward " has " (point-min) t)
@@ -786,10 +780,10 @@ If SAVE-REFILES is non-nil, then keep the sequences
that note messages to be refiled."
(let ((seqs ()))
(cond (save-refiles
- (mh-mapc (lambda (seq) ; Save the refiling sequences
- (if (mh-folder-name-p (mh-seq-name seq))
- (setq seqs (cons seq seqs))))
- mh-seq-list)))
+ (mapc (lambda (seq) ; Save the refiling sequences
+ (if (mh-folder-name-p (mh-seq-name seq))
+ (setq seqs (cons seq seqs))))
+ mh-seq-list)))
(save-excursion
(if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
(progn
@@ -942,7 +936,7 @@ font-lock is turned on."
;; the case of user sequences.
(mh-notate nil nil mh-cmd-note)
(when font-lock-mode
- (font-lock-fontify-region (point) (mh-line-end-position))))
+ (font-lock-fontify-region (point) (line-end-position))))
(forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
(let ((stack (gethash msg mh-sequence-notation-history)))
(setf (gethash msg mh-sequence-notation-history)
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index e6eddef8dcd..cc76b8d7e61 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -144,7 +144,7 @@ displayed."
(if (not clean-message-header)
(mh-start-of-uncleaned-message)))
(mh-display-msg msg folder)))
- (unless (mh-window-full-height-p) ; not vertically split
+ (unless (window-full-height-p) ; not vertically split
(shrink-window (- (window-height) (or mh-summary-height
(mh-summary-height)))))
(mh-recenter nil)
@@ -328,17 +328,15 @@ ignored if VISIBLE-HEADERS is non-nil."
(defun mh-summary-height ()
"Return ideal value for the variable `mh-summary-height'.
The current frame height is taken into consideration."
- (or (and (fboundp 'frame-height)
- (> (frame-height) 24)
+ (or (and (> (frame-height) 24)
(min 10 (/ (frame-height) 6)))
4))
-;; Infrastructure to generate show-buffer functions from folder functions
-;; XEmacs does not have deactivate-mark? What is the equivalent of
-;; transient-mark-mode for XEmacs? Should we be restoring the mark in the
-;; folder buffer after the operation has been carried out.
+;; Infrastructure to generate show-buffer functions from folder functions.
+;; Should we be restoring the mark in the folder buffer after the
+;; operation has been carried out?
(defmacro mh-defun-show-buffer (function original-function
&optional dont-return)
"Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer.
@@ -363,13 +361,14 @@ still visible.\n")
folder-buffer)
(delete-other-windows))
(mh-goto-cur-msg t)
- (mh-funcall-if-exists deactivate-mark)
+ (deactivate-mark)
(unwind-protect
(prog1 (call-interactively (function ,original-function))
(setq normal-exit t))
- (mh-funcall-if-exists deactivate-mark)
+ (deactivate-mark)
(when (eq major-mode 'mh-folder-mode)
- (mh-funcall-if-exists hl-line-highlight))
+ (when (fboundp 'hl-line-highlight)
+ (hl-line-highlight)))
(cond ((not normal-exit)
(set-window-configuration config))
,(if dont-return
@@ -464,8 +463,7 @@ still visible.\n")
(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
(mh-defun-show-buffer mh-show-junk-allowlist mh-junk-allowlist)
-(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-allowlist)
-(make-obsolete 'mh-show-junk-whitelist 'mh-show-junk-allowlist "28.1")
+(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
(mh-defun-show-buffer mh-show-junk-blocklist mh-junk-blocklist)
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
@@ -562,132 +560,132 @@ still visible.\n")
;;; MH-Show Keys
-(gnus-define-keys mh-show-mode-map
- " " mh-show-page-msg
- "!" mh-show-refile-or-write-again
- "'" mh-show-toggle-tick
- "," mh-show-header-display
- "." mh-show-show
- ":" mh-show-show-preferred-alternative
- ">" mh-show-write-message-to-file
- "?" mh-help
- "E" mh-show-extract-rejected-mail
- "M" mh-show-modify
- "\177" mh-show-previous-page
- "\C-d" mh-show-delete-msg-no-motion
- "\t" mh-show-next-button
- [backtab] mh-show-prev-button
- "\M-\t" mh-show-prev-button
- "\ed" mh-show-redistribute
- "^" mh-show-refile-msg
- "c" mh-show-copy-msg
- "d" mh-show-delete-msg
- "e" mh-show-edit-again
- "f" mh-show-forward
- "g" mh-show-goto-msg
- "i" mh-show-inc-folder
- "k" mh-show-delete-subject-or-thread
- "m" mh-show-send
- "n" mh-show-next-undeleted-msg
- "\M-n" mh-show-next-unread-msg
- "o" mh-show-refile-msg
- "p" mh-show-previous-undeleted-msg
- "\M-p" mh-show-previous-unread-msg
- "q" mh-show-quit
- "r" mh-show-reply
- "s" mh-show-send
- "t" mh-show-toggle-showing
- "u" mh-show-undo
- "x" mh-show-execute-commands
- "v" mh-show-index-visit-folder
- "|" mh-show-pipe-msg)
-
-(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
- "?" mh-prefix-help
- "'" mh-index-ticked-messages
- "S" mh-show-sort-folder
- "c" mh-show-catchup
- "f" mh-show-visit-folder
- "k" mh-show-kill-folder
- "l" mh-show-list-folders
- "n" mh-index-new-messages
- "o" mh-show-visit-folder
- "p" mh-show-pack-folder
- "q" mh-show-index-sequenced-messages
- "r" mh-show-rescan-folder
- "s" mh-search
- "t" mh-show-toggle-threads
- "u" mh-show-undo-folder
- "v" mh-show-visit-folder)
-
-(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
- "'" mh-show-narrow-to-tick
- "?" mh-prefix-help
- "d" mh-show-delete-msg-from-seq
- "k" mh-show-delete-seq
- "l" mh-show-list-sequences
- "n" mh-show-narrow-to-seq
- "p" mh-show-put-msg-in-seq
- "s" mh-show-msg-is-in-seq
- "w" mh-show-widen)
-
-(define-key mh-show-mode-map "I" mh-inc-spool-map)
-
-(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
- "?" mh-prefix-help
- "a" mh-show-junk-allowlist
- "b" mh-show-junk-blocklist
- "w" mh-show-junk-whitelist)
-
-(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
- "?" mh-prefix-help
- "C" mh-show-ps-print-toggle-color
- "F" mh-show-ps-print-toggle-faces
- "f" mh-show-ps-print-msg-file
- "l" mh-show-print-msg
- "p" mh-show-ps-print-msg)
-
-(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
- "?" mh-prefix-help
- "u" mh-show-thread-ancestor
- "p" mh-show-thread-previous-sibling
- "n" mh-show-thread-next-sibling
- "t" mh-show-toggle-threads
- "d" mh-show-thread-delete
- "o" mh-show-thread-refile)
-
-(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
- "'" mh-show-narrow-to-tick
- "?" mh-prefix-help
- "c" mh-show-narrow-to-cc
- "g" mh-show-narrow-to-range
- "m" mh-show-narrow-to-from
- "s" mh-show-narrow-to-subject
- "t" mh-show-narrow-to-to
- "w" mh-show-widen)
-
-(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
- "?" mh-prefix-help
- "s" mh-show-store-msg
- "u" mh-show-store-msg)
-
-(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map)
- "?" mh-prefix-help
- " " mh-show-page-digest
- "\177" mh-show-page-digest-backwards
- "b" mh-show-burst-digest)
-
-(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
- "?" mh-prefix-help
- "a" mh-mime-save-parts
- "e" mh-show-display-with-external-viewer
- "v" mh-show-toggle-mime-part
- "o" mh-show-save-mime-part
- "i" mh-show-inline-mime-part
- "t" mh-show-toggle-mime-buttons
- "\t" mh-show-next-button
- [backtab] mh-show-prev-button
- "\M-\t" mh-show-prev-button)
+(define-keymap :keymap mh-show-mode-map
+ "SPC" #'mh-show-page-msg
+ "!" #'mh-show-refile-or-write-again
+ "'" #'mh-show-toggle-tick
+ "," #'mh-show-header-display
+ "." #'mh-show-show
+ ":" #'mh-show-show-preferred-alternative
+ ">" #'mh-show-write-message-to-file
+ "?" #'mh-help
+ "E" #'mh-show-extract-rejected-mail
+ "M" #'mh-show-modify
+ "DEL" #'mh-show-previous-page
+ "C-d" #'mh-show-delete-msg-no-motion
+ "TAB" #'mh-show-next-button
+ "<backtab>" #'mh-show-prev-button
+ "C-M-i" #'mh-show-prev-button
+ "ESC d" #'mh-show-redistribute
+ "^" #'mh-show-refile-msg
+ "c" #'mh-show-copy-msg
+ "d" #'mh-show-delete-msg
+ "e" #'mh-show-edit-again
+ "f" #'mh-show-forward
+ "g" #'mh-show-goto-msg
+ "i" #'mh-show-inc-folder
+ "k" #'mh-show-delete-subject-or-thread
+ "m" #'mh-show-send
+ "n" #'mh-show-next-undeleted-msg
+ "M-n" #'mh-show-next-unread-msg
+ "o" #'mh-show-refile-msg
+ "p" #'mh-show-previous-undeleted-msg
+ "M-p" #'mh-show-previous-unread-msg
+ "q" #'mh-show-quit
+ "r" #'mh-show-reply
+ "s" #'mh-show-send
+ "t" #'mh-show-toggle-showing
+ "u" #'mh-show-undo
+ "x" #'mh-show-execute-commands
+ "v" #'mh-show-index-visit-folder
+ "|" #'mh-show-pipe-msg
+
+ "F" (define-keymap :prefix 'mh-show-folder-map
+ "?" #'mh-prefix-help
+ "'" #'mh-index-ticked-messages
+ "S" #'mh-show-sort-folder
+ "c" #'mh-show-catchup
+ "f" #'mh-show-visit-folder
+ "k" #'mh-show-kill-folder
+ "l" #'mh-show-list-folders
+ "n" #'mh-index-new-messages
+ "o" #'mh-show-visit-folder
+ "p" #'mh-show-pack-folder
+ "q" #'mh-show-index-sequenced-messages
+ "r" #'mh-show-rescan-folder
+ "s" #'mh-search
+ "t" #'mh-show-toggle-threads
+ "u" #'mh-show-undo-folder
+ "v" #'mh-show-visit-folder)
+
+ "S" (define-keymap :prefix 'mh-show-sequence-map
+ "'" #'mh-show-narrow-to-tick
+ "?" #'mh-prefix-help
+ "d" #'mh-show-delete-msg-from-seq
+ "k" #'mh-show-delete-seq
+ "l" #'mh-show-list-sequences
+ "n" #'mh-show-narrow-to-seq
+ "p" #'mh-show-put-msg-in-seq
+ "s" #'mh-show-msg-is-in-seq
+ "w" #'mh-show-widen)
+
+ "I" mh-inc-spool-map
+
+ "J" (define-keymap :prefix 'mh-show-junk-map
+ "?" #'mh-prefix-help
+ "a" #'mh-show-junk-allowlist
+ "b" #'mh-show-junk-blocklist
+ "w" #'mh-show-junk-whitelist)
+
+ "P" (define-keymap :prefix 'mh-show-ps-print-map
+ "?" #'mh-prefix-help
+ "C" #'mh-show-ps-print-toggle-color
+ "F" #'mh-show-ps-print-toggle-faces
+ "f" #'mh-show-ps-print-msg-file
+ "l" #'mh-show-print-msg
+ "p" #'mh-show-ps-print-msg)
+
+ "T" (define-keymap :prefix 'mh-show-thread-map
+ "?" #'mh-prefix-help
+ "u" #'mh-show-thread-ancestor
+ "p" #'mh-show-thread-previous-sibling
+ "n" #'mh-show-thread-next-sibling
+ "t" #'mh-show-toggle-threads
+ "d" #'mh-show-thread-delete
+ "o" #'mh-show-thread-refile)
+
+ "/" (define-keymap :prefix 'mh-show-limit-map
+ "'" #'mh-show-narrow-to-tick
+ "?" #'mh-prefix-help
+ "c" #'mh-show-narrow-to-cc
+ "g" #'mh-show-narrow-to-range
+ "m" #'mh-show-narrow-to-from
+ "s" #'mh-show-narrow-to-subject
+ "t" #'mh-show-narrow-to-to
+ "w" #'mh-show-widen)
+
+ "X" (define-keymap :prefix 'mh-show-extract-map
+ "?" #'mh-prefix-help
+ "s" #'mh-show-store-msg
+ "u" #'mh-show-store-msg)
+
+ "D" (define-keymap :prefix 'mh-show-digest-map
+ "?" #'mh-prefix-help
+ "SPC" #'mh-show-page-digest
+ "DEL" #'mh-show-page-digest-backwards
+ "b" #'mh-show-burst-digest)
+
+ "K" (define-keymap :prefix 'mh-show-mime-map
+ "?" #'mh-prefix-help
+ "a" #'mh-mime-save-parts
+ "e" #'mh-show-display-with-external-viewer
+ "v" #'mh-show-toggle-mime-part
+ "o" #'mh-show-save-mime-part
+ "i" #'mh-show-inline-mime-part
+ "t" #'mh-show-toggle-mime-buttons
+ "TAB" #'mh-show-next-button
+ "<backtab>" #'mh-show-prev-button
+ "C-M-i" #'mh-show-prev-button))
@@ -817,9 +815,6 @@ operation."
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-show-mode 'mode-class 'special)
-;; Shush compiler.
-(defvar font-lock-auto-fontify)
-
;;;###mh-autoload
(define-derived-mode mh-show-mode text-mode "MH-Show"
"Major mode for showing messages in MH-E.\\<mh-show-mode-map>
@@ -836,17 +831,14 @@ The hook `mh-show-mode-hook' is called upon entry to this mode.
See also `mh-folder-mode'.
\\{mh-show-mode-map}"
- (mh-do-in-gnu-emacs
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)))
- (mh-do-in-xemacs
- (mh-tool-bar-init :show))
- (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
+ (if (boundp 'tool-bar-map)
+ (setq-local tool-bar-map mh-show-tool-bar-map))
+ (setq-local mail-header-separator mh-mail-header-separator)
(setq paragraph-start (default-value 'paragraph-start))
(setq buffer-invisibility-spec '((vanish . t) t))
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local line-move-ignore-invisible t)
(make-local-variable 'font-lock-defaults)
- ;;(set (make-local-variable 'font-lock-support-mode) nil)
+ ;;(setq-local font-lock-support-mode nil)
(cond
((equal mh-highlight-citation-style 'font-lock)
(setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
@@ -858,16 +850,8 @@ See also `mh-folder-mode'.
(mh-gnus-article-highlight-citation))
(t
(setq font-lock-defaults '(mh-show-font-lock-keywords t))))
- (if (and (featurep 'xemacs)
- font-lock-auto-fontify)
- (turn-on-font-lock))
(when mh-decode-mime-flag
- (mh-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook #'mh-mime-cleanup nil t))
- (mh-do-in-xemacs
- (easy-menu-add mh-show-sequence-menu)
- (easy-menu-add mh-show-message-menu)
- (easy-menu-add mh-show-folder-menu))
(make-local-variable 'mh-show-folder-buffer)
(buffer-disable-undo)
(use-local-map mh-show-mode-map))
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 862ddbcab56..a7e9c9bd678 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -63,13 +63,13 @@
'("--"
["Visit Folder" mh-speed-view
(with-current-buffer speedbar-buffer
- (get-text-property (mh-line-beginning-position) 'mh-folder))]
+ (get-text-property (line-beginning-position) 'mh-folder))]
["Expand Nested Folders" mh-speed-expand-folder
- (and (get-text-property (mh-line-beginning-position) 'mh-children-p)
- (not (get-text-property (mh-line-beginning-position) 'mh-expanded)))]
+ (and (get-text-property (line-beginning-position) 'mh-children-p)
+ (not (get-text-property (line-beginning-position) 'mh-expanded)))]
["Contract Nested Folders" mh-speed-contract-folder
- (and (get-text-property (mh-line-beginning-position) 'mh-children-p)
- (get-text-property (mh-line-beginning-position) 'mh-expanded))]
+ (and (get-text-property (line-beginning-position) 'mh-children-p)
+ (get-text-property (line-beginning-position) 'mh-expanded))]
["Refresh Speedbar" mh-speed-refresh t])
"Extra menu items for speedbar.")
@@ -83,11 +83,11 @@
(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
"Specialized speedbar keymap for MH-E buffers.")
-(gnus-define-keys mh-folder-speedbar-key-map
- "+" mh-speed-expand-folder
- "-" mh-speed-contract-folder
- "\r" mh-speed-view
- "r" mh-speed-refresh)
+(define-keymap :keymap mh-folder-speedbar-key-map
+ "+" #'mh-speed-expand-folder
+ "-" #'mh-speed-contract-folder
+ "RET" #'mh-speed-view
+ "r" #'mh-speed-refresh)
(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
@@ -150,7 +150,7 @@ The optional arguments from speedbar are IGNORED."
(forward-line -1)
(speedbar-change-expand-button-char ?+)
(add-text-properties
- (mh-line-beginning-position) (1+ (line-beginning-position))
+ (line-beginning-position) (1+ (line-beginning-position))
'(mh-expanded nil)))
(t
(forward-line)
@@ -158,14 +158,14 @@ The optional arguments from speedbar are IGNORED."
(goto-char point)
(speedbar-change-expand-button-char ?-)
(add-text-properties
- (mh-line-beginning-position) (1+ (line-beginning-position))
+ (line-beginning-position) (1+ (line-beginning-position))
'(mh-expanded t)))))))
(defun mh-speed-view (&rest _ignored)
"Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder].
The optional arguments from speedbar are IGNORED."
(interactive)
- (let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder))
+ (let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
(range (and (stringp folder)
(mh-read-range "Scan" folder t nil nil
mh-interpret-number-as-range-flag))))
@@ -191,9 +191,9 @@ created."
(forward-line -1)
(setf (gethash nil mh-speed-folder-map)
(set-marker (or (gethash nil mh-speed-folder-map) (make-marker))
- (1+ (mh-line-beginning-position))))
+ (1+ (line-beginning-position))))
(add-text-properties
- (mh-line-beginning-position) (1+ (line-beginning-position))
+ (line-beginning-position) (1+ (line-beginning-position))
'(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
(mh-speed-stealth-update t)
(when (> mh-speed-update-interval 0)
@@ -260,12 +260,12 @@ The update is always carried out if FORCE is non-nil."
(speedbar-with-writable
(goto-char (gethash folder mh-speed-folder-map (point)))
(beginning-of-line)
- (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (mh-line-end-position) t)
+ (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
(setq face (mh-speed-bold-face face))
(setq face (mh-speed-normal-face face)))
(beginning-of-line)
- (when (re-search-forward "\\[.\\] " (mh-line-end-position) t)
- (put-text-property (point) (mh-line-end-position) 'face face)))))
+ (when (re-search-forward "\\[.\\] " (line-end-position) t)
+ (put-text-property (point) (line-end-position) 'face face)))))
(defun mh-speed-normal-face (face)
"Return normal face for given FACE."
@@ -305,7 +305,7 @@ The function will expand out parent folders of FOLDER if needed."
(while suffix-list
;; We always need at least one toggle. We need two if the directory list
;; is stale since a folder was added.
- (when (equal prefix (get-text-property (mh-line-beginning-position)
+ (when (equal prefix (get-text-property (line-beginning-position)
'mh-folder))
(mh-speed-toggle)
(unless (get-text-property (point) 'mh-expanded)
@@ -359,9 +359,9 @@ uses."
(setf (gethash folder-name mh-speed-folder-map)
(set-marker (or (gethash folder-name mh-speed-folder-map)
(make-marker))
- (1+ (mh-line-beginning-position))))
+ (1+ (line-beginning-position))))
(add-text-properties
- (mh-line-beginning-position) (1+ (mh-line-beginning-position))
+ (line-beginning-position) (1+ (line-beginning-position))
`(mh-folder ,folder-name
mh-expanded nil
mh-children-p ,(not (not (cdr f)))
@@ -374,12 +374,9 @@ uses."
(defvar mh-speed-flists-folder nil)
(defmacro mh-process-kill-without-query (process)
- "PROCESS can be killed without query on Emacs exit.
-Avoid using `process-kill-without-query' if possible since it is
-now obsolete."
- (if (fboundp 'set-process-query-on-exit-flag)
- `(set-process-query-on-exit-flag ,process nil)
- `(process-kill-without-query ,process)))
+ "PROCESS can be killed without query on Emacs exit."
+ (declare (obsolete set-process-query-on-exit-flag "29.1"))
+ `(set-process-query-on-exit-flag ,process nil))
;;;###mh-autoload
(defun mh-speed-flists (force &rest folders)
@@ -391,7 +388,7 @@ flists is run only for that one folder."
(interactive (list t))
(when force
(when mh-speed-flists-timer
- (mh-cancel-timer mh-speed-flists-timer)
+ (cancel-timer mh-speed-flists-timer)
(setq mh-speed-flists-timer nil))
(when (and (processp mh-speed-flists-process)
(not (eq (process-status mh-speed-flists-process) 'exit)))
@@ -427,7 +424,7 @@ flists is run only for that one folder."
(or mh-speed-flists-folder '("-recurse"))))
;; Run flists on all folders the next time around...
(setq mh-speed-flists-folder nil)
- (mh-process-kill-without-query mh-speed-flists-process)
+ (set-process-query-on-exit-flag mh-speed-flists-process nil)
(set-process-filter mh-speed-flists-process
#'mh-speed-parse-flists-output)))))))
@@ -462,25 +459,25 @@ be handled next."
face)
(when pos
(goto-char pos)
- (goto-char (mh-line-beginning-position))
+ (goto-char (line-beginning-position))
(cond
((null (get-text-property (point) 'mh-count))
- (goto-char (mh-line-end-position))
+ (goto-char (line-end-position))
(setq face (get-text-property (1- (point)) 'face))
(insert (format " (%s/%s)" unseen total))
(mh-speed-highlight 'unknown face)
- (goto-char (mh-line-beginning-position))
+ (goto-char (line-beginning-position))
(add-text-properties (point) (1+ (point))
`(mh-count (,unseen . ,total))))
((not (equal (get-text-property (point) 'mh-count)
(cons unseen total)))
- (goto-char (mh-line-end-position))
+ (goto-char (line-end-position))
(setq face (get-text-property (1- (point)) 'face))
- (re-search-backward " " (mh-line-beginning-position) t)
- (delete-region (point) (mh-line-end-position))
+ (re-search-backward " " (line-beginning-position) t)
+ (delete-region (point) (line-end-position))
(insert (format " (%s/%s)" unseen total))
(mh-speed-highlight 'unknown face)
- (goto-char (mh-line-beginning-position))
+ (goto-char (line-beginning-position))
(add-text-properties
(point) (1+ (point))
`(mh-count (,unseen . ,total))))))))))))
@@ -509,15 +506,15 @@ be handled next."
(caar parent-kids)))
(setq parent-change ? ))))
(goto-char parent-position)
- (when (equal (get-text-property (mh-line-beginning-position) 'mh-folder)
+ (when (equal (get-text-property (line-beginning-position) 'mh-folder)
parent)
- (when (get-text-property (mh-line-beginning-position) 'mh-expanded)
+ (when (get-text-property (line-beginning-position) 'mh-expanded)
(mh-speed-toggle))
(when parent-change
(speedbar-with-writable
(mh-speedbar-change-expand-button-char parent-change)
(add-text-properties
- (mh-line-beginning-position) (1+ (mh-line-beginning-position))
+ (line-beginning-position) (1+ (line-beginning-position))
`(mh-children-p ,(equal parent-change ?+)))))
(mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder)
(setq mh-speed-last-selected-folder nil)
@@ -531,15 +528,15 @@ be handled next."
"Change the expansion button character to CHAR for the current line."
(save-excursion
(beginning-of-line)
- (if (re-search-forward "\\[.\\]" (mh-line-end-position) t)
+ (if (re-search-forward "\\[.\\]" (line-end-position) t)
(speedbar-with-writable
(backward-char 2)
(delete-char 1)
(insert-char char 1 t)
(put-text-property (point) (1- (point)) 'invisible nil)
;; make sure we fix the image on the text here.
- (mh-funcall-if-exists
- speedbar-insert-image-button-maybe (- (point) 2) 3)))))
+ (when (fboundp 'speedbar-insert-image-button-maybe)
+ (speedbar-insert-image-button-maybe (- (point) 2) 3))))))
;;;###mh-autoload
(defun mh-speed-add-folder (folder)
@@ -562,9 +559,9 @@ The function invalidates the latest ancestor that is present."
(speedbar-with-writable
(mh-speedbar-change-expand-button-char ?+)
(add-text-properties
- (mh-line-beginning-position) (1+ (mh-line-beginning-position))
+ (line-beginning-position) (1+ (line-beginning-position))
'(mh-children-p t)))
- (when (get-text-property (mh-line-beginning-position) 'mh-expanded)
+ (when (get-text-property (line-beginning-position) 'mh-expanded)
(mh-speed-toggle))
(setq mh-speed-refresh-flag t))))
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index de90e97da7a..139e9b74cbb 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -86,41 +86,33 @@
message parent children
(real-child-p t))
-(defvar mh-thread-id-hash nil
+(defvar-local mh-thread-id-hash nil
"Hash table used to canonicalize message identifiers.")
-(make-variable-buffer-local 'mh-thread-id-hash)
-(defvar mh-thread-subject-hash nil
+(defvar-local mh-thread-subject-hash nil
"Hash table used to canonicalize subject strings.")
-(make-variable-buffer-local 'mh-thread-subject-hash)
-(defvar mh-thread-id-table nil
+(defvar-local mh-thread-id-table nil
"Thread ID table maps from message identifiers to message containers.")
-(make-variable-buffer-local 'mh-thread-id-table)
-(defvar mh-thread-index-id-map nil
+(defvar-local mh-thread-index-id-map nil
"Table to look up message identifier from message index.")
-(make-variable-buffer-local 'mh-thread-index-id-map)
-(defvar mh-thread-id-index-map nil
+(defvar-local mh-thread-id-index-map nil
"Table to look up message index number from message identifier.")
-(make-variable-buffer-local 'mh-thread-id-index-map)
-(defvar mh-thread-subject-container-hash nil
+(defvar-local mh-thread-subject-container-hash nil
"Hash table used to group messages by subject.")
-(make-variable-buffer-local 'mh-thread-subject-container-hash)
-(defvar mh-thread-duplicates nil
+(defvar-local mh-thread-duplicates nil
"Hash table used to associate messages with the same message identifier.")
-(make-variable-buffer-local 'mh-thread-duplicates)
-(defvar mh-thread-history ()
+(defvar-local mh-thread-history ()
"Variable to remember the transformations to the thread tree.
When new messages are added, these transformations are rewound,
then the links are added from the newly seen messages. Finally
the transformations are redone to get the new thread tree. This
makes incremental threading easier.")
-(make-variable-buffer-local 'mh-thread-history)
(defvar mh-thread-body-width nil
"Width of scan substring that contains subject and body of message.")
@@ -147,7 +139,7 @@ to the message that started everything."
(cond (thread-root-flag
(while (mh-thread-immediate-ancestor))
(mh-maybe-show))
- ((equal current-level 1)
+ ((equal current-level 0)
(message "Message has no ancestor"))
(t (mh-thread-immediate-ancestor)
(mh-maybe-show)))))
@@ -250,8 +242,8 @@ sibling."
(defun mh-thread-current-indentation-level ()
"Find the number of spaces by which current message is indented."
(save-excursion
- (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
- mh-scan-date-width 1))
+ (let ((address-start-offset (+ mh-cmd-note
+ mh-scan-field-from-start-offset))
(level 0))
(beginning-of-line)
(forward-char address-start-offset)
@@ -283,8 +275,8 @@ at the end."
(beginning-of-line)
(if (eobp)
nil
- (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
- mh-scan-date-width 1))
+ (let ((address-start-offset (+ mh-cmd-note
+ mh-scan-field-from-start-offset))
(level (mh-thread-current-indentation-level))
spaces begin)
(setq begin (point))
@@ -294,7 +286,7 @@ at the end."
(while (not (eobp))
(forward-char address-start-offset)
(unless (equal (string-match spaces (buffer-substring-no-properties
- (point) (mh-line-end-position)))
+ (point) (line-end-position)))
0)
(beginning-of-line)
(backward-char)
@@ -455,8 +447,8 @@ If optional argument STRING is given then that is assumed to be
the scan line. Otherwise uses the line at point as the scan line
to parse."
(let* ((string (or string (buffer-substring-no-properties
- (mh-line-beginning-position)
- (mh-line-end-position))))
+ (line-beginning-position)
+ (line-end-position))))
(address-start (+ mh-cmd-note mh-scan-field-from-start-offset))
(body-start (+ mh-cmd-note mh-scan-field-from-end-offset))
(first-string (substring string 0 address-start)))
@@ -597,20 +589,20 @@ Only information about messages in MSG-LIST are added to the tree."
(while (not (eobp))
(cl-block process-message
(let* ((index-line
- (prog1 (buffer-substring (point) (mh-line-end-position))
+ (prog1 (buffer-substring (point) (line-end-position))
(forward-line)))
(index (string-to-number index-line))
- (id (prog1 (buffer-substring (point) (mh-line-end-position))
+ (id (prog1 (buffer-substring (point) (line-end-position))
(forward-line)))
(refs (prog1
- (buffer-substring (point) (mh-line-end-position))
+ (buffer-substring (point) (line-end-position))
(forward-line)))
(in-reply-to (prog1 (buffer-substring (point)
- (mh-line-end-position))
+ (line-end-position))
(forward-line)))
(subject (prog1
(buffer-substring
- (point) (mh-line-end-position))
+ (point) (line-end-position))
(forward-line)))
(subject-re-p nil))
(unless (gethash index mh-thread-scan-line-map)
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 00a9fa724c5..17df075cfac 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -27,10 +27,8 @@
;;; Code:
(require 'mh-e)
-(mh-do-in-gnu-emacs
- (require 'tool-bar))
-(mh-do-in-xemacs
- (require 'toolbar))
+(require 'mh-acros)
+(require 'tool-bar)
;;; Tool Bar Commands
@@ -79,9 +77,6 @@ When INCLUDE-FLAG is non-nil, include message body being replied to."
;;; Tool Bar Creation
-;; Shush compiler.
-(defvar image-load-path)
-
(defmacro mh-tool-bar-define (defaults &rest buttons)
"Define a tool bar for MH-E.
DEFAULTS is the list of buttons that are present by default. It
@@ -145,8 +140,6 @@ where,
(let* ((name (nth 0 button))
(name-str (symbol-name name))
(icon (nth 2 button))
- (xemacs-icon (mh-do-in-xemacs
- `(cdr (assoc (quote ,(intern icon)) mh-xemacs-icon-map))))
(full-doc (nth 3 button))
(doc (if (string-match "\\(.*\\)\n" full-doc)
(match-string 1 full-doc)
@@ -186,11 +179,10 @@ where,
(t 'folder-buttons)))
(docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs)
((eq mbuttons 'folder-buttons) 'folder-docs))))
- (add-to-list vector-list `(vector ,xemacs-icon ',function t ,full-doc))
+ (add-to-list vector-list `(vector nil ',function t ,full-doc))
(add-to-list
setter `(when (member ',name ,list)
- (mh-funcall-if-exists
- tool-bar-add-item ,icon ',function ',key
+ (tool-bar-add-item ,icon ',function ',key
:help ,doc :enable ',enable-expr)))
(add-to-list mbuttons name)
(if docs (add-to-list docs doc))))))
@@ -209,145 +201,69 @@ where,
(unless (memq x letter-buttons)
(error "Letter defaults contains unknown button %s" x)))
`(eval-and-compile
- ;; GNU Emacs tool bar specific code
- (mh-do-in-gnu-emacs
- (defun mh-buffer-exists-p (mode)
- "Test whether a buffer with major mode MODE is present."
- (cl-loop for buf in (buffer-list)
- when (with-current-buffer buf
- (eq major-mode mode))
- return t))
- ;; Tool bar initialization functions
- (defun mh-tool-bar-folder-buttons-init ()
- (when (mh-buffer-exists-p 'mh-folder-mode)
- (let* ((load-path (mh-image-load-path-for-library "mh-e"
- "mh-logo.xpm"))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path))))
- (setq mh-folder-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- ,@(nreverse folder-button-setter)
- tool-bar-map))
- (setq mh-folder-seq-tool-bar-map
- (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
- ,@(nreverse sequence-button-setter)
- tool-bar-map))
- (setq mh-show-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- ,@(nreverse show-button-setter)
- tool-bar-map))
- (setq mh-show-seq-tool-bar-map
- (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map)))
- ,@(nreverse show-seq-button-setter)
- tool-bar-map)))))
- (defun mh-tool-bar-letter-buttons-init ()
- (when (mh-buffer-exists-p 'mh-letter-mode)
- (let* ((load-path (mh-image-load-path-for-library "mh-e"
- "mh-logo.xpm"))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path))))
- (setq mh-letter-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- ,@(nreverse letter-button-setter)
- tool-bar-map)))))
- ;; Custom setter functions
- (defun mh-tool-bar-update (mode default-map sequence-map)
- "Update `tool-bar-map' in all buffers of MODE.
+ (defun mh-buffer-exists-p (mode)
+ "Test whether a buffer with major mode MODE is present."
+ (cl-loop for buf in (buffer-list)
+ when (with-current-buffer buf
+ (eq major-mode mode))
+ return t))
+ ;; Tool bar initialization functions
+ (defun mh-tool-bar-folder-buttons-init ()
+ (when (mh-buffer-exists-p 'mh-folder-mode)
+ (mh--with-image-load-path
+ (setq mh-folder-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ ,@(nreverse folder-button-setter)
+ tool-bar-map))
+ (setq mh-folder-seq-tool-bar-map
+ (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
+ ,@(nreverse sequence-button-setter)
+ tool-bar-map))
+ (setq mh-show-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ ,@(nreverse show-button-setter)
+ tool-bar-map))
+ (setq mh-show-seq-tool-bar-map
+ (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map)))
+ ,@(nreverse show-seq-button-setter)
+ tool-bar-map)))))
+ (defun mh-tool-bar-letter-buttons-init ()
+ (when (mh-buffer-exists-p 'mh-letter-mode)
+ (mh--with-image-load-path
+ (setq mh-letter-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ ,@(nreverse letter-button-setter)
+ tool-bar-map)))))
+ ;; Custom setter functions
+ (defun mh-tool-bar-update (mode default-map sequence-map)
+ "Update `tool-bar-map' in all buffers of MODE.
Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
- (cl-loop for buf in (buffer-list)
- do (with-current-buffer buf
- (when (eq mode major-mode) ;FIXME: derived-mode-p?
- (let ((map (if mh-folder-view-stack
- sequence-map
- default-map)))
- ;; Yes, make-local-variable is necessary since we
- ;; get here during initialization when loading
- ;; mh-e.el, after the +inbox buffer has been
- ;; created, but before mh-folder-mode has run and
- ;; created the local map.
- (set (make-local-variable 'tool-bar-map) map))))))
- (defun mh-tool-bar-folder-buttons-set (symbol value)
- "Construct tool bar for `mh-folder-mode' and `mh-show-mode'."
- (set-default symbol value)
- (mh-tool-bar-folder-buttons-init)
- (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map
- mh-folder-seq-tool-bar-map)
- (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map
- mh-show-seq-tool-bar-map))
- (defun mh-tool-bar-letter-buttons-set (symbol value)
- "Construct tool bar for `mh-letter-mode'."
- (set-default symbol value)
- (mh-tool-bar-letter-buttons-init)
- (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map
- mh-letter-tool-bar-map)))
- ;; XEmacs specific code
- (mh-do-in-xemacs
- (defvar mh-tool-bar-folder-vector-map
- (list ,@(cl-loop for button in folder-buttons
- for vector in folder-vectors
- collect `(cons ',button ,vector))))
- (defvar mh-tool-bar-show-vector-map
- (list ,@(cl-loop for button in show-buttons
- for vector in show-vectors
- collect `(cons ',button ,vector))))
- (defvar mh-tool-bar-letter-vector-map
- (list ,@(cl-loop for button in letter-buttons
- for vector in letter-vectors
- collect `(cons ',button ,vector))))
- (defvar mh-tool-bar-folder-buttons)
- (defvar mh-tool-bar-show-buttons)
- (defvar mh-tool-bar-letter-buttons)
- ;; Custom setter functions
- (defun mh-tool-bar-letter-buttons-set (symbol value)
- (set-default symbol value)
- (when mh-xemacs-has-tool-bar-flag
- (setq mh-tool-bar-letter-buttons
- (cl-loop
- for b in value
- collect (cdr (assoc b mh-tool-bar-letter-vector-map))))))
- (defun mh-tool-bar-folder-buttons-set (symbol value)
- (set-default symbol value)
- (when mh-xemacs-has-tool-bar-flag
- (setq mh-tool-bar-folder-buttons
- (cl-loop
- for b in value
- collect (cdr (assoc b mh-tool-bar-folder-vector-map))))
- (setq mh-tool-bar-show-buttons
- (cl-loop
- for b in value
- collect (cdr (assoc b mh-tool-bar-show-vector-map))))))
- (defun mh-tool-bar-init (mode)
- "Install tool bar in MODE."
- (when mh-xemacs-use-tool-bar-flag
- (let ((tool-bar (cond ((eq mode :folder)
- mh-tool-bar-folder-buttons)
- ((eq mode :letter)
- mh-tool-bar-letter-buttons)
- ((eq mode :show)
- mh-tool-bar-show-buttons)))
- (height 37)
- (width 40)
- (buffer (current-buffer)))
- (cond
- ((eq mh-xemacs-tool-bar-position 'top)
- (set-specifier top-toolbar tool-bar buffer)
- (set-specifier top-toolbar-visible-p t)
- (set-specifier top-toolbar-height height))
- ((eq mh-xemacs-tool-bar-position 'bottom)
- (set-specifier bottom-toolbar tool-bar buffer)
- (set-specifier bottom-toolbar-visible-p t)
- (set-specifier bottom-toolbar-height height))
- ((eq mh-xemacs-tool-bar-position 'left)
- (set-specifier left-toolbar tool-bar buffer)
- (set-specifier left-toolbar-visible-p t)
- (set-specifier left-toolbar-width width))
- ((eq mh-xemacs-tool-bar-position 'right)
- (set-specifier right-toolbar tool-bar buffer)
- (set-specifier right-toolbar-visible-p t)
- (set-specifier right-toolbar-width width))
- (t (set-specifier default-toolbar tool-bar buffer)))))))
+ (cl-loop for buf in (buffer-list)
+ do (with-current-buffer buf
+ (when (eq mode major-mode) ;FIXME: derived-mode-p?
+ (let ((map (if mh-folder-view-stack
+ sequence-map
+ default-map)))
+ ;; Yes, make-local-variable is necessary since we
+ ;; get here during initialization when loading
+ ;; mh-e.el, after the +inbox buffer has been
+ ;; created, but before mh-folder-mode has run and
+ ;; created the local map.
+ (setq-local tool-bar-map map))))))
+ (defun mh-tool-bar-folder-buttons-set (symbol value)
+ "Construct tool bar for `mh-folder-mode' and `mh-show-mode'."
+ (set-default symbol value)
+ (mh-tool-bar-folder-buttons-init)
+ (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map
+ mh-folder-seq-tool-bar-map)
+ (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map
+ mh-show-seq-tool-bar-map))
+ (defun mh-tool-bar-letter-buttons-set (symbol value)
+ "Construct tool bar for `mh-letter-mode'."
+ (set-default symbol value)
+ (mh-tool-bar-letter-buttons-init)
+ (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map
+ mh-letter-tool-bar-map))
;; Declare customizable tool bars
(custom-declare-variable
'mh-tool-bar-folder-buttons
@@ -372,7 +288,6 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
;;:package-version '(MH-E "7.1")
))))
-;; The icon names are duplicated in the Makefile and mh-xemacs.el.
(mh-tool-bar-define
((:folder mh-inc-folder mh-mime-save-parts
mh-previous-undeleted-msg mh-page-msg
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 6e5337d9606..d7a92be5b5f 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -52,7 +52,7 @@ used in lieu of `search' in the CL package."
(let ((syntax-table (syntax-table)))
(unwind-protect
(save-excursion
- (mh-mail-abbrev-make-syntax-table)
+ (mail-abbrev-make-syntax-table)
(set-syntax-table mail-abbrev-syntax-table)
(backward-word n)
(point))
@@ -61,9 +61,9 @@ used in lieu of `search' in the CL package."
;;;###mh-autoload
(defun mh-colors-available-p ()
"Check if colors are available in the Emacs being used."
- (or (featurep 'xemacs)
- (let ((color-cells (mh-display-color-cells)))
- (and (numberp color-cells) (>= color-cells 8)))))
+ ;; FIXME: Can this be replaced with `display-color-p'?
+ (let ((color-cells (display-color-cells)))
+ (and (numberp color-cells) (>= color-cells 8))))
;;;###mh-autoload
(defun mh-colors-in-use-p ()
@@ -78,16 +78,13 @@ used in lieu of `search' in the CL package."
;;;###mh-autoload
(defun mh-make-local-vars (&rest pairs)
"Initialize local variables according to the variable-value PAIRS."
+ (declare (obsolete setq-local "29.1"))
(while pairs
(set (make-local-variable (car pairs)) (car (cdr pairs)))
(setq pairs (cdr (cdr pairs)))))
;;;###mh-autoload
-(defun mh-mapc (function list)
- "Apply FUNCTION to each element of LIST for side effects only."
- (while list
- (funcall function (car list))
- (setq list (cdr list))))
+(define-obsolete-function-alias 'mh-mapc #'mapc "29.1")
(defvar mh-pick-regexp-chars ".*$["
"List of special characters in pick regular expressions.")
@@ -102,7 +99,7 @@ PICK-EXPR is a list of strings. Return nil if PICK-EXPR is nil."
(not (string-equal string "")))
(cl-loop for i from 0 to (1- (length mh-pick-regexp-chars)) do
(let ((s (string ?\\ (aref mh-pick-regexp-chars i))))
- (setq string (mh-replace-regexp-in-string s s string t t))))
+ (setq string (replace-regexp-in-string s s string t t))))
(setq quoted-pick-expr (append quoted-pick-expr (list string)))))
quoted-pick-expr))
@@ -119,34 +116,32 @@ Ignores case when searching for OLD."
;;; Logo Display
-(defvar mh-logo-cache nil)
+;;;###mh-autoload
+(defmacro mh--with-image-load-path (&rest body)
+ "Load `image' and eval BODY with `image-load-path' set appropriately."
+ (declare (debug t) (indent 0))
+ `(progn
+ ;; Not preloaded in without-x builds.
+ (require 'image)
+ (defvar image-load-path)
+ (declare-function image-load-path-for-library "image")
+ (let* ((load-path (image-load-path-for-library "mh-e" "mh-logo.xpm"))
+ (image-load-path (cons (car load-path) image-load-path)))
+ ,@body)))
-;; Shush compiler.
-(defvar image-load-path)
+(defvar mh-logo-cache nil)
;;;###mh-autoload
(defun mh-logo-display ()
"Modify mode line to display MH-E logo."
- (mh-do-in-gnu-emacs
- (let* ((load-path (mh-image-load-path-for-library "mh-e" "mh-logo.xpm"))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path))))
- (add-text-properties
- 0 2
- `(display ,(or mh-logo-cache
- (setq mh-logo-cache
- (mh-funcall-if-exists
- find-image '((:type xpm :ascent center
- :file "mh-logo.xpm"))))))
- (car mode-line-buffer-identification))))
- (mh-do-in-xemacs
- (setq modeline-buffer-identification
- (list
- (if mh-modeline-glyph
- (cons modeline-buffer-id-left-extent mh-modeline-glyph)
- (cons modeline-buffer-id-left-extent "XEmacs%N:"))
- (cons modeline-buffer-id-right-extent " %17b")))))
+ (mh--with-image-load-path
+ (add-text-properties
+ 0 2
+ `(display ,(or mh-logo-cache
+ (setq mh-logo-cache
+ (find-image '(( :type xpm :ascent center
+ :file "mh-logo.xpm" ))))))
+ (car mode-line-buffer-identification))))
@@ -509,8 +504,8 @@ they will not be returned."
;; folder is specified, ensure it is nil to avoid adding the
;; folder to the folder-list and adding a slash to it.
(when folder
- (setq folder (mh-replace-regexp-in-string "^\\+" "" folder))
- (setq folder (mh-replace-regexp-in-string "/+$" "" folder))
+ (setq folder (replace-regexp-in-string "^\\+" "" folder))
+ (setq folder (replace-regexp-in-string "/+$" "" folder))
(if (equal folder "")
(setq folder nil)))
;; Add provided folder to list, unless all folders are asked for.
@@ -535,7 +530,12 @@ results of the actual folders call.
If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a
slash is added to each of the sub-folder names that may have
nested folders within them."
- (let* ((folder (mh-normalize-folder-name folder nil nil t))
+ ;; In most cases we want to remove a trailing slash. We keep the
+ ;; slash for "+/", because it refers to folders in the system root
+ ;; directory, whereas "+" refers to the user's top-level folders.
+ (let* ((folder (mh-normalize-folder-name folder nil
+ (string= folder "+/")
+ t))
(match (gethash folder mh-sub-folders-cache 'no-result))
(sub-folders (cond ((eq match 'no-result)
(setf (gethash folder mh-sub-folders-cache)
@@ -562,7 +562,6 @@ Expects FOLDER to have already been normalized with
(let ((arg-list `(,(expand-file-name "folders" mh-progs)
nil (t nil) nil "-noheader" "-norecurse" "-nototal"
,@(if (stringp folder) (list folder) ())))
- (results ())
(current-folder (concat
(with-temp-buffer
(call-process (expand-file-name "folder" mh-progs)
@@ -571,33 +570,48 @@ Expects FOLDER to have already been normalized with
"+")))
(with-temp-buffer
(apply #'call-process arg-list)
- (goto-char (point-min))
- (while (not (and (eolp) (bolp)))
- (goto-char (mh-line-end-position))
- (let ((start-pos (mh-line-beginning-position))
- (has-pos (search-backward " has "
- (mh-line-beginning-position) t)))
- (when (integerp has-pos)
- (while (equal (char-after has-pos) ? )
- (cl-decf has-pos))
- (cl-incf has-pos)
- (while (equal (char-after start-pos) ? )
- (cl-incf start-pos))
- (let* ((name (buffer-substring start-pos has-pos))
- (first-char (aref name 0))
- (last-char (aref name (1- (length name)))))
- (unless (member first-char '(?. ?# ?,))
- (when (and (equal last-char ?+) (equal name current-folder))
- (setq name (substring name 0 (1- (length name)))))
- (push
- (cons name
- (search-forward "(others)" (mh-line-end-position) t))
- results))))
- (forward-line 1))))
+ (mh-sub-folders-parse folder current-folder))))
+
+(defun mh-sub-folders-parse (folder current-folder)
+ "Parse the results of \"folders FOLDER\" and return a list of sub-folders.
+CURRENT-FOLDER is the result of \"folder -fast\".
+FOLDER will be nil or start with '+'; CURRENT-FOLDER will end with '+'.
+This function is a testable helper of `mh-sub-folders-actual'."
+ (let ((results ()))
+ (goto-char (point-min))
+ (while (not (and (eolp) (bolp)))
+ (goto-char (line-end-position))
+ (let ((start-pos (line-beginning-position))
+ (has-pos (search-backward " has "
+ (line-beginning-position) t)))
+ (when (integerp has-pos)
+ (while (equal (char-after has-pos) ? )
+ (cl-decf has-pos))
+ (cl-incf has-pos)
+ (while (equal (char-after start-pos) ? )
+ (cl-incf start-pos))
+ (let* ((name (buffer-substring start-pos has-pos))
+ (first-char (aref name 0))
+ (second-char (and (length> name 1) (aref name 1)))
+ (last-char (aref name (1- (length name)))))
+ (unless (member first-char '(?. ?# ?,))
+ (when (and (equal last-char ?+) (equal name current-folder))
+ (setq name (substring name 0 (1- (length name)))))
+ ;; nmh outputs double slash in root folder, e.g., "//tmp"
+ (when (and (equal first-char ?/) (equal second-char ?/))
+ (setq name (substring name 1)))
+ (push
+ (cons name
+ (search-forward "(others)" (line-end-position) t))
+ results))))
+ (forward-line 1)))
(setq results (nreverse results))
(when (stringp folder)
(setq results (cdr results))
(let ((folder-name-len (length (format "%s/" (substring folder 1)))))
+ (when (equal "+/" folder)
+ ;; folder "+/" includes a trailing slash
+ (cl-decf folder-name-len))
(setq results (mapcar (lambda (f)
(cons (substring (car f) folder-name-len)
(cdr f)))
@@ -727,16 +741,12 @@ See Info node `(elisp) Programmed Completion' for details."
((equal path mh-user-path) nil)
(t (file-directory-p path))))))))
-;; Shush compiler.
-(defvar completion-root-regexp) ;; Apparently used in XEmacs
-
(defun mh-folder-completing-read (prompt default allow-root-folder-flag)
"Read folder name with PROMPT and default result DEFAULT.
If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be
a folder name corresponding to `mh-user-path'."
(mh-normalize-folder-name
- (let ((completion-root-regexp "^[+/]") ;FIXME: Who/what uses that?
- (minibuffer-local-completion-map mh-folder-completion-map)
+ (let ((minibuffer-local-completion-map mh-folder-completion-map)
(mh-allow-root-folder-flag allow-root-folder-flag))
(completing-read prompt 'mh-folder-completion-function nil nil nil
'mh-folder-hist default))
@@ -920,11 +930,7 @@ Handle RFC 822 (or later) continuation lines."
(defvar mh-hidden-header-keymap
(let ((map (make-sparse-keymap)))
- (mh-do-in-gnu-emacs
- (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button))
- (mh-do-in-xemacs
- (define-key map '(button2)
- #'mh-letter-toggle-header-field-display-button))
+ (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button)
map))
;;;###mh-autoload
@@ -958,9 +964,9 @@ is hidden, if positive then the field is displayed."
(and (numberp arg)
(>= arg 0))
(and (eq arg 'long)
- (> (mh-line-beginning-position 5) end)))
+ (> (line-beginning-position 5) end)))
(remove-text-properties begin end '(invisible nil))
- (search-forward ":" (mh-line-end-position) t)
+ (search-forward ":" (line-end-position) t)
(mh-letter-skip-leading-whitespace-in-header-field))
;; XXX Redesign to make usable by user. Perhaps use a positive
;; numeric prefix to make that many lines visible.
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 7e5f469319b..b144c58d696 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -30,17 +30,11 @@
(autoload 'mail-header-parse-address "mail-parse")
(autoload 'message-fetch-field "message")
-(defvar mh-show-xface-function
- (cond ((and (featurep 'xemacs) (locate-library "x-face") (not (featurep 'xface)))
- (load "x-face" t t)
- #'mh-face-display-function)
- ((>= emacs-major-version 21)
- #'mh-face-display-function)
- (t #'ignore))
+(defvar mh-show-xface-function #'mh-face-display-function
"Determine at run time what function should be called to display X-Face.")
+(make-obsolete-variable 'mh-show-xface-function nil "29.1")
-(defvar mh-uncompface-executable
- (and (fboundp 'executable-find) (executable-find "uncompface")))
+(defvar mh-uncompface-executable (executable-find "uncompface"))
@@ -52,7 +46,7 @@
(when (and window-system mh-show-use-xface-flag
(or mh-decode-mime-flag mh-mhl-format-file
mh-clean-message-header-flag))
- (funcall mh-show-xface-function)))
+ (mh-face-display-function)))
(defun mh-face-display-function ()
"Display a Face, X-Face, or X-Image-URL header field.
@@ -77,53 +71,20 @@ in this order is used."
(when type
(goto-char (point-min))
(when (re-search-forward "^from:" (point-max) t)
- ;; GNU Emacs
- (mh-do-in-gnu-emacs
- (if (eq type 'url)
- (mh-x-image-url-display url)
- (mh-funcall-if-exists
- insert-image (create-image
- raw type t
- :foreground
- (mh-face-foreground 'mh-show-xface nil t)
- :background
- (mh-face-background 'mh-show-xface nil t))
- " ")))
- ;; XEmacs
- (mh-do-in-xemacs
- (cond
- ((eq type 'url)
- (mh-x-image-url-display url))
- ((eq type 'png)
- (when (featurep 'png)
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph (vector 'png ':data (mh-face-to-png face))))))
- ;; Try internal xface support if available...
- ((and (eq type 'pbm) (featurep 'xface))
- (set-glyph-face
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph (vector 'xface ':data (concat "X-Face: " x-face))))
- 'mh-show-xface))
- ;; Otherwise try external support with x-face...
- ((and (eq type 'pbm)
- (fboundp 'x-face-xmas-wl-display-x-face)
- (fboundp 'executable-find) (executable-find "uncompface"))
- (mh-funcall-if-exists x-face-xmas-wl-display-x-face))
- ;; Picon display
- ((and raw (member type '(xpm xbm gif)))
- (when (featurep type)
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph (vector type ':data raw))))))
- (when raw (insert " "))))))))
+ (if (eq type 'url)
+ (mh-x-image-url-display url)
+ (insert-image (create-image
+ raw type t
+ :foreground
+ (face-foreground 'mh-show-xface nil t)
+ :background
+ (face-background 'mh-show-xface nil t))
+ " ")))))))
(defun mh-face-to-png (data)
"Convert base64 encoded DATA to png image."
(with-temp-buffer
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
+ (set-buffer-multibyte nil)
(insert data)
(ignore-errors (base64-decode-region (point-min) (point-max)))
(buffer-string)))
@@ -131,8 +92,7 @@ in this order is used."
(defun mh-uncompface (data)
"Run DATA through `uncompface' to generate bitmap."
(with-temp-buffer
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
+ (set-buffer-multibyte nil)
(insert data)
(when (and mh-uncompface-executable
(equal (call-process-region (point-min) (point-max)
@@ -176,10 +136,8 @@ The directories are searched for in the order they appear in the list.")
(defvar mh-picon-image-types
(cl-loop for type in '(xpm xbm gif)
- when (or (mh-do-in-gnu-emacs
- (ignore-errors
- (mh-funcall-if-exists image-type-available-p type)))
- (mh-do-in-xemacs (featurep type)))
+ when (ignore-errors
+ (image-type-available-p type))
collect type))
(autoload 'message-tokenize-header "sendmail")
@@ -270,8 +228,7 @@ file contents as a string is returned. If FILE is nil, then both
elements of the list are nil."
(if (stringp file)
(with-temp-buffer
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
+ (set-buffer-multibyte nil)
(let ((type (and (string-match ".*\\.\\(...\\)$" file)
(intern (match-string 1 file)))))
(insert-file-contents-literally file)
@@ -321,7 +278,7 @@ If the URL isn't present in the cache then it is fetched with wget."
(let* ((cache-filename (mh-x-image-url-cache-canonicalize url))
(state (mh-x-image-get-download-state cache-filename))
(marker (point-marker)))
- (set (make-local-variable 'mh-x-image-marker) marker)
+ (setq-local mh-x-image-marker marker)
(cond ((not (mh-x-image-url-sane-p url)))
((eq state 'ok)
(mh-x-image-display cache-filename marker))
@@ -357,14 +314,14 @@ This is only done if `mh-x-image-cache-directory' is nil."
(defun mh-x-image-url-cache-canonicalize (url)
"Canonicalize URL.
Replace the ?/ character with a ?! character and append .png.
-Also replaces special characters with `mh-url-hexify-string'
+Also replaces special characters with `url-hexify-string'
since not all characters, such as :, are valid within Windows
filenames. In addition, replaces * with %2a. See URL
`https://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iitemnamelimits/GetValidCharacters.asp'."
(format "%s/%s.png" mh-x-image-cache-directory
- (mh-replace-regexp-in-string
+ (replace-regexp-in-string
"\\*" "%2a"
- (mh-url-hexify-string
+ (url-hexify-string
(with-temp-buffer
(insert url)
(mh-replace-string "/" "!")
@@ -404,16 +361,7 @@ filenames. In addition, replaces * with %2a. See URL
(when (and (file-readable-p image) (not (file-symlink-p image))
(eq marker mh-x-image-marker))
(goto-char marker)
- (mh-do-in-gnu-emacs
- (mh-funcall-if-exists insert-image (create-image image 'png)))
- (mh-do-in-xemacs
- (when (featurep 'png)
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph
- (vector 'png ':data (with-temp-buffer
- (insert-file-contents-literally image)
- (buffer-string))))))))
+ (insert-image (create-image image 'png)))
(set-buffer-modified-p buffer-modified-flag)))))
(defun mh-x-image-url-fetch-image (url cache-file marker sentinel)
@@ -423,12 +371,11 @@ be displayed in a buffer and position specified by MARKER. The
actual display is carried out by the SENTINEL function."
(if mh-wget-executable
(let ((buffer (generate-new-buffer mh-temp-fetch-buffer))
- (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch")
- (expand-file-name (make-temp-name "~/mhe-fetch")))))
+ (filename (make-temp-file "mhe-fetch")))
(with-current-buffer buffer
- (set (make-local-variable 'mh-x-image-url-cache-file) cache-file)
- (set (make-local-variable 'mh-x-image-marker) marker)
- (set (make-local-variable 'mh-x-image-temp-file) filename))
+ (setq-local mh-x-image-url-cache-file cache-file)
+ (setq-local mh-x-image-marker marker)
+ (setq-local mh-x-image-temp-file filename))
(set-process-sentinel
(start-process "*mh-x-image-url-fetch*" buffer
mh-wget-executable mh-wget-option filename url)
diff --git a/lisp/midnight.el b/lisp/midnight.el
index 4617ec293d8..60d9b565ef0 100644
--- a/lisp/midnight.el
+++ b/lisp/midnight.el
@@ -67,14 +67,14 @@ The autokilling is done by `clean-buffer-list' when it is in `midnight-hook'.
Currently displayed and/or modified (unsaved) buffers, as well as buffers
matching `clean-buffer-list-kill-never-buffer-names' and
`clean-buffer-list-kill-never-regexps' are excluded."
- :type 'integer)
+ :type 'natnum)
(defcustom clean-buffer-list-delay-special 3600
"The number of seconds before some buffers become eligible for autokilling.
Buffers matched by `clean-buffer-list-kill-regexps' and
`clean-buffer-list-kill-buffer-names' are killed if they were last
displayed more than this many seconds ago."
- :type 'integer)
+ :type 'natnum)
(defcustom clean-buffer-list-kill-regexps '("\\`\\*Man ")
"List of regexps saying which buffers will be killed at midnight.
@@ -159,7 +159,7 @@ the current date/time, buffer name, how many seconds ago it was
displayed (can be nil if the buffer was never displayed) and its
lifetime, i.e., its \"age\" when it will be purged."
(interactive)
- (let ((tm (current-time)) bts (ts (format-time-string "%Y-%m-%d %T"))
+ (let* ((tm (current-time)) bts (ts (format-time-string "%Y-%m-%d %T" tm))
delay cbld bn)
(dolist (buf (buffer-list))
(when (buffer-live-p buf)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0ef846ccd78..9d2abbd1180 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1,4 +1,4 @@
-;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
+;;; minibuffer.el --- Minibuffer and completion functions -*- lexical-binding: t -*-
;; Copyright (C) 2008-2022 Free Software Foundation, Inc.
@@ -864,7 +864,11 @@ Intended to be called via `clear-message-function'."
(setq minibuffer-message-timer nil))
(when (overlayp minibuffer-message-overlay)
(delete-overlay minibuffer-message-overlay)
- (setq minibuffer-message-overlay nil))))
+ (setq minibuffer-message-overlay nil)))
+
+ ;; Return nil telling the caller that the message
+ ;; should be also handled by the caller.
+ nil)
(setq clear-message-function 'clear-minibuffer-message)
@@ -894,13 +898,25 @@ If the current buffer is not a minibuffer, erase its entire contents."
(defcustom completion-auto-help t
"Non-nil means automatically provide help for invalid completion input.
-If the value is t the *Completions* buffer is displayed whenever completion
+If the value is t, the *Completions* buffer is displayed whenever completion
is requested but cannot be done.
If the value is `lazy', the *Completions* buffer is only displayed after
-the second failed attempt to complete."
- :type '(choice (const nil) (const t) (const lazy)))
-
-(defconst completion-styles-alist
+the second failed attempt to complete.
+If the value is `always', the *Completions* buffer is always shown
+after a completion attempt, and the list of completions is updated if
+already visible.
+If the value is `visible', the *Completions* buffer is displayed
+whenever completion is requested but cannot be done for the first time,
+but remains visible thereafter, and the list of completions in it is
+updated for subsequent attempts to complete.."
+ :type '(choice (const :tag "Don't show" nil)
+ (const :tag "Show only when cannot complete" t)
+ (const :tag "Show after second failed completion attempt" lazy)
+ (const :tag
+ "Leave visible after first failed completion" visible)
+ (const :tag "Always visible" always)))
+
+(defvar completion-styles-alist
'((emacs21
completion-emacs21-try-completion completion-emacs21-all-completions
"Simple prefix-based completion.
@@ -1008,7 +1024,9 @@ an association list that can specify properties such as:
- `styles': the list of `completion-styles' to use for that category.
- `cycle': the `completion-cycle-threshold' to use for that category.
Categories are symbols such as `buffer' and `file', used when
-completing buffer and file names, respectively.")
+completing buffer and file names, respectively.
+
+Also see `completion-category-overrides'.")
(defcustom completion-category-overrides nil
"List of category-specific user overrides for completion styles.
@@ -1018,7 +1036,9 @@ an association list that can specify properties such as:
- `cycle': the `completion-cycle-threshold' to use for that category.
Categories are symbols such as `buffer' and `file', used when
completing buffer and file names, respectively.
-This overrides the defaults specified in `completion-category-defaults'."
+
+If a property in a category is specified by this variable, it
+overrides the default specified in `completion-category-defaults'."
:version "25.1"
:type `(alist :key-type (choice :tag "Category"
(const buffer)
@@ -1080,9 +1100,10 @@ This overrides the defaults specified in `completion-category-defaults'."
(result-and-style
(completion--some
(lambda (style)
- (let ((probe (funcall (nth n (assq style
- completion-styles-alist))
- string table pred point)))
+ (let ((probe (funcall
+ (or (nth n (assq style completion-styles-alist))
+ (error "Invalid completion style %s" style))
+ string table pred point)))
(and probe (cons probe style))))
(completion--styles md)))
(adjust-fn (get (cdr result-and-style) 'completion--adjust-metadata)))
@@ -1123,6 +1144,7 @@ Moves point to the end of the new text."
;; The properties on `newtext' include things like the
;; `completions-first-difference' face, which we don't want to
;; include upon insertion.
+ (setq newtext (copy-sequence newtext)) ;Don't modify the arg by side-effect.
(if minibuffer-allow-text-properties
;; If we're preserving properties, then just remove the faces
;; and other properties added by the completion machinery.
@@ -1172,6 +1194,18 @@ completion candidates than this number."
:version "24.1"
:type completion--cycling-threshold-type)
+(defcustom completions-sort 'alphabetical
+ "Sort candidates in the *Completions* buffer.
+
+The value can be nil to disable sorting, `alphabetical' for
+alphabetical sorting or a custom sorting function. The sorting
+function takes and returns a list of completion candidate
+strings."
+ :type '(choice (const :tag "No sorting" nil)
+ (const :tag "Alphabetical sorting" alphabetical)
+ (function :tag "Custom function"))
+ :version "29.1")
+
(defcustom completions-group nil
"Enable grouping of completion candidates in the *Completions* buffer.
See also `completions-group-format' and `completions-group-sort'."
@@ -1330,16 +1364,18 @@ when the buffer's text is already an exact match."
(completion--cache-all-sorted-completions beg end comps)
(minibuffer-force-complete beg end))
(completed
- ;; We could also decide to refresh the completions,
- ;; if they're displayed (and assuming there are
- ;; completions left).
- (minibuffer-hide-completions)
- (if exact
- ;; If completion did not put point at end of field,
- ;; it's a sign that completion is not finished.
- (completion--done completion
- (if (< comp-pos (length completion))
- 'exact 'unknown))))
+ (cond
+ ((pcase completion-auto-help
+ ('visible (get-buffer-window "*Completions*" 0))
+ ('always t))
+ (minibuffer-completion-help beg end))
+ (t (minibuffer-hide-completions)
+ (when exact
+ ;; If completion did not put point at end of field,
+ ;; it's a sign that completion is not finished.
+ (completion--done completion
+ (if (< comp-pos (length completion))
+ 'exact 'unknown))))))
;; Show the completion table, if requested.
((not exact)
(if (pcase completion-auto-help
@@ -1385,20 +1421,40 @@ scroll the window of possible completions."
(eq t (frame-visible-p (window-frame minibuffer-scroll-window))))
(let ((window minibuffer-scroll-window))
(with-current-buffer (window-buffer window)
- (if (pos-visible-in-window-p (point-max) window)
- ;; If end is in view, scroll up to the beginning.
- (set-window-start window (point-min) nil)
- ;; Else scroll down one screen.
- (with-selected-window window
- (scroll-up)))
- nil)))
+ (cond
+ ;; Here this is possible only when second-tab, but instead of
+ ;; scrolling the completion list window, switch to it below,
+ ;; outside of `with-current-buffer'.
+ ((eq completion-auto-select 'second-tab))
+ ;; Reverse tab
+ ((equal (this-command-keys) [backtab])
+ (if (pos-visible-in-window-p (point-min) window)
+ ;; If beginning is in view, scroll up to the end.
+ (set-window-point window (point-max))
+ ;; Else scroll down one screen.
+ (with-selected-window window (scroll-down))))
+ ;; Normal tab
+ (t
+ (if (pos-visible-in-window-p (point-max) window)
+ ;; If end is in view, scroll up to the end.
+ (set-window-start window (point-min) nil)
+ ;; Else scroll down one screen.
+ (with-selected-window window (scroll-up))))))
+ (when (eq completion-auto-select 'second-tab)
+ (switch-to-completions))
+ nil))
;; If we're cycling, keep on cycling.
((and completion-cycling completion-all-sorted-completions)
(minibuffer-force-complete beg end)
t)
- (t (pcase (completion--do-completion beg end)
- (#b000 nil)
- (_ t)))))
+ (t (prog1 (pcase (completion--do-completion beg end)
+ (#b000 nil)
+ (_ t))
+ (when (and (eq completion-auto-select t)
+ (window-live-p minibuffer-scroll-window)
+ (eq t (frame-visible-p (window-frame minibuffer-scroll-window))))
+ ;; When the completion list window was displayed, select it.
+ (switch-to-completions))))))
(defun completion--cache-all-sorted-completions (beg end comps)
(add-hook 'after-change-functions
@@ -1621,8 +1677,8 @@ DONT-CYCLE tells the function not to setup cycling."
map)))))))))
(defvar minibuffer-confirm-exit-commands
- '(completion-at-point minibuffer-complete
- minibuffer-complete-word PC-complete PC-complete-word)
+ '( completion-at-point minibuffer-complete
+ minibuffer-complete-word)
"List of commands which cause an immediately following
`minibuffer-complete-and-exit' to ask for extra confirmation.")
@@ -1670,52 +1726,57 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
"Exit from `require-match' minibuffer.
COMPLETION-FUNCTION is called if the current buffer's content does not
appear to be a match."
- (cond
- ;; Allow user to specify null string
+ (cond
+ ;; Allow user to specify null string
((= beg end) (funcall exit-function))
- ((test-completion (buffer-substring beg end)
- minibuffer-completion-table
- minibuffer-completion-predicate)
- ;; FIXME: completion-ignore-case has various slightly
- ;; incompatible meanings. E.g. it can reflect whether the user
- ;; wants completion to pay attention to case, or whether the
- ;; string will be used in a context where case is significant.
- ;; E.g. usually try-completion should obey the first, whereas
- ;; test-completion should obey the second.
- (when completion-ignore-case
- ;; Fixup case of the field, if necessary.
- (let* ((string (buffer-substring beg end))
- (compl (try-completion
- string
- minibuffer-completion-table
- minibuffer-completion-predicate)))
- (when (and (stringp compl) (not (equal string compl))
- ;; If it weren't for this piece of paranoia, I'd replace
- ;; the whole thing with a call to do-completion.
- ;; This is important, e.g. when the current minibuffer's
- ;; content is a directory which only contains a single
- ;; file, so `try-completion' actually completes to
- ;; that file.
- (= (length string) (length compl)))
- (completion--replace beg end compl))))
- (funcall exit-function))
-
- ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
- ;; The user is permitted to exit with an input that's rejected
- ;; by test-completion, after confirming her choice.
- (if (or (eq last-command this-command)
- ;; For `confirm-after-completion' we only ask for confirmation
- ;; if trying to exit immediately after typing TAB (this
- ;; catches most minibuffer typos).
- (and (eq minibuffer-completion-confirm 'confirm-after-completion)
- (not (memq last-command minibuffer-confirm-exit-commands))))
+ ;; The CONFIRM argument is a predicate.
+ ((and (functionp minibuffer-completion-confirm)
+ (funcall minibuffer-completion-confirm
+ (buffer-substring beg end)))
+ (funcall exit-function))
+ ;; See if we have a completion from the table.
+ ((test-completion (buffer-substring beg end)
+ minibuffer-completion-table
+ minibuffer-completion-predicate)
+ ;; FIXME: completion-ignore-case has various slightly
+ ;; incompatible meanings. E.g. it can reflect whether the user
+ ;; wants completion to pay attention to case, or whether the
+ ;; string will be used in a context where case is significant.
+ ;; E.g. usually try-completion should obey the first, whereas
+ ;; test-completion should obey the second.
+ (when completion-ignore-case
+ ;; Fixup case of the field, if necessary.
+ (let* ((string (buffer-substring beg end))
+ (compl (try-completion
+ string
+ minibuffer-completion-table
+ minibuffer-completion-predicate)))
+ (when (and (stringp compl) (not (equal string compl))
+ ;; If it weren't for this piece of paranoia, I'd replace
+ ;; the whole thing with a call to do-completion.
+ ;; This is important, e.g. when the current minibuffer's
+ ;; content is a directory which only contains a single
+ ;; file, so `try-completion' actually completes to
+ ;; that file.
+ (= (length string) (length compl)))
+ (completion--replace beg end compl))))
+ (funcall exit-function))
+ ;; The user is permitted to exit with an input that's rejected
+ ;; by test-completion, after confirming her choice.
+ ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
+ (if (or (eq last-command this-command)
+ ;; For `confirm-after-completion' we only ask for confirmation
+ ;; if trying to exit immediately after typing TAB (this
+ ;; catches most minibuffer typos).
+ (and (eq minibuffer-completion-confirm 'confirm-after-completion)
+ (not (memq last-command minibuffer-confirm-exit-commands))))
(funcall exit-function)
- (minibuffer-message "Confirm")
- nil))
+ (minibuffer-message "Confirm")
+ nil))
- (t
- ;; Call do-completion, but ignore errors.
- (funcall completion-function))))
+ (t
+ ;; Call do-completion, but ignore errors.
+ (funcall completion-function))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
@@ -1825,6 +1886,17 @@ Return nil if there is no valid completion, else t."
This face is only used if the strings used for completions
doesn't already specify a face.")
+(defface completions-highlight
+ '((t :inherit highlight))
+ "Default face for highlighting the current completion candidate."
+ :version "29.1")
+
+(defcustom completions-highlight-face 'completions-highlight
+ "A face name to highlight the current completion candidate.
+If the value is nil, no highlighting is performed."
+ :type '(choice (const nil) face)
+ :version "29.1")
+
(defcustom completions-format 'horizontal
"Define the appearance and sorting of completions.
If the value is `vertical', display completions sorted vertically
@@ -1844,6 +1916,15 @@ completions."
:type 'boolean
:version "28.1")
+(defcustom completions-header-format
+ (propertize "%s possible completions:\n" 'face 'shadow)
+ "Format of completions header.
+It may contain one %s to show the total count of completions.
+When nil, no header is shown."
+ :type '(choice (const :tag "No header" nil)
+ (string :tag "Header format string"))
+ :version "29.1")
+
(defun completion--insert-strings (strings &optional group-fun)
"Insert a list of STRINGS into the current buffer.
The candidate strings are inserted into the buffer depending on the
@@ -1983,7 +2064,8 @@ Runs of equal candidate strings are eliminated. GROUP-FUN is a
(when title
(insert (format completions-group-format title) "\n")))))
(completion--insert str group-fun)
- (insert "\n")))))
+ (insert "\n")))
+ (delete-char -1)))
(defun completion--insert (str group-fun)
(if (not (consp str))
@@ -1995,7 +2077,7 @@ Runs of equal candidate strings are eliminated. GROUP-FUN is a
(funcall group-fun str 'transform)
str))
(point))
- `(mouse-face highlight completion--string ,str))
+ `(mouse-face highlight cursor-face ,completions-highlight-face completion--string ,str))
;; If `str' is a list that has 2 elements,
;; then the second element is a suffix annotation.
;; If `str' has 3 elements, then the second element
@@ -2005,11 +2087,11 @@ Runs of equal candidate strings are eliminated. GROUP-FUN is a
(when prefix
(let ((beg (point))
(end (progn (insert prefix) (point))))
- (put-text-property beg end 'mouse-face nil)))
+ (add-text-properties beg end `(mouse-face nil completion--string ,(car str)))))
(completion--insert (car str) group-fun)
(let ((beg (point))
(end (progn (insert suffix) (point))))
- (put-text-property beg end 'mouse-face nil)
+ (add-text-properties beg end `(mouse-face nil completion--string ,(car str)))
;; Put the predefined face only when suffix
;; is added via annotation-function without prefix,
;; and when the caller doesn't use own face.
@@ -2053,7 +2135,7 @@ and with BASE-SIZE appended as the last element."
(lambda (elem)
(let ((str
;; Don't modify the string itself, but a copy, since the
- ;; the string may be read-only or used for other purposes.
+ ;; string may be read-only or used for other purposes.
;; Furthermore, since `completions' may come from
;; display-completion-list, `elem' may be a list.
(if (consp elem)
@@ -2106,10 +2188,9 @@ candidates."
(with-current-buffer standard-output
(goto-char (point-max))
- (if (null completions)
- (insert "There are no possible completions of what you have typed.")
- (insert "Possible completions are:\n")
- (completion--insert-strings completions group-fun))))
+ (when completions-header-format
+ (insert (format completions-header-format (length completions))))
+ (completion--insert-strings completions group-fun)))
(run-hooks 'completion-setup-hook)
nil)
@@ -2144,25 +2225,6 @@ These include:
`exact' - text is a valid completion but may be further
completed.")
-(defvar completion-annotate-function
- nil
- ;; Note: there's a lot of scope as for when to add annotations and
- ;; what annotations to add. E.g. completing-help.el allowed adding
- ;; the first line of docstrings to M-x completion. But there's
- ;; a tension, since such annotations, while useful at times, can
- ;; actually drown the useful information.
- ;; So completion-annotate-function should be used parsimoniously, or
- ;; else only used upon a user's request (e.g. we could add a command
- ;; to completion-list-mode to add annotations to the current
- ;; completions).
- "Function to add annotations in the *Completions* buffer.
-The function takes a completion and should either return nil, or a string that
-will be displayed next to the completion. The function can access the
-completion table and predicates via `minibuffer-completion-table' and related
-variables.")
-(make-obsolete-variable 'completion-annotate-function
- 'completion-extra-properties "24.1")
-
(defun completion--done (string &optional finished message)
(let* ((exit-fun (plist-get completion-extra-properties :exit-function))
(pre-msg (and exit-fun (current-message))))
@@ -2181,6 +2243,19 @@ variables.")
(equal pre-msg (and exit-fun (current-message))))
(completion--message message))))
+(defcustom completions-max-height nil
+ "Maximum height for *Completions* buffer window."
+ :type '(choice (const nil) natnum)
+ :version "29.1")
+
+(defun completions--fit-window-to-buffer (&optional win &rest _)
+ "Resize *Completions* buffer window."
+ (if temp-buffer-resize-mode
+ (let ((temp-buffer-max-height (or completions-max-height
+ temp-buffer-max-height)))
+ (resize-temp-buffer-window win))
+ (fit-window-to-buffer win completions-max-height)))
+
(defun minibuffer-completion-help (&optional start end)
"Display a list of possible completions of the current minibuffer contents."
(interactive)
@@ -2210,6 +2285,9 @@ variables.")
(let* ((last (last completions))
(base-size (or (cdr last) 0))
(prefix (unless (zerop base-size) (substring string 0 base-size)))
+ (base-prefix (buffer-substring (minibuffer--completion-prompt-end)
+ (+ start base-size)))
+ (base-suffix (buffer-substring (point) (point-max)))
(all-md (completion--metadata (buffer-substring-no-properties
start (point))
base-size md
@@ -2217,8 +2295,7 @@ variables.")
minibuffer-completion-predicate))
(ann-fun (or (completion-metadata-get all-md 'annotation-function)
(plist-get completion-extra-properties
- :annotation-function)
- completion-annotate-function))
+ :annotation-function)))
(aff-fun (or (completion-metadata-get all-md 'affixation-function)
(plist-get completion-extra-properties
:affixation-function)))
@@ -2244,9 +2321,7 @@ variables.")
,(if (eq (selected-window) (minibuffer-window))
'display-buffer-at-bottom
'display-buffer-below-selected))
- ,(if temp-buffer-resize-mode
- '(window-height . resize-temp-buffer-window)
- '(window-height . fit-window-to-buffer))
+ (window-height . completions--fit-window-to-buffer)
,(when temp-buffer-resize-mode
'(preserve-size . (nil . t)))
(body-function
@@ -2263,7 +2338,10 @@ variables.")
;; same, but not always.
(setq completions (if sort-fun
(funcall sort-fun completions)
- (sort completions 'string-lessp)))
+ (pcase completions-sort
+ ('nil completions)
+ ('alphabetical (sort completions #'string-lessp))
+ (_ (funcall completions-sort completions)))))
;; After sorting, group the candidates using the
;; `group-function'.
@@ -2300,20 +2378,28 @@ variables.")
;; completion-all-completions does not give us the
;; necessary information.
end))
+ (setq-local completion-base-affixes
+ (list base-prefix base-suffix))
(setq-local completion-list-insert-choice-function
(let ((ctable minibuffer-completion-table)
(cpred minibuffer-completion-predicate)
(cprops completion-extra-properties))
(lambda (start end choice)
- (unless (or (zerop (length prefix))
- (equal prefix
- (buffer-substring-no-properties
- (max (point-min)
- (- start (length prefix)))
- start)))
- (message "*Completions* out of date"))
- ;; FIXME: Use `md' to do quoting&terminator here.
- (completion--replace start end choice)
+ (if (and (stringp start) (stringp end))
+ (progn
+ (delete-minibuffer-contents)
+ (insert start choice)
+ ;; Keep point after completion before suffix
+ (save-excursion (insert end)))
+ (unless (or (zerop (length prefix))
+ (equal prefix
+ (buffer-substring-no-properties
+ (max (point-min)
+ (- start (length prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ ;; FIXME: Use `md' to do quoting&terminator here.
+ (completion--replace start end choice))
(let* ((minibuffer-completion-table ctable)
(minibuffer-completion-predicate cpred)
(completion-extra-properties cprops)
@@ -2334,6 +2420,7 @@ variables.")
"Get rid of an out-of-date *Completions* buffer."
;; FIXME: We could/should use minibuffer-scroll-window here, but it
;; can also point to the minibuffer-parent-window, so it's a bit tricky.
+ (interactive)
(let ((win (get-buffer-window "*Completions*" 0)))
(if win (with-selected-window win (bury-buffer)))))
@@ -2448,14 +2535,15 @@ Also respects the obsolete wrapper hook `completion-in-region-functions'.
(completion-in-region-mode 1))
(completion--in-region-1 start end))))
-(defvar completion-in-region-mode-map
- (let ((map (make-sparse-keymap)))
- ;; FIXME: Only works if completion-in-region-mode was activated via
- ;; completion-at-point called directly.
- (define-key map "\M-?" 'completion-help-at-point)
- (define-key map "\t" 'completion-at-point)
- map)
- "Keymap activated during `completion-in-region'.")
+(defvar-keymap completion-in-region-mode-map
+ :doc "Keymap activated during `completion-in-region'."
+ ;; FIXME: Only works if completion-in-region-mode was activated via
+ ;; completion-at-point called directly.
+ "M-?" #'completion-help-at-point
+ "TAB" #'completion-at-point
+ "M-<up>" #'minibuffer-previous-completion
+ "M-<down>" #'minibuffer-next-completion
+ "M-RET" #'minibuffer-choose-completion)
;; It is difficult to know when to exit completion-in-region-mode (i.e. hide
;; the *Completions*). Here's how previous packages did it:
@@ -2502,6 +2590,7 @@ Also respects the obsolete wrapper hook `completion-in-region-functions'.
(cl-assert completion-in-region-mode-predicate)
(setq completion-in-region-mode--predicate
completion-in-region-mode-predicate)
+ (setq-local minibuffer-completion-auto-choose nil)
(add-hook 'post-command-hook #'completion-in-region--postch)
(push `(completion-in-region-mode . ,completion-in-region-mode-map)
minor-mode-overriding-map-alist)))
@@ -2651,48 +2740,42 @@ The completion method is determined by `completion-at-point-functions'."
(define-key map "\n" 'exit-minibuffer)
(define-key map "\r" 'exit-minibuffer))
-(defvar minibuffer-local-completion-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "\t" 'minibuffer-complete)
- ;; M-TAB is already abused for many other purposes, so we should find
- ;; another binding for it.
- ;; (define-key map "\e\t" 'minibuffer-force-complete)
- (define-key map " " 'minibuffer-complete-word)
- (define-key map "?" 'minibuffer-completion-help)
- (define-key map [prior] 'switch-to-completions)
- (define-key map "\M-v" 'switch-to-completions)
- (define-key map "\M-g\M-c" 'switch-to-completions)
- map)
- "Local keymap for minibuffer input with completion.")
-
-(defvar minibuffer-local-must-match-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-completion-map)
- (define-key map "\r" 'minibuffer-complete-and-exit)
- (define-key map "\n" 'minibuffer-complete-and-exit)
- map)
- "Local keymap for minibuffer input with completion, for exact match.")
-
-(defvar minibuffer-local-filename-completion-map
- (let ((map (make-sparse-keymap)))
- (define-key map " " nil)
- map)
- "Local keymap for minibuffer input with completion for filenames.
+(defvar-keymap minibuffer-local-completion-map
+ :doc "Local keymap for minibuffer input with completion."
+ :parent minibuffer-local-map
+ "TAB" #'minibuffer-complete
+ "<backtab>" #'minibuffer-complete
+ ;; M-TAB is already abused for many other purposes, so we should find
+ ;; another binding for it.
+ ;; "M-TAB" #'minibuffer-force-complete
+ "SPC" #'minibuffer-complete-word
+ "?" #'minibuffer-completion-help
+ "<prior>" #'switch-to-completions
+ "M-v" #'switch-to-completions
+ "M-g M-c" #'switch-to-completions
+ "M-<up>" #'minibuffer-previous-completion
+ "M-<down>" #'minibuffer-next-completion
+ "M-RET" #'minibuffer-choose-completion)
+
+(defvar-keymap minibuffer-local-must-match-map
+ :doc "Local keymap for minibuffer input with completion, for exact match."
+ :parent minibuffer-local-completion-map
+ "M-X" #'execute-extended-command-cycle
+ "RET" #'minibuffer-complete-and-exit
+ "C-j" #'minibuffer-complete-and-exit)
+
+(defvar-keymap minibuffer-local-filename-completion-map
+ :doc "Local keymap for minibuffer input with completion for filenames.
Gets combined either with `minibuffer-local-completion-map' or
-with `minibuffer-local-must-match-map'.")
+with `minibuffer-local-must-match-map'."
+ "SPC" nil)
-(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
-(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
-
-(defvar minibuffer-local-ns-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map " " #'exit-minibuffer)
- (define-key map "\t" #'exit-minibuffer)
- (define-key map "?" #'self-insert-and-exit)
- map)
- "Local keymap for the minibuffer when spaces are not allowed.")
+(defvar-keymap minibuffer-local-ns-map
+ :doc "Local keymap for the minibuffer when spaces are not allowed."
+ :parent minibuffer-local-map
+ "SPC" #'exit-minibuffer
+ "TAB" #'exit-minibuffer
+ "?" #'self-insert-and-exit)
(defun read-no-blanks-input (prompt &optional initial inherit-input-method)
"Read a string from the terminal, not allowing blanks.
@@ -2713,33 +2796,31 @@ If `inhibit-interaction' is non-nil, this function will signal an
;;; Major modes for the minibuffer
-(defvar minibuffer-inactive-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
- (define-key map "e" 'find-file-other-frame)
- (define-key map "f" 'find-file-other-frame)
- (define-key map "b" 'switch-to-buffer-other-frame)
- (define-key map "i" 'info)
- (define-key map "m" 'mail)
- (define-key map "n" 'make-frame)
- (define-key map [mouse-1] 'view-echo-area-messages)
- ;; So the global down-mouse-1 binding doesn't clutter the execution of the
- ;; above mouse-1 binding.
- (define-key map [down-mouse-1] #'ignore)
- map)
- "Keymap for use in the minibuffer when it is not active.
+(defvar-keymap minibuffer-inactive-mode-map
+ :doc "Keymap for use in the minibuffer when it is not active.
The non-mouse bindings in this keymap can only be used in minibuffer-only
frames, since the minibuffer can normally not be selected when it is
-not active.")
+not active."
+ :full t
+ :suppress t
+ "e" #'find-file-other-frame
+ "f" #'find-file-other-frame
+ "b" #'switch-to-buffer-other-frame
+ "i" #'info
+ "m" #'mail
+ "n" #'make-frame
+ "<mouse-1>" #'view-echo-area-messages
+ ;; So the global down-mouse-1 binding doesn't clutter the execution of the
+ ;; above mouse-1 binding.
+ "<down-mouse-1>" #'ignore)
(define-derived-mode minibuffer-inactive-mode nil "InactiveMinibuffer"
- :abbrev-table nil ;abbrev.el is not loaded yet during dump.
;; Note: this major mode is called from minibuf.c.
"Major mode to use in the minibuffer when it is not active.
This is only used when the minibuffer area has no active minibuffer.
Note that the minibuffer may change to this mode more often than
-you might expect. For instance, typing `M-x' may change the
+you might expect. For instance, typing \\`M-x' may change the
buffer to this mode, then to a different mode, and then back
again to this mode upon exit. Code running from
`minibuffer-inactive-mode-hook' has to be prepared to run
@@ -2755,7 +2836,6 @@ For customizing this mode, it is better to use
`minibuffer-setup-hook' and `minibuffer-exit-hook' rather than
the mode hook of this mode."
:syntax-table nil
- :abbrev-table nil
:interactive nil)
;;; Completion tables.
@@ -2922,26 +3002,30 @@ same as `substitute-in-file-name'."
(let* ((ustr (substitute-in-file-name qstr))
(uprefix (substring ustr 0 upos))
qprefix)
- ;; Main assumption: nothing after qpos should affect the text before upos,
- ;; so we can work our way backward from the end of qstr, one character
- ;; at a time.
- ;; Second assumptions: If qpos is far from the end this can be a bit slow,
- ;; so we speed it up by doing a first loop that skips a word at a time.
- ;; This word-sized loop is careful not to cut in the middle of env-vars.
- (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr)))
- (and boundary
- (progn
- (setq qprefix (substring qstr 0 boundary))
+ (if (eq upos (length ustr))
+ ;; Easy and common case. This not only speed things up in a very
+ ;; common case but it also avoids problems in some cases (bug#53053).
+ (cons (length qstr) #'minibuffer-maybe-quote-filename)
+ ;; Main assumption: nothing after qpos should affect the text before upos,
+ ;; so we can work our way backward from the end of qstr, one character
+ ;; at a time.
+ ;; Second assumptions: If qpos is far from the end this can be a bit slow,
+ ;; so we speed it up by doing a first loop that skips a word at a time.
+ ;; This word-sized loop is careful not to cut in the middle of env-vars.
+ (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr)))
+ (and boundary
+ (progn
+ (setq qprefix (substring qstr 0 boundary))
+ (string-prefix-p uprefix
+ (substitute-in-file-name qprefix)))))
+ (setq qstr qprefix))
+ (let ((qpos (length qstr)))
+ (while (and (> qpos 0)
(string-prefix-p uprefix
- (substitute-in-file-name qprefix)))))
- (setq qstr qprefix))
- (let ((qpos (length qstr)))
- (while (and (> qpos 0)
- (string-prefix-p uprefix
- (substitute-in-file-name
- (substring qstr 0 (1- qpos)))))
- (setq qpos (1- qpos)))
- (cons qpos #'minibuffer-maybe-quote-filename))))
+ (substitute-in-file-name
+ (substring qstr 0 (1- qpos)))))
+ (setq qpos (1- qpos)))
+ (cons qpos #'minibuffer-maybe-quote-filename)))))
(defalias 'completion--file-name-table
(completion-table-with-quoting #'completion-file-name-table
@@ -2984,7 +3068,8 @@ such as making the current buffer visit no file in the case of
:type 'boolean)
(defcustom minibuffer-beginning-of-buffer-movement nil
- "Control how the `M-<' command in the minibuffer behaves.
+ "Control how the \\<minibuffer-local-map>\\[minibuffer-beginning-of-buffer] \
+command in the minibuffer behaves.
If non-nil, the command will go to the end of the prompt (if
point is after the end of the prompt). If nil, it will behave
like the `beginning-of-buffer' command."
@@ -3053,10 +3138,16 @@ Fourth arg MUSTMATCH can take the following values:
input, but she needs to confirm her choice if she called
`minibuffer-complete' right before `minibuffer-complete-and-exit'
and the input is not an existing file.
+- a function, which will be called with the input as the
+ argument. If the function returns a non-nil value, the
+ minibuffer is exited with that argument as the value.
- anything else behaves like t except that typing RET does not exit if it
does non-null completion.
-Fifth arg INITIAL specifies text to start with.
+Fifth arg INITIAL specifies text to start with. It will be
+interpreted as the trailing part of DEFAULT-FILENAME, so using a
+full file name for INITIAL will usually lead to surprising
+results.
Sixth arg PREDICATE, if non-nil, should be a function of one
argument; then a file name is considered an acceptable completion
@@ -4016,7 +4107,7 @@ This turns
into
(prefix \"f\" any \"o\" any \"o\" any point)
which is at the core of flex logic. The extra
-'any' is optimized away later on."
+`any' is optimized away later on."
(mapcan (lambda (elem)
(if (stringp elem)
(mapcan (lambda (char)
@@ -4160,6 +4251,7 @@ See `completing-read' for the meaning of the arguments."
;; override bindings in base-keymap.
base-keymap)))
(buffer (current-buffer))
+ (c-i-c completion-ignore-case)
(result
(minibuffer-with-setup-hook
(lambda ()
@@ -4169,7 +4261,9 @@ See `completing-read' for the meaning of the arguments."
(setq-local minibuffer-completion-confirm
(unless (eq require-match t) require-match))
(setq-local minibuffer--require-match require-match)
- (setq-local minibuffer--original-buffer buffer))
+ (setq-local minibuffer--original-buffer buffer)
+ ;; Copy the value from original buffer to the minibuffer.
+ (setq-local completion-ignore-case c-i-c))
(read-from-minibuffer prompt initial-input keymap
nil hist def inherit-input-method))))
(when (and (equal result "") def)
@@ -4254,6 +4348,91 @@ the minibuffer was activated, and execute the forms."
(with-minibuffer-selected-window
(scroll-other-window-down arg)))
+(defmacro with-minibuffer-completions-window (&rest body)
+ "Execute the forms in BODY from the minibuffer in its completions window.
+When used in a minibuffer window, select the window with completions,
+and execute the forms."
+ (declare (indent 0) (debug t))
+ `(let ((window (or (get-buffer-window "*Completions*" 0)
+ ;; Make sure we have a completions window.
+ (progn (minibuffer-completion-help)
+ (get-buffer-window "*Completions*" 0)))))
+ (when window
+ (with-selected-window window
+ ,@body))))
+
+(defcustom minibuffer-completion-auto-choose t
+ "Non-nil means to automatically insert completions to the minibuffer.
+When non-nil, then `minibuffer-next-completion' and
+`minibuffer-previous-completion' will insert the completion
+selected by these commands to the minibuffer."
+ :type 'boolean
+ :version "29.1")
+
+(defun minibuffer-next-completion (&optional n)
+ "Move to the next item in its completions window from the minibuffer.
+When `minibuffer-completion-auto-choose' is non-nil, then also
+insert the selected completion to the minibuffer."
+ (interactive "p")
+ (let ((auto-choose minibuffer-completion-auto-choose))
+ (with-minibuffer-completions-window
+ (when completions-highlight-face
+ (setq-local cursor-face-highlight-nonselected-window t))
+ (next-completion (or n 1))
+ (when auto-choose
+ (let ((completion-use-base-affixes t))
+ (choose-completion nil t t))))))
+
+(defun minibuffer-previous-completion (&optional n)
+ "Move to the previous item in its completions window from the minibuffer.
+When `minibuffer-completion-auto-choose' is non-nil, then also
+insert the selected completion to the minibuffer."
+ (interactive "p")
+ (minibuffer-next-completion (- (or n 1))))
+
+(defun minibuffer-choose-completion (&optional no-exit no-quit)
+ "Run `choose-completion' from the minibuffer in its completions window.
+With prefix argument NO-EXIT, insert the completion at point to the
+minibuffer, but don't exit the minibuffer. When the prefix argument
+is not provided, then whether to exit the minibuffer depends on the value
+of `completion-no-auto-exit'.
+If NO-QUIT is non-nil, insert the completion at point to the
+minibuffer, but don't quit the completions window."
+ (interactive "P")
+ (with-minibuffer-completions-window
+ (let ((completion-use-base-affixes t))
+ (choose-completion nil no-exit no-quit))))
+
+(defun minibuffer-complete-history ()
+ "Complete the minibuffer history as far as possible.
+Like `minibuffer-complete' but completes on the history items
+instead of the default completion table."
+ (interactive)
+ (let ((completions-sort nil)
+ (history (mapcar (lambda (h)
+ ;; Support e.g. `C-x ESC ESC TAB' as
+ ;; a replacement of `list-command-history'
+ (if (consp h) (format "%S" h) h))
+ (symbol-value minibuffer-history-variable))))
+ (completion-in-region (minibuffer--completion-prompt-end) (point-max)
+ history nil)))
+
+(defun minibuffer-complete-defaults ()
+ "Complete minibuffer defaults as far as possible.
+Like `minibuffer-complete' but completes on the default items
+instead of the completion table."
+ (interactive)
+ (let ((completions-sort nil))
+ (when (and (not minibuffer-default-add-done)
+ (functionp minibuffer-default-add-function))
+ (setq minibuffer-default-add-done t
+ minibuffer-default (funcall minibuffer-default-add-function)))
+ (completion-in-region (minibuffer--completion-prompt-end) (point-max)
+ (ensure-list minibuffer-default) nil)))
+
+(define-key minibuffer-local-map [?\C-x up] 'minibuffer-complete-history)
+(define-key minibuffer-local-map [?\C-x down] 'minibuffer-complete-defaults)
+
(defcustom minibuffer-default-prompt-format " (default %s)"
"Format string used to output \"default\" values.
When prompting for input, there will often be a default value,
diff --git a/lisp/misc.el b/lisp/misc.el
index d85f889ffd3..28c5d6e07f5 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -33,7 +33,9 @@
"Copy characters from previous nonblank line, starting just above point.
Copy ARG characters, but not past the end of that line.
If no argument given, copy the entire rest of the line.
-The characters copied are inserted in the buffer before point."
+The characters copied are inserted in the buffer before point.
+
+Also see the `duplicate-line' command."
(interactive "P")
(let ((cc (current-column))
n
@@ -61,18 +63,41 @@ The characters copied are inserted in the buffer before point."
(+ n (point)))))))
(insert string)))
+;;;###autoload
+(defun duplicate-line (&optional n)
+ "Duplicate the current line N times.
+Interactively, N is the prefix numeric argument, and defaults to 1.
+Also see the `copy-from-above-command' command."
+ (interactive "p")
+ (unless n
+ (setq n 1))
+ (let ((line (buffer-substring (line-beginning-position) (line-end-position))))
+ (save-excursion
+ (forward-line 1)
+ (unless (bolp)
+ (insert "\n"))
+ (dotimes (_ n)
+ (insert line "\n")))))
+
;; Variation of `zap-to-char'.
;;;###autoload
-(defun zap-up-to-char (arg char)
+(defun zap-up-to-char (arg char &optional interactive)
"Kill up to, but not including ARGth occurrence of CHAR.
+When run interactively, the argument INTERACTIVE is non-nil.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found.
-Ignores CHAR at point."
+Ignores CHAR at point.
+If called interactively, do a case sensitive search if CHAR
+is an upper-case character."
(interactive (list (prefix-numeric-value current-prefix-arg)
(read-char-from-minibuffer "Zap up to char: "
- nil 'read-char-history)))
- (let ((direction (if (>= arg 0) 1 -1)))
+ nil 'read-char-history)
+ t))
+ (let ((direction (if (>= arg 0) 1 -1))
+ (case-fold-search (if (and interactive (char-uppercase-p char))
+ nil
+ case-fold-search)))
(kill-region (point)
(progn
(forward-char direction)
@@ -126,7 +151,7 @@ ripples outward, changing the flow of the eddy currents in the
upper atmosphere. These cause momentary pockets of higher-pressure
air to form, which act as lenses that deflect incoming cosmic rays,
focusing them to strike the drive platter and flip the desired bit.
-You can type `M-x butterfly C-M-c' to run it. This is a permuted
+You can type \\`M-x butterfly C-M-c' to run it. This is a permuted
variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'."
(interactive)
(if (yes-or-no-p "Do you really want to unleash the powers of the butterfly? ")
diff --git a/lisp/mouse.el b/lisp/mouse.el
index e5ea5475f43..ddcb51aecf2 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -42,7 +42,9 @@
:group 'editing)
(defcustom mouse-yank-at-point nil
- "If non-nil, mouse yank commands yank at point instead of at click."
+ "If non-nil, mouse yank commands yank at point instead of at click.
+This also allows yanking text into an isearch without moving the
+mouse cursor to the echo area."
:type 'boolean)
(defcustom mouse-drag-copy-region nil
@@ -51,9 +53,17 @@
This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
addition to mouse drags.
+If this variable is `non-empty', only copy to the kill ring if
+the region is non-empty. For instance, if you mouse drag an area
+that is less than a half a character, you'd normally get the
+empty string in your kill ring, but with this value, this short
+mouse drag won't affect the kill ring.
+
This variable applies only to mouse adjustments in Emacs, not
selecting and adjusting regions in other windows."
- :type 'boolean
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (const :tag "Non-empty" non-empty))
:version "24.1")
(defcustom mouse-1-click-follows-link 450
@@ -97,6 +107,25 @@ point at the click position."
:type 'boolean
:version "22.1")
+(defcustom mouse-drag-and-drop-region-scroll-margin nil
+ "If non-nil, the scroll margin inside a window when dragging text.
+If the mouse moves this many lines close to the top or bottom of
+a window while dragging text, then that window will be scrolled
+down and up respectively."
+ :type '(choice (const :tag "Don't scroll during mouse movement")
+ (integer :tag "This many lines from window top or bottom"))
+ :version "29.1")
+
+(defcustom mouse-drag-mode-line-buffer nil
+ "If non-nil, allow dragging files from the mode line.
+When the buffer has an associated file, it can be dragged from
+the buffer name portion of its mode line to other programs.
+
+This option is only supported on X, Haiku and Nextstep (GNUstep
+or macOS)."
+ :type 'boolean
+ :version "29.1")
+
(defvar mouse--last-down nil)
(defun mouse--down-1-maybe-follows-link (&optional _prompt)
@@ -156,6 +185,17 @@ Expects to be bound to `(double-)mouse-1' in `key-translation-map'."
(define-key key-translation-map [double-mouse-1]
#'mouse--click-1-maybe-follows-link)
+(defun mouse-double-click-time ()
+ "Return a number for `double-click-time'.
+In contrast to using the `double-click-time' variable directly,
+which could be set to nil or t, this function is guaranteed to
+always return a positive integer or zero."
+ (let ((ct double-click-time))
+ (cond ((eq ct t) 10000) ; arbitrary number useful for sit-for
+ ((eq ct nil) 0)
+ ((and (numberp ct) (> ct 0)) ct)
+ (t 0))))
+
;; Provide a mode-specific menu on a mouse button.
@@ -184,8 +224,8 @@ items `Turn Off' and `Help'."
"-" " " (format "%S" minor-mode))))
(turn-off menu-item "Turn off minor mode" ,mm-fun)
(help menu-item "Help for minor mode"
- (lambda () (interactive)
- (describe-function ',mm-fun)))))))
+ ,(lambda () (interactive)
+ (describe-function mm-fun)))))))
(if menu
(popup-menu menu)
(message "No menu available")))))
@@ -271,7 +311,7 @@ not it is actually displayed."
;; FIXME: We have a problem here: we have to use the global/local/minor
;; so they're displayed in the expected order, but later on in the command
;; loop, they're actually looked up in the opposite order.
- (apply 'append
+ (apply #'append
global-menu
local-menu
minor-mode-menus)))
@@ -298,6 +338,10 @@ and should return the same menu with changes such as added new menu items."
(function-item context-menu-buffers)
(function-item context-menu-vc)
(function-item context-menu-ffap)
+ (function-item hi-lock-context-menu)
+ (function-item occur-context-menu)
+ (function-item Man-context-menu)
+ (function-item dictionary-context-menu)
(function :tag "Custom function")))
:version "28.1")
@@ -317,9 +361,13 @@ At the end, it's possible to modify the final menu by specifying
the function `context-menu-filter-function'."
(let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))
(click (or click last-input-event))
+ (window (posn-window (event-start click)))
(fun (mouse-posn-property (event-start click)
'context-menu-function)))
+ (unless (eq (selected-window) window)
+ (select-window window))
+
(if (functionp fun)
(setq menu (funcall fun menu click))
(run-hook-wrapped 'context-menu-functions
@@ -327,13 +375,31 @@ the function `context-menu-filter-function'."
(setq menu (funcall fun menu click))
nil)))
- ;; Remove duplicate separators
- (let ((l menu))
- (while (consp l)
- (when (and (equal (cdr-safe (car l)) menu-bar-separator)
- (equal (cdr-safe (cadr l)) menu-bar-separator))
- (setcdr l (cddr l)))
- (setq l (cdr l))))
+ ;; Remove duplicate separators as well as ones at the beginning or
+ ;; end of the menu.
+ (let ((l menu) (last-saw-separator t))
+ (while (and (consp l)
+ (consp (cdr l)))
+ (if (equal (cdr-safe (cadr l)) menu-bar-separator)
+ (progn
+ ;; The next item is a separator. Remove it if the last
+ ;; item we saw was a separator too.
+ (if last-saw-separator
+ (setcdr l (cddr l))
+ ;; If we didn't delete this separator, update the last
+ ;; separator we saw to this one.
+ (setq last-saw-separator l
+ l (cdr l))))
+ ;; If the next item is a cons cell, we found a non-separator
+ ;; item. Don't remove the next separator we see. We
+ ;; specifically check for cons cells to avoid treating the
+ ;; overall prompt string as a menu item.
+ (when (consp (cadr l))
+ (setq last-saw-separator nil))
+ (setq l (cdr l))))
+ ;; If the last item we saw was a separator, remove it.
+ (when (consp last-saw-separator)
+ (setcdr last-saw-separator (cddr last-saw-separator))))
(when (functionp context-menu-filter-function)
(setq menu (funcall context-menu-filter-function menu click)))
@@ -514,8 +580,8 @@ Some context functions add menu items below the separator."
menu)
(defvar context-menu-entry
- `(menu-item ,(purecopy "Context Menu") ignore
- :filter (lambda (_) (context-menu-map)))
+ `(menu-item ,(purecopy "Context Menu") ,(make-sparse-keymap)
+ :filter ,(lambda (_) (context-menu-map)))
"Menu item that creates the context menu and can be bound to a mouse key.")
(defvar context-menu-mode-map
@@ -536,7 +602,7 @@ Some context functions add menu items below the separator."
When Context Menu mode is enabled, clicking the mouse button down-mouse-3
activates the menu whose contents depends on its surrounding context."
- :global t :group 'mouse)
+ :global t)
(defun context-menu-open ()
"Start key navigation of the context menu.
@@ -548,7 +614,7 @@ This is the keyboard interface to \\[context-menu-map]."
(call-interactively map)
(popup-menu map (point)))))
-(global-set-key [S-f10] 'context-menu-open)
+(global-set-key [S-f10] #'context-menu-open)
(defun mark-thing-at-mouse (click thing)
"Activate the region around THING found near the mouse CLICK."
@@ -589,7 +655,13 @@ This command must be bound to a mouse click."
(interactive "e")
(unless (one-window-p t)
(mouse-minibuffer-check click)
- (delete-window (posn-window (event-start click)))))
+ ;; Only delete the window if the user hasn't moved point out of
+ ;; the mode line before releasing the button.
+ (when (and (eq (posn-area (event-end click))
+ 'mode-line)
+ (eq (posn-window (event-end click))
+ (posn-window (event-start click))))
+ (delete-window (posn-window (event-start click))))))
(defun mouse-select-window (click)
"Select the window clicked on; don't move point."
@@ -603,7 +675,7 @@ This command must be bound to a mouse click."
(or (eq frame oframe)
(set-mouse-position (selected-frame) (1- (frame-width)) 0))))
-(define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4")
+(define-obsolete-function-alias 'mouse-tear-off-window #'tear-off-window "24.4")
(defun tear-off-window (click)
"Delete the selected window, and create a new frame displaying its buffer."
(interactive (list last-nonmenu-event))
@@ -615,10 +687,13 @@ This command must be bound to a mouse click."
(switch-to-buffer buf)
(delete-window window)))
-(defun mouse-delete-other-windows ()
+(defun mouse-delete-other-windows (click)
"Delete all windows except the one you click on."
- (interactive "@")
- (delete-other-windows))
+ (interactive "e")
+ (when (and (eq (posn-area (event-end click)) 'mode-line)
+ (eq (posn-window (event-start click))
+ (posn-window (event-end click))))
+ (delete-other-windows (posn-window (event-start click)))))
(defun mouse-split-window-vertically (click)
"Select Emacs window mouse is on, then split it vertically in half.
@@ -679,7 +754,6 @@ must be one of the symbols `header', `mode', or `vertical'."
;; previously sampled position. The difference of `position'
;; and `last-position' determines the size change of WINDOW.
(last-position position)
- (draggable t)
posn-window growth dragged)
;; Decide on whether we are allowed to track at all and whose
;; window's edge we drag.
@@ -732,7 +806,7 @@ must be one of the symbols `header', `mode', or `vertical'."
(setq dragged t)
(adjust-window-trailing-edge window growth t t))
(setq last-position position))
- (draggable
+ (t
;; Drag bottom edge of `window'.
(setq start (event-start event))
;; Set `posn-window' to the window where `event' was recorded.
@@ -807,8 +881,29 @@ frame instead."
(interactive "e")
(let* ((start (event-start start-event))
(window (posn-window start))
- (frame (window-frame window)))
+ (frame (window-frame window))
+ (skip-tracking nil)
+ filename)
+ ;; FIXME: is there a better way of determining if the event
+ ;; started on a buffer name?
+ (when (and mouse-drag-mode-line-buffer
+ (eq (car (posn-string start))
+ (car (with-selected-window window
+ (setq filename (buffer-file-name))
+ mode-line-buffer-identification)))
+ filename
+ (file-exists-p filename))
+ (let ((mouse-fine-grained-tracking nil))
+ (track-mouse
+ (setq track-mouse 'drag-source)
+ (let ((event (read-event)))
+ (if (not (eq (event-basic-type event)
+ 'mouse-movement))
+ (push event unread-command-events)
+ (dnd-begin-file-drag filename frame 'copy t)
+ (setq skip-tracking t))))))
(cond
+ (skip-tracking t)
((not (window-live-p window)))
((or (not (window-at-side-p window 'bottom))
;; Allow resizing the minibuffer window if it's on the
@@ -1105,7 +1200,7 @@ frame with the mouse."
(<= (- right parent-right) snap-width)
snap-x (<= (- last-x snap-x) snap-width))
;; Stay snapped when the mouse moved rightward but
- ;; not more more than `snap-width' pixels from the
+ ;; not more than `snap-width' pixels from the
;; time FRAME snapped.
(setq left (- parent-right native-width)))
(t
@@ -1127,7 +1222,7 @@ frame with the mouse."
(<= (- parent-top top) snap-width)
snap-y (<= (- snap-y last-y) snap-width))
;; Stay snapped when the mouse moved upward but
- ;; not more more than `snap-width' pixels from the
+ ;; not more than `snap-width' pixels from the
;; time FRAME snapped.
(setq top parent-top))
(t
@@ -1149,7 +1244,7 @@ frame with the mouse."
(<= (- bottom parent-bottom) snap-width)
snap-y (<= (- last-y snap-y) snap-width))
;; Stay snapped when the mouse moved downward but
- ;; not more more than `snap-width' pixels from the
+ ;; not more than `snap-width' pixels from the
;; time FRAME snapped.
(setq top (- parent-bottom native-height)))
(t
@@ -1345,11 +1440,16 @@ command alters the kill ring or not."
(if (< end beg)
(setq end (nth 0 range) beg (nth 1 range))
(setq beg (nth 0 range) end (nth 1 range)))))
- (and mouse-drag-copy-region (integerp beg) (integerp end)
+ (when (and mouse-drag-copy-region
+ (integerp beg)
+ (integerp end)
+ (or (not (eq mouse-drag-copy-region 'non-empty))
+ (/= beg end)))
;; Don't set this-command to `kill-region', so a following
;; C-w won't double the text in the kill ring. Ignore
;; `last-command' so we don't append to a preceding kill.
- (let (this-command last-command deactivate-mark)
+ (let ((last-command last-command)
+ this-command deactivate-mark)
(copy-region-as-kill beg end)))
(if (numberp beg) (goto-char beg))
;; On a text terminal, bounce the cursor.
@@ -1452,6 +1552,7 @@ is dragged over to."
(mouse-drag-and-drop-region start-event)
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
+ (ignore-preserving-kill-region)
(mouse-drag-track start-event)))
;; Inhibit the region-confinement when undoing mouse-drag-region
@@ -1573,8 +1674,7 @@ The region will be defined with mark and point."
(mouse-minibuffer-check start-event)
(setq mouse-selection-click-count-buffer (current-buffer))
(deactivate-mark)
- (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541).
- (start-posn (event-start start-event))
+ (let* ((start-posn (event-start start-event))
(start-point (posn-point start-posn))
(start-window (posn-window start-posn))
(_ (with-current-buffer (window-buffer start-window)
@@ -1596,76 +1696,89 @@ The region will be defined with mark and point."
;; Don't count the mode line.
(1- (nth 3 bounds))))
(click-count (1- (event-click-count start-event)))
- ;; Suppress automatic hscrolling, because that is a nuisance
- ;; when setting point near the right fringe (but see below).
+ ;; Save original automatic scrolling behavior (see below).
(auto-hscroll-mode-saved auto-hscroll-mode)
- (old-track-mouse track-mouse))
+ (scroll-margin-saved scroll-margin)
+ (old-track-mouse track-mouse)
+ (cleanup (lambda ()
+ (setq track-mouse old-track-mouse)
+ (setq auto-hscroll-mode auto-hscroll-mode-saved)
+ (setq scroll-margin scroll-margin-saved))))
+ (condition-case err
+ (progn
+ (setq mouse-selection-click-count click-count)
+
+ ;; Suppress automatic scrolling near the edges while tracking
+ ;; movement, as it interferes with the natural dragging behavior
+ ;; (point will unexpectedly be moved beneath the pointer, making
+ ;; selections in auto-scrolling margins impossible).
+ (setq auto-hscroll-mode nil)
+ (setq scroll-margin 0)
+
+ ;; In case the down click is in the middle of some intangible text,
+ ;; use the end of that text, and put it in START-POINT.
+ (if (< (point) start-point)
+ (goto-char start-point))
+ (setq start-point (point))
+
+ ;; Activate the region, using `mouse-start-end' to determine where
+ ;; to put point and mark (e.g., double-click will select a word).
+ (setq-local transient-mark-mode
+ (if (eq transient-mark-mode 'lambda)
+ '(only)
+ (cons 'only transient-mark-mode)))
+ (let ((range (mouse-start-end start-point start-point click-count)))
+ (push-mark (nth 0 range) t t)
+ (goto-char (nth 1 range)))
- (setq mouse-selection-click-count click-count)
- ;; In case the down click is in the middle of some intangible text,
- ;; use the end of that text, and put it in START-POINT.
- (if (< (point) start-point)
- (goto-char start-point))
- (setq start-point (point))
+ (setf (terminal-parameter nil 'mouse-drag-start) start-event)
+ ;; Set 'track-mouse' to something neither nil nor t, so that mouse
+ ;; events are not reported to have happened on the tool bar or the
+ ;; tab bar, as that breaks drag events that originate on the window
+ ;; body below these bars; see make_lispy_position and bug#51794.
+ (setq track-mouse 'drag-tracking)
- ;; Activate the region, using `mouse-start-end' to determine where
- ;; to put point and mark (e.g., double-click will select a word).
- (setq-local transient-mark-mode
- (if (eq transient-mark-mode 'lambda)
- '(only)
- (cons 'only transient-mark-mode)))
- (let ((range (mouse-start-end start-point start-point click-count)))
- (push-mark (nth 0 range) t t)
- (goto-char (nth 1 range)))
-
- (setf (terminal-parameter nil 'mouse-drag-start) start-event)
- ;; Set 'track-mouse' to something neither nil nor t, so that mouse
- ;; events are not reported to have happened on the tool bar or the
- ;; tab bar, as that breaks drag events that originate on the window
- ;; body below these bars; see make_lispy_position and bug#51794.
- (setq track-mouse 'drag-tracking)
- (setq auto-hscroll-mode nil)
-
- (set-transient-map
- (let ((map (make-sparse-keymap)))
- (define-key map [switch-frame] #'ignore)
- (define-key map [select-window] #'ignore)
- (define-key map [mouse-movement]
- (lambda (event) (interactive "e")
- (let* ((end (event-end event))
- (end-point (posn-point end)))
- (unless (eq end-point start-point)
- ;; As soon as the user moves, we can re-enable auto-hscroll.
- (setq auto-hscroll-mode auto-hscroll-mode-saved)
- ;; And remember that we have moved, so mouse-set-region can know
- ;; its event is really a drag event.
- (setcar start-event 'mouse-movement))
- (if (and (eq (posn-window end) start-window)
- (integer-or-marker-p end-point))
- (mouse--drag-set-mark-and-point start-point
- end-point click-count)
- (let ((mouse-row (cdr (cdr (mouse-position)))))
- (cond
- ((null mouse-row))
- ((< mouse-row top)
- (mouse-scroll-subr start-window (- mouse-row top)
- nil start-point))
- ((>= mouse-row bottom)
- (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
- nil start-point))))))))
- map)
- t (lambda ()
- (setq track-mouse old-track-mouse)
- (setq auto-hscroll-mode auto-hscroll-mode-saved)
- ;; Don't deactivate the mark when the context menu was invoked
- ;; by down-mouse-3 immediately after down-mouse-1 and without
- ;; releasing the mouse button with mouse-1. This allows to use
- ;; region-related context menu to operate on the selected region.
- (unless (and context-menu-mode
- (eq (car-safe (aref (this-command-keys-vector) 0))
- 'down-mouse-3))
- (deactivate-mark)
- (pop-mark))))))
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [switch-frame] #'ignore)
+ (define-key map [select-window] #'ignore)
+ (define-key map [mouse-movement]
+ (lambda (event) (interactive "e")
+ (let* ((end (event-end event))
+ (end-point (posn-point end)))
+ (unless (eq end-point start-point)
+ ;; And remember that we have moved, so mouse-set-region can know
+ ;; its event is really a drag event.
+ (setcar start-event 'mouse-movement))
+ (if (and (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+ (mouse--drag-set-mark-and-point start-point
+ end-point click-count)
+ (let ((mouse-row (cdr (cdr (mouse-position)))))
+ (cond
+ ((null mouse-row))
+ ((< mouse-row top)
+ (mouse-scroll-subr start-window (- mouse-row top)
+ nil start-point))
+ ((>= mouse-row bottom)
+ (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
+ nil start-point))))))
+ (ignore-preserving-kill-region)))
+ map)
+ t (lambda ()
+ (funcall cleanup)
+ ;; Don't deactivate the mark when the context menu was invoked
+ ;; by down-mouse-3 immediately after down-mouse-1 and without
+ ;; releasing the mouse button with mouse-1. This allows to use
+ ;; region-related context menu to operate on the selected region.
+ (unless (and context-menu-mode
+ (eq (car-safe (aref (this-command-keys-vector) 0))
+ 'down-mouse-3))
+ (deactivate-mark)
+ (pop-mark)))))
+ ;; Cleanup on errors
+ (error (funcall cleanup)
+ (signal (car err) (cdr err))))))
(defun mouse--drag-set-mark-and-point (start click click-count)
(let* ((range (mouse-start-end start click click-count))
@@ -1821,7 +1934,7 @@ If MODE is 2 then do the same for lines."
event)))
(setcar last new)
(if (and (not (equal modifiers old-modifiers))
- (key-binding (apply 'vector events)))
+ (key-binding (apply #'vector events)))
t
(setcar last event)
nil)))
@@ -1875,12 +1988,12 @@ regardless of where you click."
(setq mouse-selection-click-count 0)
(yank arg))
-(defun mouse-yank-primary (click)
- "Insert the primary selection at the position clicked on.
+(defun mouse-yank-primary (&optional event)
+ "Insert the primary selection,
Move point to the end of the inserted text, and set mark at
beginning. If `mouse-yank-at-point' is non-nil, insert at point
-regardless of where you click."
- (interactive "e")
+otherwise insert it at the position of EVENT."
+ (interactive (list last-nonmenu-event))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
;; Without this, confusing things happen upon e.g. inserting into
@@ -1888,7 +2001,7 @@ regardless of where you click."
(when select-active-regions
(let (select-active-regions)
(deactivate-mark)))
- (or mouse-yank-at-point (mouse-set-point click))
+ (or mouse-yank-at-point (mouse-set-point event))
(let ((primary (gui-get-primary-selection)))
(push-mark)
(insert-for-yank primary)))
@@ -2023,16 +2136,18 @@ if `mouse-drag-copy-region' is non-nil)."
(if before-scroll (goto-char before-scroll)))
(exchange-point-and-mark)
(mouse-set-region-1)
- (when mouse-drag-copy-region
+ (when (and mouse-drag-copy-region
+ (or (not (eq mouse-drag-copy-region 'non-empty))
+ (not (/= (mark t) (point)))))
(kill-new (filter-buffer-substring (mark t) (point))))
(setq mouse-save-then-kill-posn click-pt)))))
-(global-set-key [M-mouse-1] 'mouse-start-secondary)
-(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
-(global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
-(global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
-(global-set-key [M-mouse-2] 'mouse-yank-secondary)
+(global-set-key [M-mouse-1] #'mouse-start-secondary)
+(global-set-key [M-drag-mouse-1] #'mouse-set-secondary)
+(global-set-key [M-down-mouse-1] #'mouse-drag-secondary)
+(global-set-key [M-mouse-3] #'mouse-secondary-save-then-kill)
+(global-set-key [M-mouse-2] #'mouse-yank-secondary)
(defconst mouse-secondary-overlay
(let ((ol (make-overlay (point-min) (point-min))))
@@ -2721,18 +2836,72 @@ and selects that window."
(declare-function generate-fontset-menu "fontset" ())
+(defun mouse-generate-font-name-for-menu (entity)
+ "Return a short name for font entity ENTITY.
+The name should be used to describe ENTITY in the case that its
+family is already known, such as in a pane generated by
+`mouse-generate-font-menu'."
+ (let ((weight (font-get entity :weight))
+ (slant (font-get entity :slant))
+ (width (font-get entity :width))
+ (size (font-get entity :size))
+ (adstyle (font-get entity :adstyle))
+ (name ""))
+ (when weight
+ (setq name (concat name (symbol-name weight) " ")))
+ (when (and slant
+ (not (eq slant 'normal)))
+ (setq name (concat name (symbol-name slant) " ")))
+ (when (and width (not (eq width 'normal)))
+ (setq name (concat name (symbol-name width) " ")))
+ (when (and size (not (zerop size)))
+ (setq name (concat name (number-to-string size) " ")))
+ (when adstyle
+ (setq name (concat name (if (symbolp adstyle)
+ (symbol-name adstyle)
+ (number-to-string adstyle))
+ " ")))
+ (string-trim-right name)))
+
+(defun mouse-generate-font-menu ()
+ "Return a list of menu panes for each font family."
+ (let ((families (font-family-list))
+ (panes (list "Font families")))
+ (dolist (family families)
+ (when family
+ (let* ((fonts (list-fonts (font-spec :family family)))
+ (pane (if fonts (list family)
+ (list family (cons family family)))))
+ (when fonts
+ (dolist (font fonts)
+ (setq pane
+ (nconc pane
+ (list (list (or (font-get font :name)
+ (mouse-generate-font-name-for-menu font))
+ (font-xlfd-name font)))))))
+ (setq panes (nconc panes (list pane))))))
+ panes))
+
(defun mouse-select-font ()
"Prompt for a font name, using `x-popup-menu', and return it."
(interactive)
(unless (display-multi-font-p)
(error "Cannot change fonts on this display"))
- (car
- (x-popup-menu
- (if (listp last-nonmenu-event)
- last-nonmenu-event
- (list '(0 0) (selected-window)))
- (append x-fixed-font-alist
- (list (generate-fontset-menu))))))
+ (let ((result (car
+ (x-popup-menu
+ (if (listp last-nonmenu-event)
+ last-nonmenu-event
+ (list '(0 0) (selected-window)))
+ (append x-fixed-font-alist
+ (list (generate-fontset-menu))
+ '(("More Fonts" ("By Family" more))))))))
+ (if (eq result 'more)
+ (car (x-popup-menu
+ (if (listp last-nonmenu-event)
+ last-nonmenu-event
+ (list '(0 0) (selected-window)))
+ (mouse-generate-font-menu)))
+ result)))
(declare-function text-scale-mode "face-remap")
@@ -2746,12 +2915,7 @@ choose a font."
(interactive
(progn (unless (display-multi-font-p)
(error "Cannot change fonts on this display"))
- (x-popup-menu
- (if (listp last-nonmenu-event)
- last-nonmenu-event
- (list '(0 0) (selected-window)))
- ;; Append list of fontsets currently defined.
- (append x-fixed-font-alist (list (generate-fontset-menu))))))
+ (list (mouse-select-font))))
(if fonts
(let (font)
(while fonts
@@ -2889,6 +3053,11 @@ in addition, temporarily highlight the original region with the
:type 'boolean
:version "26.1")
+(defcustom mouse-drag-and-drop-region-cross-program nil
+ "If non-nil, allow dragging text to other programs."
+ :type 'boolean
+ :version "29.1")
+
(defface mouse-drag-and-drop-region '((t :inherit region))
"Face to highlight original text during dragging.
This face is used by `mouse-drag-and-drop-region' to temporarily
@@ -2899,6 +3068,36 @@ highlight the original region when
(declare-function rectangle-dimensions "rect" (start end))
(declare-function rectangle-position-as-coordinates "rect" (position))
(declare-function rectangle-intersect-p "rect" (pos1 size1 pos2 size2))
+(declare-function x-begin-drag "xfns.c")
+
+(defun mouse-drag-and-drop-region-display-tooltip (tooltip)
+ "Display TOOLTIP, a tooltip string, using `x-show-tip'.
+Call `tooltip-show-help-non-mode' instead on non-graphical displays."
+ (if (display-graphic-p)
+ (let ((params (copy-sequence tooltip-frame-parameters))
+ (fg (face-attribute 'tooltip :foreground))
+ (bg (face-attribute 'tooltip :background)))
+ (when (stringp fg)
+ (setf (alist-get 'foreground-color params) fg)
+ (setf (alist-get 'border-color params) fg))
+ (when (stringp bg)
+ (setf (alist-get 'background-color params) bg))
+ ;; Don't time out: this leads to very confusing behavior when
+ ;; Emacs isn't visible, and the only indication that the user
+ ;; is actually dragging something abruptly disappears.
+ (x-show-tip tooltip nil params most-positive-fixnum))
+ (tooltip-show-help-non-mode tooltip)))
+
+(declare-function x-hide-tip "xfns.c")
+(declare-function x-show-tip "xfns.c")
+
+(defun mouse-drag-and-drop-region-hide-tooltip ()
+ "Hide any tooltip currently displayed.
+Call `tooltip-show-help-non-mode' to clear the echo area message
+instead on non-graphical displays."
+ (if (display-graphic-p)
+ (x-hide-tip)
+ (tooltip-show-help-non-mode nil)))
(defun mouse-drag-and-drop-region (event)
"Move text in the region to point where mouse is dragged to.
@@ -2915,6 +3114,7 @@ is copied instead of being cut."
(display-multi-frame-p)
(require 'tooltip))
mouse-drag-and-drop-region-show-tooltip))
+ (mouse-highlight nil)
(start (region-beginning))
(end (region-end))
(point (point))
@@ -2928,6 +3128,17 @@ is copied instead of being cut."
(cdr bounds)))
(region-bounds)))
(region-noncontiguous (region-noncontiguous-p))
+ ;; Otherwise, the mouse periodically moves on top of the
+ ;; tooltip.
+ (mouse-fine-grained-tracking t)
+ (was-tooltip-mode tooltip-mode)
+ ;; System tooltips tend to flicker and in general work
+ ;; incorrectly.
+ (use-system-tooltips nil)
+ ;; Whether or not some text was ``cut'' from Emacs to another
+ ;; program and the cleaanup code should not try modifying the
+ ;; region.
+ drag-was-cross-program
point-to-paste
point-to-paste-read-only
window-to-paste
@@ -2939,331 +3150,460 @@ is copied instead of being cut."
value-selection ; This remains nil when event was "click".
text-tooltip
states
- window-exempt)
-
- ;; STATES stores for each window on this frame its start and point
- ;; positions so we can restore them on all windows but for the one
- ;; where the drop occurs. For inter-frame drags we'll have to do
- ;; this for all windows on all visible frames. In addition we save
- ;; also the cursor type for the window's buffer so we can restore it
- ;; in case we modified it.
- ;; https://lists.gnu.org/r/emacs-devel/2017-12/msg00090.html
- (walk-window-tree
- (lambda (window)
- (setq states
- (cons
- (list
- window
- (copy-marker (window-start window))
- (copy-marker (window-point window))
- (with-current-buffer (window-buffer window)
- cursor-type))
- states))))
-
- (ignore-errors
- (track-mouse
- (setq track-mouse 'dropping)
- ;; When event was "click" instead of "drag", skip loop.
- (while (progn
- (setq event (read-key)) ; read-event or read-key
- (or (mouse-movement-p event)
- ;; Handle `mouse-autoselect-window'.
- (memq (car event) '(select-window switch-frame))))
- ;; Obtain the dragged text in region. When the loop was
- ;; skipped, value-selection remains nil.
- (unless value-selection
- (setq value-selection (funcall region-extract-function nil))
- (when mouse-drag-and-drop-region-show-tooltip
- (let ((text-size mouse-drag-and-drop-region-show-tooltip))
- (setq text-tooltip
- (if (and (integerp text-size)
- (> (length value-selection) text-size))
- (concat
- (substring value-selection 0 (/ text-size 2))
- "\n...\n"
- (substring value-selection (- (/ text-size 2)) -1))
- value-selection))))
-
- ;; Check if selected text is read-only.
- (setq text-from-read-only
- (or text-from-read-only
- (catch 'loop
- (dolist (bound (region-bounds))
- (when (text-property-not-all
- (car bound) (cdr bound) 'read-only nil)
- (throw 'loop t)))))))
-
- (setq window-to-paste (posn-window (event-end event)))
- (setq point-to-paste (posn-point (event-end event)))
- ;; Set nil when target buffer is minibuffer.
- (setq buffer-to-paste (let (buf)
- (when (windowp window-to-paste)
- (setq buf (window-buffer window-to-paste))
- (when (not (minibufferp buf))
- buf))))
- (setq cursor-in-text-area (and window-to-paste
- point-to-paste
- buffer-to-paste))
-
- (when cursor-in-text-area
- ;; Check if point under mouse is read-only.
- (save-window-excursion
- (select-window window-to-paste)
- (setq point-to-paste-read-only
- (or buffer-read-only
- (get-text-property point-to-paste 'read-only))))
-
- ;; Check if "drag but negligible". Operation "drag but
- ;; negligible" is defined as drag-and-drop the text to
- ;; the original region. When modifier is pressed, the
- ;; text will be inserted to inside of the original
- ;; region.
- ;;
- ;; If the region is rectangular, check if the newly inserted
- ;; rectangular text would intersect the already selected
- ;; region. If it would, then set "drag-but-negligible" to t.
- ;; As a special case, allow dragging the region freely anywhere
- ;; to the left, as this will never trigger its contents to be
- ;; inserted into the overlays tracking it.
- (setq drag-but-negligible
- (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays))
- buffer-to-paste)
- (if region-noncontiguous
- (let ((dimensions (rectangle-dimensions start end))
- (start-coordinates
- (rectangle-position-as-coordinates start))
- (point-to-paste-coordinates
- (rectangle-position-as-coordinates
- point-to-paste)))
- (and (rectangle-intersect-p
- start-coordinates dimensions
- point-to-paste-coordinates dimensions)
- (not (< (car point-to-paste-coordinates)
- (car start-coordinates)))))
- (and (<= (overlay-start
- (car mouse-drag-and-drop-overlays))
- point-to-paste)
- (<= point-to-paste
- (overlay-end
- (car mouse-drag-and-drop-overlays))))))))
-
- ;; Show a tooltip.
- (if mouse-drag-and-drop-region-show-tooltip
- (tooltip-show (copy-sequence text-tooltip))
- (tooltip-hide))
-
- ;; Show cursor and highlight the original region.
- (when mouse-drag-and-drop-region-show-cursor
- ;; Modify cursor even when point is out of frame.
- (setq cursor-type (cond
- ((not cursor-in-text-area)
- nil)
- ((or point-to-paste-read-only
- drag-but-negligible)
- 'hollow)
- (t
- 'bar)))
- (when cursor-in-text-area
- (dolist (overlay mouse-drag-and-drop-overlays)
- (overlay-put overlay
- 'face 'mouse-drag-and-drop-region))
- (deactivate-mark) ; Maintain region in other window.
- (mouse-set-point event)))))
-
- ;; Hide a tooltip.
- (when mouse-drag-and-drop-region-show-tooltip (tooltip-hide))
-
- ;; Check if modifier was pressed on drop.
- (setq no-modifier-on-drop
- (not (member mouse-drag-and-drop-region (event-modifiers event))))
-
- ;; Check if event was "click".
- (setq clicked (not value-selection))
-
- ;; Restore status on drag to outside of text-area or non-mouse input.
- (when (or (not cursor-in-text-area)
- (not (equal (event-basic-type event) mouse-button)))
- (setq drag-but-negligible t
- no-modifier-on-drop t))
-
- ;; Do not modify any buffers when event is "click",
- ;; "drag but negligible", or "drag to read-only".
- (let* ((mouse-drag-and-drop-region-cut-when-buffers-differ
- (if no-modifier-on-drop
- mouse-drag-and-drop-region-cut-when-buffers-differ
- (not mouse-drag-and-drop-region-cut-when-buffers-differ)))
- (wanna-paste-to-same-buffer (equal buffer-to-paste buffer))
- (wanna-cut-on-same-buffer (and wanna-paste-to-same-buffer
- no-modifier-on-drop))
- (wanna-cut-on-other-buffer
- (and (not wanna-paste-to-same-buffer)
- mouse-drag-and-drop-region-cut-when-buffers-differ))
- (cannot-paste (or point-to-paste-read-only
- (when (or wanna-cut-on-same-buffer
- wanna-cut-on-other-buffer)
- text-from-read-only))))
-
- (cond
- ;; Move point within region.
- (clicked
- (deactivate-mark)
- (mouse-set-point event))
- ;; Undo operation. Set back the original text as region.
- ((or (and drag-but-negligible
- no-modifier-on-drop)
- cannot-paste)
- ;; Inform user either source or destination buffer cannot be modified.
- (when (and (not drag-but-negligible)
- cannot-paste)
- (message "Buffer is read-only"))
-
- ;; Select source window back and restore region.
- ;; (set-window-point window point)
- (select-window window)
- (goto-char point)
- (setq deactivate-mark nil)
- (activate-mark)
- (when region-noncontiguous
- (rectangle-mark-mode)))
- ;; Modify buffers.
- (t
- ;; * DESTINATION BUFFER::
- ;; Insert the text to destination buffer under mouse.
- (select-window window-to-paste)
- (setq window-exempt window-to-paste)
- (goto-char point-to-paste)
- (push-mark)
- (insert-for-yank value-selection)
-
- ;; On success, set the text as region on destination buffer.
- (when (not (equal (mark) (point)))
- (setq deactivate-mark nil)
- (activate-mark)
- (when region-noncontiguous
- (rectangle-mark-mode)))
-
- ;; * SOURCE BUFFER::
- ;; Set back the original text as region or delete the original
- ;; text, on source buffer.
- (if wanna-paste-to-same-buffer
- ;; When source buffer and destination buffer are the same,
- ;; remove the original text.
- (when no-modifier-on-drop
- (let (deactivate-mark)
- (dolist (overlay mouse-drag-and-drop-overlays)
- (delete-region (overlay-start overlay)
- (overlay-end overlay)))))
- ;; When source buffer and destination buffer are different,
- ;; keep (set back the original text as region) or remove the
- ;; original text.
- (select-window window) ; Select window with source buffer.
- (goto-char point) ; Move point to the original text on source buffer.
-
- (if mouse-drag-and-drop-region-cut-when-buffers-differ
- ;; Remove the dragged text from source buffer like
- ;; operation `cut'.
- (dolist (overlay mouse-drag-and-drop-overlays)
- (delete-region (overlay-start overlay)
- (overlay-end overlay)))
- ;; Set back the dragged text as region on source buffer
- ;; like operation `copy'.
- (activate-mark))
- (select-window window-to-paste))))))
-
- ;; Clean up.
- (dolist (overlay mouse-drag-and-drop-overlays)
- (delete-overlay overlay))
-
- ;; Restore old states but for the window where the drop
- ;; occurred. Restore cursor types for all windows.
- (dolist (state states)
- (let ((window (car state)))
- (when (and window-exempt
- (not (eq window window-exempt)))
- (set-window-start window (nth 1 state) 'noforce)
- (set-marker (nth 1 state) nil)
- ;; If window is selected, the following automatically sets
- ;; point for that window's buffer.
- (set-window-point window (nth 2 state))
- (set-marker (nth 2 state) nil))
- (with-current-buffer (window-buffer window)
- (setq cursor-type (nth 3 state)))))))
+ window-exempt
+ drag-again-mouse-position)
+
+ (unwind-protect
+ (progn
+ ;; Without this moving onto text with a help-echo will
+ ;; interfere with the tooltip containing dragged text.
+ (tooltip-mode -1)
+ ;; STATES stores for each window on this frame its start and point
+ ;; positions so we can restore them on all windows but for the one
+ ;; where the drop occurs. For inter-frame drags we'll have to do
+ ;; this for all windows on all visible frames. In addition we save
+ ;; also the cursor type for the window's buffer so we can restore it
+ ;; in case we modified it.
+ ;; https://lists.gnu.org/r/emacs-devel/2017-12/msg00090.html
+ (walk-window-tree
+ (lambda (window)
+ (setq states
+ (cons
+ (list
+ window
+ (copy-marker (window-start window))
+ (copy-marker (window-point window))
+ (with-current-buffer (window-buffer window)
+ cursor-type))
+ states))))
+
+ (ignore-errors
+ (catch 'cross-program-drag
+ (track-mouse
+ (setq track-mouse (if mouse-drag-and-drop-region-cross-program
+ ;; When `track-mouse' is `drop', we
+ ;; get events with a posn-window of
+ ;; the grabbed frame even if some
+ ;; window is between that and the
+ ;; pointer. This makes dragging to a
+ ;; window on top of a frame
+ ;; impossible. With this value of
+ ;; `track-mouse', no frame is returned
+ ;; in that particular case, which
+ ;; tells us to initiate interprogram
+ ;; drag-and-drop.
+ 'drag-source
+ 'drop))
+ ;; When event was "click" instead of "drag", skip loop.
+ (while (progn
+ (setq event (read-key)) ; read-event or read-key
+ (or (mouse-movement-p event)
+ ;; Handle `mouse-autoselect-window'.
+ (memq (car event) '(select-window switch-frame))))
+ (catch 'drag-again
+ ;; If the mouse is in the drag scroll margin, scroll
+ ;; either up or down depending on which margin it is in.
+ (when mouse-drag-and-drop-region-scroll-margin
+ (let* ((row (cdr (posn-col-row (event-end event))))
+ (window (when (windowp (posn-window (event-end event)))
+ (posn-window (event-end event))))
+ (text-height (when window
+ (window-text-height window)))
+ ;; Make sure it's possible to scroll both up
+ ;; and down if the margin is too large for the
+ ;; window.
+ (margin (when text-height
+ (min (/ text-height 3)
+ mouse-drag-and-drop-region-scroll-margin))))
+ (when (windowp window)
+ ;; At 2 lines, the window becomes too small for any
+ ;; meaningful scrolling.
+ (unless (<= text-height 2)
+ ;; We could end up at the beginning or end of the
+ ;; buffer.
+ (ignore-errors
+ (cond
+ ;; Inside the bottom scroll margin, scroll up.
+ ((> row (- text-height margin))
+ (with-selected-window window
+ (scroll-up 1)))
+ ;; Inside the top scroll margin, scroll down.
+ ((< row margin)
+ (with-selected-window window
+ (scroll-down 1)))))))))
+
+ ;; Obtain the dragged text in region. When the loop was
+ ;; skipped, value-selection remains nil.
+ (unless value-selection
+ (setq value-selection (funcall region-extract-function nil))
+ (when mouse-drag-and-drop-region-show-tooltip
+ (let ((text-size mouse-drag-and-drop-region-show-tooltip))
+ (setq text-tooltip
+ (if (and (integerp text-size)
+ (> (length value-selection) text-size))
+ (concat
+ (substring value-selection 0 (/ text-size 2))
+ "\n...\n"
+ (substring value-selection (- (/ text-size 2)) -1))
+ value-selection))))
+
+ ;; Check if selected text is read-only.
+ (setq text-from-read-only
+ (or text-from-read-only
+ (catch 'loop
+ (dolist (bound (region-bounds))
+ (when (text-property-not-all
+ (car bound) (cdr bound) 'read-only nil)
+ (throw 'loop t)))))))
+
+ (when (and mouse-drag-and-drop-region-cross-program
+ (display-graphic-p)
+ (fboundp 'x-begin-drag)
+ (or (and (framep (posn-window (event-end event)))
+ (let ((location (posn-x-y (event-end event)))
+ (frame (posn-window (event-end event))))
+ (or (< (car location) 0)
+ (< (cdr location) 0)
+ (> (car location)
+ (frame-pixel-width frame))
+ (> (cdr location)
+ (frame-pixel-height frame)))))
+ (and (or (not drag-again-mouse-position)
+ (let ((mouse-position (mouse-absolute-pixel-position)))
+ (or (< 5 (abs (- (car drag-again-mouse-position)
+ (car mouse-position))))
+ (< 5 (abs (- (cdr drag-again-mouse-position)
+ (cdr mouse-position)))))))
+ (not (posn-window (event-end event))))))
+ (setq drag-again-mouse-position nil)
+ (gui-set-selection 'XdndSelection value-selection)
+ (let ((drag-action-or-frame
+ (condition-case nil
+ (x-begin-drag '("UTF8_STRING" "text/plain"
+ "text/plain;charset=utf-8"
+ "STRING" "TEXT" "COMPOUND_TEXT")
+ (if mouse-drag-and-drop-region-cut-when-buffers-differ
+ 'XdndActionMove
+ 'XdndActionCopy)
+ (posn-window (event-end event)) 'now
+ ;; On platforms where we know
+ ;; `return-frame' doesn't
+ ;; work, allow dropping on
+ ;; the drop frame.
+ (eq window-system 'haiku) t)
+ (quit nil))))
+ (when (framep drag-action-or-frame)
+ ;; With some window managers `x-begin-drag'
+ ;; returns a frame sooner than `mouse-position'
+ ;; will return one, due to over-wide frame windows
+ ;; being drawn by the window manager. To avoid
+ ;; that, we just require the mouse move a few
+ ;; pixels before beginning another cross-program
+ ;; drag.
+ (setq drag-again-mouse-position
+ (mouse-absolute-pixel-position))
+ (throw 'drag-again nil))
+
+ (let ((min-char (point)))
+ (when (eq drag-action-or-frame 'XdndActionMove)
+ ;; Remove the dragged text from source buffer like
+ ;; operation `cut'.
+ (dolist (overlay mouse-drag-and-drop-overlays)
+ (when (< min-char (min (overlay-start overlay)
+ (overlay-end overlay)))
+ (setq min-char (min (overlay-start overlay)
+ (overlay-end overlay))))
+ (delete-region (overlay-start overlay)
+ (overlay-end overlay)))
+ (goto-char min-char)
+ (setq deactivate-mark t)
+ (setq drag-was-cross-program t)))
+
+ (when (eq drag-action-or-frame 'XdndActionCopy)
+ ;; Set back the dragged text as region on source buffer
+ ;; like operation `copy'.
+ (activate-mark)))
+ (throw 'cross-program-drag nil))
+
+ (setq window-to-paste (posn-window (event-end event)))
+ (setq point-to-paste (posn-point (event-end event)))
+ ;; Set nil when target buffer is minibuffer.
+ (setq buffer-to-paste (let (buf)
+ (when (windowp window-to-paste)
+ (setq buf (window-buffer window-to-paste))
+ (when (not (minibufferp buf))
+ buf))))
+ (setq cursor-in-text-area (and window-to-paste
+ point-to-paste
+ buffer-to-paste))
+
+ (when cursor-in-text-area
+ ;; Check if point under mouse is read-only.
+ (save-window-excursion
+ (select-window window-to-paste)
+ (setq point-to-paste-read-only
+ (or buffer-read-only
+ (get-text-property point-to-paste 'read-only))))
+
+ ;; Check if "drag but negligible". Operation "drag but
+ ;; negligible" is defined as drag-and-drop the text to
+ ;; the original region. When modifier is pressed, the
+ ;; text will be inserted to inside of the original
+ ;; region.
+ ;;
+ ;; If the region is rectangular, check if the newly inserted
+ ;; rectangular text would intersect the already selected
+ ;; region. If it would, then set "drag-but-negligible" to t.
+ ;; As a special case, allow dragging the region freely anywhere
+ ;; to the left, as this will never trigger its contents to be
+ ;; inserted into the overlays tracking it.
+ (setq drag-but-negligible
+ (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays))
+ buffer-to-paste)
+ (if region-noncontiguous
+ (let ((dimensions (rectangle-dimensions start end))
+ (start-coordinates
+ (rectangle-position-as-coordinates start))
+ (point-to-paste-coordinates
+ (rectangle-position-as-coordinates
+ point-to-paste)))
+ (and (rectangle-intersect-p
+ start-coordinates dimensions
+ point-to-paste-coordinates dimensions)
+ (not (< (car point-to-paste-coordinates)
+ (car start-coordinates)))))
+ (and (<= (overlay-start
+ (car mouse-drag-and-drop-overlays))
+ point-to-paste)
+ (<= point-to-paste
+ (overlay-end
+ (car mouse-drag-and-drop-overlays))))))))
+
+ ;; Show a tooltip.
+ (if mouse-drag-and-drop-region-show-tooltip
+ ;; Don't use tooltip-show since it has side effects
+ ;; which change the text properties, and
+ ;; `text-tooltip' can potentially be the text which
+ ;; will be pasted.
+ (mouse-drag-and-drop-region-display-tooltip text-tooltip)
+ (mouse-drag-and-drop-region-hide-tooltip))
+
+ ;; Show cursor and highlight the original region.
+ (when mouse-drag-and-drop-region-show-cursor
+ ;; Modify cursor even when point is out of frame.
+ (setq cursor-type (cond
+ ((not cursor-in-text-area)
+ nil)
+ ((or point-to-paste-read-only
+ drag-but-negligible)
+ 'hollow)
+ (t
+ 'bar)))
+ (when cursor-in-text-area
+ (dolist (overlay mouse-drag-and-drop-overlays)
+ (overlay-put overlay
+ 'face 'mouse-drag-and-drop-region))
+ (deactivate-mark) ; Maintain region in other window.
+ (mouse-set-point event)))))))
+
+ ;; Hide a tooltip.
+ (when mouse-drag-and-drop-region-show-tooltip (x-hide-tip))
+
+ ;; Check if modifier was pressed on drop.
+ (setq no-modifier-on-drop
+ (not (member mouse-drag-and-drop-region (event-modifiers event))))
+
+ ;; Check if event was "click".
+ (setq clicked (not value-selection))
+
+ ;; Restore status on drag to outside of text-area or non-mouse input.
+ (when (or (not cursor-in-text-area)
+ (not (equal (event-basic-type event) mouse-button)))
+ (setq drag-but-negligible t
+ no-modifier-on-drop t))
+
+ ;; Do not modify any buffers when event is "click",
+ ;; "drag but negligible", or "drag to read-only".
+ (unless drag-was-cross-program
+ (let* ((mouse-drag-and-drop-region-cut-when-buffers-differ
+ (if no-modifier-on-drop
+ mouse-drag-and-drop-region-cut-when-buffers-differ
+ (not mouse-drag-and-drop-region-cut-when-buffers-differ)))
+ (wanna-paste-to-same-buffer (equal buffer-to-paste buffer))
+ (wanna-cut-on-same-buffer (and wanna-paste-to-same-buffer
+ no-modifier-on-drop))
+ (wanna-cut-on-other-buffer
+ (and (not wanna-paste-to-same-buffer)
+ mouse-drag-and-drop-region-cut-when-buffers-differ))
+ (cannot-paste (or point-to-paste-read-only
+ (when (or wanna-cut-on-same-buffer
+ wanna-cut-on-other-buffer)
+ text-from-read-only))))
+
+ (cond
+ ;; Move point within region.
+ (clicked
+ (deactivate-mark)
+ (mouse-set-point event))
+ ;; Undo operation. Set back the original text as region.
+ ((or (and drag-but-negligible
+ no-modifier-on-drop)
+ cannot-paste)
+ ;; Inform user either source or destination buffer cannot be modified.
+ (when (and (not drag-but-negligible)
+ cannot-paste)
+ (message "Buffer is read-only"))
+
+ ;; Select source window back and restore region.
+ ;; (set-window-point window point)
+ (select-window window)
+ (goto-char point)
+ (setq deactivate-mark nil)
+ (activate-mark)
+ (when region-noncontiguous
+ (rectangle-mark-mode)))
+ ;; Modify buffers.
+ (t
+ ;; * DESTINATION BUFFER::
+ ;; Insert the text to destination buffer under mouse.
+ (select-window window-to-paste)
+ (setq window-exempt window-to-paste)
+ (goto-char point-to-paste)
+ (push-mark)
+ (insert-for-yank value-selection)
+
+ ;; On success, set the text as region on destination buffer.
+ (when (not (equal (mark) (point)))
+ (setq deactivate-mark nil)
+ (activate-mark)
+ (when region-noncontiguous
+ (rectangle-mark-mode)))
+
+ ;; * SOURCE BUFFER::
+ ;; Set back the original text as region or delete the original
+ ;; text, on source buffer.
+ (if wanna-paste-to-same-buffer
+ ;; When source buffer and destination buffer are the same,
+ ;; remove the original text.
+ (when no-modifier-on-drop
+ (let (deactivate-mark)
+ (dolist (overlay mouse-drag-and-drop-overlays)
+ (delete-region (overlay-start overlay)
+ (overlay-end overlay)))))
+ ;; When source buffer and destination buffer are different,
+ ;; keep (set back the original text as region) or remove the
+ ;; original text.
+ (select-window window) ; Select window with source buffer.
+ (goto-char point) ; Move point to the original text on source buffer.
+
+ (if mouse-drag-and-drop-region-cut-when-buffers-differ
+ ;; Remove the dragged text from source buffer like
+ ;; operation `cut'.
+ (dolist (overlay mouse-drag-and-drop-overlays)
+ (delete-region (overlay-start overlay)
+ (overlay-end overlay)))
+ ;; Set back the dragged text as region on source buffer
+ ;; like operation `copy'.
+ (activate-mark))
+ (select-window window-to-paste))))))))
+
+ (when was-tooltip-mode
+ (tooltip-mode 1))
+
+ ;; Clean up.
+ (dolist (overlay mouse-drag-and-drop-overlays)
+ (delete-overlay overlay))
+
+ ;; Restore old states but for the window where the drop
+ ;; occurred. Restore cursor types for all windows.
+ (dolist (state states)
+ (let ((window (car state)))
+ (when (and window-exempt
+ (not (eq window window-exempt)))
+ (set-window-start window (nth 1 state) 'noforce)
+ (set-marker (nth 1 state) nil)
+ ;; If window is selected, the following automatically sets
+ ;; point for that window's buffer.
+ (set-window-point window (nth 2 state))
+ (set-marker (nth 2 state) nil))
+ (with-current-buffer (window-buffer window)
+ (setq cursor-type (nth 3 state))))))))
;;; Bindings for mouse commands.
-(global-set-key [down-mouse-1] 'mouse-drag-region)
-(global-set-key [mouse-1] 'mouse-set-point)
-(global-set-key [drag-mouse-1] 'mouse-set-region)
+(global-set-key [down-mouse-1] #'mouse-drag-region)
+(global-set-key [mouse-1] #'mouse-set-point)
+(global-set-key [drag-mouse-1] #'mouse-set-region)
(defun mouse--strip-first-event (_prompt)
(substring (this-single-command-raw-keys) 1))
-(define-key function-key-map [left-fringe mouse-1] 'mouse--strip-first-event)
-(define-key function-key-map [right-fringe mouse-1] 'mouse--strip-first-event)
+(define-key function-key-map [left-fringe mouse-1] #'mouse--strip-first-event)
+(define-key function-key-map [right-fringe mouse-1] #'mouse--strip-first-event)
-(global-set-key [mouse-2] 'mouse-yank-primary)
+(global-set-key [mouse-2] #'mouse-yank-primary)
;; Allow yanking also when the corresponding cursor is "in the fringe".
-(define-key function-key-map [right-fringe mouse-2] 'mouse--strip-first-event)
-(define-key function-key-map [left-fringe mouse-2] 'mouse--strip-first-event)
-(global-set-key [mouse-3] 'mouse-save-then-kill)
-(define-key function-key-map [right-fringe mouse-3] 'mouse--strip-first-event)
-(define-key function-key-map [left-fringe mouse-3] 'mouse--strip-first-event)
+(define-key function-key-map [right-fringe mouse-2] #'mouse--strip-first-event)
+(define-key function-key-map [left-fringe mouse-2] #'mouse--strip-first-event)
+(global-set-key [mouse-3] #'mouse-save-then-kill)
+(define-key function-key-map [right-fringe mouse-3] #'mouse--strip-first-event)
+(define-key function-key-map [left-fringe mouse-3] #'mouse--strip-first-event)
;; By binding these to down-going events, we let the user use the up-going
;; event to make the selection, saving a click.
-(global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
+(global-set-key [C-down-mouse-1] #'mouse-buffer-menu)
(if (not (eq system-type 'ms-dos))
- (global-set-key [S-down-mouse-1] 'mouse-appearance-menu))
+ (global-set-key [S-down-mouse-1] #'mouse-appearance-menu))
;; C-down-mouse-2 is bound in facemenu.el.
(global-set-key [C-down-mouse-3]
`(menu-item ,(purecopy "Menu Bar") ignore
- :filter (lambda (_)
- (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
- (mouse-menu-bar-map)
- (mouse-menu-major-mode-map)))))
+ :filter ,(lambda (_)
+ (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
+ (mouse-menu-bar-map)
+ (mouse-menu-major-mode-map)))))
;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
;; vertical-line prevents Emacs from signaling an error when the mouse
;; button is released after dragging these lines, on non-toolkit
;; versions.
-(global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
-(global-set-key [header-line mouse-1] 'mouse-select-window)
-(global-set-key [tab-line down-mouse-1] 'mouse-drag-tab-line)
-(global-set-key [tab-line mouse-1] 'mouse-select-window)
+(global-set-key [header-line down-mouse-1] #'mouse-drag-header-line)
+(global-set-key [header-line mouse-1] #'mouse-select-window)
+(global-set-key [tab-line down-mouse-1] #'mouse-drag-tab-line)
+(global-set-key [tab-line mouse-1] #'mouse-select-window)
;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
-(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
-(global-set-key [mode-line mouse-1] 'mouse-select-window)
-(global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
-(global-set-key [mode-line mouse-3] 'mouse-delete-window)
-(global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
-(global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
-(global-set-key [horizontal-scroll-bar C-mouse-2] 'mouse-split-window-horizontally)
-(global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
-(global-set-key [vertical-line mouse-1] 'mouse-select-window)
-(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
-(global-set-key [right-divider down-mouse-1] 'mouse-drag-vertical-line)
-(global-set-key [right-divider mouse-1] 'ignore)
-(global-set-key [right-divider C-mouse-2] 'mouse-split-window-vertically)
-(global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
-(global-set-key [bottom-divider mouse-1] 'ignore)
-(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
-(global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge)
-(global-set-key [left-edge mouse-1] 'ignore)
-(global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner)
-(global-set-key [top-left-corner mouse-1] 'ignore)
-(global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge)
-(global-set-key [top-edge mouse-1] 'ignore)
-(global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner)
-(global-set-key [top-right-corner mouse-1] 'ignore)
-(global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge)
-(global-set-key [right-edge mouse-1] 'ignore)
-(global-set-key [bottom-right-corner down-mouse-1] 'mouse-drag-bottom-right-corner)
-(global-set-key [bottom-right-corner mouse-1] 'ignore)
-(global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge)
-(global-set-key [bottom-edge mouse-1] 'ignore)
-(global-set-key [bottom-left-corner down-mouse-1] 'mouse-drag-bottom-left-corner)
-(global-set-key [bottom-left-corner mouse-1] 'ignore)
+(global-set-key [mode-line down-mouse-1] #'mouse-drag-mode-line)
+(global-set-key [mode-line mouse-1] #'mouse-select-window)
+(global-set-key [mode-line mouse-2] #'mouse-delete-other-windows)
+(global-set-key [mode-line mouse-3] #'mouse-delete-window)
+(global-set-key [mode-line C-mouse-2] #'mouse-split-window-horizontally)
+(global-set-key [vertical-scroll-bar C-mouse-2] #'mouse-split-window-vertically)
+(global-set-key [horizontal-scroll-bar C-mouse-2] #'mouse-split-window-horizontally)
+(global-set-key [vertical-line down-mouse-1] #'mouse-drag-vertical-line)
+(global-set-key [vertical-line mouse-1] #'mouse-select-window)
+(global-set-key [vertical-line C-mouse-2] #'mouse-split-window-vertically)
+(global-set-key [right-divider down-mouse-1] #'mouse-drag-vertical-line)
+(global-set-key [right-divider mouse-1] #'ignore)
+(global-set-key [right-divider C-mouse-2] #'mouse-split-window-vertically)
+(global-set-key [bottom-divider down-mouse-1] #'mouse-drag-mode-line)
+(global-set-key [bottom-divider mouse-1] #'ignore)
+(global-set-key [bottom-divider C-mouse-2] #'mouse-split-window-horizontally)
+(global-set-key [left-edge down-mouse-1] #'mouse-drag-left-edge)
+(global-set-key [left-edge mouse-1] #'ignore)
+(global-set-key [top-left-corner down-mouse-1] #'mouse-drag-top-left-corner)
+(global-set-key [top-left-corner mouse-1] #'ignore)
+(global-set-key [top-edge down-mouse-1] #'mouse-drag-top-edge)
+(global-set-key [top-edge mouse-1] #'ignore)
+(global-set-key [top-right-corner down-mouse-1] #'mouse-drag-top-right-corner)
+(global-set-key [top-right-corner mouse-1] #'ignore)
+(global-set-key [right-edge down-mouse-1] #'mouse-drag-right-edge)
+(global-set-key [right-edge mouse-1] #'ignore)
+(global-set-key [bottom-right-corner down-mouse-1] #'mouse-drag-bottom-right-corner)
+(global-set-key [bottom-right-corner mouse-1] #'ignore)
+(global-set-key [bottom-edge down-mouse-1] #'mouse-drag-bottom-edge)
+(global-set-key [bottom-edge mouse-1] #'ignore)
+(global-set-key [bottom-left-corner down-mouse-1] #'mouse-drag-bottom-left-corner)
+(global-set-key [bottom-left-corner mouse-1] #'ignore)
(provide 'mouse)
diff --git a/lisp/msb.el b/lisp/msb.el
index 6e1d03ac277..6843df2edcf 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -103,7 +103,7 @@
((eq major-mode 'Man-mode)
4090
"Manuals (%d)")
- ((eq major-mode 'w3-mode)
+ ((eq major-mode 'eww-mode)
4020
"WWW (%d)")
((or (memq major-mode
@@ -154,7 +154,7 @@
((eq major-mode 'Man-mode)
5030
"Manuals (%d)")
- ((eq major-mode 'w3-mode)
+ ((eq major-mode 'eww-mode)
5020
"WWW (%d)")
((or (memq major-mode
@@ -299,7 +299,7 @@ If the value is not a number, then the value 10 is used."
(defcustom msb-display-most-recently-used 15
"How many buffers should be in the most-recently-used menu.
No buffers at all if less than 1 or nil (or any non-number)."
- :type 'integer
+ :type 'natnum
:set #'msb-custom-set)
(defcustom msb-most-recently-used-title "Most recently used (%d)"
@@ -353,9 +353,6 @@ This is instead of the groups in `msb-menu-cond'."
:type 'boolean
:set #'msb-custom-set)
-(define-obsolete-variable-alias 'msb-after-load-hooks
- 'msb-after-load-hook "24.1")
-
(defcustom msb-after-load-hook nil
"Hook run after the msb package has been loaded."
:type 'hook
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 4a620443f31..ba5255fc076 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,6 +1,7 @@
;;; mwheel.el --- Mouse wheel support -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2000-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2022 Free Software Foundation, Inc.
+
;; Keywords: mouse
;; Package: emacs
@@ -22,7 +23,7 @@
;;; Commentary:
;; This enables the use of the mouse wheel (or scroll wheel) in Emacs.
-;; Under X11/X.Org, the wheel events are sent as button4/button5
+;; Under X11/X.Org, the wheel events are sent as mouse-4/mouse-5
;; events.
;; Mouse wheel support is already enabled by default on most graphical
@@ -32,7 +33,7 @@
;; Implementation note:
;;
-;; I for one would prefer some way of converting the button4/button5
+;; I for one would prefer some way of converting the mouse-4/mouse-5
;; events into different event types, like 'mwheel-up' or
;; 'mwheel-down', but I cannot find a way to do this very easily (or
;; portably), so for now I just live with it.
@@ -40,6 +41,7 @@
(require 'timer)
(defvar mouse-wheel-mode)
+
(defvar mouse-wheel--installed-bindings-alist nil
"Alist of all installed mouse wheel key bindings.")
@@ -55,7 +57,8 @@
(mouse-wheel-mode 1)))
(defcustom mouse-wheel-down-event
- (if (or (featurep 'w32-win) (featurep 'ns-win))
+ (if (or (featurep 'w32-win) (featurep 'ns-win)
+ (featurep 'haiku-win) (featurep 'pgtk-win))
'wheel-up
'mouse-4)
"Event used for scrolling down."
@@ -63,8 +66,20 @@
:type 'symbol
:set 'mouse-wheel-change-button)
+(defcustom mouse-wheel-down-alternate-event
+ (if (featurep 'xinput2)
+ 'wheel-up
+ (unless (featurep 'x)
+ 'mouse-4))
+ "Alternative wheel down event to consider."
+ :group 'mouse
+ :type 'symbol
+ :version "29.1"
+ :set 'mouse-wheel-change-button)
+
(defcustom mouse-wheel-up-event
- (if (or (featurep 'w32-win) (featurep 'ns-win))
+ (if (or (featurep 'w32-win) (featurep 'ns-win)
+ (featurep 'haiku-win) (featurep 'pgtk-win))
'wheel-down
'mouse-5)
"Event used for scrolling up."
@@ -72,6 +87,17 @@
:type 'symbol
:set 'mouse-wheel-change-button)
+(defcustom mouse-wheel-up-alternate-event
+ (if (featurep 'xinput2)
+ 'wheel-down
+ (unless (featurep 'x)
+ 'mouse-5))
+ "Alternative wheel up event to consider."
+ :group 'mouse
+ :type 'symbol
+ :version "29.1"
+ :set 'mouse-wheel-change-button)
+
(defcustom mouse-wheel-click-event 'mouse-2
"Event that should be temporarily inhibited after mouse scrolling.
The mouse wheel is typically on the mouse-2 button, so it may easily
@@ -88,7 +114,10 @@ set to the event sent when clicking on the mouse wheel button."
:type 'number)
(defcustom mouse-wheel-scroll-amount
- '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale))
+ '(1 ((shift) . hscroll)
+ ((meta) . nil)
+ ((control meta) . global-text-scale)
+ ((control) . text-scale))
"Amount to scroll windows by when spinning the mouse wheel.
This is an alist mapping the modifier key to the amount to scroll when
the wheel is moved with the modifier key depressed.
@@ -100,12 +129,14 @@ screen. It can also be a floating point number, specifying the fraction of
a full screen to scroll. A near full screen is `next-screen-context-lines'
less than a full screen.
-If AMOUNT is the symbol 'hscroll', this means that with MODIFIER,
+If AMOUNT is the symbol `hscroll', this means that with MODIFIER,
the mouse wheel will scroll horizontally instead of vertically.
-If AMOUNT is the symbol 'text-scale', this means that with
-MODIFIER, the mouse wheel will change the face height instead of
-scrolling."
+If AMOUNT is the symbol `text-scale' or `global-text-scale', this
+means that with MODIFIER, the mouse wheel will change the font size
+instead of scrolling (by adjusting the font height of the default
+face, either locally in the buffer or globally). For more
+information, see `text-scale-adjust' and `global-text-scale-adjust'."
:group 'mouse
:type '(cons
(choice :tag "Normal"
@@ -130,7 +161,8 @@ scrolling."
(integer :tag "Scroll specific # of lines")
(float :tag "Scroll fraction of window")
(const :tag "Scroll horizontally" :value hscroll)
- (const :tag "Change face size" :value text-scale)))))
+ (const :tag "Change buffer face size" :value text-scale)
+ (const :tag "Change global face size" :value global-text-scale)))))
:set 'mouse-wheel-change-button
:version "28.1")
@@ -221,17 +253,33 @@ Also see `mouse-wheel-tilt-scroll'."
"Function that does the job of scrolling right.")
(defvar mouse-wheel-left-event
- (if (or (featurep 'w32-win) (featurep 'ns-win))
+ (if (or (featurep 'w32-win) (featurep 'ns-win)
+ (featurep 'haiku-win) (featurep 'pgtk-win))
'wheel-left
'mouse-6)
"Event used for scrolling left.")
+(defvar mouse-wheel-left-alternate-event
+ (if (featurep 'xinput2)
+ 'wheel-left
+ (unless (featurep 'x)
+ 'mouse-6))
+ "Alternative wheel left event to consider.")
+
(defvar mouse-wheel-right-event
- (if (or (featurep 'w32-win) (featurep 'ns-win))
+ (if (or (featurep 'w32-win) (featurep 'ns-win)
+ (featurep 'haiku-win) (featurep 'pgtk-win))
'wheel-right
'mouse-7)
"Event used for scrolling right.")
+(defvar mouse-wheel-right-alternate-event
+ (if (featurep 'xinput2)
+ 'wheel-right
+ (unless (featurep 'x)
+ 'mouse-7))
+ "Alternative wheel right event to consider.")
+
(defun mouse-wheel--get-scroll-window (event)
"Return window for mouse wheel event EVENT.
If `mouse-wheel-follow-mouse' is non-nil, return the window that
@@ -296,14 +344,16 @@ value of ARG, and the command uses it in subsequent scrolls."
(condition-case nil
(unwind-protect
(let ((button (mwheel-event-button event)))
- (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event))
+ (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event
+ mouse-wheel-down-alternate-event)))
(when (and (natnump arg) (> arg 0))
(setq mouse-wheel-scroll-amount-horizontal arg))
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-left-function
mwheel-scroll-right-function)
mouse-wheel-scroll-amount-horizontal))
- ((eq button mouse-wheel-down-event)
+ ((memq button (list mouse-wheel-down-event
+ mouse-wheel-down-alternate-event))
(condition-case nil (funcall mwheel-scroll-down-function amt)
;; Make sure we do indeed scroll to the beginning of
;; the buffer.
@@ -318,23 +368,27 @@ value of ARG, and the command uses it in subsequent scrolls."
;; for a reason that escapes me. This problem seems
;; to only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
- ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event))
+ ((and (eq amt 'hscroll) (memq button (list mouse-wheel-up-event
+ mouse-wheel-up-alternate-event)))
(when (and (natnump arg) (> arg 0))
(setq mouse-wheel-scroll-amount-horizontal arg))
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-right-function
mwheel-scroll-left-function)
mouse-wheel-scroll-amount-horizontal))
- ((eq button mouse-wheel-up-event)
+ ((memq button (list mouse-wheel-up-event
+ mouse-wheel-up-alternate-event))
(condition-case nil (funcall mwheel-scroll-up-function amt)
;; Make sure we do indeed scroll to the end of the buffer.
(end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
- ((eq button mouse-wheel-left-event) ; for tilt scroll
+ ((memq button (list mouse-wheel-left-event
+ mouse-wheel-left-alternate-event)) ; for tilt scroll
(when mouse-wheel-tilt-scroll
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-right-function
mwheel-scroll-left-function) amt)))
- ((eq button mouse-wheel-right-event) ; for tilt scroll
+ ((memq button (list mouse-wheel-right-event
+ mouse-wheel-right-alternate-event)) ; for tilt scroll
(when mouse-wheel-tilt-scroll
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-left-function
@@ -371,19 +425,36 @@ value of ARG, and the command uses it in subsequent scrolls."
(put 'mwheel-scroll 'scroll-command t)
(defun mouse-wheel-text-scale (event)
- "Increase or decrease the height of the default face according to the EVENT."
+ "Adjust font size of the default face according to EVENT.
+See also `text-scale-adjust'."
(interactive (list last-input-event))
(let ((selected-window (selected-window))
(scroll-window (mouse-wheel--get-scroll-window event))
(button (mwheel-event-button event)))
(select-window scroll-window 'mark-for-redisplay)
(unwind-protect
- (cond ((eq button mouse-wheel-down-event)
+ (cond ((memq button (list mouse-wheel-down-event
+ mouse-wheel-down-alternate-event))
(text-scale-increase 1))
- ((eq button mouse-wheel-up-event)
+ ((memq button (list mouse-wheel-up-event
+ mouse-wheel-up-alternate-event))
(text-scale-decrease 1)))
(select-window selected-window))))
+(declare-function global-text-scale-adjust "face-remap.el" (increment))
+(defun mouse-wheel-global-text-scale (event)
+ "Increase or decrease the global font size according to the EVENT.
+This invokes `global-text-scale-adjust', which see."
+ (interactive (list last-input-event))
+ (let ((button (mwheel-event-button event)))
+ (unwind-protect
+ (cond ((memq button (list mouse-wheel-down-event
+ mouse-wheel-down-alternate-event))
+ (global-text-scale-adjust 1))
+ ((memq button (list mouse-wheel-up-event
+ mouse-wheel-up-alternate-event))
+ (global-text-scale-adjust -1))))))
+
(defun mouse-wheel--add-binding (key fun)
"Bind mouse wheel button KEY to function FUN.
Save it for later removal by `mouse-wheel--remove-bindings'."
@@ -432,15 +503,30 @@ an event used for scrolling, such as `mouse-wheel-down-event'."
(cond
;; Bindings for changing font size.
((and (consp binding) (eq (cdr binding) 'text-scale))
- (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
- (mouse-wheel--add-binding `[,(list (caar binding) event)]
- 'mouse-wheel-text-scale)))
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-down-alternate-event
+ mouse-wheel-up-alternate-event))
+ (when event
+ (mouse-wheel--add-binding `[,(append (car binding) (list event))]
+ 'mouse-wheel-text-scale))))
+ ((and (consp binding) (eq (cdr binding) 'global-text-scale))
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-down-alternate-event
+ mouse-wheel-up-alternate-event))
+ (when event
+ (mouse-wheel--add-binding `[,(append (car binding) (list event))]
+ 'mouse-wheel-global-text-scale))))
;; Bindings for scrolling.
(t
(dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-left-event mouse-wheel-right-event))
- (dolist (key (mouse-wheel--create-scroll-keys binding event))
- (mouse-wheel--add-binding key 'mwheel-scroll)))))))
+ mouse-wheel-left-event mouse-wheel-right-event
+ mouse-wheel-down-alternate-event
+ mouse-wheel-up-alternate-event
+ mouse-wheel-left-alternate-event
+ mouse-wheel-right-alternate-event))
+ (when event
+ (dolist (key (mouse-wheel--create-scroll-keys binding event))
+ (mouse-wheel--add-binding key 'mwheel-scroll))))))))
(when mouse-wheel-mode
(mouse-wheel--setup-bindings))
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 4d97dbcc96a..9937c022d9f 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1230,8 +1230,9 @@ only return the directory part of FILE."
;; found another machine with the same user.
;; Try that account.
(read-passwd
- (format "passwd for %s@%s (default same as %s@%s): "
- user host user other)
+ (format-prompt "passwd for %s@%s"
+ (format "same as %s@%s" user other)
+ user host)
nil
(ange-ftp-lookup-passwd other user))
@@ -2546,13 +2547,16 @@ can parse the output from a DIR listing for a host of type TYPE.")
(defvar ange-ftp-after-parse-ls-hook nil
"Normal hook run after parsing the text of an FTP directory listing.")
+(declare-function ls-lisp--sanitize-switches "ls-lisp" (switches))
+
(defun ange-ftp-ls (file lsargs parse &optional no-error wildcard)
"Return the output of a `DIR' or `ls' command done over FTP.
FILE is the full name of the remote file, LSARGS is any args to pass to the
`ls' command, and PARSE specifies that the output should be parsed and stored
away in the internal cache."
- (while (string-match "^--dired\\s-+" lsargs)
- (setq lsargs (replace-match "" nil t lsargs)))
+ (while (string-match "--" lsargs)
+ (require 'ls-lisp)
+ (setq lsargs (ls-lisp--sanitize-switches lsargs)))
;; If parse is t, we assume that file is a directory. i.e. we only parse
;; full directory listings.
(let* ((ange-ftp-this-file (ange-ftp-expand-file-name file))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index ccfbf51e48c..a55aec76bfc 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1,4 +1,4 @@
-;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*-
+;;; browse-url.el --- pass a URL to a web browser -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2022 Free Software Foundation, Inc.
@@ -24,23 +24,28 @@
;;; Commentary:
-;; This package provides functions which read a URL (Uniform Resource
-;; Locator) from the minibuffer, defaulting to the URL around point,
-;; and ask a World-Wide Web browser to load it. It can also load the
-;; URL associated with the current buffer. Different browsers use
-;; different methods of remote control so there is one function for
-;; each supported browser. If the chosen browser is not running, it
-;; is started. Currently there is support for the following browsers,
-;; as well as some other obsolete ones:
+;; This package provides functions which read a URL from the
+;; minibuffer, defaulting to the URL around point, and ask a web
+;; browser to load it. It can also load the URL at point, or one
+;; associated with the current buffer. The main functions are:
+
+;; `browse-url' Open URL
+;; `browse-url-at-point' Open URL at point
+;; `browse-url-of-buffer' Use web browser to display buffer
+;; `browse-url-of-file' Use web browser to display file
+
+;; Different browsers use different methods of remote control so there
+;; is one function for each supported browser. If the chosen browser
+;; is not running, it is started. Currently there is support for the
+;; following browsers, as well as some other obsolete ones:
;; Function Browser Earliest version
-;; browse-url-mozilla Mozilla Don't know
;; browse-url-firefox Firefox Don't know (tried with 1.0.1)
;; browse-url-chrome Chrome 47.0.2526.111
;; browse-url-chromium Chromium 3.0
;; browse-url-epiphany GNOME Web (Epiphany) Don't know
-;; browse-url-w3 w3 0
-;; browse-url-text-* Any text browser 0
+;; browse-url-webpositive WebPositive 1.2-alpha (Haiku R1/beta3)
+;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
;; browse-url-default-windows-browser MS-Windows browser
;; browse-url-default-macosx-browser macOS browser
@@ -49,14 +54,12 @@
;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT)
;; eww-browse-url Emacs Web Wowser
-;; Browsers can cache Web pages so it may be necessary to tell them to
+;; Browsers can cache web pages so it may be necessary to tell them to
;; reload the current page if it has changed (e.g., if you have edited
;; it). There is currently no perfect automatic solution to this.
-;; This package generalizes function html-previewer-process in Marc
-;; Andreessen's html-mode (LCD modes/html-mode.el.Z). See also the
-;; ffap.el package. The huge hyperbole package also contains similar
-;; functions.
+;; See also the ffap.el package. The huge hyperbole package also
+;; contains similar functions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Usage
@@ -82,34 +85,34 @@
;; M-x browse-url-of-dired-file RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Customization (~/.emacs)
+;; Customization (Init File)
;; To see what variables are available for customization, type
;; `M-x set-variable browse-url TAB'. Better, use
;; `M-x customize-group browse-url'.
-;; Bind the browse-url commands to keys with the `C-c C-z' prefix
-;; (as used by html-helper-mode):
-;; (global-set-key "\C-c\C-z." 'browse-url-at-point)
-;; (global-set-key "\C-c\C-zb" 'browse-url-of-buffer)
-;; (global-set-key "\C-c\C-zr" 'browse-url-of-region)
-;; (global-set-key "\C-c\C-zu" 'browse-url)
-;; (global-set-key "\C-c\C-zv" 'browse-url-of-file)
+;; Bind the browse-url commands to keys with the `C-c C-z' prefix:
+
+;; (keymap-global-set "C-c C-z ." 'browse-url-at-point)
+;; (keymap-global-set "C-c C-z b" 'browse-url-of-buffer)
+;; (keymap-global-set "C-c C-z r" 'browse-url-of-region)
+;; (keymap-global-set "C-c C-z u" 'browse-url)
+;; (keymap-global-set "C-c C-z v" 'browse-url-of-file)
;; (add-hook 'dired-mode-hook
;; (lambda ()
-;; (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file)))
+;; (keymap-local-set "C-c C-z f" 'browse-url-of-dired-file)))
;; Browse URLs in mail messages under RMAIL by clicking mouse-2:
;; (add-hook 'rmail-mode-hook (lambda () ; rmail-mode startup
-;; (define-key rmail-mode-map [mouse-2] 'browse-url-at-mouse)))
+;; (keymap-set rmail-mode-map [mouse-2] 'browse-url-at-mouse)))
;; Alternatively, add `goto-address' to `rmail-show-message-hook'.
;; Gnus provides a standard feature to activate URLs in article
;; buffers for invocation of browse-url.
-;; Use the Emacs w3 browser when not running under X11:
+;; Use the Emacs Web Wowser (EWW) when not running under X11:
;; (or (eq window-system 'x)
-;; (setq browse-url-browser-function 'browse-url-w3))
+;; (setq browse-url-browser-function #'eww-browse-url))
;; To always save modified buffers before displaying the file in a browser:
;; (setq browse-url-save-file t)
@@ -148,14 +151,14 @@
:group 'comm)
(defvar browse-url--browser-defcustom-type
- '(choice
- (function-item :tag "Emacs W3" :value browse-url-w3)
- (function-item :tag "eww" :value eww-browse-url)
- (function-item :tag "Mozilla" :value browse-url-mozilla)
+ `(choice
+ (function-item :tag "Emacs Web Wowser (EWW)" :value eww-browse-url)
(function-item :tag "Firefox" :value browse-url-firefox)
(function-item :tag "Google Chrome" :value browse-url-chrome)
(function-item :tag "Chromium" :value browse-url-chromium)
(function-item :tag "GNOME Web (Epiphany)" :value browse-url-epiphany)
+ ,@(when (eq system-type 'haiku)
+ (list '(function-item :tag "WebPositive" :value browse-url-webpositive)))
(function-item :tag "Text browser in an xterm window"
:value browse-url-text-xterm)
(function-item :tag "Text browser in an Emacs window"
@@ -163,11 +166,13 @@
(function-item :tag "KDE" :value browse-url-kde)
(function-item :tag "Elinks" :value browse-url-elinks)
(function-item :tag "Specified by `Browse Url Generic Program'"
- :value browse-url-generic)
- (function-item :tag "Default Windows browser"
- :value browse-url-default-windows-browser)
- (function-item :tag "Default macOS browser"
- :value browse-url-default-macosx-browser)
+ :value browse-url-generic)
+ ,@(when (eq system-type 'windows-nt)
+ (list '(function-item :tag "Default Windows browser"
+ :value browse-url-default-windows-browser)))
+ ,@(when (eq system-type 'darwin)
+ (list '(function-item :tag "Default macOS browser"
+ :value browse-url-default-macosx-browser)))
(function-item :tag "Default browser"
:value browse-url-default-browser)
(function :tag "Your own function")
@@ -219,7 +224,7 @@ be used instead."
(defcustom browse-url-button-regexp
(concat
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
+ "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|"
"nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
"\\(//[-a-z0-9_.]+:[0-9]*\\)?"
(let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
@@ -238,33 +243,6 @@ be used instead."
:version "27.1"
:type 'regexp)
-(defcustom browse-url-netscape-program "netscape"
- ;; Info about netscape-remote from Karl Berry.
- "The name by which to invoke Netscape.
-
-The free program `netscape-remote' from
-<URL:http://home.netscape.com/newsref/std/remote.c> is said to start
-up very much quicker than `netscape'. Reported to compile on a GNU
-system, given vroot.h from the same directory, with cc flags
- -DSTANDALONE -L/usr/X11R6/lib -lXmu -lX11."
- :type 'string)
-
-(make-obsolete-variable 'browse-url-netscape-program nil "25.1")
-
-(defcustom browse-url-netscape-arguments nil
- "A list of strings to pass to Netscape as arguments."
- :type '(repeat (string :tag "Argument")))
-
-(make-obsolete-variable 'browse-url-netscape-arguments nil "25.1")
-
-(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
- "A list of strings to pass to Netscape when it starts up.
-Defaults to the value of `browse-url-netscape-arguments' at the time
-`browse-url' is loaded."
- :type '(repeat (string :tag "Argument")))
-
-(make-obsolete-variable 'browse-url-netscape-startup-arguments nil "25.1")
-
(defcustom browse-url-browser-display nil
"The X display for running the browser, if not same as Emacs's."
:type '(choice string (const :tag "Default" nil)))
@@ -272,22 +250,27 @@ Defaults to the value of `browse-url-netscape-arguments' at the time
(defcustom browse-url-mozilla-program "mozilla"
"The name by which to invoke Mozilla."
:type 'string)
+(make-obsolete-variable 'browse-url-mozilla-program nil "29.1")
(defcustom browse-url-mozilla-arguments nil
"A list of strings to pass to Mozilla as arguments."
:type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'browse-url-mozilla-arguments nil "29.1")
(defcustom browse-url-mozilla-startup-arguments browse-url-mozilla-arguments
"A list of strings to pass to Mozilla when it starts up.
Defaults to the value of `browse-url-mozilla-arguments' at the time
`browse-url' is loaded."
:type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'browse-url-mozilla-startup-arguments nil "29.1")
+
+(defun browse-url--find-executable (candidates default)
+ (while (and candidates (not (executable-find (car candidates))))
+ (setq candidates (cdr candidates)))
+ (or (car candidates) default))
(defcustom browse-url-firefox-program
- (let ((candidates '("icecat" "iceweasel" "firefox")))
- (while (and candidates (not (executable-find (car candidates))))
- (setq candidates (cdr candidates)))
- (or (car candidates) "firefox"))
+ (browse-url--find-executable '("icecat" "iceweasel") "firefox")
"The name by which to invoke Firefox or a variant of it."
:type 'string)
@@ -305,10 +288,8 @@ Defaults to the value of `browse-url-firefox-arguments' at the time
"it no longer has any effect." "24.5")
(defcustom browse-url-chrome-program
- (let ((candidates '("google-chrome-stable" "google-chrome")))
- (while (and candidates (not (executable-find (car candidates))))
- (setq candidates (cdr candidates)))
- (or (car candidates) "chromium"))
+ (browse-url--find-executable '("google-chrome-stable" "google-chrome")
+ "chromium")
"The name by which to invoke the Chrome browser."
:type 'string
:version "25.1")
@@ -319,10 +300,7 @@ Defaults to the value of `browse-url-firefox-arguments' at the time
:version "25.1")
(defcustom browse-url-chromium-program
- (let ((candidates '("chromium" "chromium-browser")))
- (while (and candidates (not (executable-find (car candidates))))
- (setq candidates (cdr candidates)))
- (or (car candidates) "chromium"))
+ (browse-url--find-executable '("chromium" "chromium-browser") "chromium")
"The name by which to invoke Chromium."
:type 'string
:version "24.1")
@@ -332,26 +310,6 @@ Defaults to the value of `browse-url-firefox-arguments' at the time
:type '(repeat (string :tag "Argument"))
:version "24.1")
-(defcustom browse-url-galeon-program "galeon"
- "The name by which to invoke Galeon."
- :type 'string)
-
-(make-obsolete-variable 'browse-url-galeon-program nil "25.1")
-
-(defcustom browse-url-galeon-arguments nil
- "A list of strings to pass to Galeon as arguments."
- :type '(repeat (string :tag "Argument")))
-
-(make-obsolete-variable 'browse-url-galeon-arguments nil "25.1")
-
-(defcustom browse-url-galeon-startup-arguments browse-url-galeon-arguments
- "A list of strings to pass to Galeon when it starts up.
-Defaults to the value of `browse-url-galeon-arguments' at the time
-`browse-url' is loaded."
- :type '(repeat (string :tag "Argument")))
-
-(make-obsolete-variable 'browse-url-galeon-startup-arguments nil "25.1")
-
(defcustom browse-url-epiphany-program "epiphany"
"The name by which to invoke GNOME Web (Epiphany)."
:type 'string)
@@ -366,7 +324,12 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time
`browse-url' is loaded."
:type '(repeat (string :tag "Argument")))
-;; GNOME means of invoking either Mozilla or Netscape.
+(defcustom browse-url-webpositive-program "WebPositive"
+ "The name by which to invoke WebPositive."
+ :type 'string
+ :version "29.1")
+
+;; GNOME means of invoking Mozilla.
(defvar browse-url-gnome-moz-program "gnome-moz-remote")
(make-obsolete-variable 'browse-url-gnome-moz-program nil "25.1")
@@ -383,6 +346,7 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-mozilla' is asked to open it in a new window."
:type 'boolean)
+(make-obsolete-variable 'browse-url-mozilla-new-window-is-tab nil "29.1")
(defcustom browse-url-firefox-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
@@ -399,29 +363,12 @@ If non-nil, then open the URL in a new buffer rather than a new window if
(make-obsolete-variable 'browse-url-conkeror-new-window-is-buffer nil "28.1")
-(defcustom browse-url-galeon-new-window-is-tab nil
- "Whether to open up new windows in a tab or a new window.
-If non-nil, then open the URL in a new tab rather than a new window if
-`browse-url-galeon' is asked to open it in a new window."
- :type 'boolean)
-
-(make-obsolete-variable 'browse-url-galeon-new-window-is-tab nil "25.1")
-
(defcustom browse-url-epiphany-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-epiphany' is asked to open it in a new window."
:type 'boolean)
-(defcustom browse-url-netscape-new-window-is-tab nil
- "Whether to open up new windows in a tab or a new window.
-If non-nil, then open the URL in a new tab rather than a new
-window if `browse-url-netscape' is asked to open it in a new
-window."
- :type 'boolean)
-
-(make-obsolete-variable 'browse-url-netscape-new-window-is-tab nil "25.1")
-
(defcustom browse-url-new-window-flag nil
"Non-nil means always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
@@ -464,7 +411,7 @@ address to an HTTP URL:
(setq browse-url-filename-alist
\\='((\"/webmaster@webserver:/home/www/html/\" .
- \"http://www.acme.co.uk/\")
+ \"https://www.example.org/\")
(\"^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*\" . \"ftp://\\2/\")
(\"^/\\([^:@/]+@\\)?\\([^:/]+\\):/*\" . \"ftp://\\1\\2/\")
(\"^/+\" . \"file:/\")))"
@@ -497,11 +444,13 @@ These might set its size, for instance."
(defcustom browse-url-gnudoit-program "gnudoit"
"The name of the `gnudoit' program used by `browse-url-w3-gnudoit'."
:type 'string)
+(make-obsolete-variable 'browse-url-gnudoit-program nil "29.1")
(defcustom browse-url-gnudoit-args '("-q")
"A list of strings defining options for `browse-url-gnudoit-program'.
These might set the port, for instance."
:type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'browse-url-gnudoit-args nil "29.1")
(defcustom browse-url-generic-program nil
"The name of the browser program used by `browse-url-generic'."
@@ -518,14 +467,6 @@ You might want to set this to somewhere with restricted read permissions
for privacy's sake."
:type 'string)
-(defcustom browse-url-netscape-version 3
- "The version of Netscape you are using.
-This affects how URL reloading is done; the mechanism changed
-incompatibly at version 4."
- :type 'number)
-
-(make-obsolete-variable 'browse-url-netscape-version nil "25.1")
-
(defcustom browse-url-text-browser "lynx"
"The name of the text browser to invoke."
:type 'string
@@ -703,18 +644,32 @@ CHARS is a regexp that matches a character."
The annoying characters are those that can mislead a web browser
regarding its parameter treatment."
;; FIXME: Is there an actual example of a web browser getting
- ;; confused? (This used to encode commas, but at least Firefox
- ;; handles commas correctly and doesn't accept encoded commas.)
- (browse-url-url-encode-chars url "[\"()$ ]"))
+ ;; confused? (This used to encode commas and dollar signs, but at
+ ;; least Firefox handles commas correctly and doesn't accept those
+ ;; encoded.)
+ (browse-url-url-encode-chars url "[\"() ]"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input
+(defcustom browse-url-default-scheme "http"
+ "URL scheme that `browse-url' (and related commands) will use by default.
+
+For example, when point is on an URL fragment like
+\"www.example.org\", `browse-url' will assume that this is an
+\"http\" URL by default (i.e. \"http://www.example.org\").
+
+Note that if you set this to \"https\", websites that do not yet
+support HTTPS may not load correctly in your web browser. Such
+websites are increasingly rare, but they do still exist."
+ :type 'string
+ :version "29.1")
+
(defun browse-url-url-at-point ()
(or (thing-at-point 'url t)
;; assume that the user is pointing at something like gnu.org/gnu
(let ((f (thing-at-point 'filename t)))
- (and f (concat "http://" f)))))
+ (and f (concat browse-url-default-scheme "://" f)))))
;; Having this as a separate function called by the browser-specific
;; functions allows them to be stand-alone commands, making it easier
@@ -769,21 +724,45 @@ interactively. Turn the filename into a URL with function
(cond ((not (buffer-modified-p)))
(browse-url-save-file (save-buffer))
(t (message "%s modified since last save" file))))))
- (when (file-remote-p file)
- (setq file (file-local-copy file)))
+ (when (and (file-remote-p file)
+ (not browse-url-temp-file-name))
+ (setq browse-url-temp-file-name (file-local-copy file)
+ file browse-url-temp-file-name))
(browse-url (browse-url-file-url file))
(run-hooks 'browse-url-of-file-hook))
+(defun browse-url--file-name-coding-system ()
+ (if (equal system-type 'windows-nt)
+ ;; W32 pretends that file names are UTF-8 encoded.
+ 'utf-8
+ (or file-name-coding-system default-file-name-coding-system)))
+
(defun browse-url-file-url (file)
"Return the URL corresponding to FILE.
Use variable `browse-url-filename-alist' to map filenames to URLs."
- (let ((coding (if (equal system-type 'windows-nt)
- ;; W32 pretends that file names are UTF-8 encoded.
- 'utf-8
- (and (or file-name-coding-system
- default-file-name-coding-system)))))
- (if coding (setq file (encode-coding-string file coding))))
- (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]"))
+ (when-let ((coding (browse-url--file-name-coding-system)))
+ (setq file (encode-coding-string file coding)))
+ (if (and (file-remote-p file)
+ ;; We're applying special rules for FTP URLs for historical
+ ;; reasons.
+ (seq-find (lambda (match)
+ (and (string-match-p (car match) file)
+ (not (string-match "\\`file:" (cdr match)))))
+ browse-url-filename-alist))
+ (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]"))
+ ;; Encode all other file names properly.
+ (let ((bits (file-name-split file)))
+ (setq file
+ (string-join
+ ;; On Windows, the first bit here might be "c:" or the
+ ;; like, so don't encode the ":" in the first bit.
+ (cons (let ((url-unreserved-chars
+ (if (file-name-absolute-p file)
+ (cons ?: url-unreserved-chars)
+ url-unreserved-chars)))
+ (url-hexify-string (car bits)))
+ (mapcar #'url-hexify-string (cdr bits)))
+ "/"))))
(dolist (map browse-url-filename-alist)
(when (and map (string-match (car map) file))
(setq file (replace-match (cdr map) t nil file))))
@@ -858,6 +837,8 @@ See `browse-url' for details."
;; A generic command to call the current browse-url-browser-function
+(declare-function pgtk-backend-display-class "pgtkfns.c" (&optional terminal))
+
;;;###autoload
(defun browse-url (url &rest args)
"Open URL using a configurable method.
@@ -895,8 +876,21 @@ If ARGS are omitted, the default is to pass
;; When connected to various displays, be careful to use the display of
;; the currently selected frame, rather than the original start display,
;; which may not even exist any more.
- (if (stringp (frame-parameter nil 'display))
- (setenv "DISPLAY" (frame-parameter nil 'display)))
+ (let ((dpy (frame-parameter nil 'display))
+ classname)
+ (if (stringp dpy)
+ (cond
+ ((featurep 'pgtk)
+ (setq classname (pgtk-backend-display-class))
+ (if (equal classname "GdkWaylandDisplay")
+ (progn
+ ;; The `display' frame parameter is probably wrong.
+ ;; See bug#53969 for some context.
+ ;; (setenv "WAYLAND_DISPLAY" dpy)
+ )
+ (setenv "DISPLAY" dpy)))
+ (t
+ (setenv "DISPLAY" dpy)))))
(if (functionp function)
(apply function url args)
(error "No suitable browser for URL %s" url))))
@@ -1005,8 +999,6 @@ The optional NEW-WINDOW argument is not used."
(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind
'external)
-;; --- Netscape ---
-
(defun browse-url-process-environment ()
"Set DISPLAY in the environment to the X display the browser will use.
This is either the value of variable `browse-url-browser-display' if
@@ -1014,7 +1006,13 @@ non-nil, or the same display as Emacs if different from the current
environment, otherwise just use the current environment."
(let ((display (or browse-url-browser-display (browse-url-emacs-display))))
(if display
- (cons (concat "DISPLAY=" display) process-environment)
+ (cons (concat (if (and (eq window-system 'pgtk)
+ (equal (pgtk-backend-display-class)
+ "GdkWaylandDisplay"))
+ "WAYLAND_DISPLAY="
+ "DISPLAY=")
+ display)
+ process-environment)
process-environment)))
(defun browse-url-emacs-display ()
@@ -1044,23 +1042,21 @@ instead of `browse-url-new-window-flag'."
'browse-url-default-windows-browser)
((memq system-type '(darwin))
'browse-url-default-macosx-browser)
+ ((featurep 'haiku)
+ 'browse-url-default-haiku-browser)
((browse-url-can-use-xdg-open) 'browse-url-xdg-open)
;;; ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
- ((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
((executable-find browse-url-firefox-program) 'browse-url-firefox)
((executable-find browse-url-chromium-program) 'browse-url-chromium)
-;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon)
((executable-find browse-url-kde-program) 'browse-url-kde)
-;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape)
((executable-find browse-url-chrome-program) 'browse-url-chrome)
+ ((executable-find browse-url-webpositive-program) 'browse-url-webpositive)
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
- ((locate-library "w3") 'browse-url-w3)
- (t
- (lambda (&rest _ignore) (error "No usable browser found"))))
+ (t #'eww-browse-url))
url args))
(function-put 'browse-url-default-browser 'browse-url-browser-kind
- ;; Well, most probably external if we ignore w3.
+ ;; Well, most probably external if we ignore EWW.
'external)
(defun browse-url-can-use-xdg-open ()
@@ -1085,82 +1081,6 @@ The optional argument IGNORED is not used."
(function-put 'browse-url-xdg-open 'browse-url-browser-kind 'external)
;;;###autoload
-(defun browse-url-netscape (url &optional new-window)
- "Ask the Netscape WWW browser to load URL.
-Default to the URL around or before point. The strings in variable
-`browse-url-netscape-arguments' are also passed to Netscape.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Netscape window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-netscape-new-window-is-tab' is non-nil, then
-whenever a document would otherwise be loaded in a new window, it
-is loaded in a new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
- (declare (obsolete nil "25.1"))
- (interactive (browse-url-interactive-arg "URL: "))
- (setq url (browse-url-encode-url url))
- (let* ((process-environment (browse-url-process-environment))
- (process
- (apply #'start-process
- (concat "netscape " url) nil
- browse-url-netscape-program
- (append
- browse-url-netscape-arguments
- (if (eq window-system 'w32)
- (list url)
- (append
- (if new-window '("-noraise"))
- (list "-remote"
- (concat "openURL(" url
- (if (browse-url-maybe-new-window
- new-window)
- (if browse-url-netscape-new-window-is-tab
- ",new-tab"
- ",new-window"))
- ")"))))))))
- (set-process-sentinel process
- (lambda (process _change)
- (browse-url-netscape-sentinel process url)))))
-
-(function-put 'browse-url-netscape 'browse-url-browser-kind 'external)
-
-(defun browse-url-netscape-sentinel (process url)
- "Handle a change to the process communicating with Netscape."
- (declare (obsolete nil "25.1"))
- (or (eq (process-exit-status process) 0)
- (let* ((process-environment (browse-url-process-environment)))
- ;; Netscape not running - start it
- (message "Starting %s..." browse-url-netscape-program)
- (apply #'start-process (concat "netscape" url) nil
- browse-url-netscape-program
- (append browse-url-netscape-startup-arguments (list url))))))
-
-(defun browse-url-netscape-reload ()
- "Ask Netscape to reload its current document.
-How depends on `browse-url-netscape-version'."
- (declare (obsolete nil "25.1"))
- (interactive)
- ;; Backwards incompatibility reported by
- ;; <peter.kruse@psychologie.uni-regensburg.de>.
- (browse-url-netscape-send (if (>= browse-url-netscape-version 4)
- "xfeDoCommand(reload)"
- "reload")))
-
-(defun browse-url-netscape-send (command)
- "Send a remote control command to Netscape."
- (declare (obsolete nil "25.1"))
- (let* ((process-environment (browse-url-process-environment)))
- (apply #'start-process "netscape" nil
- browse-url-netscape-program
- (append browse-url-netscape-arguments
- (list "-remote" command)))))
-
-;;;###autoload
(defun browse-url-mozilla (url &optional new-window)
"Ask the Mozilla WWW browser to load URL.
Default to the URL around or before point. The strings in variable
@@ -1177,6 +1097,7 @@ new tab in an existing window instead.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "29.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
@@ -1203,6 +1124,7 @@ used instead of `browse-url-new-window-flag'."
(defun browse-url-mozilla-sentinel (process url)
"Handle a change to the process communicating with Mozilla."
+ (declare (obsolete nil "29.1"))
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Mozilla is not running - start it
@@ -1280,56 +1202,6 @@ The optional argument NEW-WINDOW is not used."
(function-put 'browse-url-chrome 'browse-url-browser-kind 'external)
-;;;###autoload
-(defun browse-url-galeon (url &optional new-window)
- "Ask the Galeon WWW browser to load URL.
-Default to the URL around or before point. The strings in variable
-`browse-url-galeon-arguments' are also passed to Galeon.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Galeon window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-galeon-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
- (declare (obsolete nil "25.1"))
- (interactive (browse-url-interactive-arg "URL: "))
- (setq url (browse-url-encode-url url))
- (let* ((process-environment (browse-url-process-environment))
- (process (apply #'start-process
- (concat "galeon " url)
- nil
- browse-url-galeon-program
- (append
- browse-url-galeon-arguments
- (if (browse-url-maybe-new-window new-window)
- (if browse-url-galeon-new-window-is-tab
- '("--new-tab")
- '("--new-window" "--noraise"))
- '("--existing"))
- (list url)))))
- (set-process-sentinel process
- (lambda (process _change)
- (browse-url-galeon-sentinel process url)))))
-
-(function-put 'browse-url-galeon 'browse-url-browser-kind 'external)
-
-(defun browse-url-galeon-sentinel (process url)
- "Handle a change to the process communicating with Galeon."
- (declare (obsolete nil "25.1"))
- (or (eq (process-exit-status process) 0)
- (let* ((process-environment (browse-url-process-environment)))
- ;; Galeon is not running - start it
- (message "Starting %s..." browse-url-galeon-program)
- (apply #'start-process (concat "galeon " url) nil
- browse-url-galeon-program
- (append browse-url-galeon-startup-arguments (list url))))))
-
(defun browse-url-epiphany (url &optional new-window)
"Ask the GNOME Web (Epiphany) WWW browser to load URL.
Default to the URL around or before point. The strings in variable
@@ -1380,6 +1252,36 @@ used instead of `browse-url-new-window-flag'."
(defvar url-handler-regexp)
;;;###autoload
+(defun browse-url-webpositive (url &optional _new-window)
+ "Ask the WebPositive WWW browser to load URL.
+Default to the URL around or before point.
+The optional argument NEW-WINDOW is not used."
+ (interactive (browse-url-interactive-arg "URL: "))
+ (setq url (browse-url-encode-url url))
+ (let* ((process-environment (browse-url-process-environment)))
+ (start-process (concat "WebPositive " url) nil "WebPositive" url)))
+
+(function-put 'browse-url-webpositive 'browse-url-browser-kind 'external)
+
+(declare-function haiku-roster-launch "haikuselect.c")
+
+;;;###autoload
+(defun browse-url-default-haiku-browser (url &optional _new-window)
+ "Browse URL with the system default browser.
+Default to the URL around or before point."
+ (interactive (browse-url-interactive-arg "URL: "))
+ (setq url (browse-url-encode-url url))
+ (let* ((scheme (save-match-data
+ (if (string-match "\\(.+\\):/" url)
+ (match-string 1 url)
+ "http")))
+ (mime (concat "application/x-vnd.Be.URL." scheme)))
+ (haiku-roster-launch mime (vector url))))
+
+(function-put 'browse-url-default-haiku-browser
+ 'browse-url-browser-kind 'external)
+
+;;;###autoload
(defun browse-url-emacs (url &optional same-window)
"Ask Emacs to load URL into a buffer and show it in another window.
Optional argument SAME-WINDOW non-nil means show the URL in the
@@ -1388,10 +1290,12 @@ currently selected window instead."
(require 'url-handlers)
(let ((parsed (url-generic-parse-url url))
(func (if same-window 'find-file 'find-file-other-window)))
- (if (and (equal (url-type parsed) "file")
- (file-directory-p (url-filename parsed)))
- ;; It's a directory; just open it.
- (funcall func (url-filename parsed))
+ (if (equal (url-type parsed) "file")
+ ;; It's a file; just open it.
+ (let ((file (url-unhex-string (url-filename parsed))))
+ (when-let ((coding (browse-url--file-name-coding-system)))
+ (setq file (decode-coding-string file 'utf-8)))
+ (funcall func file))
(let ((file-name-handler-alist
(cons (cons url-handler-regexp 'url-file-handler)
file-name-handler-alist)))
@@ -1401,7 +1305,7 @@ currently selected window instead."
;;;###autoload
(defun browse-url-gnome-moz (url &optional new-window)
- "Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
+ "Ask Mozilla to load URL via the GNOME program `gnome-moz-remote'.
Default to the URL around or before point. The strings in variable
`browse-url-gnome-moz-arguments' are also passed.
@@ -1482,6 +1386,7 @@ prefix argument reverses the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "29.1"))
(interactive (browse-url-interactive-arg "W3 URL: "))
(require 'w3) ; w3-fetch-other-window not autoloaded
(if (browse-url-maybe-new-window new-window)
@@ -1751,13 +1656,11 @@ from `browse-url-elinks-wrapper'."
;;; Adding buttons to a buffer to call `browse-url' when you hit them.
-(defvar browse-url-button-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" #'browse-url-button-open)
- (define-key map [mouse-2] #'browse-url-button-open)
- (define-key map "w" #'browse-url-button-copy)
- map)
- "The keymap used for `browse-url' buttons.")
+(defvar-keymap browse-url-button-map
+ :doc "The keymap used for `browse-url' buttons."
+ "RET" #'browse-url-button-open
+ "<mouse-2>" #'browse-url-button-open
+ "w" #'browse-url-button-copy)
(defface browse-url-button
'((t :inherit link))
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 54e8d0c5d4e..d4d4ed54e90 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -36,6 +36,7 @@
;; Declare used subroutines and variables.
(declare-function dbus-message-internal "dbusbind.c")
(declare-function dbus--init-bus "dbusbind.c")
+(declare-function libxml-parse-xml-region "xml.c")
(defvar dbus-message-type-invalid)
(defvar dbus-message-type-method-call)
(defvar dbus-message-type-method-return)
@@ -1870,13 +1871,7 @@ name and cdr is the list of properties as returned by
\(dbus-get-all-managed-objects :session \"org.gnome.SettingsDaemon\" \"/\")
- => ((\"/org/gnome/SettingsDaemon/MediaKeys\"
- (\"org.gnome.SettingsDaemon.MediaKeys\")
- (\"org.freedesktop.DBus.Peer\")
- (\"org.freedesktop.DBus.Introspectable\")
- (\"org.freedesktop.DBus.Properties\")
- (\"org.freedesktop.DBus.ObjectManager\"))
- (\"/org/gnome/SettingsDaemon/Power\"
+ => ((\"/org/gnome/SettingsDaemon/Power\"
(\"org.gnome.SettingsDaemon.Power.Keyboard\")
(\"org.gnome.SettingsDaemon.Power.Screen\")
(\"org.gnome.SettingsDaemon.Power\"
@@ -2102,7 +2097,7 @@ has been handled by this function."
(interface (dbus-event-interface-name event))
(member (dbus-event-member-name event))
(arguments (dbus-event-arguments event))
- (time (time-to-seconds (current-time))))
+ (time (float-time)))
(save-excursion
;; Check for matching method-call.
(goto-char (point-max))
@@ -2252,15 +2247,19 @@ keywords `:system-private' or `:session-private', respectively."
bus nil dbus-path-local dbus-interface-local
"Disconnected" #'dbus-handle-bus-disconnect)))
-
-;; Initialize `:system' and `:session' buses. This adds their file
-;; descriptors to input_wait_mask, in order to detect incoming
-;; messages immediately.
-(when (featurep 'dbusbind)
- (dbus-ignore-errors
- (dbus-init-bus :system))
- (dbus-ignore-errors
- (dbus-init-bus :session)))
+
+(defun dbus--init ()
+ ;; Initialize `:system' and `:session' buses. This adds their file
+ ;; descriptors to input_wait_mask, in order to detect incoming
+ ;; messages immediately.
+ (when (featurep 'dbusbind)
+ (dbus-ignore-errors
+ (dbus-init-bus :system))
+ (dbus-ignore-errors
+ (dbus-init-bus :session))))
+
+(add-hook 'after-pdump-load-hook #'dbus--init)
+(dbus--init)
(provide 'dbus)
diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el
index aef3c4efc74..a4afcd6647d 100644
--- a/lisp/net/dictionary-connection.el
+++ b/lisp/net/dictionary-connection.el
@@ -83,10 +83,10 @@ Return a data structure identifying the connection."
"Return the status of the CONNECTION.
Possible return values are the symbols:
nil: argument is not a connection object
- 'none: argument is not connected
- 'up: connection is open and buffer is existing
- 'down: connection is closed
- 'alone: connection is not associated with a buffer"
+ `none': argument is not connected
+ `up': connection is open and buffer is existing
+ `down': connection is closed
+ `alone': connection is not associated with a buffer"
(when (dictionary-connection-p connection)
(let ((process (dictionary-connection-process connection))
(buffer (dictionary-connection-buffer connection)))
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index e0824f39716..31cc5035a3e 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -89,7 +89,7 @@ You can specify here:
This port is probably always 2628 so there should be no need to modify it."
:group 'dictionary
:set #'dictionary-set-server-var
- :type 'number
+ :type 'natnum
:version "28.1")
(defcustom dictionary-identification
@@ -206,7 +206,7 @@ where the current word was found."
"The port of the proxy server, used only when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
:set #'dictionary-set-server-var
- :type 'number
+ :type 'natnum
:version "28.1")
(defcustom dictionary-use-single-buffer
@@ -326,26 +326,22 @@ is utf-8"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar dictionary-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (set-keymap-parent map button-buffer-map)
-
- (define-key map "q" #'dictionary-close)
- (define-key map "h" #'dictionary-help)
- (define-key map "s" #'dictionary-search)
- (define-key map "d" #'dictionary-lookup-definition)
- (define-key map "D" #'dictionary-select-dictionary)
- (define-key map "M" #'dictionary-select-strategy)
- (define-key map "m" #'dictionary-match-words)
- (define-key map "l" #'dictionary-previous)
- (define-key map "n" #'forward-button)
- (define-key map "p" #'backward-button)
- (define-key map " " #'scroll-up-command)
- (define-key map [?\S-\ ] #'scroll-down-command)
- (define-key map (read-kbd-macro "M-SPC") #'scroll-down-command)
- map)
- "Keymap for the dictionary mode.")
+(defvar-keymap dictionary-mode-map
+ :doc "Keymap for the dictionary mode."
+ :suppress t :parent button-buffer-map
+ "q" #'dictionary-close
+ "h" #'dictionary-help
+ "s" #'dictionary-search
+ "d" #'dictionary-lookup-definition
+ "D" #'dictionary-select-dictionary
+ "M" #'dictionary-select-strategy
+ "m" #'dictionary-match-words
+ "l" #'dictionary-previous
+ "n" #'forward-button
+ "p" #'backward-button
+ "SPC" #'scroll-up-command
+ "S-SPC" #'scroll-down-command
+ "M-SPC" #'scroll-down-command)
(defvar dictionary-connection
nil
@@ -759,31 +755,31 @@ of matching words."
(progn
(insert-button "[Back]" :type 'dictionary-button
'callback 'dictionary-restore-state
- 'help-echo (purecopy "Mouse-2 to go backwards in history"))
+ 'help-echo "Mouse-2 to go backwards in history")
(insert " ")
(insert-button "[Search definition]" :type 'dictionary-button
'callback 'dictionary-search
- 'help-echo (purecopy "Mouse-2 to look up a new word"))
+ 'help-echo "Mouse-2 to look up a new word")
(insert " ")
(insert-button "[Matching words]" :type 'dictionary-button
'callback 'dictionary-match-words
- 'help-echo (purecopy "Mouse-2 to find matches for a pattern"))
+ 'help-echo "Mouse-2 to find matches for a pattern")
(insert " ")
(insert-button "[Quit]" :type 'dictionary-button
'callback 'dictionary-close
- 'help-echo (purecopy "Mouse-2 to close this window"))
+ 'help-echo "Mouse-2 to close this window")
(insert "\n ")
(insert-button "[Select dictionary]" :type 'dictionary-button
'callback 'dictionary-select-dictionary
- 'help-echo (purecopy "Mouse-2 to select dictionary for future searches"))
+ 'help-echo "Mouse-2 to select dictionary for future searches")
(insert " ")
(insert-button "[Select match strategy]" :type 'dictionary-button
'callback 'dictionary-select-strategy
- 'help-echo (purecopy "Mouse-2 to select matching algorithm"))
+ 'help-echo "Mouse-2 to select matching algorithm")
(insert "\n\n")))
(setq dictionary-marker (point-marker)))
@@ -932,13 +928,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(insert-button (concat dictionary ": " translated) :type 'dictionary-link
'callback 'dictionary-set-dictionary
'data (cons dictionary description)
- 'help-echo (purecopy "Mouse-2 to select this dictionary"))
+ 'help-echo "Mouse-2 to select this dictionary")
(unless (dictionary-special-dictionary dictionary)
(insert " ")
(insert-button "(Details)" :type 'dictionary-link
'callback 'dictionary-set-dictionary
'list-data (list (cons dictionary description) t)
- 'help-echo (purecopy "Mouse-2 to get more information")))
+ 'help-echo "Mouse-2 to get more information"))
(insert "\n")))))
(defun dictionary-set-dictionary (param &optional more)
@@ -976,7 +972,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(insert-button description :type 'dictionary-link
'callback 'dictionary-set-dictionary
'data (cons dictionary description)
- 'help-echo (purecopy "Mouse-2 to select this dictionary"))
+ 'help-echo "Mouse-2 to select this dictionary")
(insert "\n\n")
(setq reply (dictionary-read-answer))
(insert reply)
@@ -1027,7 +1023,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(insert-button description :type 'dictionary-link
'callback 'dictionary-set-strategy
'data strategy
- 'help-echo (purecopy "Mouse-2 to select this matching algorithm"))
+ 'help-echo "Mouse-2 to select this matching algorithm")
(insert "\n")))))
(defun dictionary-set-strategy (strategy &rest _ignored)
@@ -1128,7 +1124,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(insert-button word :type 'dictionary-link
'callback 'dictionary-new-search
'data (cons word dictionary)
- 'help-echo (purecopy "Mouse-2 to lookup word"))
+ 'help-echo "Mouse-2 to lookup word")
(insert "\n")) (reverse word-list))
(insert "\n")))
list))
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index f7f1500454a..d4fad0c61fd 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -44,6 +44,11 @@
"Name of dig (domain information groper) binary."
:type 'file)
+(defcustom dig-program-options nil
+ "Options for the dig program."
+ :type '(repeat string)
+ :version "26.1")
+
(defcustom dig-dns-server nil
"DNS server to query.
If nil, use system defaults."
@@ -59,8 +64,8 @@ If nil, use system defaults."
:type 'sexp)
(defun dig-invoke (domain &optional
- query-type query-class query-option
- dig-option server)
+ query-type query-class query-option
+ dig-option server)
"Call dig with given arguments and return buffer containing output.
DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional
string with a DNS type. QUERY-CLASS is an optional string with a DNS
@@ -79,7 +84,8 @@ and is a commonly available debugging tool."
(push domain cmdline)
(if server (push (concat "@" server) cmdline)
(if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
- (apply #'call-process dig-program nil buf nil cmdline)
+ (apply #'call-process dig-program nil buf nil
+ (append dig-program-options cmdline))
buf))
(defun dig-extract-rr (domain &optional type class)
@@ -117,11 +123,9 @@ Buffer should contain output generated by `dig-invoke'."
(setq str (replace-match "" nil nil str)))
str))
-(defvar dig-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "g" nil)
- (define-key map "q" #'dig-exit)
- map))
+(defvar-keymap dig-mode-map
+ "g" nil
+ "q" #'dig-exit)
(define-derived-mode dig-mode special-mode "Dig"
"Major mode for displaying dig output."
@@ -132,7 +136,7 @@ Buffer should contain output generated by `dig-invoke'."
(defun dig-exit ()
"Quit dig output buffer."
- (interactive)
+ (interactive nil dig-mode)
(quit-window t))
;;;###autoload
@@ -140,12 +144,23 @@ Buffer should contain output generated by `dig-invoke'."
query-type query-class query-option dig-option server)
"Query addresses of a DOMAIN using dig.
See `dig-invoke' for an explanation for the parameters.
-When called interactively, DOMAIN is prompted for. If given a prefix,
-also prompt for the QUERY-TYPE parameter."
+When called interactively, DOMAIN is prompted for.
+
+If given a \\[universal-argument] prefix, also prompt \
+for the QUERY-TYPE parameter.
+
+If given a \\[universal-argument] \\[universal-argument] \
+prefix, also prompt for the SERVER parameter."
(interactive
- (list (read-string "Host: ")
+ (list (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Host" default) nil nil default))
(and current-prefix-arg
(read-string "Query type: "))))
+ (when (and (numberp (car current-prefix-arg))
+ (>= (car current-prefix-arg) 16))
+ (let ((serv (read-from-minibuffer "Name server: ")))
+ (when (not (equal serv ""))
+ (setq server serv))))
(pop-to-buffer-same-window
(dig-invoke domain query-type query-class query-option dig-option server))
(goto-char (point-min))
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 6a2cd13dd03..68a0ccb3a13 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -86,7 +86,7 @@
`("EUDC Image Menu"
["---" nil nil]
["Toggle inline display" eudc-bob-toggle-inline-display
- (eudc-bob-can-display-inline-images)]
+ (display-graphic-p)]
,@(cdr (cdr eudc-bob-generic-menu))))
(defvar eudc-bob-sound-menu
@@ -109,14 +109,6 @@
(setq overlays (cdr overlays)))
value))
-(defun eudc-bob-can-display-inline-images ()
- "Return non-nil if we can display images inline."
- (if (fboundp 'console-type)
- (and (memq (console-type) '(x mswindows))
- (fboundp 'make-glyph))
- (and (fboundp 'display-graphic-p)
- (display-graphic-p))))
-
(defun eudc-bob-make-button (label keymap &optional menu plist)
"Create a button with LABEL.
Attach KEYMAP, MENU and properties from PLIST to a new overlay covering
@@ -124,7 +116,7 @@ LABEL."
(let (overlay
(p (point))
prop val)
- (insert label)
+ (insert (or label ""))
(put-text-property p (point) 'face 'bold)
(setq overlay (make-overlay p (point)))
(overlay-put overlay 'mouse-face 'highlight)
@@ -142,19 +134,7 @@ LABEL."
"Display the JPEG DATA at point.
If INLINE is non-nil, try to inline the image otherwise simply
display a button."
- (cond ((fboundp 'make-glyph)
- (let ((glyph (if (eudc-bob-can-display-inline-images)
- (make-glyph (list (vector 'jpeg :data data)
- [string :data "[JPEG Picture]"])))))
- (eudc-bob-make-button "[JPEG Picture]"
- eudc-bob-image-keymap
- eudc-bob-image-menu
- (list 'glyph glyph
- 'end-glyph (if inline glyph)
- 'duplicable t
- 'invisible inline
- 'object-data data))))
- ((fboundp 'create-image)
+ (cond ((fboundp 'create-image)
(let* ((image (create-image data nil t))
(props (list 'object-data data 'eudc-image image)))
(when (and inline (image-type-available-p 'jpeg))
@@ -167,7 +147,7 @@ display a button."
(defun eudc-bob-toggle-inline-display ()
"Toggle inline display of an image."
(interactive)
- (when (eudc-bob-can-display-inline-images)
+ (when (display-graphic-p)
(let* ((overlays (append (overlays-at (1- (point)))
(overlays-at (point))))
image)
@@ -287,11 +267,13 @@ display a button."
;;;###autoload
(defun eudc-display-jpeg-inline (data)
"Display the JPEG DATA inline at point if possible."
- (eudc-bob-display-jpeg data (eudc-bob-can-display-inline-images)))
+ (eudc-bob-display-jpeg data (display-graphic-p)))
;;;###autoload
(defun eudc-display-jpeg-as-button (data)
"Display a button for the JPEG DATA."
(eudc-bob-display-jpeg data nil))
+(define-obsolete-function-alias 'eudc-bob-can-display-inline-images #'display-graphic-p "29.1")
+
;;; eudc-bob.el ends here
diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el
new file mode 100644
index 00000000000..68cbfd93ffe
--- /dev/null
+++ b/lisp/net/eudc-capf.el
@@ -0,0 +1,133 @@
+;;; eudc-capf.el --- EUDC - completion-at-point bindings -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Author: Alexander Adolf
+;;
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides functions to deliver email addresses from
+;; EUDC search results to `completion-at-point'.
+;;
+;; Email address completion will likely be desirable only in
+;; situations where designating email recipients plays a role, such
+;; as when composing or replying to email messages, or when posting
+;; to newsgroups, possibly with copies of the post being emailed.
+;; Hence, modes relevant in such contexts, such as for example
+;; `message-mode' and `mail-mode', often at least to some extent
+;; provide infrastructure for different functions to be called when
+;; completing in certain message header fields, or in the body of
+;; the message. In other modes for editing email messages or
+;; newsgroup posts, which do not provide such infrastructure, any
+;; completion function providing email addresses will need to check
+;; whether the completion attempt occurs in an appropriate context
+;; (that is, in a relevant message header field) before providing
+;; completion candidates. Two mechanisms are thus provided by this
+;; library.
+;;
+;; The first mechanism is intended for use by the modes listed in
+;; `eudc-capf-modes', and relies on these modes adding
+;; `eudc-capf-complete' to `completion-at-point-functions', as
+;; would be usually done for any general-purpose completion
+;; function. In this mode of operation, and in order to offer
+;; email addresses only in contexts where the user would expect
+;; them, a check is performed whether point is on a line that is a
+;; message header field suitable for email addresses, such as for
+;; example "To:", "Cc:", etc.
+;;
+;; The second mechanism is intended for when the user modifies
+;; `message-completion-alist' to replace `message-expand-name' with
+;; the function `eudc-capf-message-expand-name'. As a result,
+;; minibuffer completion (`completing-read') for email addresses
+;; would no longer enabled in `message-mode', but
+;; `completion-at-point' (in-buffer completion) only.
+
+;;; Usage:
+
+;; In a major mode, or context where you want email address
+;; completion, you would do something along the lines of:
+;;
+;; (require 'eudc-capf)
+;; (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t)
+;;
+;; The minus one argument puts it at the front of the list so it is
+;; called first, and the t value for the LOCAL parameter causes the
+;; setting to be buffer local, so as to avoid modifying any global
+;; setting.
+;;
+;; The value of the variable `eudc-capf-modes' indicates which
+;; major modes do such a setup as part of their initialisation
+;; code.
+
+;;; Code:
+
+(require 'eudc)
+
+(defvar message-email-recipient-header-regexp)
+(defvar mail-abbrev-mode-regexp)
+(declare-function mail-abbrev-in-expansion-header-p "mailabbrev" ())
+
+(defconst eudc-capf-modes '(message-mode)
+ "List of modes in which email address completion is to be attempted.")
+
+;; completion functions
+
+;;;###autoload
+(defun eudc-capf-complete ()
+ "Email address completion function for `completion-at-point-functions'.
+
+This function checks whether the current major mode is one of the
+modes listed in `eudc-capf-modes', and whether point is on a line
+with a message header listing email recipients, that is, a line
+whose beginning matches `message-email-recipient-header-regexp',
+and, if the check succeeds, searches for records matching the
+words before point.
+
+The return value is either nil when no match is found, or a
+completion table as required for functions listed in
+`completion-at-point-functions'."
+ (if (and (seq-some #'derived-mode-p eudc-capf-modes)
+ (let ((mail-abbrev-mode-regexp message-email-recipient-header-regexp))
+ (mail-abbrev-in-expansion-header-p)))
+ (eudc-capf-message-expand-name)))
+
+;;;###autoload
+(defun eudc-capf-message-expand-name ()
+ "Email address completion function for `message-completion-alist'.
+
+When this function is added to `message-completion-alist',
+replacing any existing entry for `message-expand-name' there,
+with an appropriate regular expression such as for example
+`message-email-recipient-header-regexp', then EUDC will be
+queried for email addresses, and the results delivered to
+`completion-at-point'."
+ (if (or eudc-server eudc-server-hotlist)
+ (progn
+ (let* ((beg (save-excursion
+ (re-search-backward "\\([:,]\\|^\\)[ \t]*")
+ (match-end 0)))
+ (end (point))
+ (prefix (save-excursion (buffer-substring-no-properties beg end))))
+ (list beg end
+ (completion-table-with-cache
+ (lambda (_)
+ (eudc-query-with-words (split-string prefix "[ \t]+") t))
+ t))))))
+
+(provide 'eudc-capf)
+;;; eudc-capf.el ends here
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index 26afd768051..d70e0cf4f63 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -35,15 +35,13 @@
(defvar eudc-hotlist-menu nil)
(defvar eudc-hotlist-list-beginning nil)
-(defvar eudc-hotlist-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "a" #'eudc-hotlist-add-server)
- (define-key map "d" #'eudc-hotlist-delete-server)
- (define-key map "s" #'eudc-hotlist-select-server)
- (define-key map "t" #'eudc-hotlist-transpose-servers)
- (define-key map "q" #'eudc-hotlist-quit-edit)
- (define-key map "x" #'kill-current-buffer)
- map))
+(defvar-keymap eudc-hotlist-mode-map
+ "a" #'eudc-hotlist-add-server
+ "d" #'eudc-hotlist-delete-server
+ "s" #'eudc-hotlist-select-server
+ "t" #'eudc-hotlist-transpose-servers
+ "q" #'eudc-hotlist-quit-edit
+ "x" #'kill-current-buffer)
(define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers"
"Major mode used to edit the hotlist of servers.
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index 3122b26cd81..59347ccc89a 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -42,7 +42,7 @@ A port number may be specified by appending a colon and a
number to the name of the server. Use `localhost' if the directory
server resides on your computer (BBDB backend).
-To specify multiple servers, customize eudc-server-hotlist
+To specify multiple servers, customize `eudc-server-hotlist'
instead."
:type '(choice (string :tag "Server") (const :tag "None" nil)))
@@ -179,32 +179,63 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and
(symbol :menu-tag "Other" :tag "Attribute name"))))
:version "25.1")
-;; Default to nil so that the most common use of eudc-expand-inline,
-;; where replace is nil, does not affect the kill ring.
-(defcustom eudc-expansion-overwrites-query nil
- "If non-nil, expanding a query overwrites the query string."
+(define-obsolete-variable-alias
+ 'eudc-expansion-overwrites-query
+ 'eudc-expansion-save-query-as-kill
+ "29.1")
+
+;; Default to nil so that the most common use of `eudc-expand-inline',
+;; where `save-query-as-kill' is nil, does not affect the kill ring.
+(defcustom eudc-expansion-save-query-as-kill nil
+ "If non-nil, expansion saves the query string to the kill ring."
:type 'boolean
:version "25.1")
-(defcustom eudc-inline-expansion-format '("%s %s <%s>" firstname name email)
- "A list specifying the format of the expansion of inline queries.
-This variable controls what `eudc-expand-inline' actually inserts in
-the buffer. First element is a string passed to `format'. Remaining
-elements are symbols indicating attribute names; the corresponding values
-are passed as additional arguments to `format'."
- :type '(list
- (string :tag "Format String")
- (repeat :inline t
- :tag "Attributes"
- (choice
- :tag "Attribute"
- (const :menu-tag "First Name" :tag "First Name" firstname)
- (const :menu-tag "Surname" :tag "Surname" name)
- (const :menu-tag "Email Address" :tag "Email Address" email)
- (const :menu-tag "Phone" :tag "Phone" phone)
- (symbol :menu-tag "Other")
- (symbol :tag "Attribute name"))))
- :version "25.1")
+(defcustom eudc-inline-expansion-format nil
+ "Specify the format of the expansion of inline queries.
+This variable controls what `eudc-expand-inline' actually inserts
+in the buffer. It is either a list, or a function.
+
+When set to a list, the expansion result will be formatted
+according to the first element of the list, a string, which is
+passed as the first argument to `format'. The remaining elements
+of the list are symbols indicating attribute names; the
+corresponding values are passed as additional arguments to
+`format'.
+
+When set to nil, the expansion result will be formatted using
+`eudc-rfc5322-make-address', and the PHRASE part will be
+formatted according to \"firstname name\", quoting the result if
+necessary. No COMMENT will be added in this case.
+
+When set to a function, the expansion result will be formatted
+using `eudc-rfc5322-make-address', and the referenced function is
+used to format the PHRASE, and COMMENT parts, respectively. It
+receives a single argument, which is an alist of
+protocol-specific attributes describing the recipient. To access
+the alist elements using generic EUDC attribute names, such as
+for example name, or email, use `eudc-translate-attribute-list'.
+The function should return a list, which should contain two
+elements. If the first element is a string, it will be used as
+the PHRASE part, quoting it if necessary. If the second element
+is a string, it will be used as the COMMENT part, unless it
+contains characters not allowed in the COMMENT part by RFC 5322,
+in which case the COMMENT part will be omitted."
+ :type '(choice (const :tag "RFC 5322 formatted \"first last <address>\"" nil)
+ (function :tag "RFC 5322 phrase/comment formatting function")
+ (list :tag "Format string (deprecated)"
+ (string :tag "Format String")
+ (repeat :inline t
+ :tag "Attributes"
+ (choice
+ :tag "Attribute"
+ (const :menu-tag "First Name" :tag "First Name" firstname)
+ (const :menu-tag "Surname" :tag "Surname" name)
+ (const :menu-tag "Email Address" :tag "Email Address" email)
+ (const :menu-tag "Phone" :tag "Phone" phone)
+ (symbol :menu-tag "Other")
+ (symbol :tag "Attribute name")))))
+ :version "29.1")
(defcustom eudc-inline-expansion-servers 'server-then-hotlist
"Which servers to contact for the expansion of inline queries.
@@ -252,6 +283,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'."
(firstname . "First Name")
(cn . "Full Name")
(sn . "Surname")
+ (name . "Surname")
(givenname . "First Name")
(ou . "Unit")
(labeledurl . "URL")
@@ -394,6 +426,15 @@ BBDB fields. SPECs are sexps which are evaluated:
(symbol :tag "BBDB Field")
(sexp :tag "Conversion Spec"))))
+(defcustom eudc-ldap-no-wildcard-attributes
+ '(objectclass objectcategory)
+ "LDAP attributes which are always searched for without wildcard character.
+This is the list of special dictionary-valued attributes, where
+wildcarded search may fail. For example, it fails with
+objectclass in Active Directory servers."
+ :type '(repeat (symbol :tag "Directory attribute")))
+
+
;;}}}
;;{{{ BBDB Custom Group
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 5258947902d..9208e40a730 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -46,15 +46,9 @@
;;; Code:
(require 'wid-edit)
-
(require 'cl-lib)
-
-(unless (fboundp 'custom-menu-create)
- (autoload 'custom-menu-create "cus-edit"))
-
(require 'eudc-vars)
-
-
+(eval-when-compile (require 'subr-x))
;;{{{ Internal cooking
@@ -62,16 +56,14 @@
(defvar eudc-form-widget-list nil)
-(defvar eudc-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map "q" #'kill-current-buffer)
- (define-key map "x" #'kill-current-buffer)
- (define-key map "f" #'eudc-query-form)
- (define-key map "b" #'eudc-try-bbdb-insert)
- (define-key map "n" #'eudc-move-to-next-record)
- (define-key map "p" #'eudc-move-to-previous-record)
- map))
+(defvar-keymap eudc-mode-map
+ :parent widget-keymap
+ "q" #'kill-current-buffer
+ "x" #'kill-current-buffer
+ "f" #'eudc-query-form
+ "b" #'eudc-try-bbdb-insert
+ "n" #'eudc-move-to-next-record
+ "p" #'eudc-move-to-previous-record)
(defvar mode-popup-menu)
@@ -169,6 +161,75 @@ Value is the new string."
newtext)))
(concat rtn-str (substring str start))))
+
+(defconst eudc-rfc5322-atext-token "[:alpha:][:digit:]!#$%&'*+/=?^_`{|}~-"
+ "Printable US-ASCII characters not including specials. Used for atoms.")
+
+(defconst eudc-rfc5322-wsp-token " \t"
+ "Non-folding white space.")
+
+(defconst eudc-rfc5322-fwsp-token
+ (concat eudc-rfc5322-wsp-token "\n")
+ "Folding white space.")
+
+(defconst eudc-rfc5322-cctext-token "\u005D-\u007E\u002A-\u005B\u0021-\u0027"
+ "Printable US-ASCII characters not including \"(\", \")\", or \"\\\".")
+
+(defun eudc-rfc5322-quote-phrase (string)
+ "Quote STRING if it needs quoting as a phrase in a header."
+ (if (string-match
+ (concat "[^" eudc-rfc5322-wsp-token eudc-rfc5322-atext-token "]")
+ string)
+ (concat "\"" string "\"")
+ string))
+
+(defun eudc-rfc5322-valid-comment-p (string)
+ "Check if STRING can be used as comment in a header."
+ (if (string-match
+ (concat "[^" eudc-rfc5322-cctext-token eudc-rfc5322-fwsp-token "]")
+ string)
+ nil
+ t))
+
+(defun eudc-rfc5322-make-address (address &optional firstname name comment)
+ "Create a valid address specification according to RFC5322.
+RFC5322 address specifications are used in message header fields
+to indicate senders and recipients of messages. They generally
+have one of the forms:
+
+ADDRESS
+ADDRESS (COMMENT)
+PHRASE <ADDRESS>
+PHRASE <ADDRESS> (COMMENT)
+
+The arguments FIRSTNAME and NAME are combined to form PHRASE.
+PHRASE is enclosed in double quotes if necessary.
+
+COMMENT is omitted if it contains any symbols outside the
+permitted set `eudc-rfc5322-cctext-token'."
+ (if (and address
+ (not (string-blank-p address)))
+ (let ((result address)
+ (name-given (and name
+ (not (string-blank-p name))))
+ (firstname-given (and firstname
+ (not (string-blank-p firstname))))
+ (valid-comment-given (and comment
+ (not (string-blank-p comment))
+ (eudc-rfc5322-valid-comment-p comment))))
+ (if (or name-given firstname-given)
+ (let ((phrase (string-trim (concat firstname " " name))))
+ (setq result
+ (concat
+ (eudc-rfc5322-quote-phrase phrase)
+ " <" result ">"))))
+ (if valid-comment-given
+ (setq result
+ (concat result " (" comment ")")))
+ result)
+ ;; nil or empty address, nothing to return
+ nil))
+
;;}}}
;;{{{ Server and Protocol Variable Routines
@@ -305,8 +366,8 @@ accordingly. Otherwise it is set to its EUDC default binding."
;;}}}
-;; Add PROTOCOL to the list of supported protocols
(defun eudc-register-protocol (protocol)
+ "Add PROTOCOL to the list of supported protocols."
(unless (memq protocol eudc-supported-protocols)
(setq eudc-supported-protocols
(cons protocol eudc-supported-protocols))
@@ -320,32 +381,51 @@ accordingly. Otherwise it is set to its EUDC default binding."
(cons protocol eudc-known-protocols))))
-(defun eudc-translate-query (query)
+(defun eudc-translate-query (query &optional reverse)
"Translate attribute names of QUERY.
The translation is done according to
-`eudc-protocol-attributes-translation-alist'."
+`eudc-protocol-attributes-translation-alist'.
+
+When REVERSE is nil or omitted, the attribute names are
+translated from EUDC generic names to protocol-specific
+names. When REVERSE is non-nil, the translation is from
+protocol-specific names back to EUDC generic names."
(if eudc-protocol-attributes-translation-alist
(mapcar (lambda (attribute)
- (let ((trans (assq (car attribute)
- (symbol-value eudc-protocol-attributes-translation-alist))))
+ (let ((trans
+ (if reverse
+ (rassq (car attribute)
+ (symbol-value eudc-protocol-attributes-translation-alist))
+ (assq (car attribute)
+ (symbol-value eudc-protocol-attributes-translation-alist)))))
(if trans
- (cons (cdr trans) (cdr attribute))
+ (cons (if reverse (car trans) (cdr trans))
+ (cdr attribute))
attribute)))
query)
query))
-(defun eudc-translate-attribute-list (list)
+(defun eudc-translate-attribute-list (list &optional reverse)
"Translate a list of attribute names LIST.
The translation is done according to
-`eudc-protocol-attributes-translation-alist'."
+`eudc-protocol-attributes-translation-alist'.
+
+When REVERSE is nil or omitted, the attribute names are
+translated from EUDC generic names to protocol-specific
+names. When REVERSE is non-nil, the translation is from
+protocol-specific names back to EUDC generic names."
(if eudc-protocol-attributes-translation-alist
(let (trans)
(mapcar (lambda (attribute)
- (setq trans (assq attribute
- (symbol-value eudc-protocol-attributes-translation-alist)))
- (if trans
- (cdr trans)
- attribute))
+ (setq trans
+ (if reverse
+ (rassq attribute
+ (symbol-value eudc-protocol-attributes-translation-alist))
+ (assq attribute
+ (symbol-value eudc-protocol-attributes-translation-alist))))
+ (if trans
+ (if reverse (car trans) (cdr trans))
+ attribute))
list))
list))
@@ -658,7 +738,7 @@ server for future sessions."
(defun eudc-get-email (name &optional error)
"Get the email field of NAME from the directory server.
If ERROR is non-nil, report an error if there is none."
- (interactive "sName: \np")
+ (interactive "sSurname: \np")
(or eudc-server
(call-interactively 'eudc-set-server))
(let ((result (eudc-query (list (cons 'name name)) '(email)))
@@ -676,7 +756,7 @@ If ERROR is non-nil, report an error if there is none."
(defun eudc-get-phone (name &optional error)
"Get the phone field of NAME from the directory server.
If ERROR is non-nil, report an error if there is none."
- (interactive "sName: \np")
+ (interactive "sSurname: \np")
(or eudc-server
(call-interactively 'eudc-set-server))
(let ((result (eudc-query (list (cons 'name name)) '(phone)))
@@ -748,9 +828,18 @@ If none try N - 1 and so forth."
(setq n (1- n)))
formats))
+;;;###autoload
+(defun eudc-expand-try-all (&optional try-all-servers)
+ "Wrap `eudc-expand-inline' with a prefix argument.
+If TRY-ALL-SERVERS -- the prefix argument when called
+interactively -- is non-nil, collect results from all servers.
+If TRY-ALL-SERVERS is nil, do not try subsequent servers after
+one server returns any match."
+ (interactive "P")
+ (eudc-expand-inline (not eudc-expansion-save-query-as-kill) try-all-servers))
;;;###autoload
-(defun eudc-expand-inline (&optional replace)
+(defun eudc-expand-inline (&optional save-query-as-kill try-all-servers)
"Query the directory server, and expand the query string before point.
The query string consists of the buffer substring from the point back to
the preceding comma, colon or beginning of line.
@@ -758,10 +847,12 @@ The variable `eudc-inline-query-format' controls how to associate the
individual inline query words with directory attribute names.
After querying the server for the given string, the expansion specified by
`eudc-inline-expansion-format' is inserted in the buffer at point.
-If REPLACE is non-nil, then this expansion replaces the name in the buffer.
-`eudc-expansion-overwrites-query' being non-nil inverts the meaning of REPLACE.
+If SAVE-QUERY-AS-KILL is non-nil, then save the pre-expansion
+text to the kill ring. `eudc-expansion-save-query-as-kill' being
+non-nil inverts the meaning of SAVE-QUERY-AS-KILL.
Multiple servers can be tried with the same query until one finds a match,
-see `eudc-inline-expansion-servers'."
+see `eudc-inline-expansion-servers'. If TRY-ALL-SERVERS is
+non-nil, collect results from all servers."
(interactive)
(let* ((end (point))
(beg (save-excursion
@@ -771,13 +862,13 @@ see `eudc-inline-expansion-servers'."
(point)))
(query-words (split-string (buffer-substring-no-properties beg end)
"[ \t]+"))
- (response-strings (eudc-query-with-words query-words)))
+ (response-strings (eudc-query-with-words query-words try-all-servers)))
(if (null response-strings)
(error "No match")
(if (or
- (and replace (not eudc-expansion-overwrites-query))
- (and (not replace) eudc-expansion-overwrites-query))
+ (and save-query-as-kill (not eudc-expansion-save-query-as-kill))
+ (and (not save-query-as-kill) eudc-expansion-save-query-as-kill))
(kill-ring-save beg end))
(cond
((or (= (length response-strings) 1)
@@ -794,15 +885,65 @@ see `eudc-inline-expansion-servers'."
(error "There is more than one match for the query"))))))
;;;###autoload
-(defun eudc-query-with-words (query-words)
+(defun eudc-format-inline-expansion-result (res query-attrs)
+ "Format a query result according to `eudc-inline-expansion-format'."
+ (cond
+ ;; format string
+ ((consp eudc-inline-expansion-format)
+ (string-trim (apply #'format
+ (car eudc-inline-expansion-format)
+ (mapcar
+ (lambda (field)
+ (or (cdr (assq field res))
+ ""))
+ (eudc-translate-attribute-list
+ (cdr eudc-inline-expansion-format))))))
+
+ ;; formatting function
+ ((functionp eudc-inline-expansion-format)
+ (let ((addr (cdr (assq (nth 2 query-attrs) res)))
+ (ucontent (funcall eudc-inline-expansion-format res)))
+ (if (and ucontent
+ (listp ucontent))
+ (let* ((phrase (car ucontent))
+ (comment (cadr ucontent))
+ (phrase-given
+ (and phrase
+ (stringp phrase)
+ (not (string-blank-p phrase))))
+ (valid-comment-given
+ (and comment
+ (stringp comment)
+ (not (string-blank-p comment))
+ (eudc-rfc5322-valid-comment-p
+ comment))))
+ (eudc-rfc5322-make-address
+ addr nil
+ (if phrase-given phrase nil)
+ (if valid-comment-given comment nil)))
+ (progn
+ (error "Error: the function referenced by \
+`eudc-inline-expansion-format' is expected to return a list.")
+ nil))))
+
+ ;; fallback behaviour (nil function, or non-matching type)
+ (t
+ (let ((fname (cdr (assq (nth 0 query-attrs) res)))
+ (lname (cdr (assq (nth 1 query-attrs) res)))
+ (addr (cdr (assq (nth 2 query-attrs) res))))
+ (eudc-rfc5322-make-address addr fname lname)))))
+
+;;;###autoload
+(defun eudc-query-with-words (query-words &optional try-all-servers)
"Query the directory server, and return the matching responses.
The variable `eudc-inline-query-format' controls how to associate the
individual QUERY-WORDS with directory attribute names.
After querying the server for the given string, the expansion
specified by `eudc-inline-expansion-format' is applied to the
-matches before returning them.inserted in the buffer at point.
+matches before returning them.
Multiple servers can be tried with the same query until one finds a match,
-see `eudc-inline-expansion-servers'."
+see `eudc-inline-expansion-servers'. When TRY-ALL-SERVERS is non-nil,
+keep collecting results from subsequent servers after the first match."
(cond
((eq eudc-inline-expansion-servers 'current-server)
(or eudc-server
@@ -819,6 +960,7 @@ see `eudc-inline-expansion-servers'."
(error "Wrong value for `eudc-inline-expansion-servers': %S"
eudc-inline-expansion-servers)))
(let* (query-formats
+ response-strings
(eudc-former-server eudc-server)
(eudc-former-protocol eudc-protocol)
;; Prepare the list of servers to query
@@ -830,7 +972,7 @@ see `eudc-inline-expansion-servers'."
(if eudc-server
(cons (cons eudc-server eudc-protocol)
(delete (cons eudc-server eudc-protocol)
- (copy-sequence eudc-server-hotlist)))
+ (copy-sequence eudc-server-hotlist)))
eudc-server-hotlist))
((eq eudc-inline-expansion-servers 'current-server)
(list (cons eudc-server eudc-protocol))))))
@@ -840,46 +982,46 @@ see `eudc-inline-expansion-servers'."
(setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil))
(unwind-protect
- (let ((response
- (catch 'found
- ;; Loop on the servers
- (dolist (server servers)
- (eudc-set-server (car server) (cdr server) t)
-
- ;; Determine which formats apply in the query-format list
- (setq query-formats
- (or
- (eudc-extract-n-word-formats eudc-inline-query-format
- (length query-words))
- (if (null eudc-protocol-has-default-query-attributes)
- '(name))))
-
- ;; Loop on query-formats
- (while query-formats
- (let ((response
- (eudc-query
- (eudc-format-query query-words (car query-formats))
- (eudc-translate-attribute-list
- (cdr eudc-inline-expansion-format)))))
- (if response
- (throw 'found response)))
- (setq query-formats (cdr query-formats))))
- ;; No more servers to try... no match found
- nil))
- (response-strings '()))
-
- ;; Process response through eudc-inline-expansion-format
- (dolist (r response)
- (let ((response-string
- (apply #'format
- (car eudc-inline-expansion-format)
- (mapcar (lambda (field)
- (or (cdr (assq field r))
- ""))
- (eudc-translate-attribute-list
- (cdr eudc-inline-expansion-format))))))
- (if (> (length response-string) 0)
- (push response-string response-strings))))
+ (cl-flet
+ ((run-query
+ (query-formats)
+ (let* ((query-attrs (eudc-translate-attribute-list
+ (if (consp eudc-inline-expansion-format)
+ (cdr eudc-inline-expansion-format)
+ '(firstname name email))))
+ (response
+ (eudc-query
+ (eudc-format-query query-words (car query-formats))
+ query-attrs)))
+ (when response
+ ;; Format response.
+ (dolist (r response)
+ (let ((response-string
+ (eudc-format-inline-expansion-result r query-attrs)))
+ (if response-string
+ (cl-pushnew response-string response-strings
+ :test #'equal))))
+ (when (not try-all-servers)
+ (throw 'found nil))))))
+ (catch 'found
+ ;; Loop on the servers.
+ (dolist (server servers)
+ (eudc-set-server (car server) (cdr server) t)
+
+ ;; Determine which formats apply in the query-format list.
+ (setq query-formats
+ (or
+ (eudc-extract-n-word-formats eudc-inline-query-format
+ (length query-words))
+ (if (null eudc-protocol-has-default-query-attributes)
+ '(name))))
+
+ ;; Loop on query-formats.
+ (while query-formats
+ (run-query query-formats)
+ (setq query-formats (cdr query-formats))))
+ ;; No more servers to try... no match found.
+ nil)
response-strings)
(or (and (equal eudc-server eudc-former-server)
(equal eudc-protocol eudc-former-protocol))
@@ -901,7 +1043,10 @@ queries the server for the existing fields and displays a corresponding form."
pt)
(switch-to-buffer buffer)
(let ((inhibit-read-only t))
+ (remove-hook 'after-change-functions 'widget-after-change t)
+ (delete-all-overlays)
(erase-buffer)
+ (add-hook 'after-change-functions 'widget-after-change nil t)
(kill-all-local-variables)
(make-local-variable 'eudc-form-widget-list)
(widget-insert "Directory Query Form\n")
@@ -1059,6 +1204,8 @@ queries the server for the existing fields and displays a corresponding form."
`(["---" nil nil]
["Query with Form" eudc-query-form
:help "Display a form to query the directory server"]
+ ["Expand Inline Query Trying All Servers" eudc-expand-try-all
+ :help "Query all directory servers and expand the query string before point"]
["Expand Inline Query" eudc-expand-inline
:help "Query the directory server, and expand the query string before point"]
["Insert Record into BBDB" eudc-insert-record-at-point-into-bbdb
@@ -1093,6 +1240,7 @@ queries the server for the existing fields and displays a corresponding form."
:help "Set the directory server to SERVER using PROTOCOL"]))
(defun eudc-menu ()
+ "Return easy menu for EUDC."
(let (command)
(append '("Directory Servers")
(list
@@ -1124,6 +1272,7 @@ queries the server for the existing fields and displays a corresponding form."
eudc-tail-menu)))
(defun eudc-install-menu ()
+ "Install EUDC menu."
(define-key
global-map
[menu-bar tools directory-search]
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 365dace961a..1201c84f2d3 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -151,16 +151,20 @@ attribute names are returned. Default to `person'."
(interactive)
(or eudc-server
(call-interactively 'eudc-set-server))
- (let ((ldap-host-parameters-alist
- (list (cons eudc-server
- '(scope subtree sizelimit 1)))))
- (mapcar #'eudc-ldap-cleanup-record-filtering-addresses
- (ldap-search
- (eudc-ldap-format-query-as-rfc1558
- (list (cons "objectclass"
- (or objectclass
- "person"))))
- eudc-server nil t))))
+ (let ((plist (copy-sequence
+ (alist-get eudc-server ldap-host-parameters-alist
+ nil nil #'equal))))
+ (plist-put plist 'scope 'subtree)
+ (plist-put plist 'sizelimit '1)
+ (let ((ldap-host-parameters-alist
+ (list (cons eudc-server plist))))
+ (mapcar #'eudc-ldap-cleanup-record-filtering-addresses
+ (ldap-search
+ (eudc-ldap-format-query-as-rfc1558
+ (list (cons 'objectclass
+ (or objectclass
+ "person"))))
+ eudc-server nil t)))))
(defun eudc-ldap-escape-query-special-chars (string)
"Value is STRING with characters forbidden in LDAP queries escaped."
@@ -178,12 +182,17 @@ attribute names are returned. Default to `person'."
(defun eudc-ldap-format-query-as-rfc1558 (query)
"Format the EUDC QUERY list as a RFC1558 LDAP search filter."
- (let ((formatter (lambda (item &optional wildcard)
- (format "(%s=%s)"
- (car item)
- (concat
- (eudc-ldap-escape-query-special-chars
- (cdr item)) (if wildcard "*" ""))))))
+ (let ((formatter
+ (lambda (item &optional wildcard)
+ (format "(%s=%s)"
+ (car item)
+ (concat
+ (eudc-ldap-escape-query-special-chars
+ (cdr item))
+ (if (and wildcard
+ (not (memq (car item)
+ eudc-ldap-no-wildcard-attributes)))
+ "*" ""))))))
(format "(&%s)"
(concat
(mapconcat formatter (butlast query) "")
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index c39f6e3e1e1..4dbd5de2ef7 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -32,6 +32,7 @@
(require 'thingatpt)
(require 'url)
(require 'url-queue)
+(require 'url-file)
(require 'xdg)
(eval-when-compile (require 'subr-x))
@@ -178,6 +179,40 @@ the tab bar is enabled."
:group 'eww
:type 'hook)
+(defcustom eww-auto-rename-buffer nil
+ "Automatically rename EWW buffers once the page is rendered.
+
+When nil, do not rename the buffer. With a non-nil value
+determine the renaming scheme, as follows:
+
+- `title': Use the web page's title.
+- `url': Use the web page's URL.
+- a function's symbol: Run a user-defined function that returns a
+ string with which to rename the buffer. Sample of a
+ user-defined function:
+
+ (defun my-eww-rename-buffer ()
+ (when (eq major-mode \\='eww-mode)
+ (when-let ((string (or (plist-get eww-data :title)
+ (plist-get eww-data :url))))
+ (format \"*%s*\" string))))
+
+The string of `title' and `url' is always truncated to the value
+of `eww-buffer-name-length'."
+ :version "29.1"
+ :type '(choice
+ (const :tag "Do not rename buffers (default)" nil)
+ (const :tag "Rename buffer to web page title" title)
+ (const :tag "Rename buffer to web page URL" url)
+ (function :tag "A user-defined function to rename the buffer"))
+ :group 'eww)
+
+(defcustom eww-buffer-name-length 40
+ "Length of renamed buffer name, per `eww-auto-rename-buffer'."
+ :type 'natnum
+ :version "29.1"
+ :group 'eww)
+
(defcustom eww-form-checkbox-selected-symbol "[X]"
"Symbol used to represent a selected checkbox.
See also `eww-form-checkbox-symbol'."
@@ -197,8 +232,15 @@ See also `eww-form-checkbox-selected-symbol'."
(const "☐") ; Unicode BALLOT BOX
string))
+(defcustom eww-url-transformers '(eww-remove-tracking)
+ "This is a list of transforming functions applied to an URL before usage.
+The functions will be called with the URL as the single
+parameter, and should return the (possibly) transformed URL."
+ :type '(repeat function)
+ :version "29.1")
+
(defface eww-form-submit
- '((((type x w32 ns) (class color)) ; Like default mode line
+ '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "#808080" :foreground "black"))
"Face for eww buffer buttons."
@@ -206,7 +248,7 @@ See also `eww-form-checkbox-selected-symbol'."
:group 'eww)
(defface eww-form-file
- '((((type x w32 ns) (class color)) ; Like default mode line
+ '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "#808080" :foreground "black"))
"Face for eww buffer buttons."
@@ -214,7 +256,7 @@ See also `eww-form-checkbox-selected-symbol'."
:group 'eww)
(defface eww-form-checkbox
- '((((type x w32 ns) (class color)) ; Like default mode line
+ '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for eww buffer buttons."
@@ -222,7 +264,7 @@ See also `eww-form-checkbox-selected-symbol'."
:group 'eww)
(defface eww-form-select
- '((((type x w32 ns) (class color)) ; Like default mode line
+ '((((type x w32 ns haiku pgtk) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for eww buffer buttons."
@@ -269,17 +311,15 @@ See also `eww-form-checkbox-selected-symbol'."
(defvar eww-accept-content-types
"text/html, text/plain, text/sgml, text/css, application/xhtml+xml, */*;q=0.01"
- "Value used for the HTTP 'Accept' header.")
+ "Value used for the HTTP \"Accept\" header.")
-(defvar eww-link-keymap
- (let ((map (copy-keymap shr-map)))
- (define-key map "\r" 'eww-follow-link)
- map))
+(defvar-keymap eww-link-keymap
+ :parent shr-map
+ "RET" #'eww-follow-link)
-(defvar eww-image-link-keymap
- (let ((map (copy-keymap shr-image-map)))
- (define-key map "\r" 'eww-follow-link)
- map))
+(defvar-keymap eww-image-link-keymap
+ :parent shr-map
+ "RET" #'eww-follow-link)
(defun eww-suggested-uris nil
"Return the list of URIs to suggest at the `eww' prompt.
@@ -313,27 +353,29 @@ will start Emacs and browse the GNU web site."
;;;###autoload
-(defun eww (url &optional arg buffer)
+(defun eww (url &optional new-buffer buffer)
"Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'.
-If called with a prefix ARG, use a new buffer instead of reusing
-the default EWW buffer.
+If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
+new buffer instead of reusing the default EWW buffer.
If BUFFER, the data to be rendered is in that buffer. In that
case, this function doesn't actually fetch URL. BUFFER will be
-killed after rendering."
+killed after rendering.
+
+For more information, see Info node `(eww) Top'."
(interactive
(let ((uris (eww-suggested-uris)))
(list (read-string (format-prompt "Enter URL or keywords"
(and uris (car uris)))
nil 'eww-prompt-history uris)
- (prefix-numeric-value current-prefix-arg))))
+ current-prefix-arg)))
(setq url (eww--dwim-expand-url url))
(pop-to-buffer-same-window
(cond
- ((eq arg 4)
+ (new-buffer
(generate-new-buffer "*eww*"))
((eq major-mode 'eww-mode)
(current-buffer))
@@ -353,9 +395,10 @@ killed after rendering."
(while (string-match "\\`/[.][.]/" (url-filename parsed))
(setf (url-filename parsed) (substring (url-filename parsed) 3))))
(setq url (url-recreate-url parsed)))
+ (setq url (eww--transform-url url))
(plist-put eww-data :url url)
(plist-put eww-data :title "")
- (eww-update-header-line-format)
+ (eww--after-page-change)
(let ((inhibit-read-only t))
(insert (format "Loading %s..." url))
(goto-char (point-min)))
@@ -447,22 +490,21 @@ killed after rendering."
(defun eww-open-file (file)
"Render FILE using EWW."
(interactive "fFile: ")
- (eww (concat "file://"
- (and (memq system-type '(windows-nt ms-dos))
- "/")
- (expand-file-name file))
- nil
- ;; The file name may be a non-local Tramp file. The URL
- ;; library doesn't understand these file names, so use the
- ;; normal Emacs machinery to load the file.
- (with-current-buffer (generate-new-buffer " *eww file*")
- (set-buffer-multibyte nil)
- (insert "Content-type: " (or (mailcap-extension-to-mime
- (url-file-extension file))
- "application/octet-stream")
- "\n\n")
- (insert-file-contents file)
- (current-buffer))))
+ (let ((url-allow-non-local-files t))
+ (eww (concat "file://"
+ (and (memq system-type '(windows-nt ms-dos))
+ "/")
+ (expand-file-name file)))))
+
+(defun eww--file-buffer (file)
+ (with-current-buffer (generate-new-buffer " *eww file*")
+ (set-buffer-multibyte nil)
+ (insert "Content-type: " (or (mailcap-extension-to-mime
+ (url-file-extension file))
+ "application/octet-stream")
+ "\n\n")
+ (insert-file-contents file)
+ (current-buffer)))
;;;###autoload
(defun eww-search-words ()
@@ -504,6 +546,30 @@ Currently this means either text/html or application/xhtml+xml."
(member content-type '("text/html"
"application/xhtml+xml")))
+(defun eww--rename-buffer ()
+ "Rename the current EWW buffer.
+The renaming scheme is performed in accordance with
+`eww-auto-rename-buffer'."
+ (let ((rename-string)
+ (formatter
+ (lambda (string)
+ (format "*%s # eww*" (truncate-string-to-width
+ string eww-buffer-name-length))))
+ (site-title (plist-get eww-data :title))
+ (site-url (plist-get eww-data :url)))
+ (cond ((null eww-auto-rename-buffer))
+ ((eq eww-auto-rename-buffer 'url)
+ (setq rename-string (funcall formatter site-url)))
+ ((functionp eww-auto-rename-buffer)
+ (setq rename-string (funcall eww-auto-rename-buffer)))
+ (t (setq rename-string
+ (funcall formatter (if (or (equal site-title "")
+ (null site-title))
+ "Untitled"
+ site-title)))))
+ (when rename-string
+ (rename-buffer rename-string t))))
+
(defun eww-render (status url &optional point buffer encode)
(let* ((headers (eww-parse-headers))
(content-type
@@ -554,7 +620,7 @@ Currently this means either text/html or application/xhtml+xml."
(eww-display-raw buffer (or encode charset 'utf-8))))
(with-current-buffer buffer
(plist-put eww-data :url url)
- (eww-update-header-line-format)
+ (eww--after-page-change)
(setq eww-history-position 0)
(and last-coding-system-used
(set-buffer-file-coding-system last-coding-system-used))
@@ -638,14 +704,15 @@ Currently this means either text/html or application/xhtml+xml."
(meta . eww-tag-meta)
(a . eww-tag-a)))))
(erase-buffer)
- (shr-insert-document document)
+ (with-delayed-message (2 "Rendering HTML...")
+ (shr-insert-document document))
(cond
(point
(goto-char point))
(shr-target-id
(goto-char (point-min))
(let ((match (text-property-search-forward
- 'shr-target-id shr-target-id t)))
+ 'shr-target-id shr-target-id #'member)))
(when match
(goto-char (prop-match-beginning match)))))
(t
@@ -768,7 +835,7 @@ Currently this means either text/html or application/xhtml+xml."
(when url
(setq url (propertize url 'face 'variable-pitch))
(let* ((parsed (url-generic-parse-url url))
- (host-length (shr-string-pixel-width
+ (host-length (string-pixel-width
(propertize
(format "%s://%s" (url-type parsed)
(url-host parsed))
@@ -777,17 +844,17 @@ Currently this means either text/html or application/xhtml+xml."
(cond
;; The host bit is wider than the window, so nix
;; the title.
- ((> (+ host-length (shr-string-pixel-width "xxxxx")) width)
+ ((> (+ host-length (string-pixel-width "xxxxx")) width)
(setq title ""))
;; Trim the title.
- ((> (+ (shr-string-pixel-width (concat title "xx"))
+ ((> (+ (string-pixel-width (concat title "xx"))
host-length)
width)
(setq title
(concat
(eww--limit-string-pixelwise
title (- width host-length
- (shr-string-pixel-width
+ (string-pixel-width
(propertize "...: " 'face
'variable-pitch))))
(propertize "..." 'face 'variable-pitch)))))))
@@ -798,12 +865,16 @@ Currently this means either text/html or application/xhtml+xml."
`((?u . ,(or url ""))
(?t . ,title))))))))
+(defun eww--after-page-change ()
+ (eww-update-header-line-format)
+ (eww--rename-buffer))
+
(defun eww-tag-title (dom)
(plist-put eww-data :title
(replace-regexp-in-string
"^ \\| $" ""
(replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
- (eww-update-header-line-format))
+ (eww--after-page-change))
(defun eww-display-raw (buffer &optional encode)
(let ((data (buffer-substring (point) (point-max))))
@@ -863,9 +934,9 @@ Currently this means either text/html or application/xhtml+xml."
(defun eww-links-at-point ()
"Return list of URIs, if any, linked at point."
- (remq nil
- (list (get-text-property (point) 'shr-url)
- (get-text-property (point) 'image-url))))
+ (seq-filter #'stringp
+ (list (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url))))
(defun eww-view-source ()
"View the HTML source code of the current page."
@@ -931,7 +1002,7 @@ the like."
nil (current-buffer))
(dolist (elem '(:source :url :title :next :previous :up))
(plist-put eww-data elem (plist-get old-data elem)))
- (eww-update-header-line-format)))
+ (eww--after-page-change)))
(defun eww-score-readability (node)
(let ((score -1))
@@ -973,67 +1044,67 @@ the like."
(setq result highest))))
result))
-(defvar eww-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead!
- (define-key map "G" 'eww)
- (define-key map [?\M-\r] 'eww-open-in-new-buffer)
- (define-key map [?\t] 'shr-next-link)
- (define-key map [?\M-\t] 'shr-previous-link)
- (define-key map [backtab] 'shr-previous-link)
- (define-key map [delete] 'scroll-down-command)
- (define-key map "l" 'eww-back-url)
- (define-key map "r" 'eww-forward-url)
- (define-key map "n" 'eww-next-url)
- (define-key map "p" 'eww-previous-url)
- (define-key map "u" 'eww-up-url)
- (define-key map "t" 'eww-top-url)
- (define-key map "&" 'eww-browse-with-external-browser)
- (define-key map "d" 'eww-download)
- (define-key map "w" 'eww-copy-page-url)
- (define-key map "C" 'url-cookie-list)
- (define-key map "v" 'eww-view-source)
- (define-key map "R" 'eww-readable)
- (define-key map "H" 'eww-list-histories)
- (define-key map "E" 'eww-set-character-encoding)
- (define-key map "s" 'eww-switch-to-buffer)
- (define-key map "S" 'eww-list-buffers)
- (define-key map "F" 'eww-toggle-fonts)
- (define-key map "D" 'eww-toggle-paragraph-direction)
- (define-key map [(meta C)] 'eww-toggle-colors)
- (define-key map [(meta I)] 'eww-toggle-images)
-
- (define-key map "b" 'eww-add-bookmark)
- (define-key map "B" 'eww-list-bookmarks)
- (define-key map [(meta n)] 'eww-next-bookmark)
- (define-key map [(meta p)] 'eww-previous-bookmark)
-
- (easy-menu-define nil map ""
- '("Eww"
- ["Exit" quit-window t]
- ["Close browser" quit-window t]
- ["Reload" eww-reload t]
- ["Follow URL in new buffer" eww-open-in-new-buffer]
- ["Back to previous page" eww-back-url
- :active (not (zerop (length eww-history)))]
- ["Forward to next page" eww-forward-url
- :active (not (zerop eww-history-position))]
- ["Browse with external browser" eww-browse-with-external-browser t]
- ["Download" eww-download t]
- ["View page source" eww-view-source]
- ["Copy page URL" eww-copy-page-url t]
- ["List histories" eww-list-histories t]
- ["Switch to buffer" eww-switch-to-buffer t]
- ["List buffers" eww-list-buffers t]
- ["Add bookmark" eww-add-bookmark t]
- ["List bookmarks" eww-list-bookmarks t]
- ["List cookies" url-cookie-list t]
- ["Toggle fonts" eww-toggle-fonts t]
- ["Toggle colors" eww-toggle-colors t]
- ["Toggle images" eww-toggle-images t]
- ["Character Encoding" eww-set-character-encoding]
- ["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
- map))
+(defvar-keymap eww-mode-map
+ "g" #'eww-reload ;FIXME: revert-buffer-function instead!
+ "G" #'eww
+ "M-RET" #'eww-open-in-new-buffer
+ "TAB" #'shr-next-link
+ "C-M-i" #'shr-previous-link
+ "<backtab>" #'shr-previous-link
+ "<delete>" #'scroll-down-command
+ "l" #'eww-back-url
+ "r" #'eww-forward-url
+ "n" #'eww-next-url
+ "p" #'eww-previous-url
+ "u" #'eww-up-url
+ "t" #'eww-top-url
+ "&" #'eww-browse-with-external-browser
+ "d" #'eww-download
+ "w" #'eww-copy-page-url
+ "C" #'url-cookie-list
+ "v" #'eww-view-source
+ "R" #'eww-readable
+ "H" #'eww-list-histories
+ "E" #'eww-set-character-encoding
+ "s" #'eww-switch-to-buffer
+ "S" #'eww-list-buffers
+ "F" #'eww-toggle-fonts
+ "D" #'eww-toggle-paragraph-direction
+ "M-C" #'eww-toggle-colors
+ "M-I" #'eww-toggle-images
+
+ "b" #'eww-add-bookmark
+ "B" #'eww-list-bookmarks
+ "M-n" #'eww-next-bookmark
+ "M-p" #'eww-previous-bookmark
+
+ "<mouse-8>" #'eww-back-url
+ "<mouse-9>" #'eww-forward-url
+
+ :menu '("Eww"
+ ["Exit" quit-window t]
+ ["Close browser" quit-window t]
+ ["Reload" eww-reload t]
+ ["Follow URL in new buffer" eww-open-in-new-buffer]
+ ["Back to previous page" eww-back-url
+ :active (not (zerop (length eww-history)))]
+ ["Forward to next page" eww-forward-url
+ :active (not (zerop eww-history-position))]
+ ["Browse with external browser" eww-browse-with-external-browser t]
+ ["Download" eww-download t]
+ ["View page source" eww-view-source]
+ ["Copy page URL" eww-copy-page-url t]
+ ["List histories" eww-list-histories t]
+ ["Switch to buffer" eww-switch-to-buffer t]
+ ["List buffers" eww-list-buffers t]
+ ["Add bookmark" eww-add-bookmark t]
+ ["List bookmarks" eww-list-bookmarks t]
+ ["List cookies" url-cookie-list t]
+ ["Toggle fonts" eww-toggle-fonts t]
+ ["Toggle colors" eww-toggle-colors t]
+ ["Toggle images" eww-toggle-images t]
+ ["Character Encoding" eww-set-character-encoding]
+ ["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
(defun eww-context-menu (menu click)
"Populate MENU with eww commands at CLICK."
@@ -1135,7 +1206,10 @@ instead of `browse-url-new-window-flag'."
(format "*eww-%s*" (url-host (url-generic-parse-url
(eww--dwim-expand-url url))))))
(eww-mode))
- (eww url))
+ (let ((url-allow-non-local-files t))
+ (eww url)))
+
+(function-put 'eww-browse-url 'browse-url-browser-kind 'internal)
(defun eww-back-url ()
"Go to the previously displayed page."
@@ -1166,7 +1240,7 @@ instead of `browse-url-new-window-flag'."
(goto-char (plist-get elem :point))
;; Make buffer listings more informative.
(setq list-buffers-directory (plist-get elem :url))
- (eww-update-header-line-format))))
+ (eww--after-page-change))))
(defun eww-next-url ()
"Go to the page marked `next'.
@@ -1222,62 +1296,58 @@ just re-display the HTML already fetched."
(error "No current HTML data")
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
(point) (current-buffer)))
- (let ((url-mime-accept-string eww-accept-content-types))
- (eww-retrieve url #'eww-render
- (list url (point) (current-buffer) encode))))))
+ (let ((parsed (url-generic-parse-url url)))
+ (if (equal (url-type parsed) "file")
+ ;; Use Tramp instead of url.el for files (since url.el
+ ;; doesn't work well with Tramp files).
+ (let ((eww-buffer (current-buffer)))
+ (with-current-buffer (eww--file-buffer (url-filename parsed))
+ (eww-render nil url nil eww-buffer)))
+ (let ((url-mime-accept-string eww-accept-content-types))
+ (eww-retrieve url #'eww-render
+ (list url (point) (current-buffer) encode))))))))
;; Form support.
(defvar eww-form nil)
-(defvar eww-submit-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'eww-submit)
- (define-key map [(control c) (control c)] 'eww-submit)
- map))
-
-(defvar eww-submit-file
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'eww-select-file)
- (define-key map [(control c) (control c)] 'eww-submit)
- map))
-
-(defvar eww-checkbox-map
- (let ((map (make-sparse-keymap)))
- (define-key map " " 'eww-toggle-checkbox)
- (define-key map "\r" 'eww-toggle-checkbox)
- (define-key map [(control c) (control c)] 'eww-submit)
- map))
-
-(defvar eww-text-map
- (let ((map (make-keymap)))
- (set-keymap-parent map text-mode-map)
- (define-key map "\r" 'eww-submit)
- (define-key map [(control a)] 'eww-beginning-of-text)
- (define-key map [(control c) (control c)] 'eww-submit)
- (define-key map [(control e)] 'eww-end-of-text)
- (define-key map [?\t] 'shr-next-link)
- (define-key map [?\M-\t] 'shr-previous-link)
- (define-key map [backtab] 'shr-previous-link)
- map))
-
-(defvar eww-textarea-map
- (let ((map (make-keymap)))
- (set-keymap-parent map text-mode-map)
- (define-key map "\r" 'forward-line)
- (define-key map [(control c) (control c)] 'eww-submit)
- (define-key map [?\t] 'shr-next-link)
- (define-key map [?\M-\t] 'shr-previous-link)
- (define-key map [backtab] 'shr-previous-link)
- map))
-
-(defvar eww-select-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'eww-change-select)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'eww-change-select)
- (define-key map [(control c) (control c)] 'eww-submit)
- map))
+(defvar-keymap eww-submit-map
+ "RET" #'eww-submit
+ "C-c C-c" #'eww-submit)
+
+(defvar-keymap eww-submit-file
+ "RET" #'eww-select-file
+ "C-c C-c" #'eww-submit)
+
+(defvar-keymap eww-checkbox-map
+ "SPC" #'eww-toggle-checkbox
+ "RET" #'eww-toggle-checkbox
+ "C-c C-c" #'eww-submit)
+
+(defvar-keymap eww-text-map
+ :full t :parent text-mode-map
+ "RET" #'eww-submit
+ "C-a" #'eww-beginning-of-text
+ "C-c C-c" #'eww-submit
+ "C-e" #'eww-end-of-text
+ "TAB" #'shr-next-link
+ "M-TAB" #'shr-previous-link
+ "<backtab>" #'shr-previous-link)
+
+(defvar-keymap eww-textarea-map
+ :full t :parent text-mode-map
+ "RET" #'forward-line
+ "C-c C-c" #'eww-submit
+ "TAB" #'shr-next-link
+ "M-TAB" #'shr-previous-link
+ "<backtab>" #'shr-previous-link)
+
+(defvar-keymap eww-select-map
+ :doc "Map for select buttons"
+ "RET" #'eww-change-select
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'eww-change-select
+ "C-c C-c" #'eww-submit)
(defun eww-beginning-of-text ()
"Move to the start of the input field."
@@ -1784,6 +1854,17 @@ The browser to used is specified by the
(funcall browse-url-secondary-browser-function
(or url (plist-get eww-data :url))))
+(defun eww-remove-tracking (url)
+ "Remove the commong utm_ tracking cookies from URLs."
+ (replace-regexp-in-string ".utm_.*" "" url))
+
+(defun eww--transform-url (url)
+ "Apply `eww-url-transformers'."
+ (when url
+ (dolist (func eww-url-transformers)
+ (setq url (funcall func url)))
+ url))
+
(defun eww-follow-link (&optional external mouse-event)
"Browse the URL under point.
If EXTERNAL is single prefix, browse the URL using
@@ -1794,7 +1875,8 @@ If EXTERNAL is double prefix, browse in new buffer."
(list current-prefix-arg last-nonmenu-event)
eww-mode)
(mouse-set-point mouse-event)
- (let ((url (get-text-property (point) 'shr-url)))
+ (let* ((orig-url (get-text-property (point) 'shr-url))
+ (url (eww--transform-url orig-url)))
(cond
((not url)
(message "No link under point"))
@@ -1813,7 +1895,7 @@ If EXTERNAL is double prefix, browse in new buffer."
(plist-put eww-data :url url)
(eww-display-html 'utf-8 url dom nil (current-buffer))))
(t
- (eww-browse-url url external)))))
+ (eww-browse-url orig-url external)))))
(defun eww-same-page-p (url1 url2)
"Return non-nil if URL1 and URL2 represent the same page.
@@ -1975,7 +2057,9 @@ If CHARSET is nil then use UTF-8."
(defun eww-write-bookmarks ()
(with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
(insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
- (pp eww-bookmarks (current-buffer))))
+ (let ((print-length nil)
+ (print-level nil))
+ (pp eww-bookmarks (current-buffer)))))
(defun eww-read-bookmarks (&optional error-out)
"Read bookmarks from `eww-bookmarks'.
@@ -2100,23 +2184,18 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
'eww-bookmark)))
(eww-browse-url (plist-get bookmark :url))))
-(defvar eww-bookmark-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(control k)] 'eww-bookmark-kill)
- (define-key map [(control y)] 'eww-bookmark-yank)
- (define-key map "\r" 'eww-bookmark-browse)
-
- (easy-menu-define nil map
- "Menu for `eww-bookmark-mode-map'."
- '("Eww Bookmark"
- ["Exit" quit-window t]
- ["Browse" eww-bookmark-browse
- :active (get-text-property (line-beginning-position) 'eww-bookmark)]
- ["Kill" eww-bookmark-kill
- :active (get-text-property (line-beginning-position) 'eww-bookmark)]
- ["Yank" eww-bookmark-yank
- :active eww-bookmark-kill-ring]))
- map))
+(defvar-keymap eww-bookmark-mode-map
+ "C-k" #'eww-bookmark-kill
+ "C-y" #'eww-bookmark-yank
+ "RET" #'eww-bookmark-browse
+ :menu '("Eww Bookmark"
+ ["Exit" quit-window t]
+ ["Browse" eww-bookmark-browse
+ :active (get-text-property (line-beginning-position) 'eww-bookmark)]
+ ["Kill" eww-bookmark-kill
+ :active (get-text-property (line-beginning-position) 'eww-bookmark)]
+ ["Yank" eww-bookmark-yank
+ :active eww-bookmark-kill-ring]))
(define-derived-mode eww-bookmark-mode special-mode "eww bookmarks"
"Mode for listing bookmarks.
@@ -2181,19 +2260,15 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(pop-to-buffer-same-window buffer)))
(eww-restore-history history)))
-(defvar eww-history-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'eww-history-browse)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
-
- (easy-menu-define nil map
- "Menu for `eww-history-mode-map'."
- '("Eww History"
- ["Exit" quit-window t]
- ["Browse" eww-history-browse
- :active (get-text-property (line-beginning-position) 'eww-history)]))
- map))
+(defvar-keymap eww-history-mode-map
+ "RET" #'eww-history-browse
+ "n" #'next-line
+ "p" #'previous-line
+ :menu '("Eww History"
+ ["Exit" quit-window t]
+ ["Browse" eww-history-browse
+ :active (get-text-property (line-beginning-position)
+ 'eww-history)]))
(define-derived-mode eww-history-mode special-mode "eww history"
"Mode for listing eww-histories.
@@ -2304,22 +2379,18 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(forward-line -1))
(eww-buffer-show))
-(defvar eww-buffers-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(control k)] 'eww-buffer-kill)
- (define-key map "\r" 'eww-buffer-select)
- (define-key map "n" 'eww-buffer-show-next)
- (define-key map "p" 'eww-buffer-show-previous)
-
- (easy-menu-define nil map
- "Menu for `eww-buffers-mode-map'."
- '("Eww Buffers"
- ["Exit" quit-window t]
- ["Select" eww-buffer-select
- :active (get-text-property (line-beginning-position) 'eww-buffer)]
- ["Kill" eww-buffer-kill
- :active (get-text-property (line-beginning-position) 'eww-buffer)]))
- map))
+(defvar-keymap eww-buffers-mode-map
+ "C-k" #'eww-buffer-kill
+ "RET" #'eww-buffer-select
+ "n" #'eww-buffer-show-next
+ "p" #'eww-buffer-show-previous
+ :menu '("Eww Buffers"
+ ["Exit" quit-window t]
+ ["Select" eww-buffer-select
+ :active (get-text-property (line-beginning-position) 'eww-buffer)]
+ ["Kill" eww-buffer-kill
+ :active (get-text-property (line-beginning-position)
+ 'eww-buffer)]))
(define-derived-mode eww-buffers-mode special-mode "eww buffers"
"Mode for listing buffers.
@@ -2442,6 +2513,8 @@ Otherwise, the restored buffer will contain a prompt to do so by using
"Default bookmark handler for EWW buffers."
(eww (bookmark-prop-get bookmark 'location)))
+(put 'eww-bookmark-jump 'bookmark-handler-type "EWW")
+
(provide 'eww)
;;; eww.el ends here
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index 13af2c123f8..0c8a29cc392 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -37,6 +37,7 @@ a string and return a digest of it (in binary form).
B is a byte length of a block size of H. (B=64 for both SHA1 and MD5.)
L is a byte length of hash outputs. (L=16 for MD5, L=20 for SHA1.)
If BIT is non-nil, truncate output to specified bits."
+ (declare (indent defun))
`(defun ,name (text key)
,(concat "Compute "
(upcase (symbol-name name))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index ce6c270e0bc..0f2943cbb03 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -54,7 +54,7 @@ a separator."
Initialized from the LDAP library at build time.
Default value is 389."
:type '(choice (const :tag "Use library default" nil)
- (integer :tag "Port number")))
+ (natnum :tag "Port number")))
(defcustom ldap-default-base nil
"Default base for LDAP searches.
@@ -148,7 +148,7 @@ Valid properties include:
"The name of the ldapsearch command line program."
:type '(string :tag "`ldapsearch' Program"))
-(defcustom ldap-ldapsearch-args '("-LL" "-tt")
+(defcustom ldap-ldapsearch-args '("-LLL" "-tt")
"A list of additional arguments to pass to `ldapsearch'."
:type '(repeat :tag "`ldapsearch' Arguments"
(string :tag "Argument")))
@@ -663,7 +663,7 @@ an alist of attribute/value pairs."
(while (not (memq (process-status proc) '(exit signal)))
(sit-for 0.1))
(let ((status (process-exit-status proc)))
- (when (not (eq status 0))
+ (when (not (memql status '(0 4))) ; 4 = Size limit exceeded
;; Handle invalid credentials exit status specially
;; for ldap-password-read.
(if (eq status 49)
@@ -682,7 +682,7 @@ an alist of attribute/value pairs."
(while (re-search-forward (concat "[\t\n\f]+ \\|"
ldap-ldapsearch-password-prompt-regexp)
nil t)
- (replace-match "" nil nil))
+ (replace-match ""))
(goto-char (point-min))
(if (looking-at "usage")
@@ -691,7 +691,6 @@ an alist of attribute/value pairs."
;; Skip error message when retrieving attribute list
(if (looking-at "Size limit exceeded")
(forward-line 1))
- (if (looking-at "version:") (forward-line 1)) ;bug#12724.
(while (progn
(skip-chars-forward " \t\n")
(not (eobp)))
@@ -699,7 +698,7 @@ an alist of attribute/value pairs."
(forward-line 1)
(while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
\\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
-\\(<[\t ]*file://\\)\\(.*\\)$")
+\\(<[\t ]*file://\\)?\\(.*\\)$")
(setq name (match-string 1)
value (match-string 4))
;; Need to handle file:///D:/... as generated by OpenLDAP
@@ -724,7 +723,6 @@ an alist of attribute/value pairs."
(record
(push (nreverse record) result)))
(setq record nil)
- (skip-chars-forward " \t\n")
(message "Parsing results... %d" numres)
(setq numres (1+ numres)))
(message "Parsing results... done")
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index a59220c1be8..8ba7f1bec3d 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -55,7 +55,7 @@ you have an entry for \"image/*\" in your ~/.mailcap file."
"A syntax table for parsing SGML attributes.")
(defvar mailcap-print-command
- (mapconcat 'identity
+ (mapconcat #'identity
(cons (if (boundp 'lpr-command)
lpr-command
"lpr")
@@ -116,8 +116,7 @@ is consulted."
(regexp :tag "MIME Type")
(sexp :tag "Test (optional)")))
:get #'mailcap--get-user-mime-data
- :set #'mailcap--set-user-mime-data
- :group 'mailcap)
+ :set #'mailcap--set-user-mime-data)
;; Postpone using defcustom for this as it's so big and we essentially
;; have to have two copies of the data around then. Perhaps just
@@ -320,8 +319,9 @@ attribute name (viewer, test, etc). This looks like:
Where VIEWERINFO specifies how the content-type is viewed. Can be
a string, in which case it is run through a shell, with appropriate
-parameters, or a symbol, in which case the symbol is `funcall'ed if
-and only if it exists as a function, with the buffer as an argument.
+parameters, or a symbol, in which case the symbol must name a function
+of zero arguments which is called in a buffer holding the MIME part's
+content.
TESTINFO is a test for the viewer's applicability, or nil. If nil, it
means the viewer is always valid. If it is a Lisp function, it is
@@ -344,8 +344,7 @@ Same format as `mailcap-mime-data'.")
"Directory to which `mailcap-save-binary-file' downloads files by default.
nil means your home directory."
:type '(choice (const :tag "Home directory" nil)
- directory)
- :group 'mailcap)
+ directory))
(defvar mailcap-poor-system-types
'(ms-dos windows-nt)
@@ -423,14 +422,6 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
(interactive (list nil t))
(when (or (not mailcap-parsed-p)
force)
- ;; Clear out all old data.
- (setq mailcap--computed-mime-data nil)
- ;; Add the Emacs-distributed defaults (which will be used as
- ;; fallbacks). Do it this way instead of just copying the list,
- ;; since entries are destructively modified.
- (cl-loop for (major . minors) in mailcap-mime-data
- do (cl-loop for (minor . entry) in minors
- do (mailcap-add-mailcap-entry major minor entry)))
(cond
(path nil)
((getenv "MAILCAPS")
@@ -447,18 +438,27 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
("/etc/mailcap" system)
("/usr/etc/mailcap" system)
("/usr/local/etc/mailcap" system)))))
- ;; The ~/.mailcap entries will end up first in the resulting data.
- (dolist (spec (reverse
- (if (stringp path)
- (split-string path path-separator t)
- path)))
- (let ((source (and (consp spec) (cadr spec)))
- (file-name (if (stringp spec)
- spec
- (car spec))))
- (when (and (file-readable-p file-name)
- (file-regular-p file-name))
- (mailcap-parse-mailcap file-name source))))
+ (when (stringp path)
+ (setq path (mapcar #'list (split-string path path-separator t))))
+ (when (or (null mailcap--computed-mime-data)
+ (seq-some (lambda (f)
+ (file-has-changed-p (car f) 'mail-parse-mailcaps))
+ path))
+ ;; Clear out all old data.
+ (setq mailcap--computed-mime-data nil)
+ ;; Add the Emacs-distributed defaults (which will be used as
+ ;; fallbacks). Do it this way instead of just copying the list,
+ ;; since entries are destructively modified.
+ (cl-loop for (major . minors) in mailcap-mime-data
+ do (cl-loop for (minor . entry) in minors
+ do (mailcap-add-mailcap-entry major minor entry)))
+ ;; The ~/.mailcap entries will end up first in the resulting data.
+ (dolist (spec (reverse path))
+ (let ((source (cadr spec))
+ (file-name (car spec)))
+ (when (and (file-readable-p file-name)
+ (file-regular-p file-name))
+ (mailcap-parse-mailcap file-name source)))))
(setq mailcap-parsed-p t)))
(defun mailcap-parse-mailcap (fname &optional source)
@@ -636,7 +636,7 @@ the test clause will be unchanged."
((and (listp test) (symbolp (car test))) test)
((or (stringp test)
(and (listp test) (stringp (car test))
- (setq test (mapconcat 'identity test " "))))
+ (setq test (mapconcat #'identity test " "))))
(with-temp-buffer
(insert test)
(goto-char (point-min))
@@ -707,12 +707,12 @@ to supply to the test."
(symbol-value test))
((and (listp test) ; List to be eval'd
(symbolp (car test)))
- (eval test))
+ (eval test t))
(t
(setq test (mailcap-unescape-mime-test test type-info)
test (list shell-file-name nil nil nil
shell-command-switch test)
- status (apply 'call-process test))
+ status (apply #'call-process test))
(eq 0 status))))
(push (list otest result) mailcap-viewer-test-cache)
result))))
@@ -837,7 +837,7 @@ If NO-DECODE is non-nil, don't decode STRING."
(dolist (entry viewers)
(when (mailcap-viewer-passes-test entry info)
(push entry passed)))
- (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
+ (setq passed (sort (nreverse passed) #'mailcap-viewer-lessp))
;; When we want to prefer entries from the user's
;; ~/.mailcap file, then we filter out the system entries
;; and see whether we have anything left.
@@ -1065,12 +1065,21 @@ For instance, \"foo.png\" will result in \"image/png\"."
(match-string 1 file-name)
"")))
+;;;###autoload
+(defun mailcap-mime-type-to-extension (mime-type)
+ "Return a file name extension based on a MIME-TYPE.
+For instance, `image/png' will result in `png'."
+ (intern (cadr (split-string (if (symbolp mime-type)
+ (symbol-name mime-type)
+ mime-type)
+ "/"))))
+
(defun mailcap-mime-types ()
"Return a list of MIME media types."
(mailcap-parse-mimetypes)
(delete-dups
(nconc
- (mapcar 'cdr mailcap-mime-extensions)
+ (mapcar #'cdr mailcap-mime-extensions)
(let (res type)
(dolist (data mailcap--computed-mime-data)
(dolist (info (cdr data))
@@ -1089,11 +1098,12 @@ For instance, \"foo.png\" will result in \"image/png\"."
(mailcap-parse-mimetypes)
(let* ((all-mime-type
;; All unique MIME types from file extensions
- (delete-dups
- (mapcar (lambda (file)
- (mailcap-extension-to-mime
- (file-name-extension file t)))
- files)))
+ (delq nil
+ (delete-dups
+ (mapcar (lambda (file)
+ (mailcap-extension-to-mime
+ (file-name-extension file t)))
+ files))))
(all-mime-info
;; All MIME info lists
(delete-dups
@@ -1167,34 +1177,45 @@ See \"~/.mailcap\", `mailcap-mime-data' and related files and variables."
(mailcap-parse-mailcaps)
(let ((command (mailcap-mime-info
(mailcap-extension-to-mime (file-name-extension file)))))
- (unless command
- (error "No viewer for %s" (file-name-extension file)))
- ;; Remove quotes around the file name - we'll use shell-quote-argument.
- (while (string-match "['\"]%s['\"]" command)
- (setq command (replace-match "%s" t t command)))
- (setq command (replace-regexp-in-string
- "%s"
- (shell-quote-argument (convert-standard-filename file))
- command
- nil t))
- ;; Handlers such as "gio open" and kde-open5 start viewer in background
- ;; and exit immediately. Avoid `start-process' since it assumes
- ;; :connection-type `pty' and kills children processes with SIGHUP
- ;; when temporary terminal session is finished (Bug#44824).
- ;; An alternative is `process-connection-type' let-bound to nil for
- ;; `start-process-shell-command' call (with no chance to report failure).
- (make-process
- :name "mailcap-view-file"
- :connection-type 'pipe
- :buffer nil ; "*Messages*" may be suitable for debugging
- :sentinel (lambda (proc event)
- (when (and (memq (process-status proc) '(exit signal))
- (/= (process-exit-status proc) 0))
- (message
- "Command %s: %s."
- (mapconcat #'identity (process-command proc) " ")
- (substring event 0 -1))))
- :command (list shell-file-name shell-command-switch command))))
+ (if (functionp command)
+ ;; command is a viewer function (a mode) expecting the file
+ ;; contents to be in the current buffer.
+ (let ((buf (generate-new-buffer (file-name-nondirectory file))))
+ (set-buffer buf)
+ (insert-file-contents file)
+ (setq buffer-file-name file)
+ (funcall command)
+ (set-buffer-modified-p nil)
+ (pop-to-buffer buf))
+ ;; command is a program to run with file as an argument.
+ (unless command
+ (error "No viewer for %s" (file-name-extension file)))
+ ;; Remove quotes around the file name - we'll use shell-quote-argument.
+ (while (string-match "['\"]%s['\"]" command)
+ (setq command (replace-match "%s" t t command)))
+ (setq command (replace-regexp-in-string
+ "%s"
+ (shell-quote-argument (convert-standard-filename file))
+ command
+ nil t))
+ ;; Handlers such as "gio open" and kde-open5 start viewer in background
+ ;; and exit immediately. Avoid `start-process' since it assumes
+ ;; :connection-type `pty' and kills children processes with SIGHUP
+ ;; when temporary terminal session is finished (Bug#44824).
+ ;; An alternative is `process-connection-type' let-bound to nil for
+ ;; `start-process-shell-command' call (with no chance to report failure).
+ (make-process
+ :name "mailcap-view-file"
+ :connection-type 'pipe
+ :buffer nil ; "*Messages*" may be suitable for debugging
+ :sentinel (lambda (proc event)
+ (when (and (memq (process-status proc) '(exit signal))
+ (/= (process-exit-status proc) 0))
+ (message
+ "Command %s: %s."
+ (mapconcat #'identity (process-command proc) " ")
+ (substring event 0 -1))))
+ :command (list shell-file-name shell-command-switch command)))))
(provide 'mailcap)
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index d84763b1626..0b99d2a0b7c 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -743,21 +743,20 @@ VALUES may contain values for editable fields from current article."
;;;; Major mode for editing/deleting/saving searches
-(defvar mairix-searches-mode-map
- (let ((map (make-keymap)))
- (define-key map [(return)] 'mairix-select-search)
- (define-key map [(down)] 'mairix-next-search)
- (define-key map [(up)] 'mairix-previous-search)
- (define-key map [(right)] 'mairix-next-search)
- (define-key map [(left)] 'mairix-previous-search)
- (define-key map "\C-p" 'mairix-previous-search)
- (define-key map "\C-n" 'mairix-next-search)
- (define-key map [(q)] 'mairix-select-quit)
- (define-key map [(e)] 'mairix-select-edit)
- (define-key map [(d)] 'mairix-select-delete)
- (define-key map [(s)] 'mairix-select-save)
- map)
- "`mairix-searches-mode' keymap.")
+(defvar-keymap mairix-searches-mode-map
+ :doc "`mairix-searches-mode' keymap."
+ :full t
+ "<return>" #'mairix-select-search
+ "<down>" #'mairix-next-search
+ "<up>" #'mairix-previous-search
+ "<right>" #'mairix-next-search
+ "<left>" #'mairix-previous-search
+ "C-p" #'mairix-previous-search
+ "C-n" #'mairix-next-search
+ "q" #'mairix-select-quit
+ "e" #'mairix-select-edit
+ "d" #'mairix-select-delete
+ "s" #'mairix-select-save)
(defvar mairix-searches-mode-font-lock-keywords
'(("^\\([0-9]+\\)"
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 47b5271ef03..c7ff175e08e 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -175,15 +175,6 @@ This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
:type 'regexp)
-(defcustom dig-program "dig"
- "Program to query DNS information."
- :type 'string)
-
-(defcustom dig-program-options nil
- "Options for the dig program."
- :type '(repeat string)
- :version "26.1")
-
(defcustom ftp-program "ftp"
"Program to run to do FTP transfers."
:type 'string)
@@ -279,6 +270,7 @@ This variable is only used if the variable
(define-derived-mode net-utils-mode special-mode "NetworkUtil"
"Major mode for interacting with an external network utility."
+ :interactive nil
(setq-local font-lock-defaults
'((net-utils-font-lock-keywords)))
(setq-local revert-buffer-function #'net-utils--revert-function))
@@ -287,31 +279,6 @@ This variable is only used if the variable
;; Utility functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Simplified versions of some at-point functions from ffap.el.
-;; It's not worth loading all of ffap just for these.
-(defun net-utils-machine-at-point ()
- (let ((pt (point)))
- (buffer-substring-no-properties
- (save-excursion
- (skip-chars-backward "-a-zA-Z0-9.")
- (point))
- (save-excursion
- (skip-chars-forward "-a-zA-Z0-9.")
- (skip-chars-backward "." pt)
- (point)))))
-
-(defun net-utils-url-at-point ()
- (let ((pt (point)))
- (buffer-substring-no-properties
- (save-excursion
- (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
- (skip-chars-forward "^A-Za-z0-9" pt)
- (point))
- (save-excursion
- (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
- (skip-chars-backward ":;.,!?" pt)
- (point)))))
-
(defun net-utils-remove-ctrl-m-filter (process output-string)
"Remove trailing control Ms."
(with-current-buffer (process-buffer process)
@@ -463,7 +430,8 @@ This variable is only used if the variable
If your system's ping continues until interrupted, you can try setting
`ping-program-options'."
(interactive
- (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
+ (list (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Ping host" default) nil nil default))))
(let ((options
(if ping-program-options
(append ping-program-options (list host))
@@ -496,7 +464,8 @@ See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
non-interactive versions of this function more suitable for use
in Lisp code."
(interactive
- (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
+ (list (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Lookup host" default) nil nil default))
(if current-prefix-arg (read-from-minibuffer "Name server: "))))
(let ((options
(append nslookup-program-options (list host)
@@ -588,14 +557,12 @@ This command uses `nslookup-program' to look up DNS records."
(autoload 'comint-mode "comint" nil t)
-(defvar nslookup-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\t" #'completion-at-point)
- map))
+(defvar-keymap nslookup-mode-map
+ "TAB" #'completion-at-point)
-;; Using a derived mode gives us keymaps, hooks, etc.
(define-derived-mode nslookup-mode comint-mode "Nslookup"
"Major mode for interacting with the nslookup program."
+ :interactive nil
(setq-local font-lock-defaults
'((nslookup-font-lock-keywords)))
(setq comint-prompt-regexp nslookup-prompt-regexp)
@@ -610,7 +577,8 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument.
This command uses `dns-lookup-program' for looking up the DNS information."
(interactive
- (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
+ (list (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Lookup host" default) nil nil default))
(if current-prefix-arg (read-from-minibuffer "Name server: "))))
(let ((options
(append dns-lookup-program-options (list host)
@@ -632,20 +600,12 @@ DNS resolution.
Interactively, prompt for NAME-SERVER if invoked with prefix argument.
This command uses `dig-program' for looking up the DNS information."
+ (declare (obsolete dig "29.1"))
(interactive
- (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
+ (list (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Lookup host" default) nil nil default))
(if current-prefix-arg (read-from-minibuffer "Name server: "))))
- (let ((options
- (append dig-program-options (list host)
- (if name-server (list (concat "@" name-server))))))
- (net-utils-run-program
- "Dig"
- (concat "** "
- (mapconcat #'identity
- (list "Dig" host dig-program)
- " ** "))
- dig-program
- options)))
+ (dig host nil nil nil nil name-server))
(autoload 'comint-exec "comint")
(declare-function comint-watch-for-password-prompt "comint" (string))
@@ -655,9 +615,8 @@ This command uses `dig-program' for looking up the DNS information."
(defun ftp (host)
"Run `ftp-program' to connect to HOST."
(interactive
- (list
- (read-from-minibuffer
- "Ftp to Host: " (net-utils-machine-at-point))))
+ (list (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Ftp to Host" default) nil nil default))))
(let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
(set-buffer buf)
(ftp-mode)
@@ -667,14 +626,12 @@ This command uses `dig-program' for looking up the DNS information."
(list host)))
(pop-to-buffer buf)))
-(defvar ftp-mode-map
- (let ((map (make-sparse-keymap)))
- ;; Occasionally useful
- (define-key map "\t" #'completion-at-point)
- map))
+(defvar-keymap ftp-mode-map
+ "TAB" #'completion-at-point)
(define-derived-mode ftp-mode comint-mode "FTP"
"Major mode for interacting with the ftp program."
+ :interactive nil
(setq comint-prompt-regexp ftp-prompt-regexp)
(setq comint-input-autoexpand t)
;; Only add the password-prompting hook if it's not already in the
@@ -694,8 +651,8 @@ This command uses `dig-program' for looking up the DNS information."
This command uses `smbclient-program' to connect to HOST."
(interactive
(list
- (read-from-minibuffer
- "Connect to Host: " (net-utils-machine-at-point))
+ (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Connect to Host" default) nil nil default))
(read-from-minibuffer "SMB Service: ")))
(let* ((name (format "smbclient [%s\\%s]" host service))
(buf (get-buffer-create (concat "*" name "*")))
@@ -713,8 +670,8 @@ This command uses `smbclient-program' to connect to HOST."
This command uses `smbclient-program' to connect to HOST."
(interactive
(list
- (read-from-minibuffer
- "Connect to Host: " (net-utils-machine-at-point))))
+ (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Connect to Host" default) nil nil default))))
(let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
(set-buffer buf)
(smbclient-mode)
@@ -724,6 +681,7 @@ This command uses `smbclient-program' to connect to HOST."
(define-derived-mode smbclient-mode comint-mode "smbclient"
"Major mode for interacting with the smbclient program."
+ :interactive nil
(setq comint-prompt-regexp smbclient-prompt-regexp)
(setq comint-input-autoexpand t)
;; Only add the password-prompting hook if it's not already in the
@@ -812,15 +770,15 @@ and `network-connection-service-alist', which see."
;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
;; host name. If we don't see an "@", we'll prompt for the host.
(interactive
- (let* ((answer (read-from-minibuffer "Finger User: "
- (net-utils-url-at-point)))
+ (let* ((answer (let ((default (ffap-url-at-point)))
+ (read-string (format-prompt "Finger User" default) nil nil default)))
(index (string-match (regexp-quote "@") answer)))
(if index
(list (substring answer 0 index)
(substring answer (1+ index)))
(list answer
- (read-from-minibuffer "At Host: "
- (net-utils-machine-at-point))))))
+ (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "At Host" default) nil nil default))))))
(let* ((user-and-host (concat user "@" host))
(process-name (concat "Finger [" user-and-host "]"))
(regexps finger-X.500-host-regexps)
@@ -939,10 +897,9 @@ The port is deduced from `network-connection-service-alist'."
;;; General Network connection
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Using a derived mode gives us keymaps, hooks, etc.
-(define-derived-mode
- network-connection-mode comint-mode "Network-Connection"
- "Major mode for interacting with the `network-connection' program.")
+(define-derived-mode network-connection-mode comint-mode "Network-Connection"
+ "Major mode for interacting with the `network-connection' program."
+ :interactive nil)
(defun network-connection-mode-setup (host service)
(setq-local network-connection-host host)
@@ -954,7 +911,8 @@ The port is deduced from `network-connection-service-alist'."
This command uses `network-connection-service-alist', which see."
(interactive
(list
- (read-from-minibuffer "Host: " (net-utils-machine-at-point))
+ (let ((default (ffap-machine-at-point)))
+ (read-string (format-prompt "Host" default) nil nil default))
(completing-read "Service: "
(mapcar
(lambda (elt)
@@ -1007,6 +965,9 @@ This command uses `network-connection-service-alist', which see."
(and old-comint-input-ring
(setq comint-input-ring old-comint-input-ring)))))
+(define-obsolete-function-alias 'net-utils-machine-at-point #'ffap-machine-at-point "29.1")
+(define-obsolete-function-alias 'net-utils-url-at-point #'ffap-url-at-point "29.1")
+
(provide 'net-utils)
;;; net-utils.el ends here
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index 01cbbbbe011..5ae2df769a2 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -40,7 +40,6 @@
;; Silence warnings
(defvar newsticker-groups)
-(defvar w3-mode-map)
(defvar w3m-minor-mode-map)
(defvar newsticker--retrieval-timer-list nil
@@ -402,13 +401,6 @@ headline after it has been retrieved for the first time."
"Miscellaneous newsticker settings."
:group 'newsticker)
-(defcustom newsticker-cache-filename
- "~/.newsticker-cache"
- "Name of the newsticker cache file."
- :type 'string
- :group 'newsticker-miscellaneous)
-(make-obsolete-variable 'newsticker-cache-filename 'newsticker-dir "23.1")
-
(defcustom newsticker-dir
(locate-user-emacs-file "newsticker/" ".newsticker/")
"Directory where newsticker saves data."
@@ -1704,11 +1696,11 @@ Checks list of active processes against list of newsticker processes."
;; ======================================================================
(defun newsticker--images-dir ()
"Return directory where feed images are saved."
- (concat newsticker-dir "/images/"))
+ (expand-file-name "images/" newsticker-dir))
(defun newsticker--icons-dir ()
"Return directory where feed icons are saved."
- (concat newsticker-dir "/icons/"))
+ (expand-file-name "icons/" newsticker-dir))
(defun newsticker--image-get (feed-name filename directory url)
"Get image for FEED-NAME by returning FILENAME from DIRECTORY.
@@ -2114,28 +2106,6 @@ well."
(throw 'result t)))))
(< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
-(defun newsticker--cache-save-version1 ()
- "Update and save newsticker cache file."
- (interactive)
- (newsticker--cache-update t))
-
-(defun newsticker--cache-update (&optional save)
- "Update newsticker cache file.
-If optional argument SAVE is not nil the cache file is saved to disk."
- (save-excursion
- (unless (file-directory-p newsticker-dir)
- (make-directory newsticker-dir t))
- (let ((coding-system-for-write 'utf-8)
- (buf (find-file-noselect newsticker-cache-filename)))
- (when buf
- (set-buffer buf)
- (setq buffer-undo-list t)
- (erase-buffer)
- (insert ";; -*- coding: utf-8 -*-\n")
- (insert (prin1-to-string newsticker--cache))
- (when save
- (save-buffer))))))
-
(defun newsticker--cache-get-feed (feed)
"Return the cached data for the feed FEED.
FEED is a symbol!"
@@ -2143,7 +2113,7 @@ FEED is a symbol!"
(defun newsticker--cache-dir ()
"Return directory for saving cache data."
- (concat newsticker-dir "/feeds"))
+ (expand-file-name "feeds/" newsticker-dir))
(defun newsticker--cache-save ()
"Save cache data for all feeds."
@@ -2154,42 +2124,27 @@ FEED is a symbol!"
(defun newsticker--cache-save-feed (feed)
"Save cache data for FEED."
- (let ((dir (concat (newsticker--cache-dir) "/" (symbol-name (car feed)))))
+ (let ((dir (file-name-as-directory
+ (expand-file-name (symbol-name (car feed))
+ (newsticker--cache-dir)))))
(unless (file-directory-p dir)
(make-directory dir t))
(let ((coding-system-for-write 'utf-8))
- (with-temp-file (concat dir "/data")
+ (with-temp-file (expand-file-name "data" dir)
(insert ";; -*- coding: utf-8 -*-\n")
- (insert (prin1-to-string (cdr feed)))))))
-
-(defun newsticker--cache-read-version1 ()
- "Read version1 cache data."
- (let ((coding-system-for-read 'utf-8))
- (when (file-exists-p newsticker-cache-filename)
- (with-temp-buffer
- (insert-file-contents newsticker-cache-filename)
- (goto-char (point-min))
- (condition-case nil
- (setq newsticker--cache (read (current-buffer)))
- (error
- (message "Error while reading newsticker cache file!")
- (setq newsticker--cache nil)))))))
+ (prin1 (cdr feed) (current-buffer) t)))))
(defun newsticker--cache-read ()
"Read cache data."
(setq newsticker--cache nil)
- (if (file-exists-p newsticker-cache-filename)
- (progn
- (when (y-or-n-p "Old newsticker cache file exists. Read it? ")
- (newsticker--cache-read-version1))
- (when (y-or-n-p "Delete old newsticker cache file? ")
- (delete-file newsticker-cache-filename)))
- (dolist (f (append newsticker-url-list-defaults newsticker-url-list))
- (newsticker--cache-read-feed (car f)))))
+ (dolist (f (append newsticker-url-list-defaults newsticker-url-list))
+ (newsticker--cache-read-feed (car f))))
(defun newsticker--cache-read-feed (feed-name)
"Read cache data for feed named FEED-NAME."
- (let ((file-name (concat (newsticker--cache-dir) "/" feed-name "/data"))
+ (let ((file-name (expand-file-name
+ "data" (expand-file-name
+ feed-name (newsticker--cache-dir))))
(coding-system-for-read 'utf-8))
(when (file-exists-p file-name)
(with-temp-buffer
@@ -2261,8 +2216,7 @@ Export subscriptions to a buffer in OPML Format."
(newsticker--opml-insert-feed (car f) 4)))
(insert " </body>\n</opml>\n")))
(pop-to-buffer "*OPML Export*")
- (when (fboundp 'sgml-mode)
- (sgml-mode)))
+ (sgml-mode))
(defun newsticker--opml-insert-elt (elt depth)
"Insert an OPML ELT with indentation level DEPTH."
@@ -2382,14 +2336,19 @@ This function just prints out the values of the FEEDNAME and title of the ITEM."
"Download the first image.
If FEEDNAME equals \"imagefeed\" download the first image URL
found in the description=contents of ITEM to the directory
-\"~/tmp/newsticker/FEEDNAME/TITLE\" where TITLE is the title of
-the item."
+`temporary-file-directory'/newsticker/FEEDNAME/TITLE where TITLE
+is the title of the item."
(when (string= feedname "imagefeed")
(let ((title (newsticker--title item))
(desc (newsticker--desc item)))
(when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
(let ((url (substring desc (match-beginning 1) (match-end 1)))
- (temp-dir (concat "~/tmp/newsticker/" feedname "/" title))
+ (temp-dir (file-name-as-directory
+ (expand-file-name
+ title (expand-file-name
+ feedname (expand-file-name
+ "newsticker"
+ temporary-file-directory)))))
(org-dir default-directory))
(unless (file-directory-p temp-dir)
(make-directory temp-dir t))
@@ -2403,7 +2362,8 @@ the item."
(defun newsticker-download-enclosures (feedname item)
"In all feeds download the enclosed object of the news ITEM.
-The object is saved to the directory \"~/tmp/newsticker/FEEDNAME/TITLE\", which
+The object is saved to the directory
+`temporary-file-directory'/newsticker/FEEDNAME/TITLE, which
is created if it does not exist. TITLE is the title of the news
item. Argument FEEDNAME is ignored.
This function is suited for adding it to `newsticker-new-item-functions'."
@@ -2411,7 +2371,12 @@ This function is suited for adding it to `newsticker-new-item-functions'."
(enclosure (newsticker--enclosure item)))
(when enclosure
(let ((url (cdr (assoc 'url enclosure)))
- (temp-dir (concat "~/tmp/newsticker/" feedname "/" title))
+ (temp-dir (file-name-as-directory
+ (expand-file-name
+ title (expand-file-name
+ feedname (expand-file-name
+ "newsticker"
+ temporary-file-directory)))))
(org-dir default-directory))
(unless (file-directory-p temp-dir)
(make-directory temp-dir t))
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index f026948251d..4eb6f6c695e 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -37,7 +37,6 @@
(require 'xml)
;; Silence warnings
-(defvar w3-mode-map)
(defvar w3m-minor-mode-map)
;; ======================================================================
@@ -589,7 +588,7 @@ calls `w3m-toggle-inline-image'. It works only if
(defun newsticker-close-buffer ()
"Close the newsticker buffer."
(interactive)
- (newsticker--cache-update t)
+ (newsticker--cache-save)
(bury-buffer))
(defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
@@ -748,7 +747,7 @@ Return new buffer position."
(newsticker--cache-replace-age newsticker--cache feed 'new 'old)
(newsticker--cache-replace-age newsticker--cache feed 'obsolete
'old)
- (newsticker--cache-update)
+ (newsticker--cache-save)
(newsticker--buffer-set-uptodate nil)
(newsticker--ticker-text-setup)
(newsticker-buffer-update)
@@ -879,7 +878,7 @@ not get changed."
(newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
(newsticker--buffer-set-uptodate nil)
(newsticker--ticker-text-setup)
- (newsticker--cache-update)
+ (newsticker--cache-save)
(newsticker-buffer-update)))
(defun newsticker-hide-extra ()
@@ -1232,7 +1231,6 @@ item-retrieval time is added as well."
(newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
(defvar w3m-fill-column)
-(defvar w3-maximum-line-length)
(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
"Actually insert contents of news item, format it, render it and all that.
@@ -1366,19 +1364,14 @@ FEED-NAME-SYMBOL tells to which feed this item belongs."
"</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" pos-text-end t)
;; (message "%s" (newsticker--title item))
(let ((w3m-fill-column (if newsticker-use-full-width
- -1 fill-column))
- (w3-maximum-line-length
- (if newsticker-use-full-width nil fill-column)))
+ -1 fill-column)))
(save-excursion
(funcall newsticker-html-renderer pos-text-start
pos-text-end)))
- (cond ((eq newsticker-html-renderer 'w3m-region)
- (add-text-properties pos (point-max)
- (list 'keymap
- w3m-minor-mode-map)))
- ((eq newsticker-html-renderer 'w3-region)
- (add-text-properties pos (point-max)
- (list 'keymap w3-mode-map))))
+ (when (eq newsticker-html-renderer 'w3m-region)
+ (add-text-properties pos (point-max)
+ (list 'keymap
+ w3m-minor-mode-map)))
(setq is-rendered-HTML t)))
(error
(message "Error: HTML rendering failed: %s, %s"
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index 7e00ac93e75..4a7f0b8e3ee 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -112,18 +112,18 @@ window is used when filling. See also `newsticker-justification'."
"Function for rendering HTML contents.
If non-nil, newsticker.el will call this function whenever it
finds HTML-like tags in item descriptions.
-Possible functions include `shr-render-region', `w3m-region', `w3-region', and
+Possible functions include `shr-render-region', `w3m-region', and
`newsticker-htmlr-render'.
-Newsticker automatically loads the respective package w3m, w3, or
+Newsticker automatically loads the respective package w3m, or
htmlr if this option is set."
:type '(choice :tag "Function"
(const :tag "None" nil)
(const :tag "SHR" shr-render-region)
- (const :tag "w3" w3-region)
(const :tag "w3m" w3m-region)
(const :tag "htmlr" newsticker-htmlr-render))
:set #'newsticker--set-customvar-formatting
- :group 'newsticker-reader)
+ :group 'newsticker-reader
+ :version "29.1")
(defcustom newsticker-date-format
"(%A, %H:%M)"
@@ -315,8 +315,6 @@ Return the image."
(if newsticker-html-renderer
(cond ((eq newsticker-html-renderer 'w3m-region)
(require 'w3m))
- ((eq newsticker-html-renderer 'w3-region)
- (require 'w3-auto))
((eq newsticker-html-renderer 'newsticker-htmlr-render)
(require 'htmlr))))
(funcall newsticker-frontend))
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 80d9fd1cef2..637f53e6550 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -106,13 +106,13 @@ applies to newsticker only."
(defcustom newsticker-treeview-use-feed-name-from-url-list-in-treeview
t
- "Use the feed names from 'newsticker-url-list' for display in treeview."
+ "Use the feed names from `newsticker-url-list' for display in treeview."
:version "28.1"
:type 'boolean)
(defcustom newsticker-treeview-use-feed-name-from-url-list-in-itemview
t
- "Use feed names from 'newsticker-url-list' in itemview."
+ "Use feed names from `newsticker-url-list' in itemview."
:version "28.1"
:type 'boolean)
@@ -252,7 +252,6 @@ their id stays constant."
(declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
(defvar w3m-fill-column)
-(defvar w3-maximum-line-length)
(defun newsticker--treeview-render-text (start end)
"Render text between markers START and END."
@@ -272,17 +271,13 @@ their id stays constant."
"</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
;; (message "%s" (newsticker--title item))
(let ((w3m-fill-column (if newsticker-use-full-width
- -1 fill-column))
- (w3-maximum-line-length
- (if newsticker-use-full-width nil fill-column)))
+ -1 fill-column)))
(select-window (newsticker--treeview-item-window))
(save-excursion
(funcall newsticker-html-renderer start end)))
;;(cond ((eq newsticker-html-renderer 'w3m-region)
;; (add-text-properties start end (list 'keymap
;; w3m-minor-mode-map)))
- ;;((eq newsticker-html-renderer 'w3-region)
- ;;(add-text-properties start end (list 'keymap w3-mode-map))))
(if (eq newsticker-html-renderer 'w3m-region)
(w3m-toggle-inline-images t))
t)))
@@ -608,14 +603,10 @@ If CLEAR-BUFFER is non-nil the list buffer is completely erased."
(newsticker--treeview-list-update-faces)
(goto-char (point-min))))
-(defvar newsticker-treeview-list-sort-button-map
- (let ((map (make-sparse-keymap)))
- (define-key map [header-line mouse-1]
- #'newsticker--treeview-list-sort-by-column)
- (define-key map [header-line mouse-2]
- #'newsticker--treeview-list-sort-by-column)
- map)
- "Local keymap for newsticker treeview list window sort buttons.")
+(defvar-keymap newsticker-treeview-list-sort-button-map
+ :doc "Local keymap for newsticker treeview list window sort buttons."
+ "<header-line> <mouse-1>" #'newsticker--treeview-list-sort-by-column
+ "<header-line> <mouse-2>" #'newsticker--treeview-list-sort-by-column)
(defun newsticker--treeview-list-sort-by-column (&optional event)
"Sort the newsticker list window buffer by the column clicked on.
@@ -1257,20 +1248,20 @@ Note: does not update the layout."
"Save treeview group settings."
(interactive)
(let ((coding-system-for-write 'utf-8)
- (buf (find-file-noselect (concat newsticker-dir "/groups"))))
+ (buf (find-file-noselect (expand-file-name "groups" newsticker-dir))))
(when buf
(with-current-buffer buf
(setq buffer-undo-list t)
(erase-buffer)
(insert ";; -*- coding: utf-8 -*-\n")
- (insert (prin1-to-string newsticker-groups))
+ (prin1 newsticker-groups (current-buffer) t)
(save-buffer)
(kill-buffer)))))
(defun newsticker--treeview-load ()
"Load treeview settings."
(let* ((coding-system-for-read 'utf-8)
- (filename (concat newsticker-dir "/groups"))
+ (filename (expand-file-name "groups" newsticker-dir))
(buf (and (file-exists-p filename)
(find-file-noselect filename))))
(when buf
@@ -1283,7 +1274,6 @@ Note: does not update the layout."
(setq newsticker-groups nil)))
(kill-buffer buf))))
-
(defun newsticker-treeview-scroll-item ()
"Scroll current item."
(interactive)
@@ -2013,41 +2003,39 @@ Return t if groups have changed, nil otherwise."
menu)
"Map for newsticker item menu.")
-(defvar newsticker-treeview-mode-map
- (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
- (define-key map " " #'newsticker-treeview-next-page)
- (define-key map "a" #'newsticker-add-url)
- (define-key map "b" #'newsticker-treeview-browse-url-item)
- (define-key map "c" #'newsticker-treeview-customize-current-feed)
- (define-key map "F" #'newsticker-treeview-prev-feed)
- (define-key map "f" #'newsticker-treeview-next-feed)
- (define-key map "g" #'newsticker-treeview-get-news)
- (define-key map "G" #'newsticker-get-all-news)
- (define-key map "i" #'newsticker-treeview-toggle-item-immortal)
- (define-key map "j" #'newsticker-treeview-jump)
- (define-key map "n" #'newsticker-treeview-next-item)
- (define-key map "N" #'newsticker-treeview-next-new-or-immortal-item)
- (define-key map "O" #'newsticker-treeview-mark-list-items-old)
- (define-key map "o" #'newsticker-treeview-mark-item-old)
- (define-key map "p" #'newsticker-treeview-prev-item)
- (define-key map "P" #'newsticker-treeview-prev-new-or-immortal-item)
- (define-key map "q" #'newsticker-treeview-quit)
- (define-key map "S" #'newsticker-treeview-save-item)
- (define-key map "s" #'newsticker-treeview-save)
- (define-key map "u" #'newsticker-treeview-update)
- (define-key map "v" #'newsticker-treeview-browse-url)
- ;;(define-key map "\n" #'newsticker-treeview-scroll-item)
- ;;(define-key map "\C-m" #'newsticker-treeview-scroll-item)
- (define-key map "\M-m" #'newsticker-group-move-feed)
- (define-key map "\M-a" #'newsticker-group-add-group)
- (define-key map "\M-d" #'newsticker-group-delete-group)
- (define-key map "\M-r" #'newsticker-group-rename-group)
- (define-key map [M-down] #'newsticker-group-shift-feed-down)
- (define-key map [M-up] #'newsticker-group-shift-feed-up)
- (define-key map [M-S-down] #'newsticker-group-shift-group-down)
- (define-key map [M-S-up] #'newsticker-group-shift-group-up)
- map)
- "Mode map for newsticker treeview.")
+(defvar-keymap newsticker-treeview-mode-map
+ :doc "Mode map for newsticker treeview."
+ "SPC" #'newsticker-treeview-next-page
+ "a" #'newsticker-add-url
+ "b" #'newsticker-treeview-browse-url-item
+ "c" #'newsticker-treeview-customize-current-feed
+ "F" #'newsticker-treeview-prev-feed
+ "f" #'newsticker-treeview-next-feed
+ "g" #'newsticker-treeview-get-news
+ "G" #'newsticker-get-all-news
+ "i" #'newsticker-treeview-toggle-item-immortal
+ "j" #'newsticker-treeview-jump
+ "n" #'newsticker-treeview-next-item
+ "N" #'newsticker-treeview-next-new-or-immortal-item
+ "O" #'newsticker-treeview-mark-list-items-old
+ "o" #'newsticker-treeview-mark-item-old
+ "p" #'newsticker-treeview-prev-item
+ "P" #'newsticker-treeview-prev-new-or-immortal-item
+ "q" #'newsticker-treeview-quit
+ "S" #'newsticker-treeview-save-item
+ "s" #'newsticker-treeview-save
+ "u" #'newsticker-treeview-update
+ "v" #'newsticker-treeview-browse-url
+ ;;"C-j" #'newsticker-treeview-scroll-item
+ ;;"RET" #'newsticker-treeview-scroll-item
+ "M-m" #'newsticker-group-move-feed
+ "M-a" #'newsticker-group-add-group
+ "M-d" #'newsticker-group-delete-group
+ "M-r" #'newsticker-group-rename-group
+ "M-<down>" #'newsticker-group-shift-feed-down
+ "M-<up>" #'newsticker-group-shift-feed-up
+ "M-S-<down>" #'newsticker-group-shift-group-down
+ "M-S-<up>" #'newsticker-group-shift-group-up)
(define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
"Major mode for Newsticker Treeview.
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index d95593da3bc..3146189be63 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -79,8 +79,7 @@ option."
(const :tag "Off" nil)
(function :tag "Custom function")))
-(defcustom nsm-settings-file (expand-file-name "network-security.data"
- user-emacs-directory)
+(defcustom nsm-settings-file (locate-user-emacs-file "network-security.data")
"The file the security manager settings will be stored in."
:version "25.1"
:type 'file)
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 1589770f203..b58f0abb56b 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -102,9 +102,7 @@ is not given."
(let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
(request-msgType (concat (make-string 1 1) (make-string 3 0)))
;0x01 0x00 0x00 0x00
- (request-flags (concat (make-string 1 7) (make-string 1 130)
- (make-string 1 8) (make-string 1 0)))
- ;0x07 0x82 0x08 0x00
+ (request-flags (unibyte-string #x07 #x82 #x08 #x00))
)
(when (and user (string-match "@" user))
(unless domain
@@ -245,9 +243,7 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
(uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
;; match default setting in `ntlm-build-auth-request'
- (request-flags (concat (make-string 1 7) (make-string 1 130)
- (make-string 1 8) (make-string 1 0)))
- ;0x07 0x82 0x08 0x00
+ (request-flags (unibyte-string #x07 #x82 #x08 #x00))
(flags (substring rchallenge 20 24)) ;flags, 4 bytes
(challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
;; Extract domain string from challenge string.
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index 0f6dfb6ad46..de225d76dcc 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -59,7 +59,7 @@
(defcustom pop3-port 110
"POP3 port."
:version "22.1" ;; Oort Gnus
- :type 'number
+ :type 'natnum
:group 'pop3)
(defcustom pop3-password-required t
@@ -88,7 +88,7 @@ valid value is `apop'."
The lower the number, the more latency-sensitive the fetching
will be. If your pop3 server doesn't support streaming at all,
set this to 1."
- :type 'number
+ :type 'natnum
:version "24.1"
:group 'pop3)
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index d22cc88b7bd..3a276791ab2 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -43,6 +43,7 @@ For instance, \"fśf.org\" => \"xn--ff-2sa.org\"."
"Encode STRING according to the IDNA/punycode algorithm.
This is used to encode non-ASCII domain names.
For instance, \"bücher\" => \"xn--bcher-kva\"."
+ (setq string (downcase (string-glyph-compose string)))
(let ((ascii (seq-filter (lambda (char)
(< char 128))
string)))
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index 598a7da0712..61cae43a88a 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -163,19 +163,17 @@ in your init file (after loading/requiring quickurl).")
(defvar quickurl-urls nil
"URL alist for use with `quickurl' and `quickurl-ask'.")
-(defvar quickurl-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "a" #'quickurl-list-add-url)
- (define-key map [(control m)] #'quickurl-list-insert-url)
- (define-key map "u" #'quickurl-list-insert-naked-url)
- (define-key map " " #'quickurl-list-insert-with-lookup)
- (define-key map "l" #'quickurl-list-insert-lookup)
- (define-key map "d" #'quickurl-list-insert-with-desc)
- (define-key map [(control g)] #'quickurl-list-quit)
- (define-key map "q" #'quickurl-list-quit)
- (define-key map [mouse-2] #'quickurl-list-mouse-select)
- map)
- "Local keymap for a `quickurl-list-mode' buffer.")
+(defvar-keymap quickurl-list-mode-map
+ :doc "Local keymap for a `quickurl-list-mode' buffer."
+ "a" #'quickurl-list-add-url
+ "RET" #'quickurl-list-insert-url
+ "u" #'quickurl-list-insert-naked-url
+ "SPC" #'quickurl-list-insert-with-lookup
+ "l" #'quickurl-list-insert-lookup
+ "d" #'quickurl-list-insert-with-desc
+ "C-g" #'quickurl-list-quit
+ "q" #'quickurl-list-quit
+ "<mouse-2>" #'quickurl-list-mouse-select)
(defvar quickurl-list-buffer-name "*quickurl-list*"
"Name for the URL listing buffer.")
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index b23b0d64ae6..54d7861f445 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -130,7 +130,7 @@ be displayed instead."
(defcustom rcirc-default-port 6667
"The default port to connect to."
- :type 'integer)
+ :type 'natnum)
(defcustom rcirc-default-nick (user-login-name)
"Your nick."
@@ -262,10 +262,12 @@ The ARGUMENTS for each METHOD symbol are:
`bitlbee': NICK PASSWORD
`quakenet': ACCOUNT PASSWORD
`sasl': NICK PASSWORD
+ `certfp': KEY CERT
Examples:
((\"Libera.Chat\" nickserv \"bob\" \"p455w0rd\")
(\"Libera.Chat\" chanserv \"bob\" \"#bobland\" \"passwd99\")
+ (\"Libera.Chat\" certfp \"/path/to/key\" \"/path/to/cert\")
(\"bitlbee\" bitlbee \"robert\" \"sekrit\")
(\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
(\"quakenet.org\" quakenet \"bobby\" \"sekrit\")
@@ -291,7 +293,11 @@ Examples:
(list :tag "SASL"
(const sasl)
(string :tag "Nick")
- (string :tag "Password")))))
+ (string :tag "Password"))
+ (list :tag "CertFP"
+ (const certfp)
+ (string :tag "Key")
+ (string :tag "Certificate")))))
(defcustom rcirc-auto-authenticate-flag t
"Non-nil means automatically send authentication string to server.
@@ -428,6 +434,20 @@ will be killed."
:version "28.1"
:type 'boolean)
+(defcustom rcirc-cycle-completion-flag nil
+ "Non-nil means to use cycling for completion in rcirc buffers.
+See the Info node `(emacs) Completion Options' for background on
+what cycling completion means."
+ :version "29.1"
+ :set (lambda (sym val)
+ (dolist (buf (match-buffers '(major-mode . rcirc-mode)))
+ (with-current-buffer buf
+ (if val
+ (setq-local completion-cycle-threshold t)
+ (kill-local-variable 'completion-cycle-threshold))))
+ (set-default sym val))
+ :type 'boolean)
+
(defvar-local rcirc-nick nil
"The nickname used for the current connection.")
@@ -547,13 +567,16 @@ If ARG is non-nil, instead prompt for connection parameters."
(password (plist-get (cdr c) :password))
(encryption (plist-get (cdr c) :encryption))
(server-alias (plist-get (cdr c) :server-alias))
+ (client-cert (when (eq (rcirc-get-server-method (car c))
+ 'certfp)
+ (rcirc-get-server-cert (car c))))
contact)
(when-let (((not password))
(auth (auth-source-search :host server
:user user-name
:port port))
- (fn (plist-get (car auth) :secret)))
- (setq password (funcall fn)))
+ (pwd (auth-info-password (car auth))))
+ (setq password pwd))
(when server
(let (connected)
(dolist (p (rcirc-process-list))
@@ -563,7 +586,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(condition-case nil
(let ((process (rcirc-connect server port nick user-name
full-name channels password encryption
- server-alias)))
+ client-cert server-alias)))
(when rcirc-display-server-buffer
(pop-to-buffer-same-window (process-buffer process))))
(quit (message "Quit connecting to %s"
@@ -646,29 +669,23 @@ See `rcirc-connect' for more details on these variables.")
(defun rcirc-get-server-method (server)
"Return authentication method for SERVER."
- (catch 'method
- (dolist (i rcirc-authinfo)
- (let ((server-i (car i))
- (method (cadr i)))
- (when (string-match server-i server)
- (throw 'method method))))))
+ (cadr (assoc server rcirc-authinfo #'string-match)))
(defun rcirc-get-server-password (server)
"Return password for SERVER."
- (catch 'pass
- (dolist (i rcirc-authinfo)
- (let ((server-i (car i))
- (args (cdddr i)))
- (when (string-match server-i server)
- (throw 'pass (car args)))))))
+ (cadddr (assoc server rcirc-authinfo #'string-match)))
+
+(defun rcirc-get-server-cert (server)
+ "Return a list of key and certificate for SERVER."
+ (cddr (assoc server rcirc-authinfo #'string-match)))
;;;###autoload
(defun rcirc-connect (server &optional port nick user-name
full-name startup-channels password encryption
- server-alias)
+ certfp server-alias)
"Connect to SERVER.
The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
-ENCRYPTION, SERVER-ALIAS are interpreted as in
+ENCRYPTION, CERTFP, SERVER-ALIAS are interpreted as in
`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
that are joined after authentication."
(save-excursion
@@ -695,6 +712,7 @@ that are joined after authentication."
(setq process (open-network-stream
(or server-alias server) nil server port-number
:type (or encryption 'plain)
+ :client-certificate certfp
:nowait t))
(set-process-coding-system process 'raw-text 'raw-text)
(with-current-buffer (get-buffer-create (rcirc-generate-new-buffer-name process nil))
@@ -713,8 +731,8 @@ that are joined after authentication."
(setq rcirc-nick-table (make-hash-table :test 'equal))
(setq rcirc-nick nick)
(setq rcirc-startup-channels startup-channels)
- (setq rcirc-last-server-message-time (current-time))
(setq rcirc-last-connect-time (current-time))
+ (setq rcirc-last-server-message-time rcirc-last-connect-time)
;; Check if the immediate process state
(sit-for .1)
@@ -754,18 +772,26 @@ SERVER-PLIST is the property list for the server."
(yes-or-no-p "Encrypt connection?"))
'tls 'plain))
+(defvar rcirc-reconnect-delay)
(defun rcirc-keepalive ()
"Send keep alive pings to active rcirc processes.
Kill processes that have not received a server message since the
last ping."
(if (rcirc-process-list)
(mapc (lambda (process)
- (with-rcirc-process-buffer process
- (when (not rcirc-connecting)
- (rcirc-send-ctcp process
- rcirc-nick
- (format "KEEPALIVE %f"
- (float-time))))))
+ (with-rcirc-process-buffer process
+ (when (not rcirc-connecting)
+ (condition-case nil
+ (rcirc-send-ctcp process
+ rcirc-nick
+ (format "KEEPALIVE %f"
+ (float-time)))
+ (rcirc-closed-connection
+ (if (zerop rcirc-reconnect-delay)
+ (message "rcirc: Connection to %s closed"
+ (process-name process))
+ (rcirc-reconnect process))
+ (message ""))))))
(rcirc-process-list))
;; no processes, clean up timer
(when (timerp rcirc-keepalive-timer)
@@ -1057,17 +1083,18 @@ Note that the messages are stored in reverse order.")
;; expression and `rcirc-process-regexp'.
(error "Malformed tag %S" tag))
(cons (match-string 1 tag)
- (replace-regexp-in-string
- (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n))
- (lambda (rep)
- (concat (substring rep 0 -2)
- (cl-case (aref rep (1- (length rep)))
- (?: ";")
- (?s " ")
- (?\\ "\\\\")
- (?r "\r")
- (?n "\n"))))
- (match-string 2 tag))))
+ (when (match-string 2 tag)
+ (replace-regexp-in-string
+ (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n))
+ (lambda (rep)
+ (concat (substring rep 0 -2)
+ (cl-case (aref rep (1- (length rep)))
+ (?: ";")
+ (?s " ")
+ (?\\ "\\\\")
+ (?r "\r")
+ (?n "\n"))))
+ (match-string 2 tag)))))
(split-string tag-data ";"))))
rcirc-message-tags))
(user (match-string 3 text))
@@ -1119,6 +1146,8 @@ used as the message body."
"Check if PROCESS is open or running."
(memq (process-status process) '(run open)))
+(define-error 'rcirc-closed-connection "Network connection not open")
+
(defun rcirc-send-string (process &rest parts)
"Send PROCESS a PARTS plus a newline.
PARTS may contain a `:' symbol, to designate that the next string
@@ -1136,8 +1165,7 @@ element in PARTS is a list, append it to PARTS."
rcirc-encode-coding-system)
"\n")))
(unless (rcirc--connection-open-p process)
- (error "Network connection to %s is not open"
- (process-name process)))
+ (signal 'rcirc-closed-connection process))
(rcirc-debug process string)
(process-send-string process string)))
@@ -1318,33 +1346,30 @@ The list is updated automatically by `defun-rcirc-command'.")
'set-rcirc-encode-coding-system
"28.1")
-(defvar rcirc-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'rcirc-send-input)
- (define-key map (kbd "M-p") 'rcirc-insert-prev-input)
- (define-key map (kbd "M-n") 'rcirc-insert-next-input)
- (define-key map (kbd "TAB") 'completion-at-point)
- (define-key map (kbd "C-c C-b") 'rcirc-browse-url)
- (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline)
- (define-key map (kbd "C-c C-j") 'rcirc-cmd-join)
- (define-key map (kbd "C-c C-k") 'rcirc-cmd-kick)
- (define-key map (kbd "C-c C-l") 'rcirc-toggle-low-priority)
- (define-key map (kbd "C-c C-d") 'rcirc-cmd-mode)
- (define-key map (kbd "C-c C-m") 'rcirc-cmd-msg)
- (define-key map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
- (define-key map (kbd "C-c C-o") 'rcirc-omit-mode)
- (define-key map (kbd "C-c C-p") 'rcirc-cmd-part)
- (define-key map (kbd "C-c C-q") 'rcirc-cmd-query)
- (define-key map (kbd "C-c C-t") 'rcirc-cmd-topic)
- (define-key map (kbd "C-c C-n") 'rcirc-cmd-names)
- (define-key map (kbd "C-c C-w") 'rcirc-cmd-whois)
- (define-key map (kbd "C-c C-x") 'rcirc-cmd-quit)
- (define-key map (kbd "C-c TAB") ; C-i
- 'rcirc-toggle-ignore-buffer-activity)
- (define-key map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer)
- (define-key map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line)
- map)
- "Keymap for rcirc mode.")
+(defvar-keymap rcirc-mode-map
+ :doc "Keymap for rcirc mode."
+ "RET" #'rcirc-send-input
+ "M-p" #'rcirc-insert-prev-input
+ "M-n" #'rcirc-insert-next-input
+ "TAB" #'completion-at-point
+ "C-c C-b" #'rcirc-browse-url
+ "C-c C-c" #'rcirc-edit-multiline
+ "C-c C-j" #'rcirc-cmd-join
+ "C-c C-k" #'rcirc-cmd-kick
+ "C-c C-l" #'rcirc-toggle-low-priority
+ "C-c C-d" #'rcirc-cmd-mode
+ "C-c C-m" #'rcirc-cmd-msg
+ "C-c C-r" #'rcirc-cmd-nick ; rename
+ "C-c C-o" #'rcirc-omit-mode
+ "C-c C-p" #'rcirc-cmd-part
+ "C-c C-q" #'rcirc-cmd-query
+ "C-c C-t" #'rcirc-cmd-topic
+ "C-c C-n" #'rcirc-cmd-names
+ "C-c C-w" #'rcirc-cmd-whois
+ "C-c C-x" #'rcirc-cmd-quit
+ "C-c C-i" #'rcirc-toggle-ignore-buffer-activity
+ "C-c C-s" #'rcirc-switch-to-server-buffer
+ "C-c C-a" #'rcirc-jump-to-first-unread-line)
(defvar-local rcirc-short-buffer-name nil
"Generated abbreviation to use to indicate buffer activity.")
@@ -1431,7 +1456,8 @@ PROCESS is the process object used for communication.
(add-hook 'completion-at-point-functions
'rcirc-completion-at-point nil 'local)
- (setq-local completion-cycle-threshold t)
+ (when rcirc-cycle-completion-flag
+ (setq-local completion-cycle-threshold t))
(run-mode-hooks 'rcirc-mode-hook))
@@ -1680,16 +1706,17 @@ extracted."
(setq rcirc-parent-buffer parent)
(insert text)
(and (> pos 0) (goto-char pos))
- (message "Type C-c C-c to return text to %s, or C-c C-k to cancel" parent))))
-
-(defvar rcirc-multiline-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") 'rcirc-multiline-minor-submit)
- (define-key map (kbd "C-x C-s") 'rcirc-multiline-minor-submit)
- (define-key map (kbd "C-c C-k") 'rcirc-multiline-minor-cancel)
- (define-key map (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel)
- map)
- "Keymap for multiline mode in rcirc.")
+ (message "Type %s to return text to %s, or %s to cancel"
+ (substitute-command-keys "\\[rcirc-multiline-minor-submit]")
+ parent
+ (substitute-command-keys "\\[rcirc-multiline-minor-cancel]")))))
+
+(defvar-keymap rcirc-multiline-minor-mode-map
+ :doc "Keymap for multiline mode in rcirc."
+ "C-c C-c" #'rcirc-multiline-minor-submit
+ "C-x C-s" #'rcirc-multiline-minor-submit
+ "C-c C-k" #'rcirc-multiline-minor-cancel
+ "ESC ESC ESC" #'rcirc-multiline-minor-cancel)
(define-minor-mode rcirc-multiline-minor-mode
"Minor mode for editing multiple lines in rcirc."
@@ -2044,6 +2071,13 @@ connection."
(run-hook-with-args 'rcirc-print-functions
process sender response target text)))))
+(defun rcirc-when ()
+ "Show the time of reception of the message at point."
+ (interactive)
+ (if-let (time (get-text-property (point) 'rcirc-time))
+ (message (format-time-string "%c" time))
+ (message "No time information at point.")))
+
(defun rcirc-generate-log-filename (process target)
"Return filename for log file based on PROCESS and TARGET."
(if target
@@ -2230,12 +2264,10 @@ This function does not alter the INPUT string."
(mapconcat rcirc-nick-filter sorted sep)))
;;; activity tracking
-(defvar rcirc-track-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-@") 'rcirc-next-active-buffer)
- (define-key map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
- map)
- "Keymap for rcirc track minor mode.")
+(defvar-keymap rcirc-track-minor-mode-map
+ :doc "Keymap for rcirc track minor mode."
+ "C-c C-@" #'rcirc-next-active-buffer
+ "C-c C-SPC" #'rcirc-next-active-buffer)
(defcustom rcirc-track-abbrevate-flag t
"Non-nil means `rcirc-track-minor-mode' should abbreviate names."
@@ -2582,15 +2614,22 @@ that, an interactive form can specified."
(defun ,fn-name (,argument &optional process target)
,(concat documentation
"\n\nNote: If PROCESS or TARGET are nil, the values given"
- "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
- (interactive (list ,interactive-spec))
+ "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
+ (interactive ,(if (stringp interactive-spec)
+ ;; HACK: Necessary to wrap the result of
+ ;; the interactive spec in a list.
+ `(list (call-interactively
+ (lambda (&rest args)
+ (interactive ,interactive-spec)
+ args)))
+ `(list ,interactive-spec)))
(unless (if (listp ,argument)
(<= ,required (length ,argument) ,total)
(string-match ,regexp ,argument))
(user-error "Malformed input (%s): %S" ',command ,argument))
(push ,(upcase (symbol-name command)) rcirc-pending-requests)
(let ((process (or process (rcirc-buffer-process)))
- (target (or target rcirc-target)))
+ (target (or target rcirc-target)))
(ignore target process)
(let (,@(cl-loop
for i from 0 for arg in (delq '&optional arguments)
@@ -3256,7 +3295,7 @@ PROCESS is the process object for the current connection."
(with-current-buffer chat-buffer
(rcirc-print process sender "NICK" old-nick new-nick)
(setq rcirc-target new-nick)
- (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))
+ (rename-buffer (rcirc-generate-new-buffer-name process new-nick) t))
(setf rcirc-buffer-alist
(cons (cons new-nick chat-buffer)
(delq (assoc-string old-nick rcirc-buffer-alist t)
diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el
index b8d83627963..ee52ed6e071 100644
--- a/lisp/net/sasl-scram-rfc.el
+++ b/lisp/net/sasl-scram-rfc.el
@@ -90,6 +90,8 @@
(sasl-mechanism-name (sasl-client-mechanism client))
(sasl-client-name client))))
(salt (base64-decode-string salt-base64))
+ (string-xor (lambda (a b)
+ (apply #'unibyte-string (cl-mapcar #'logxor a b))))
(salted-password
;; Hi(str, salt, i):
(let ((digest (concat salt (string 0 0 0 1)))
@@ -98,7 +100,7 @@
(setq digest (funcall hmac-fun digest password))
(setq xored (if (null xored)
digest
- (cl-map 'string 'logxor xored digest))))))
+ (funcall string-xor xored digest))))))
(client-key
(funcall hmac-fun "Client Key" salted-password))
(stored-key (decode-hex-string (funcall hash-fun client-key)))
@@ -108,7 +110,7 @@
step-data ","
client-final-message-without-proof))
(client-signature (funcall hmac-fun (encode-coding-string auth-message 'utf-8) stored-key))
- (client-proof (cl-map 'string 'logxor client-key client-signature))
+ (client-proof (funcall string-xor client-key client-signature))
(client-final-message
(concat client-final-message-without-proof ","
"p=" (base64-encode-string client-proof))))
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index c4ba99f47c8..e0def55ad9f 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -174,21 +174,24 @@ It contain at least 64 bits of entropy."
;; stolen (and renamed) from message.el
(defun sasl-unique-id-function ()
- ;; Don't use microseconds from (current-time), they may be unsupported.
+ ;; Don't use fractional seconds from timestamp; they may be unsupported.
;; Instead we use this randomly inited counter.
(setq sasl-unique-id-char
- (% (1+ (or sasl-unique-id-char (logand (random) (1- (ash 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (current-time)))
+ ;; 2^16 * 25 just fits into 4 digits i base 36.
+ (let ((base (* 25 25)))
+ (if sasl-unique-id-char
+ (% (1+ sasl-unique-id-char) base)
+ (random base))))
+ (let ((tm (time-convert nil 'integer)))
(concat
(sasl-unique-id-number-base36
- (+ (car tm)
- (ash (% sasl-unique-id-char 25) 16)) 4)
+ (+ (ash tm -16)
+ (ash (% sasl-unique-id-char 25) 16))
+ 4)
(sasl-unique-id-number-base36
- (+ (nth 1 tm)
- (ash (/ sasl-unique-id-char 25) 16)) 4))))
+ (+ (logand tm #xffff)
+ (ash (/ sasl-unique-id-char 25) 16))
+ 4))))
(defun sasl-unique-id-number-base36 (num len)
(if (if (< len 0)
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index faadcb94b11..c4f97a92fb5 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -77,15 +77,17 @@
;; (secrets-delete-collection "my collection")
;; (secrets-create-collection "my collection")
-;; There exists a special collection called "session", which has the
-;; lifetime of the corresponding client session (aka Emacs's
-;; lifetime). It is created automatically when Emacs uses the Secret
-;; Service interface, and it is deleted when Emacs is killed.
+;; With GNOME Keyring, there exists a special collection called
+;; "session", which has the lifetime of the user being logged in. Its
+;; data are not stored on disk and go away when the user logs out.
;; Therefore, it can be used to store and retrieve secret items
-;; temporarily. This shall be preferred over creation of a persistent
-;; collection, when the information shall not live longer than Emacs.
-;; The session collection can be addressed either by the string
-;; "session", or by nil, whenever a collection parameter is needed.
+;; temporarily. The "session" collection can be addressed either by
+;; the string "session", or by nil, whenever a collection parameter is
+;; needed.
+
+;; However, other Secret Service provider don't create this temporary
+;; "session" collection. You shall check first that this collection
+;; exists, before you use it.
;; As already said, a collection is a group of secret items. A secret
;; item has a label, the "secret" (which is a string), and a set of
@@ -98,8 +100,7 @@
;; => ("this item" "another item")
;; Secret items can be added or deleted to a collection. In the
-;; following examples, we use the special collection "session", which
-;; is bound to Emacs's lifetime.
+;; following examples, we use the special collection "session".
;;
;; (secrets-delete-item "session" "my item")
;; (secrets-create-item "session" "my item" "geheim"
@@ -137,7 +138,7 @@
;; It has been tested with GNOME Keyring 2.29.92. An implementation
;; for KWallet will be available at
;; svn://anonsvn.kde.org/home/kde/trunk/playground/base/ksecretservice;
-;; not tested yet.
+;; not tested yet. This package has also been tested with KeePassXC 2.6.6.
;; Pacify byte-compiler. D-Bus support in the Emacs core can be
;; disabled with configuration option "--without-dbus". Declare used
@@ -263,6 +264,7 @@ It returns t if not."
;; </signal>
;; </interface>
+;; This exist only for GNOME Keyring.
(defconst secrets-session-collection-path
"/org/freedesktop/secrets/collection/session"
"The D-Bus temporary session collection object path.")
@@ -311,43 +313,8 @@ It returns t if not."
(defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic"
"The default item type we are using.")
-;; We cannot use introspection, because some servers, like
-;; mate-keyring-daemon, don't provide relevant data. Once the dust
-;; has settled, we shall assume the new interface, and get rid of the test.
-(defconst secrets-struct-secret-content-type
- (ignore-errors
- (let ((content-type "text/plain")
- (path (cadr
- (dbus-call-method
- :session secrets-service secrets-path
- secrets-interface-service
- "OpenSession" "plain" '(:variant ""))))
- result)
- ;; Create a dummy item.
- (setq result
- (dbus-call-method
- :session secrets-service secrets-session-collection-path
- secrets-interface-collection "CreateItem"
- ;; Properties.
- `(:array
- (:dict-entry ,(concat secrets-interface-item ".Label")
- (:variant " ")))
- ;; Secret.
- `(:struct :object-path ,path
- (:array :signature "y")
- ,(dbus-string-to-byte-array " ")
- :string ,content-type)
- ;; Don't replace.
- nil))
- ;; Remove it.
- (dbus-call-method
- :session secrets-service (car result)
- secrets-interface-item "Delete")
- ;; Result.
- `(,content-type)))
- "The content_type of a secret struct.
-It must be wrapped as list, because we add it via `append'. This
-is an interface introduced in 2011.")
+(defconst secrets-struct-secret-content-type "text/plain"
+ "The content_type of a secret struct.")
(defconst secrets-interface-session "org.freedesktop.Secret.Session"
"A session tracks state between the service and a client application.")
@@ -696,13 +663,10 @@ The object path of the created item is returned."
`((:dict-entry ,(concat secrets-interface-item ".Attributes")
(:variant ,(append '(:array) props))))))
;; Secret.
- (append
- `(:struct :object-path ,secrets-session-path
- (:array :signature "y") ;; No parameters.
- ,(dbus-string-to-byte-array password))
- ;; We add the content_type. In backward compatibility
- ;; mode, nil is appended, which means nothing.
- secrets-struct-secret-content-type)
+ `(:struct :object-path ,secrets-session-path
+ (:array :signature "y") ;; No parameters.
+ ,(dbus-string-to-byte-array password)
+ ,secrets-struct-secret-content-type)
;; Do not replace. Replace does not seem to work.
nil))
(secrets-prompt (cadr result))
@@ -777,14 +741,13 @@ ITEM can also be an object path, which is used if contained in COLLECTION."
;;; Visualization.
-(defvar secrets-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map (make-composed-keymap special-mode-map widget-keymap))
- (define-key map "n" #'next-line)
- (define-key map "p" #'previous-line)
- (define-key map "z" #'kill-current-buffer)
- map)
- "Keymap used in `secrets-mode' buffers.")
+(defvar-keymap secrets-mode-map
+ :doc "Keymap used in `secrets-mode' buffers."
+ :parent (make-composed-keymap special-mode-map
+ widget-keymap)
+ "n" #'next-line
+ "p" #'previous-line
+ "z" #'kill-current-buffer)
(define-derived-mode secrets-mode special-mode "Secrets"
"Major mode for presenting password entries retrieved by Security Service.
@@ -943,7 +906,7 @@ to their attributes."
secrets-interface-service "CollectionDeleted"
'secrets-collection-handler)
- ;; We shall inform, whether the secret service is enabled on this
+ ;; We shall inform, that the secret service is enabled on this
;; machine.
(setq secrets-enabled t))
@@ -954,6 +917,7 @@ to their attributes."
;; * secrets-debug should be structured like auth-source-debug to
;; prevent leaking sensitive information. Right now I don't see
;; anything sensitive though.
+
;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be
;; used for the transfer of the secrets. Currently, we use the
;; plain algorithm.
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e8b0fbc18c4..c4f0d3b9404 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -40,6 +40,8 @@
(require 'image)
(require 'puny)
(require 'url-cookie)
+(require 'url-file)
+(require 'pixel-fill)
(require 'text-property-search)
(defgroup shr nil
@@ -56,8 +58,15 @@ fit these criteria."
:version "24.1"
:type 'float)
+(defcustom shr-allowed-images nil
+ "If non-nil, only images that match this regexp are displayed.
+If nil, all URLs are allowed. Also see `shr-blocked-images'."
+ :version "29.1"
+ :type '(choice (const nil) regexp))
+
(defcustom shr-blocked-images nil
- "Images that have URLs matching this regexp will be blocked."
+ "Images that have URLs matching this regexp will be blocked.
+If nil, no images are blocked. Also see `shr-allowed-images'."
:version "24.1"
:type '(choice (const nil) regexp))
@@ -162,6 +171,10 @@ cid: URL as the argument.")
(defvar shr-put-image-function #'shr-put-image
"Function called to put image and alt string.")
+(defface shr-text '((t :inherit variable-pitch-text))
+ "Face used for rendering text."
+ :version "29.1")
+
(defface shr-strike-through '((t :strike-through t))
"Face for <s> elements."
:version "24.1")
@@ -183,6 +196,11 @@ temporarily blinks with this face."
"Face for <abbr> elements."
:version "27.1")
+(defface shr-sup
+ '((t :height 0.8))
+ "Face for <sup> and <sub> elements."
+ :version "29.1")
+
(defface shr-h1
'((t :height 1.3 :weight bold))
"Face for <h1> elements."
@@ -210,6 +228,15 @@ temporarily blinks with this face."
"Face for <h6> elements."
:version "28.1")
+(defface shr-code '((t :inherit fixed-pitch))
+ "Face used for rendering <code> blocks."
+ :version "29.1")
+
+(defface shr-mark
+ '((t :background "yellow" :foreground "black"))
+ "Face used for <mark> elements."
+ :version "29.1")
+
(defcustom shr-inhibit-images nil
"If non-nil, inhibit loading images."
:version "28.1"
@@ -231,7 +258,6 @@ and other things:
(defvar shr-internal-width nil)
(defvar shr-list-mode nil)
(defvar shr-content-cache nil)
-(defvar shr-kinsoku-shorten nil)
(defvar shr-table-depth 0)
(defvar shr-stylesheet nil)
(defvar shr-base nil)
@@ -246,30 +272,28 @@ and other things:
(defvar shr-target-id nil
"Target fragment identifier anchor.")
-
-(defvar shr-map
- (let ((map (make-sparse-keymap)))
- (define-key map "a" #'shr-show-alt-text)
- (define-key map "i" #'shr-browse-image)
- (define-key map "z" #'shr-zoom-image)
- (define-key map [?\t] #'shr-next-link)
- (define-key map [?\M-\t] #'shr-previous-link)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] #'shr-browse-url)
- (define-key map [C-down-mouse-1] #'shr-mouse-browse-url-new-window)
- (define-key map "I" #'shr-insert-image)
- (define-key map "w" #'shr-maybe-probe-and-copy-url)
- (define-key map "u" #'shr-maybe-probe-and-copy-url)
- (define-key map "v" #'shr-browse-url)
- (define-key map "O" #'shr-save-contents)
- (define-key map "\r" #'shr-browse-url)
- map))
-
-(defvar shr-image-map
- (let ((map (copy-keymap shr-map)))
- (when (boundp 'image-map)
- (set-keymap-parent map image-map))
- map))
+(defvar shr--link-targets nil)
+
+(defvar-keymap shr-map
+ "a" #'shr-show-alt-text
+ "i" #'shr-browse-image
+ "z" #'shr-zoom-image
+ "TAB" #'shr-next-link
+ "C-M-i" #'shr-previous-link
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'shr-browse-url
+ "C-<down-mouse-1>" #'shr-mouse-browse-url-new-window
+ "I" #'shr-insert-image
+ "w" #'shr-maybe-probe-and-copy-url
+ "u" #'shr-maybe-probe-and-copy-url
+ "v" #'shr-browse-url
+ "O" #'shr-save-contents
+ "RET" #'shr-browse-url)
+
+(defvar-keymap shr-image-map
+ :parent (if (boundp 'image-map)
+ (make-composed-keymap shr-map image-map)
+ shr-map))
;; Public functions and commands.
(declare-function libxml-parse-html-region "xml.c"
@@ -305,6 +329,23 @@ and other things:
(or (not (zerop (fringe-columns 'right)))
(not (zerop (fringe-columns 'left))))))
+(defun shr--window-width ()
+ ;; Compute the width based on the window width. We need to
+ ;; adjust the available width for when the user disables
+ ;; the fringes, which will cause the display engine usurp
+ ;; one column for the continuation glyph.
+ (if (not shr-use-fonts)
+ (- (window-body-width) 1
+ (if (shr--have-one-fringe-p)
+ 1
+ 0))
+ (pixel-fill-width)))
+
+(defmacro shr-string-pixel-width (string)
+ `(if (not shr-use-fonts)
+ (length ,string)
+ (string-pixel-width ,string)))
+
;;;###autoload
(defun shr-insert-document (dom)
"Render the parsed document DOM into the current buffer.
@@ -326,22 +367,10 @@ DOM should be a parse tree as generated by
(if (not shr-use-fonts)
shr-width
(* shr-width (frame-char-width)))
- ;; Compute the width based on the window width. We need to
- ;; adjust the available width for when the user disables
- ;; the fringes, which will cause the display engine usurp
- ;; one column for the continuation glyph.
- (if (not shr-use-fonts)
- (- (window-body-width) 1
- (if (shr--have-one-fringe-p)
- 1
- 0))
- (- (window-body-width nil t)
- (* 2 (frame-char-width))
- (if (shr--have-one-fringe-p)
- 0
- (* (frame-char-width) 2))
- 1))))
+ (shr--window-width)))
(max-specpdl-size max-specpdl-size)
+ (shr--link-targets nil)
+ (hscroll (window-hscroll))
;; `bidi-display-reordering' is supposed to be only used for
;; debugging purposes, but Shr's naïve filling algorithm
;; cannot cope with the complexity of RTL text in an LTR
@@ -361,13 +390,29 @@ DOM should be a parse tree as generated by
;; below will misbehave, because it silently assumes that it
;; starts with a non-hscrolled window (vertical-motion will move
;; to a wrong place otherwise).
- (set-window-hscroll nil 0)
- (shr-descend dom)
- (shr-fill-lines start (point))
- (shr--remove-blank-lines-at-the-end start (point))
+ (unwind-protect
+ (progn
+ (set-window-hscroll nil 0)
+ (shr-descend dom)
+ (shr-fill-lines start (point))
+ (shr--remove-blank-lines-at-the-end start (point))
+ (shr--set-target-ids shr--link-targets))
+ (set-window-hscroll nil hscroll))
(when shr-warning
(message "%s" shr-warning))))
+(defun shr--set-target-ids (ids)
+ ;; If the buffer is empty, there's no point in setting targets.
+ (unless (zerop (- (point-max) (point-min)))
+ ;; We may have several targets in the same place (if you have
+ ;; several <span id='foo'> things after one another). So group
+ ;; them by position.
+ (dolist (group (seq-group-by #'cdr ids))
+ (let ((point (min (1- (point-max)) (car group))))
+ (put-text-property point (1+ point)
+ 'shr-target-id
+ (mapcar #'car (cdr group)))))))
+
(defun shr--remove-blank-lines-at-the-end (start end)
(save-restriction
(save-excursion
@@ -547,6 +592,12 @@ size, and full-buffer size."
(shr-insert sub)
(shr-descend sub))))
+(defun shr-image-blocked-p (url)
+ (or (and shr-blocked-images
+ (string-match shr-blocked-images url))
+ (and shr-allowed-images
+ (not (string-match shr-allowed-images url)))))
+
(defun shr-indirect-call (tag-name dom &rest args)
(let ((function (intern (concat "shr-tag-" (symbol-name tag-name)) obarray))
;; Allow other packages to override (or provide) rendering
@@ -577,7 +628,7 @@ size, and full-buffer size."
(setq shr-warning
"Not rendering the complete page because of too-deep nesting")
(when style
- (if (string-match "color\\|display\\|border-collapse" style)
+ (if (string-match-p "color\\|display\\|border-collapse" style)
(setq shr-stylesheet (nconc (shr-parse-style style)
shr-stylesheet))
(setq style nil)))
@@ -596,16 +647,8 @@ size, and full-buffer size."
(funcall function dom))
(t
(shr-generic dom)))
- (when-let* ((id (dom-attr dom 'id)))
- ;; If the element was empty, we don't have anything to put the
- ;; anchor on. So just insert a dummy character.
- (when (= start (point))
- (if (not (bolp))
- (insert ? )
- (insert ? )
- (shr-mark-fill start))
- (put-text-property (1- (point)) (point) 'display ""))
- (put-text-property (1- (point)) (point) 'shr-target-id id))
+ (when-let ((id (dom-attr dom 'id)))
+ (push (cons id (set-marker (make-marker) start)) shr--link-targets))
;; If style is set, then this node has set the color.
(when style
(shr-colorize-region
@@ -619,43 +662,11 @@ size, and full-buffer size."
(with-temp-buffer
(let ((shr-indentation 0)
(shr-start nil)
- (shr-internal-width (- (window-body-width nil t)
- (* 2 (frame-char-width))
- ;; Adjust the window width for when
- ;; the user disables the fringes,
- ;; which causes the display engine
- ;; to usurp one column for the
- ;; continuation glyph.
- (if (and (null shr-width)
- (not (shr--have-one-fringe-p)))
- (* (frame-char-width) 2)
- 0))))
+ (shr-internal-width (shr--window-width)))
(shr-insert text)
(shr-fill-lines (point-min) (point-max))
(buffer-string)))))
-(define-inline shr-char-breakable-p (char)
- "Return non-nil if a line can be broken before and after CHAR."
- (inline-quote (aref fill-find-break-point-function-table ,char)))
-(define-inline shr-char-nospace-p (char)
- "Return non-nil if no space is required before and after CHAR."
- (inline-quote (aref fill-nospace-between-words-table ,char)))
-
-;; KINSOKU is a Japanese word meaning a rule that should not be violated.
-;; In Emacs, it is a term used for characters, e.g. punctuation marks,
-;; parentheses, and so on, that should not be placed in the beginning
-;; of a line or the end of a line.
-(define-inline shr-char-kinsoku-bol-p (char)
- "Return non-nil if a line ought not to begin with CHAR."
- (inline-letevals (char)
- (inline-quote (and (not (eq ,char ?'))
- (aref (char-category-set ,char) ?>)))))
-(define-inline shr-char-kinsoku-eol-p (char)
- "Return non-nil if a line ought not to end with CHAR."
- (inline-quote (aref (char-category-set ,char) ?<)))
-(unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35))
- (load "kinsoku" nil t))
-
(defun shr-pixel-column ()
(if (not shr-use-fonts)
(current-column)
@@ -669,24 +680,12 @@ size, and full-buffer size."
(car (window-text-pixel-size nil (line-beginning-position) (point))))))
(defun shr-pixel-region ()
+ (declare (obsolete nil "29.1"))
(- (shr-pixel-column)
(save-excursion
(goto-char (mark))
(shr-pixel-column))))
-(defun shr-string-pixel-width (string)
- (if (not shr-use-fonts)
- (length string)
- ;; Save and restore point across with-temp-buffer, since
- ;; shr-pixel-column uses save-window-excursion, which can reset
- ;; point to 1.
- (let ((pt (point)))
- (prog1
- (with-temp-buffer
- (insert string)
- (shr-pixel-column))
- (goto-char pt)))))
-
(defsubst shr--translate-insertion-chars ()
;; Remove soft hyphens.
(goto-char (point-min))
@@ -711,7 +710,7 @@ size, and full-buffer size."
(goto-char (point-max)))))
(t
(let ((font-start (point)))
- (when (and (string-match "\\`[ \t\n\r]" text)
+ (when (and (string-match-p "\\`[ \t\n\r]" text)
(not (bolp))
(not (eq (char-after (1- (point))) ? )))
(insert " "))
@@ -739,7 +738,7 @@ size, and full-buffer size."
(when shr-use-fonts
(put-text-property font-start (point)
'face
- (or shr-current-font 'variable-pitch)))))))))
+ (or shr-current-font 'shr-text)))))))))
(defun shr-fill-lines (start end)
(if (<= shr-internal-width 0)
@@ -788,7 +787,7 @@ size, and full-buffer size."
(while (not (eolp))
;; We have to do some folding. First find the first
;; previous point suitable for folding.
- (if (or (not (shr-find-fill-point (line-beginning-position)))
+ (if (or (not (pixel-fill-find-fill-point (line-beginning-position)))
(= (point) start))
;; We had unbreakable text (for this width), so just go to
;; the first space and carry on.
@@ -829,84 +828,6 @@ size, and full-buffer size."
(when (looking-at " $")
(delete-region (point) (line-end-position)))))))
-(defun shr-find-fill-point (start)
- (let ((bp (point))
- (end (point))
- failed)
- (while (not (or (setq failed (<= (point) start))
- (eq (preceding-char) ? )
- (eq (following-char) ? )
- (shr-char-breakable-p (preceding-char))
- (shr-char-breakable-p (following-char))
- (and (shr-char-kinsoku-bol-p (preceding-char))
- (shr-char-breakable-p (following-char))
- (not (shr-char-kinsoku-bol-p (following-char))))
- (shr-char-kinsoku-eol-p (following-char))
- (bolp)))
- (backward-char 1))
- (if failed
- ;; There's no breakable point, so we give it up.
- (let (found)
- (goto-char bp)
- ;; Don't overflow the window edge, even if
- ;; shr-kinsoku-shorten is nil.
- (unless (or shr-kinsoku-shorten (null shr-width))
- (while (setq found (re-search-forward
- "\\(\\c>\\)\\| \\|\\c<\\|\\c|"
- (line-end-position) 'move)))
- (if (and found
- (not (match-beginning 1)))
- (goto-char (match-beginning 0)))))
- (or
- (eolp)
- ;; Don't put kinsoku-bol characters at the beginning of a line,
- ;; or kinsoku-eol characters at the end of a line.
- (cond
- ;; Don't overflow the window edge, even if shr-kinsoku-shorten
- ;; is nil.
- ((or shr-kinsoku-shorten (null shr-width))
- (while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (or (shr-char-kinsoku-eol-p (preceding-char))
- (shr-char-kinsoku-bol-p (following-char))))
- (backward-char 1))
- (when (setq failed (<= (point) start))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we look for the second best position.
- (while (and (progn
- (forward-char 1)
- (<= (point) end))
- (progn
- (setq bp (point))
- (shr-char-kinsoku-eol-p (following-char)))))
- (goto-char bp)))
- ((shr-char-kinsoku-eol-p (preceding-char))
- ;; Find backward the point where kinsoku-eol characters begin.
- (let ((count 4))
- (while
- (progn
- (backward-char 1)
- (and (> (setq count (1- count)) 0)
- (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (or (shr-char-kinsoku-eol-p (preceding-char))
- (shr-char-kinsoku-bol-p (following-char)))))))
- (when (setq failed (<= (point) start))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we go to the second best position.
- (if (looking-at "\\(\\c<+\\)\\c<")
- (goto-char (match-end 1))
- (forward-char 1))))
- ((shr-char-kinsoku-bol-p (following-char))
- ;; Find forward the point where kinsoku-bol characters end.
- (let ((count 4))
- (while (progn
- (forward-char 1)
- (and (>= (setq count (1- count)) 0)
- (shr-char-kinsoku-bol-p (following-char))
- (shr-char-breakable-p (following-char))))))))
- (when (eq (following-char) ? )
- (forward-char 1))))
- (not failed)))
-
(defun shr-parse-base (url)
;; Always chop off anchors.
(when (string-match "#.*" url)
@@ -941,15 +862,13 @@ size, and full-buffer size."
shr-base))
(when (zerop (length url))
(setq url nil))
- ;; Strip leading/trailing whitespace
- (and url (string-match "\\`\\s-+" url)
- (setq url (substring url (match-end 0))))
- (and url (string-match "\\s-+\\'" url)
- (setq url (substring url 0 (match-beginning 0))))
+ ;; Strip leading/trailing whitespace.
+ (when url
+ (setq url (string-trim url)))
(cond ((zerop (length url))
(nth 3 base))
((or (not base)
- (string-match "\\`[a-z]*:" url))
+ (string-match-p "\\`[a-z]*:" url))
;; Absolute or empty URI
url)
((eq (aref url 0) ?/)
@@ -963,8 +882,10 @@ size, and full-buffer size."
;; A link to an anchor.
(concat (nth 3 base) url))
(t
- ;; Totally relative.
- (url-expand-file-name url (concat (car base) (cadr base))))))
+ ;; Totally relative. Allow Tramp file names if we're
+ ;; rendering a file:// URL.
+ (let ((url-allow-non-local-files (equal (nth 2 base) "file")))
+ (url-expand-file-name url (concat (car base) (cadr base)))))))
(defun shr-ensure-newline ()
(unless (bobp)
@@ -986,22 +907,6 @@ size, and full-buffer size."
(looking-at " *$")))
;; We're already at a new paragraph; do nothing.
)
- ((and (not (bolp))
- (save-excursion
- (beginning-of-line)
- (looking-at " *$"))
- (save-excursion
- (forward-line -1)
- (looking-at " *$"))
- ;; Check all chars on the current line and see whether
- ;; they're all placeholders.
- (cl-loop for pos from (line-beginning-position) upto (1- (point))
- unless (get-text-property pos 'shr-target-id)
- return nil
- finally return t))
- ;; We have some invisible markers from <div id="foo"></div>;
- ;; do nothing.
- )
((and prefix
(= prefix (- (point) (line-beginning-position))))
;; Do nothing; we're at the start of a <li>.
@@ -1089,8 +994,7 @@ the mouse click event."
(let ((url (get-text-property (point) 'shr-url)))
(if (not url)
(message "No link under point")
- (url-retrieve (shr-encode-url url)
- #'shr-store-contents (list url directory)))))
+ (url-retrieve url #'shr-store-contents (list url directory)))))
(defun shr-store-contents (status url directory)
(unless (plist-get status :error)
@@ -1134,14 +1038,14 @@ the mouse click event."
(let ((param (match-string 4 data))
(payload (url-unhex-string (match-string 5 data))))
(when (and param
- (string-match "^.*\\(;[ \t]*base64\\)$" param))
+ (string-match-p "^.*\\(;[ \t]*base64\\)$" param))
(setq payload (ignore-errors
(base64-decode-string payload))))
payload)))
;; Behind display-graphic-p test.
(declare-function image-size "image.c" (spec &optional pixels frame))
-(declare-function image-animate "image" (image &optional index limit))
+(declare-function image-animate "image" (image &optional index limit position))
(defun shr-put-image (spec alt &optional flags)
"Insert image SPEC with a string ALT. Return image.
@@ -1178,13 +1082,14 @@ element is the data blob and the second element is the content-type."
(when (and (> (current-column) 0)
(> (car (image-size image t)) 400))
(insert "\n"))
- (if (eq size 'original)
- (insert-sliced-image image (or alt "*") nil 20 1)
- (insert-image image (or alt "*")))
- (put-text-property start (point) 'image-size size)
- (when (and shr-image-animate
- (cdr (image-multi-frame-p image)))
- (image-animate image nil 60)))
+ (let ((image-pos (point)))
+ (if (eq size 'original)
+ (insert-sliced-image image (or alt "*") nil 20 1)
+ (insert-image image (or alt "*")))
+ (put-text-property start (point) 'image-size size)
+ (when (and shr-image-animate
+ (cdr (image-multi-frame-p image)))
+ (image-animate image nil 60 image-pos))))
image)
(insert (or alt ""))))
@@ -1248,7 +1153,7 @@ Return a string with image data."
(with-temp-buffer
(set-buffer-multibyte nil)
(when (ignore-errors
- (url-cache-extract (url-cache-create-filename (shr-encode-url url)))
+ (url-cache-extract (url-cache-create-filename url))
t)
(when (re-search-forward "\r?\n\r?\n" nil t)
(shr-parse-image-data)))))
@@ -1270,7 +1175,7 @@ Return a string with image data."
;; SVG images may contain references to further images that we may
;; want to block. So special-case these by parsing the XML data
;; and remove anything that looks like a blocked bit.
- (when (and shr-blocked-images
+ (when (and (or shr-allowed-images shr-blocked-images)
(eq content-type 'image/svg+xml))
(setq data
;; Note that libxml2 doesn't parse everything perfectly,
@@ -1346,6 +1251,7 @@ START, and END. Note that START and END should be markers."
(defun shr-encode-url (url)
"Encode URL."
+ (declare (obsolete nil "29.1"))
(browse-url-url-encode-chars url "[)$ ]"))
(autoload 'shr-color-visible "shr-color")
@@ -1420,6 +1326,11 @@ ones, in case fg and bg are nil."
(defun shr-tag-comment (_dom)
)
+;; Introduced in HTML5. For text browsers, functionally similar to a
+;; comment.
+(defun shr-tag-template (_dom)
+ )
+
(defun shr-dom-to-xml (dom &optional charset)
(with-temp-buffer
(shr-dom-print dom)
@@ -1449,8 +1360,7 @@ ones, in case fg and bg are nil."
((or (not (eq (dom-tag elem) 'image))
;; Filter out blocked elements inside the SVG image.
(not (setq url (dom-attr elem ':xlink:href)))
- (not shr-blocked-images)
- (not (string-match shr-blocked-images url)))
+ (not (shr-image-blocked-p url)))
(insert " ")
(shr-dom-print elem)))))
(insert (format "</%s>" (dom-tag dom))))
@@ -1467,12 +1377,14 @@ ones, in case fg and bg are nil."
(defun shr-tag-sup (dom)
(let ((start (point)))
(shr-generic dom)
- (put-text-property start (point) 'display '(raise 0.2))))
+ (put-text-property start (point) 'display '(raise 0.2))
+ (add-face-text-property start (point) 'shr-sup)))
(defun shr-tag-sub (dom)
(let ((start (point)))
(shr-generic dom)
- (put-text-property start (point) 'display '(raise -0.2))))
+ (put-text-property start (point) 'display '(raise -0.2))
+ (add-face-text-property start (point) 'shr-sup)))
(defun shr-tag-p (dom)
(shr-ensure-paragraph)
@@ -1507,13 +1419,21 @@ ones, in case fg and bg are nil."
(shr-fontize-dom dom 'underline))
(defun shr-tag-code (dom)
- (let ((shr-current-font 'fixed-pitch))
+ (let ((shr-current-font 'shr-code))
(shr-generic dom)))
(defun shr-tag-tt (dom)
;; The `tt' tag is deprecated in favor of `code'.
(shr-tag-code dom))
+(defun shr-tag-mark (dom)
+ (when (and (not (bobp))
+ (not (= (char-after (1- (point))) ?\s)))
+ (insert " "))
+ (let ((start (point)))
+ (shr-generic dom)
+ (shr-add-font start (point) 'shr-mark)))
+
(defun shr-tag-ins (cont)
(let* ((start (point))
(color "green")
@@ -1534,9 +1454,7 @@ ones, in case fg and bg are nil."
(defun shr-parse-style (style)
(when style
- (save-match-data
- (when (string-match "\n" style)
- (setq style (replace-match " " t t style))))
+ (setq style (replace-regexp-in-string "\n" " " style))
(let ((plist nil))
(dolist (elem (split-string style ";"))
(when elem
@@ -1565,15 +1483,22 @@ ones, in case fg and bg are nil."
(start (point))
shr-start)
(shr-generic dom)
- (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'.
- (dom-attr dom 'name)))) ; Obsolete since HTML5.
- ;; We have an empty element, so just insert... something.
- (when (= start (point))
- (insert ?\s)
- (put-text-property (1- (point)) (point) 'display ""))
- (put-text-property start (1+ start) 'shr-target-id id))
+ (when-let* ((id (and (not (dom-attr dom 'id)) ; Handled by `shr-descend'.
+ (dom-attr dom 'name)))) ; Obsolete since HTML5.
+ (push (cons id (set-marker (make-marker) start)) shr--link-targets))
(when url
- (shr-urlify (or shr-start start) (shr-expand-url url) title))))
+ (shr-urlify (or shr-start start) (shr-expand-url url) title)
+ ;; Check whether the URL is suspicious.
+ (when-let ((warning (or (textsec-suspicious-p
+ (shr-expand-url url) 'url)
+ (textsec-suspicious-p
+ (cons (shr-expand-url url)
+ (buffer-substring (or shr-start start)
+ (point)))
+ 'link))))
+ (add-text-properties (or shr-start start) (point)
+ (list 'face '(shr-link textsec-suspicious)))
+ (insert (propertize "⚠️" 'help-echo warning))))))
(defun shr-tag-abbr (dom)
(let ((title (dom-attr dom 'title))
@@ -1594,7 +1519,7 @@ ones, in case fg and bg are nil."
(let ((start (point))
url multimedia image)
(when-let* ((type (dom-attr dom 'type)))
- (when (string-match "\\`image/svg" type)
+ (when (string-match-p "\\`image/svg" type)
(setq url (dom-attr dom 'data)
image t)))
(dolist (child (dom-non-text-children dom))
@@ -1630,6 +1555,14 @@ url if no type is specified. The value should be a float in the range 0.0 to
:version "24.4"
:type '(alist :key-type regexp :value-type float))
+(defcustom shr-use-xwidgets-for-media nil
+ "If non-nil, use xwidgets to display video and audio elements.
+This also depends on Emacs being built with xwidgets capability.
+Note that this is experimental, and may lead to instability on
+some platforms."
+ :type 'boolean
+ :version "29.1")
+
(defun shr--get-media-pref (elem)
"Determine the preference for ELEM.
The preference is a float determined from `shr-prefer-media-type'."
@@ -1666,16 +1599,39 @@ The preference is a float determined from `shr-prefer-media-type'."
pref (cdr ret)))))))))
(cons url pref))
+(declare-function xwidget-webkit-execute-script "xwidget.c"
+ (xwidget script &optional callback))
+
(defun shr-tag-video (dom)
(let ((image (dom-attr dom 'poster))
(url (dom-attr dom 'src))
(start (point)))
(unless url
(setq url (car (shr--extract-best-source dom))))
- (if (> (length image) 0)
- (shr-indirect-call 'img nil image)
- (shr-insert " [video] "))
- (shr-urlify start (shr-expand-url url))))
+ (if (and shr-use-xwidgets-for-media
+ (fboundp 'make-xwidget))
+ ;; Play the video.
+ (progn
+ (require 'xwidget)
+ (let ((widget (make-xwidget
+ 'webkit
+ "Video"
+ (truncate (* (window-pixel-width) 0.8))
+ (truncate (* (window-pixel-width) 0.8 0.75)))))
+ (insert
+ (propertize
+ " [video] "
+ 'display (list 'xwidget :xwidget widget)))
+ (xwidget-webkit-execute-script
+ widget (format "document.body.innerHTML = %S;"
+ (format
+ "<style>body { margin: 0px; }</style><div style='background: black; height: 100%%; display: flex; align-items: center; justify-content: center;'><video autoplay loop muted controls style='max-width: 100%%; max-height: 100%%;'><source src=%S type='video/mp4'></source></video></div>"
+ url)))))
+ ;; No xwidgets.
+ (if (> (length image) 0)
+ (shr-indirect-call 'img nil image)
+ (shr-insert " [video] "))
+ (shr-urlify start (shr-expand-url url)))))
(defun shr-tag-audio (dom)
(let ((url (dom-attr dom 'src))
@@ -1725,18 +1681,17 @@ The preference is a float determined from `shr-prefer-media-type'."
(funcall shr-put-image-function image alt
(list :width width :height height)))))
((or shr-inhibit-images
- (and shr-blocked-images
- (string-match shr-blocked-images url)))
+ (shr-image-blocked-p url))
(setq shr-start (point))
(shr-insert alt))
((and (not shr-ignore-cache)
- (url-is-cached (shr-encode-url url)))
+ (url-is-cached url))
(funcall shr-put-image-function (shr-get-image-data url) alt
(list :width width :height height)))
(t
(when (and shr-ignore-cache
- (url-is-cached (shr-encode-url url)))
- (let ((file (url-cache-create-filename (shr-encode-url url))))
+ (url-is-cached url))
+ (let ((file (url-cache-create-filename url)))
(when (file-exists-p file)
(delete-file file))))
(when (image-type-available-p 'svg)
@@ -1745,7 +1700,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(or alt "")))
(insert " ")
(url-queue-retrieve
- (shr-encode-url url) #'shr-image-fetched
+ url #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))
(list :width width :height height))
t
@@ -2038,7 +1993,8 @@ BASE is the URL of the HTML being rendered."
(setq dom (or (dom-child-by-tag dom 'tbody) dom))
(let* ((shr-inhibit-images t)
(shr-table-depth (1+ shr-table-depth))
- (shr-kinsoku-shorten t)
+ ;; Fill hard in CJK languages.
+ (pixel-fill-respect-kinsoku nil)
;; Find all suggested widths.
(columns (shr-column-specs dom))
;; Compute how many pixels wide each TD should be.
@@ -2532,9 +2488,10 @@ flags that control whether to collect or render objects."
(style (dom-attr dom 'style))
(shr-stylesheet shr-stylesheet)
(max-width 0)
+ (shr--link-targets nil)
natural-width)
(when style
- (setq style (and (string-match "color" style)
+ (setq style (and (string-search "color" style)
(shr-parse-style style))))
(when bgcolor
(setq style (nconc (list (cons 'background-color bgcolor))
@@ -2573,6 +2530,7 @@ flags that control whether to collect or render objects."
(end-of-line)
(point)))
(goto-char (point-min))
+ (shr--set-target-ids shr--link-targets)
(list max-width
natural-width
(count-lines (point-min) (point-max))
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 468bc90a9d7..a39e35a53a1 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -79,6 +79,7 @@
(require 'sasl)
(autoload 'sasl-find-mechanism "sasl")
(autoload 'auth-source-search "auth-source")
+(autoload 'auth-info-password "auth-source")
;; User customizable variables:
@@ -130,7 +131,7 @@ for doing the actual authentication."
(defcustom sieve-manage-default-port "sieve"
"Default port number or service name for managesieve protocol."
- :type '(choice integer string)
+ :type '(choice natnum string)
:version "24.4")
(defcustom sieve-manage-default-stream 'network
@@ -230,10 +231,7 @@ Return the buffer associated with the connection."
:max 1
:create t))
(user-name (or (plist-get (nth 0 auth-info) :user) ""))
- (user-password (or (plist-get (nth 0 auth-info) :secret) ""))
- (user-password (if (functionp user-password)
- (funcall user-password)
- user-password))
+ (user-password (or (auth-info-password (nth 0 auth-info)) ""))
(client (sasl-make-client (sasl-find-mechanism (list mech))
user-name "sieve" sieve-manage-server))
(sasl-read-passphrase
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index 58fd41d8995..f62af03534a 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -137,13 +137,11 @@
;; Key map definition
-(defvar sieve-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-l" #'sieve-upload)
- (define-key map "\C-c\C-c" #'sieve-upload-and-kill)
- (define-key map "\C-c\C-m" #'sieve-manage)
- map)
- "Key map used in sieve mode.")
+(defvar-keymap sieve-mode-map
+ :doc "Keymap used in sieve mode."
+ "C-c C-l" #'sieve-upload
+ "C-c C-c" #'sieve-upload-and-kill
+ "C-c RET" #'sieve-manage)
;; Menu
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 630ea04070b..3a6067ee10b 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -106,33 +106,31 @@ require \"fileinto\";
;; FIXME: This is arguably a bug/problem in `easy-menu-define'.
(declare-function sieve-manage-mode-menu "sieve")
-(defvar sieve-manage-mode-map
- (let ((map (make-sparse-keymap)))
- ;; various
- (define-key map "?" #'sieve-help)
- (define-key map "h" #'sieve-help)
- ;; activating
- (define-key map "m" #'sieve-activate)
- (define-key map "u" #'sieve-deactivate)
- (define-key map "\M-\C-?" #'sieve-deactivate-all)
- ;; navigation keys
- (define-key map "\C-p" #'sieve-prev-line)
- (define-key map [up] #'sieve-prev-line)
- (define-key map "\C-n" #'sieve-next-line)
- (define-key map [down] #'sieve-next-line)
- (define-key map " " #'sieve-next-line)
- (define-key map "n" #'sieve-next-line)
- (define-key map "p" #'sieve-prev-line)
- (define-key map "\C-m" #'sieve-edit-script)
- (define-key map "f" #'sieve-edit-script)
- ;; (define-key map "o" #'sieve-edit-script-other-window)
- (define-key map "r" #'sieve-remove)
- (define-key map "q" #'sieve-bury-buffer)
- (define-key map "Q" #'sieve-manage-quit)
- (define-key map [(down-mouse-2)] #'sieve-edit-script)
- (define-key map [(down-mouse-3)] #'sieve-manage-mode-menu)
- map)
- "Keymap for `sieve-manage-mode'.")
+(defvar-keymap sieve-manage-mode-map
+ :doc "Keymap for `sieve-manage-mode'."
+ ;; various
+ "?" #'sieve-help
+ "h" #'sieve-help
+ ;; activating
+ "m" #'sieve-activate
+ "u" #'sieve-deactivate
+ "M-DEL" #'sieve-deactivate-all
+ ;; navigation keys
+ "C-p" #'sieve-prev-line
+ "<up>" #'sieve-prev-line
+ "C-n" #'sieve-next-line
+ "<down>" #'sieve-next-line
+ "SPC" #'sieve-next-line
+ "n" #'sieve-next-line
+ "p" #'sieve-prev-line
+ "RET" #'sieve-edit-script
+ "f" #'sieve-edit-script
+ ;; "o" #'sieve-edit-script-other-window
+ "r" #'sieve-remove
+ "q" #'sieve-bury-buffer
+ "Q" #'sieve-manage-quit
+ "<down-mouse-2>" #'sieve-edit-script
+ "<down-mouse-3>" #'sieve-manage-mode-menu)
(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
"Sieve Menu."
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index de84b4f8dd1..394c4a9666d 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -248,14 +248,12 @@ This is used during Tempo template completion."
;; Set up our keymap
;;
-(defvar snmp-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\177" 'backward-delete-char-untabify)
- (define-key map "\C-c\C-i" 'tempo-complete-tag)
- (define-key map "\C-c\C-f" 'tempo-forward-mark)
- (define-key map "\C-c\C-b" 'tempo-backward-mark)
- map)
- "Keymap used in SNMP mode.")
+(defvar-keymap snmp-mode-map
+ :doc "Keymap used in SNMP mode."
+ "DEL" #'backward-delete-char-untabify
+ "C-c TAB" #'tempo-complete-tag
+ "C-c C-f" #'tempo-forward-mark
+ "C-c C-b" #'tempo-backward-mark)
;; Set up our syntax table
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 27acc8a4f32..5e7bdbe6c6a 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -5,12 +5,11 @@
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Created: December, 2009
-;; Version: 3.2.0
+;; Version: 3.2.1
;; Keywords: soap, web-services, comm, hypermedia
;; Package: soap-client
;; URL: https://github.com/alex-hhh/emacs-soap-client
-;; Package-Requires: ((cl-lib "0.6.1"))
-;;FIXME: Put in `Package-Requires:' the Emacs version we expect.
+;; Package-Requires: ((emacs "24.1") (cl-lib "0.6.1"))
;; This file is part of GNU Emacs.
@@ -659,7 +658,7 @@ representing leap seconds."
(if second
(if second-fraction
(let* ((second-fraction-significand
- (string-replace "." "" second-fraction))
+ (replace-regexp-in-string "\\." "" second-fraction))
(hertz
(expt 10 (length second-fraction-significand)))
(ticks (+ (* hertz (string-to-number second))
@@ -718,10 +717,9 @@ representing leap seconds."
second)
minute hour day month year second-fraction datatype time-zone)
(let ((time
- (apply
- #'encode-time (list
- (if new-decode-time new-decode-time-second second)
- minute hour day month year nil nil time-zone))))
+ (encode-time (list
+ (if new-decode-time new-decode-time-second second)
+ minute hour day month year nil nil time-zone))))
(if new-decode-time
(with-no-warnings (decode-time time nil t))
(decode-time time))))))
@@ -1938,7 +1936,7 @@ This is a specialization of `soap-decode-type' for
(e-name (soap-xs-element-name element))
;; Heuristic: guess if we need to decode using local
;; namespaces.
- (use-fq-names (string-search ":" (symbol-name (car node))))
+ (use-fq-names (string-match ":" (symbol-name (car node))))
(children (if e-name
(if use-fq-names
;; Find relevant children
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 8df0773e1d2..2ba1c20566f 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -407,11 +407,10 @@ When ATYPE indicates an IP, param ADDRESS must be given as raw bytes."
(setq version (process-get proc 'socks-server-protocol))
(cond
((equal version 'http)
- (setq request (format (eval-when-compile
- (concat
- "CONNECT %s:%d HTTP/1.0\r\n"
- "User-Agent: Emacs/SOCKS v1.0\r\n"
- "\r\n"))
+ (setq request (format (concat
+ "CONNECT %s:%d HTTP/1.0\r\n"
+ "User-Agent: Emacs/SOCKS v1.0\r\n"
+ "\r\n")
(cond
((equal atype socks-address-type-name) address)
(t
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index 0d54d2220b6..802e7bc0a28 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -1,7 +1,6 @@
;;; telnet.el --- run a telnet session from within an Emacs buffer -*- lexical-binding: t; -*-
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: William F. Schelter
;; Maintainer: emacs-devel@gnu.org
@@ -61,14 +60,13 @@ PROGRAM says which program to run, to talk to that machine.
LOGIN-NAME, which is optional, says what to log in as on that machine.")
(defvar telnet-new-line "\r")
-(defvar telnet-mode-map
- (let ((map (nconc (make-sparse-keymap) comint-mode-map)))
- (define-key map "\C-m" #'telnet-send-input)
- ;; (define-key map "\C-j" #'telnet-send-input)
- (define-key map "\C-c\C-q" #'send-process-next-char)
- (define-key map "\C-c\C-c" #'telnet-interrupt-subjob)
- (define-key map "\C-c\C-z" #'telnet-c-z)
- map))
+(defvar-keymap telnet-mode-map
+ :parent comint-mode-map
+ "RET" #'telnet-send-input
+ ;; "C-j" #'telnet-send-input
+ "C-c C-q" #'send-process-next-char
+ "C-c C-c" #'telnet-interrupt-subjob
+ "C-c C-z" #'telnet-c-z)
(defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *")
(defvar telnet-replace-c-g nil)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 1fe10a560b1..b504ce600d1 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -107,7 +107,8 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defconst tramp-adb-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -158,6 +159,7 @@ It is used for TCP/IP devices."
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -167,6 +169,7 @@ It is used for TCP/IP devices."
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-adb-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file)
(set-file-acl . ignore)
@@ -178,6 +181,7 @@ It is used for TCP/IP devices."
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
@@ -191,11 +195,10 @@ It is used for TCP/IP devices."
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-adb-file-name-p (filename)
- "Check if it's a FILENAME for ADB."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-adb-method)))
+(defsubst tramp-adb-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for ADB."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-adb-method)))
;;;###tramp-autoload
(defun tramp-adb-file-name-handler (operation &rest args)
@@ -267,7 +270,7 @@ arguments to pass to the OPERATION."
"Parse `file-attributes' for Tramp files using the ls(1) command."
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
- (let ((file-properties nil))
+ (let (file-properties)
(while (re-search-forward tramp-adb-ls-toolbox-regexp nil t)
(let* ((mod-string (match-string 1))
(is-dir (eq ?d (aref mod-string 0)))
@@ -306,7 +309,7 @@ arguments to pass to the OPERATION."
(directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
(when (file-directory-p directory)
(with-parsed-tramp-file-name (expand-file-name directory) nil
(copy-tree
@@ -415,6 +418,8 @@ Emacs dired can't find files."
(defun tramp-adb-ls-output-time-less-p (a b)
"Sort \"ls\" output by time, descending."
(let (time-a time-b)
+ ;; Once we can assume Emacs 27 or later, the two calls
+ ;; (apply #'encode-time X) can be replaced by (encode-time X).
(string-match tramp-adb-ls-date-regexp a)
(setq time-a (apply #'encode-time (parse-time-string (match-string 0 a))))
(string-match tramp-adb-ls-date-regexp b)
@@ -499,7 +504,7 @@ Emacs dired can't find files."
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (file-exists-p (file-truename filename))
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
@@ -543,28 +548,8 @@ Emacs dired can't find files."
(defun tramp-adb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ (tramp-skeleton-write-region start end filename append visit lockname mustbenew
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
@@ -577,34 +562,7 @@ Emacs dired can't find files."
(unless (tramp-adb-execute-adb-command
v "push" tmpfile (tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Cannot write: `%s'" filename))
- (delete-file tmpfile)))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (delete-file tmpfile))))))
(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
@@ -660,7 +618,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -720,8 +678,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when keep-date
(tramp-compat-set-file-times
newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
+ (file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))))
(defun tramp-adb-handle-rename-file
@@ -742,7 +699,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -776,7 +733,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(defun tramp-adb-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
(with-tramp-connection-property vec "signal-strings"
- (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+ (let ((default-directory (tramp-make-tramp-file-name vec 'noloc))
;; `shell-file-name' and `shell-command-switch' are needed
;; for Emacs < 27.1, which doesn't support connection-local
;; variables in `shell-command'.
@@ -972,6 +929,7 @@ implementation will be used."
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (orig-command command)
(program (car command))
(args (cdr command))
(command
@@ -984,7 +942,8 @@ implementation will be used."
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
- (i 0))
+ (i 0)
+ p)
(when (string-match-p "[[:multibyte:]]" command)
(tramp-error
@@ -995,95 +954,103 @@ implementation will be used."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process'
- ;; could be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-adb-maybe-open-connection',
- ;; in order to cleanup the prompt afterwards.
- (tramp-adb-maybe-open-connection v)
- (delete-region (point-min) (point-max))
- ;; Send the command.
- (let* ((p (tramp-get-connection-process v)))
- (tramp-adb-send-command v command nil t) ; nooutput
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for
- ;; this process. We ignore errors, because
- ;; the process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; We must flush them here already;
- ;; otherwise `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Read initial output. Remove the first
- ;; line, which is the command echo.
- (unless (eq filter t)
- (while
- (progn
- (goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
- (tramp-accept-process-output p 0))
- (delete-region (point-min) (point)))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on will be inserted when the
- ;; process is deleted. The temporary file
- ;; will exist until the process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit nil nil 'replace))
- (delete-file remote-tmpstderr))))
- ;; Return process.
- p))))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer (tramp-get-connection-process v) nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))))
+
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise,
+ ;; `make-process' could be called on the local
+ ;; host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save
+ ;; BUFFER contents. Clear also the
+ ;; modification time; otherwise we might be
+ ;; interrupted by `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection',
+ ;; in order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (delete-region (point-min) (point-max))
+ ;; Send the command.
+ (setq p (tramp-get-connection-process v))
+ (tramp-adb-send-command v command nil t) ; nooutput
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors,
+ ;; because the process could have finished
+ ;; already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point))
+ ;; We must flush them here already;
+ ;; otherwise `rename-file', `delete-file' or
+ ;; `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property
+ v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; Read initial output. Remove the
+ ;; first line, which is the command
+ ;; echo.
+ (unless (eq filter t)
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "[\n]" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point)))
+ ;; Provide error buffer. This shows
+ ;; only initial error messages; messages
+ ;; arriving later on will be inserted
+ ;; when the process is deleted. The
+ ;; temporary file will exist until the
+ ;; process is deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit nil nil 'replace))
+ (delete-file remote-tmpstderr))))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))))))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
@@ -1322,8 +1289,7 @@ connection if a previous connection has died for some reason."
"echo \\\"`getprop ro.product.model` "
"`getprop ro.product.version` "
"`getprop ro.build.version.release`\\\""))
- (let ((old-getprop
- (tramp-get-connection-property vec "getprop" nil))
+ (let ((old-getprop (tramp-get-connection-property vec "getprop"))
(new-getprop
(tramp-set-connection-property
vec "getprop"
@@ -1353,24 +1319,39 @@ connection if a previous connection has died for some reason."
;; Mark it as connected.
(tramp-set-connection-property p "connected" t)))))))
-;;; Default connection-local variables for Tramp:
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
+;;; Default connection-local variables for Tramp.
(defconst tramp-adb-connection-local-default-shell-variables
'((shell-file-name . "/system/bin/sh")
(shell-command-switch . "-c"))
"Default connection-local shell variables for remote adb connections.")
-(tramp-compat-funcall
- 'connection-local-set-profile-variables
+(connection-local-set-profile-variables
'tramp-adb-connection-local-default-shell-profile
tramp-adb-connection-local-default-shell-variables)
+(defconst tramp-adb-connection-local-default-ps-variables
+ '((tramp-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ((user . string)
+ (pid . number)
+ (ppid . number)
+ (vsize . number)
+ (rss . number)
+ (wchan . string) ; ??
+ (pc . string) ; ??
+ (state . string)
+ (args . nil))))
+ "Default connection-local ps variables for remote adb connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-adb-connection-local-default-ps-profile
+ tramp-adb-connection-local-default-ps-variables)
+
(with-eval-after-load 'shell
- (tramp-compat-funcall
- 'connection-local-set-profiles
+ (connection-local-set-profiles
`(:application tramp :protocol ,tramp-adb-method)
- 'tramp-adb-connection-local-default-shell-profile))
+ 'tramp-adb-connection-local-default-shell-profile
+ 'tramp-adb-connection-local-default-ps-profile))
;; `shell-mode' tries to open remote files like "/adb::~/.history".
;; This fails, because the tilde cannot be expanded. Tell
@@ -1384,7 +1365,7 @@ connection if a previous connection has died for some reason."
(funcall orig-fun)))
(add-function
- :around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
+ :around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
(add-hook 'tramp-adb-unload-hook
(lambda ()
(remove-function
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 4b649edaabd..119ac54dd29 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -54,8 +54,10 @@
;; * ".ar" - UNIX archiver formats
;; * ".cab", ".CAB" - Microsoft Windows cabinets
;; * ".cpio" - CPIO archives
+;; * ".crate" - Cargo (Rust) packages
;; * ".deb" - Debian packages
;; * ".depot" - HP-UX SD depots
+;; * ".epub" - Electronic publications
;; * ".exe" - Self extracting Microsoft Windows EXE files
;; * ".iso" - ISO 9660 images
;; * ".jar" - Java archives
@@ -141,8 +143,10 @@
"ar" ;; UNIX archiver formats.
"cab" "CAB" ;; Microsoft Windows cabinets.
"cpio" ;; CPIO archives.
+ "crate" ;; Cargo (Rust) packages. Not in libarchive testsuite.
"deb" ;; Debian packages. Not in libarchive testsuite.
"depot" ;; HP-UX SD depot. Not in libarchive testsuite.
+ "epub" ;; Electronic publications. Not in libarchive testsuite.
"exe" ;; Self extracting Microsoft Windows EXE files.
"iso" ;; ISO 9660 images.
"jar" ;; Java archives. Not in libarchive testsuite.
@@ -213,7 +217,8 @@ It must be supported by libarchive(3).")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-archive-file-name-handler-alist
- '((access-file . tramp-archive-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-archive-handle-access-file)
(add-name-to-file . tramp-archive-handle-not-implemented)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
@@ -264,6 +269,7 @@ It must be supported by libarchive(3).")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-archive-handle-insert-directory)
(insert-file-contents . tramp-archive-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-archive-handle-load)
(lock-file . ignore)
(make-auto-save-file-name . ignore)
@@ -273,6 +279,7 @@ It must be supported by libarchive(3).")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-archive-handle-not-implemented)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-archive-handle-not-implemented)
(set-file-acl . ignore)
@@ -284,6 +291,7 @@ It must be supported by libarchive(3).")
(start-file-process . tramp-archive-handle-not-implemented)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-archive-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
@@ -301,7 +309,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
#'tramp-archive-file-name-p))
(apply #'tramp-file-name-for-operation operation args)))
-(defun tramp-archive-run-real-handler (operation args)
+;;;###tramp-autoload
+(progn (defun tramp-archive-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
First arg specifies the OPERATION, second arg ARGS is a list of
arguments to pass to the OPERATION."
@@ -311,7 +320,7 @@ arguments to pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
- (apply operation args)))
+ (apply operation args))))
;;;###tramp-autoload
(defun tramp-archive-file-name-handler (operation &rest args)
@@ -461,7 +470,7 @@ name is kept in slot `hop'"
((tramp-archive-file-name-p archive)
(let ((archive
(tramp-make-tramp-file-name
- (tramp-archive-dissect-file-name archive) nil 'noarchive)))
+ (tramp-archive-dissect-file-name archive))))
(setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
(puthash archive (list vec) tramp-archive-hash))
@@ -564,8 +573,7 @@ offered."
(defun tramp-archive-gvfs-file-name (name)
"Return NAME in GVFS syntax."
- (tramp-make-tramp-file-name
- (tramp-archive-dissect-file-name name) nil 'nohop))
+ (tramp-make-tramp-file-name (tramp-archive-dissect-file-name name)))
;; File name primitives.
@@ -579,9 +587,8 @@ offered."
preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for file archives."
(when (tramp-archive-file-name-p newname)
- (tramp-error
- (tramp-archive-dissect-file-name newname) 'file-error
- "Permission denied: %s" newname))
+ (tramp-compat-permission-denied
+ (tramp-archive-dissect-file-name newname) newname))
(copy-file
(tramp-archive-gvfs-file-name filename) newname ok-if-already-exists
keep-date preserve-uid-gid preserve-extended-attributes))
@@ -625,7 +632,7 @@ offered."
(defun tramp-archive-handle-file-system-info (filename)
"Like `file-system-info' for file archives."
(with-parsed-tramp-archive-file-name filename nil
- (list (tramp-compat-file-attribute-size (file-attributes archive)) 0 0)))
+ (list (file-attribute-size (file-attributes archive)) 0 0)))
(defun tramp-archive-handle-file-truename (filename)
"Like `file-truename' for file archives."
@@ -665,7 +672,7 @@ offered."
;; mounted directory, it is returned as it. Not what we want.
(with-parsed-tramp-archive-file-name default-directory nil
(let ((default-directory (file-name-directory archive)))
- (tramp-compat-temporary-file-directory-function))))
+ (temporary-file-directory))))
(defun tramp-archive-handle-not-implemented (operation &rest args)
"Generic handler for operations not implemented for file archives."
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 347da916edf..dbebcad1a84 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -99,8 +99,7 @@ details see the info pages."
(choice :tag " Value" sexp))))
;;;###tramp-autoload
-(defcustom tramp-persistency-file-name
- (expand-file-name (locate-user-emacs-file "tramp"))
+(defcustom tramp-persistency-file-name (locate-user-emacs-file "tramp")
"File which keeps connection history for Tramp connections."
:group 'tramp
:type 'file)
@@ -125,12 +124,12 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil."
(dolist (elt tramp-connection-properties)
(when (string-match-p
(or (nth 0 elt) "")
- (tramp-make-tramp-file-name key 'noloc 'nohop))
+ (tramp-make-tramp-file-name key 'noloc))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
hash))))
;;;###tramp-autoload
-(defun tramp-get-file-property (key file property default)
+(defun tramp-get-file-property (key file property &optional default)
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
@@ -223,7 +222,9 @@ Return VALUE."
(defun tramp-flush-file-upper-properties (key file)
"Remove some properties of FILE's upper directory."
(when (file-name-absolute-p file)
- (let ((file (directory-file-name (file-name-directory file))))
+ ;; `file-name-directory' can return nil, for example for "~".
+ (when-let ((file (file-name-directory file))
+ (file (directory-file-name file)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
@@ -239,7 +240,7 @@ Return VALUE."
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
(let* ((file (tramp-run-real-handler #'directory-file-name (list file)))
- (truename (tramp-get-file-property key file "file-truename" nil)))
+ (truename (tramp-get-file-property key file "file-truename")))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
@@ -261,7 +262,7 @@ Remove also properties of all files in subdirectories."
(setq directory (tramp-compat-file-name-unquote directory))
(let* ((directory (tramp-run-real-handler
#'directory-file-name (list directory)))
- (truename (tramp-get-file-property key directory "file-truename" nil)))
+ (truename (tramp-get-file-property key directory "file-truename")))
(tramp-message key 8 "%s" directory)
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (tramp-file-name-p key)
@@ -310,7 +311,7 @@ This is suppressed for temporary buffers."
;;; -- Properties --
;;;###tramp-autoload
-(defun tramp-get-connection-property (key property default)
+(defun tramp-get-connection-property (key property &optional default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
@@ -426,7 +427,7 @@ used to cache connection properties of the local machine."
;;;###tramp-autoload
(defun tramp-list-connections ()
- "Return all known `tramp-file-name' structs according to `tramp-cache'."
+ "Return all active `tramp-file-name' structs according to `tramp-cache-data'."
(let ((tramp-verbose 0))
(delq nil (mapcar
(lambda (key)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 8e359c382bf..bd2dbf4a1e0 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -69,7 +69,7 @@ SYNTAX can be one of the symbols `default' (default),
nil
(mapcar
(lambda (x)
- (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
+ (when (tramp-tramp-file-p (tramp-get-default-directory x)) x))
(buffer-list))))
;;;###tramp-autoload
@@ -135,7 +135,7 @@ When called interactively, a Tramp connection has to be selected."
(get-buffer (tramp-debug-buffer-name vec)))
(unless keep-debug
(get-buffer (tramp-trace-buffer-name vec)))
- (tramp-get-connection-property vec "process-buffer" nil)))
+ (tramp-get-connection-property vec "process-buffer")))
(when (bufferp buf) (kill-buffer buf)))
;; Flush file cache.
@@ -595,9 +595,8 @@ buffer in your bug report.
(defun tramp-reporter-dump-variable (varsym mailbuf)
"Pretty-print the value of the variable in symbol VARSYM."
- (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
- (val (with-current-buffer reporter-eval-buffer
- (symbol-value varsym))))
+ (when-let ((reporter-eval-buffer reporter-eval-buffer)
+ (val (buffer-local-value varsym reporter-eval-buffer)))
(if (hash-table-p val)
;; Pretty print the cache.
@@ -723,7 +722,7 @@ the debug buffer(s).")
(when (y-or-n-p "Do you want to append the buffer(s)?")
;; OK, let's send. First we delete the buffer list.
- (kill-buffer nil)
+ (kill-buffer)
(switch-to-buffer curbuf)
(goto-char (point-max))
(insert (propertize "\n" 'display "\n\
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index aead1dedd24..a12e4859ac4 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,27 +23,21 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 28. This
-;; package provides compatibility functions for Emacs 25, Emacs 26 and
-;; Emacs 27.
+;; Tramp's main Emacs version for development is Emacs 29. This
+;; package provides compatibility functions for Emacs 26, Emacs 27 and
+;; Emacs 28.
;;; Code:
-;; In Emacs 25, `tramp-unload-file-name-handlers' is not autoloaded.
-;; So we declare it here in order to avoid recursive load. This will
-;; be overwritten in tramp.el.
-(defun tramp-unload-file-name-handlers () ".")
-
(require 'auth-source)
(require 'format-spec)
-(require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'.
+(require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'.
(require 'parse-time)
(require 'shell)
(require 'subr-x)
(declare-function tramp-error "tramp")
-;; `temporary-file-directory' as function is introduced with Emacs 26.1.
-(declare-function tramp-handle-temporary-file-directory "tramp")
+(declare-function tramp-file-name-handler "tramp")
(declare-function tramp-tramp-file-p "tramp")
(defvar tramp-temp-name-prefix)
@@ -83,133 +77,19 @@ Add the extension of F, if existing."
tramp-temp-name-prefix tramp-compat-temporary-file-directory)
dir-flag (file-name-extension f t)))
-;; `temporary-file-directory' as function is introduced with Emacs 26.1.
-(defalias 'tramp-compat-temporary-file-directory-function
- (if (fboundp 'temporary-file-directory)
- #'temporary-file-directory
- #'tramp-handle-temporary-file-directory))
-
-;; `file-attribute-*' are introduced in Emacs 26.1.
-
-(defalias 'tramp-compat-file-attribute-type
- (if (fboundp 'file-attribute-type)
- #'file-attribute-type
- (lambda (attributes)
- "The type field in ATTRIBUTES returned by `file-attributes'.
-The value is either t for directory, string (name linked to) for
-symbolic link, or nil."
- (nth 0 attributes))))
-
-(defalias 'tramp-compat-file-attribute-link-number
- (if (fboundp 'file-attribute-link-number)
- #'file-attribute-link-number
- (lambda (attributes)
- "Return the number of links in ATTRIBUTES returned by `file-attributes'."
- (nth 1 attributes))))
-
-(defalias 'tramp-compat-file-attribute-user-id
- (if (fboundp 'file-attribute-user-id)
- #'file-attribute-user-id
- (lambda (attributes)
- "The UID field in ATTRIBUTES returned by `file-attributes'.
-This is either a string or a number. If a string value cannot be
-looked up, a numeric value, either an integer or a float, is
-returned."
- (nth 2 attributes))))
-
-(defalias 'tramp-compat-file-attribute-group-id
- (if (fboundp 'file-attribute-group-id)
- #'file-attribute-group-id
- (lambda (attributes)
- "The GID field in ATTRIBUTES returned by `file-attributes'.
-This is either a string or a number. If a string value cannot be
-looked up, a numeric value, either an integer or a float, is
-returned."
- (nth 3 attributes))))
-
-(defalias 'tramp-compat-file-attribute-access-time
- (if (fboundp 'file-attribute-access-time)
- #'file-attribute-access-time
- (lambda (attributes)
- "The last access time in ATTRIBUTES returned by `file-attributes'.
-This a Lisp timestamp in the style of `current-time'."
- (nth 4 attributes))))
-
-(defalias 'tramp-compat-file-attribute-modification-time
- (if (fboundp 'file-attribute-modification-time)
- #'file-attribute-modification-time
- (lambda (attributes)
- "The modification time in ATTRIBUTES returned by `file-attributes'.
-This is the time of the last change to the file's contents, and
-is a Lisp timestamp in the style of `current-time'."
- (nth 5 attributes))))
-
-(defalias 'tramp-compat-file-attribute-status-change-time
- (if (fboundp 'file-attribute-status-change-time)
- #'file-attribute-status-change-time
- (lambda (attributes)
- "The status modification time in ATTRIBUTES returned by `file-attributes'.
-This is the time of last change to the file's attributes: owner
-and group, access mode bits, etc., and is a Lisp timestamp in the
-style of `current-time'."
- (nth 6 attributes))))
-
-(defalias 'tramp-compat-file-attribute-size
- (if (fboundp 'file-attribute-size)
- #'file-attribute-size
- (lambda (attributes)
- "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
-If the size is too large for a fixnum, this is a bignum in Emacs 27
-and later, and is a float in Emacs 26 and earlier."
- (nth 7 attributes))))
-
-(defalias 'tramp-compat-file-attribute-modes
- (if (fboundp 'file-attribute-modes)
- #'file-attribute-modes
- (lambda (attributes)
- "The file modes in ATTRIBUTES returned by `file-attributes'.
-This is a string of ten letters or dashes as in ls -l."
- (nth 8 attributes))))
-
-;; `file-missing' is introduced in Emacs 26.1.
-(defconst tramp-file-missing
- (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
- "The error symbol for the `file-missing' error.")
-
-(defsubst tramp-compat-file-missing (vec file)
- "Emit the `file-missing' error."
- (if (get 'file-missing 'error-conditions)
- (tramp-error vec tramp-file-missing file)
- (tramp-error vec tramp-file-missing "No such file or directory: %s" file)))
-
-;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
-;; `file-name-unquote' are introduced in Emacs 26.1.
-(defalias 'tramp-compat-file-local-name
- (if (fboundp 'file-local-name)
- #'file-local-name
- (lambda (name)
- "Return the local name component of NAME.
-It returns a file name which can be used directly as argument of
-`process-file', `start-file-process', or `shell-command'."
- (or (file-remote-p name 'localname) name))))
-
;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got
;; a second argument in Emacs 27.1.
(defalias 'tramp-compat-file-name-quoted-p
- (if (and
- (fboundp 'file-name-quoted-p)
- (equal (tramp-compat-funcall 'func-arity #'file-name-quoted-p) '(1 . 2)))
+ (if (equal (func-arity #'file-name-quoted-p) '(1 . 2))
#'file-name-quoted-p
(lambda (name &optional top)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name and TOP is nil, check the local part of NAME."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
- (string-prefix-p "/:" (tramp-compat-file-local-name name))))))
+ (string-prefix-p "/:" (file-local-name name))))))
(defalias 'tramp-compat-file-name-quote
- (if (and
- (fboundp 'file-name-quote)
- (equal (tramp-compat-funcall 'func-arity #'file-name-quote) '(1 . 2)))
+ (if (equal (func-arity #'file-name-quote) '(1 . 2))
#'file-name-quote
(lambda (name &optional top)
"Add the quotation prefix \"/:\" to file NAME.
@@ -217,20 +97,17 @@ If NAME is a remote file name and TOP is nil, the local part of NAME is quoted."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(if (tramp-compat-file-name-quoted-p name top)
name
- (concat
- (file-remote-p name) "/:" (tramp-compat-file-local-name name)))))))
+ (concat (file-remote-p name) "/:" (file-local-name name)))))))
(defalias 'tramp-compat-file-name-unquote
- (if (and
- (fboundp 'file-name-unquote)
- (equal (tramp-compat-funcall 'func-arity #'file-name-unquote) '(1 . 2)))
+ (if (equal (func-arity #'file-name-unquote) '(1 . 2))
#'file-name-unquote
(lambda (name &optional top)
"Remove quotation prefix \"/:\" from file NAME.
If NAME is a remote file name and TOP is nil, the local part of
NAME is unquoted."
(let* ((file-name-handler-alist (unless top file-name-handler-alist))
- (localname (tramp-compat-file-local-name name)))
+ (localname (file-local-name name)))
(when (tramp-compat-file-name-quoted-p localname top)
(setq
localname (if (= (length localname) 2) "/" (substring localname 2))))
@@ -257,8 +134,8 @@ NAME is unquoted."
#'exec-path
(lambda ()
"List of directories to search programs to run in remote subprocesses."
- (if-let ((handler (find-file-name-handler default-directory 'exec-path)))
- (funcall handler 'exec-path)
+ (if (tramp-tramp-file-p default-directory)
+ (tramp-file-name-handler 'exec-path)
exec-path))))
;; `time-equal-p' has appeared in Emacs 27.1.
@@ -288,8 +165,7 @@ A nil value for either argument stands for the current time."
;; `progress-reporter-update' got argument SUFFIX in Emacs 27.1.
(defalias 'tramp-compat-progress-reporter-update
- (if (equal (tramp-compat-funcall 'func-arity #'progress-reporter-update)
- '(1 . 3))
+ (if (equal (func-arity #'progress-reporter-update) '(1 . 3))
#'progress-reporter-update
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
@@ -306,19 +182,19 @@ CONDITION can also be a list of error conditions."
;; `file-modes', `set-file-modes' and `set-file-times' got argument
;; FLAG in Emacs 28.1.
(defalias 'tramp-compat-file-modes
- (if (equal (tramp-compat-funcall 'func-arity #'file-modes) '(1 . 2))
+ (if (equal (func-arity #'file-modes) '(1 . 2))
#'file-modes
(lambda (filename &optional _flag)
(file-modes filename))))
(defalias 'tramp-compat-set-file-modes
- (if (equal (tramp-compat-funcall 'func-arity #'set-file-modes) '(2 . 3))
+ (if (equal (func-arity #'set-file-modes) '(2 . 3))
#'set-file-modes
(lambda (filename mode &optional _flag)
(set-file-modes filename mode))))
(defalias 'tramp-compat-set-file-times
- (if (equal (tramp-compat-funcall 'func-arity #'set-file-times) '(1 . 3))
+ (if (equal (func-arity #'set-file-times) '(1 . 3))
#'set-file-times
(lambda (filename &optional timestamp _flag)
(set-file-times filename timestamp))))
@@ -326,14 +202,13 @@ CONDITION can also be a list of error conditions."
;; `directory-files' and `directory-files-and-attributes' got argument
;; COUNT in Emacs 28.1.
(defalias 'tramp-compat-directory-files
- (if (equal (tramp-compat-funcall 'func-arity #'directory-files) '(1 . 5))
+ (if (equal (func-arity #'directory-files) '(1 . 5))
#'directory-files
(lambda (directory &optional full match nosort _count)
(directory-files directory full match nosort))))
(defalias 'tramp-compat-directory-files-and-attributes
- (if (equal (tramp-compat-funcall 'func-arity #'directory-files-and-attributes)
- '(1 . 6))
+ (if (equal (func-arity #'directory-files-and-attributes) '(1 . 6))
#'directory-files-and-attributes
(lambda (directory &optional full match nosort id-format _count)
(directory-files-and-attributes directory full match nosort id-format))))
@@ -359,7 +234,7 @@ CONDITION can also be a list of error conditions."
(if (fboundp 'string-replace)
#'string-replace
(lambda (from-string to-string in-string)
- (let ((case-fold-search nil))
+ (let (case-fold-search)
(replace-regexp-in-string
(regexp-quote from-string) to-string in-string t t)))))
@@ -368,7 +243,7 @@ CONDITION can also be a list of error conditions."
(if (fboundp 'string-search)
#'string-search
(lambda (needle haystack &optional start-pos)
- (let ((case-fold-search nil))
+ (let (case-fold-search)
(string-match-p (regexp-quote needle) haystack start-pos)))))
;; Function `make-lock-file-name' is new in Emacs 28.1.
@@ -398,6 +273,27 @@ CONDITION can also be a list of error conditions."
(car components))
(cdr components)))))))
+;; `permission-denied' is introduced in Emacs 29.1.
+(defconst tramp-permission-denied
+ (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error)
+ "The error symbol for the `permission-denied' error.")
+
+(defsubst tramp-compat-permission-denied (vec file)
+ "Emit the `permission-denied' error."
+ (if (get 'permission-denied 'error-conditions)
+ (tramp-error vec tramp-permission-denied file)
+ (tramp-error vec tramp-permission-denied "Permission denied: %s" file)))
+
+;; Function `auth-info-password' is new in Emacs 29.1.
+(defalias 'tramp-compat-auth-info-password
+ (if (fboundp 'auth-info-password)
+ #'auth-info-password
+ (lambda (auth-info)
+ (let ((secret (plist-get auth-info :secret)))
+ (while (functionp secret)
+ (setq secret (funcall secret)))
+ secret))))
+
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))
@@ -410,8 +306,6 @@ CONDITION can also be a list of error conditions."
;;; TODO:
;;
-;; * `func-arity' exists since Emacs 26.1.
-;;
;; * Starting with Emacs 27.1, there's no need to escape open
;; parentheses with a backslash in docstrings anymore.
;;
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 5028e489328..6cb1237a0f4 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -151,13 +151,14 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(dolist (dir tramp-crypt-directories)
(and (string-prefix-p
dir (file-name-as-directory (expand-file-name name)))
- (throw 'crypt-file-name-p dir))))))
+ (throw 'crypt-file-name-p dir))))))
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-crypt-file-name-handler-alist
- '((access-file . tramp-crypt-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-crypt-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -208,6 +209,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-crypt-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-crypt-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -217,6 +219,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-crypt-handle-rename-file)
(set-file-acl . ignore)
@@ -228,6 +231,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(start-file-process . ignore)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ ;; `tramp-get-home-directory' performed by default-handler.
;; `tramp-get-remote-gid' performed by default handler.
;; `tramp-get-remote-uid' performed by default handler.
(tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
@@ -294,8 +298,8 @@ arguments to pass to the OPERATION."
(defun tramp-crypt-config-file-name (vec)
"Return the encfs config file name for VEC."
(expand-file-name
- (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config)
- user-emacs-directory))
+ (locate-user-emacs-file
+ (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config))))
(defun tramp-crypt-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -322,7 +326,7 @@ connection if a previous connection has died for some reason."
tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec)))
(local-config (tramp-crypt-config-file-name vec)))
;; There is no local encfs6 config file.
- (when (not (file-exists-p local-config))
+ (unless (file-exists-p local-config)
(if (and tramp-crypt-save-encfs-config-remote
(file-exists-p remote-config))
;; Copy remote encfs6 config file if possible.
@@ -485,6 +489,7 @@ See `tramp-crypt-do-encrypt-or-decrypt-file'."
Files in that directory and all subdirectories will be encrypted
before copying to, and decrypted after copying from that
directory. File names will be also encrypted."
+ ;; (declare (completion tramp-crypt-command-completion-p))
(interactive "DRemote directory name: ")
(unless tramp-crypt-enabled
(tramp-user-error nil "Feature is not enabled."))
@@ -596,7 +601,7 @@ absolute file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -698,7 +703,7 @@ absolute file names."
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
(when (file-directory-p directory)
(setq directory (file-name-as-directory (expand-file-name directory)))
(let* (tramp-crypt-enabled
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 650e839f823..dd7e0f9f342 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -125,7 +125,7 @@ pass to the OPERATION."
;; "ftp" method is used in the Tramp file name. So we unset
;; those values.
(ange-ftp-ftp-name-arg "")
- (ange-ftp-ftp-name-res nil))
+ ange-ftp-ftp-name-res)
(cond
;; If argument is a symlink, `file-directory-p' and
;; `file-exists-p' call the traversed file recursively. So we
@@ -135,12 +135,21 @@ pass to the OPERATION."
;; completion. We don't use `with-parsed-tramp-file-name',
;; because this returns another user but the one declared in
;; "~/.netrc".
+ ;; For file names which look like Tramp archive files like
+ ;; "/ftp:anonymous@ftp.gnu.org:/gnu/tramp/tramp-2.0.39.tar.gz",
+ ;; we must disable tramp-archive.el, because in
+ ;; `ange-ftp-get-files' this is "normalized" by
+ ;; `file-name-as-directory' with unwelcome side side-effects.
+ ;; This disables the file archive functionality, perhaps we
+ ;; could fix this otherwise. (Bug#56078)
((memq operation '(file-directory-p file-exists-p))
- (if (apply #'ange-ftp-hook-function operation args)
+ (cl-letf (((symbol-function #'tramp-archive-file-name-handler)
+ (lambda (operation &rest args)
+ (tramp-archive-run-real-handler operation args))))
+ (prog1 (apply #'ange-ftp-hook-function operation args)
(let ((v (tramp-dissect-file-name (car args) t)))
(setf (tramp-file-name-method v) tramp-ftp-method)
- (tramp-set-connection-property v "started" t))
- nil))
+ (tramp-set-connection-property v "started" t)))))
;; If the second argument of `copy-file' or `rename-file' is a
;; remote file name but via FTP, ange-ftp doesn't check this.
@@ -175,11 +184,10 @@ pass to the OPERATION."
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-ftp-file-name-p (filename)
- "Check if it's a FILENAME that should be forwarded to Ange-FTP."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-ftp-method)))
+(defsubst tramp-ftp-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME that should be forwarded to Ange-FTP."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-ftp-method)))
;;;###tramp-autoload
(tramp--with-startup
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index 7344c3c730a..2ff106d6023 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -59,7 +59,7 @@
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
(when (file-directory-p directory)
(setq directory (file-name-as-directory (expand-file-name directory)))
(with-parsed-tramp-file-name directory nil
@@ -120,12 +120,6 @@
(unless (string-match-p elt item) (throw 'match nil)))
(setq result (cons (concat item "/") result)))))))))))
-(defun tramp-fuse-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-readable-p"
- (file-readable-p (tramp-fuse-local-file-name filename)))))
-
;; This function isn't used.
(defun tramp-fuse-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
@@ -159,7 +153,7 @@
(defun tramp-fuse-mount-point (vec)
"Return local mount point of VEC."
- (or (tramp-get-connection-property vec "mount-point" nil)
+ (or (tramp-get-connection-property vec "mount-point")
(expand-file-name
(concat
tramp-temp-name-prefix
@@ -183,7 +177,7 @@ It has the same meaning as `remote-file-name-inhibit-cache'.")
;; cannot use `with-tramp-file-property', because we don't want to
;; cache a nil result.
(let ((remote-file-name-inhibit-cache tramp-fuse-mount-timeout))
- (or (tramp-get-file-property vec "/" "mounted" nil)
+ (or (tramp-get-file-property vec "/" "mounted")
(let* ((default-directory tramp-compat-temporary-file-directory)
(command (format "mount -t fuse.%s" (tramp-file-name-method vec)))
(mount (shell-command-to-string command)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 4adc35bcb6d..056237fd55c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -122,10 +122,7 @@
(autoload 'zeroconf-init "zeroconf")
(tramp-compat-funcall 'dbus-get-unique-name :system)
(tramp-compat-funcall 'dbus-get-unique-name :session)
- (or ;; Until Emacs 25, `process-attributes' could crash Emacs
- ;; for some processes. Better we don't check.
- (<= emacs-major-version 25)
- (tramp-process-running-p "gvfs-fuse-daemon")
+ (or (tramp-process-running-p "gvfs-fuse-daemon")
(tramp-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")
@@ -471,8 +468,7 @@ It has been changed in GVFS 1.14.")
;; </method>
;; </interface>
-;; The basic structure for GNOME Online Accounts. We use a list :type,
-;; in order to be compatible with Emacs 25.
+;; The basic structure for GNOME Online Accounts.
(cl-defstruct (tramp-goa-account (:type list) :named) method user host port)
;;;###tramp-autoload
@@ -672,8 +668,7 @@ It has been changed in GVFS 1.14.")
;; STRING key (always-call-mount, is-removable, ...)
;; VARIANT value (boolean?)
-;; The basic structure for media devices. We use a list :type, in
-;; order to be compatible with Emacs 25.
+;; The basic structure for media devices.
(cl-defstruct (tramp-media-device (:type list) :named) method host port)
;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
@@ -749,7 +744,8 @@ It has been changed in GVFS 1.14.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-gvfs-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -800,6 +796,7 @@ It has been changed in GVFS 1.14.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -809,6 +806,7 @@ It has been changed in GVFS 1.14.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
(set-file-acl . ignore)
@@ -820,6 +818,7 @@ It has been changed in GVFS 1.14.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-gvfs-handle-get-home-directory)
(tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid)
(tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
@@ -834,12 +833,11 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-gvfs-file-name-p (filename)
- "Check if it's a FILENAME handled by the GVFS daemon."
- (and (tramp-tramp-file-p filename)
- (let ((method
- (tramp-file-name-method (tramp-dissect-file-name filename))))
- (and (stringp method) (member method tramp-gvfs-methods)))))
+(defsubst tramp-gvfs-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME handled by the GVFS daemon."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (let ((method (tramp-file-name-method vec)))
+ (and (stringp method) (member method tramp-gvfs-methods)))))
(defvar tramp-gvfs-dbus-event-vector)
@@ -927,8 +925,6 @@ or `dbus-call-method-asynchronously'."
;; when loading.
(dbus-ignore-errors (tramp-dbus-function ,vec func args))))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
-
(defmacro with-tramp-dbus-get-all-properties
(vec bus service path interface)
"Return all properties of INTERFACE.
@@ -943,8 +939,6 @@ The call will be traced by Tramp with trace level 6."
(tramp-dbus-function
,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface))))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-get-all-properties\\>"))
-
(defvar tramp-gvfs-dbus-event-vector nil
"Current Tramp file name to be used, as vector.
It is needed when D-Bus signals or errors arrive, because there
@@ -1009,7 +1003,7 @@ file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -1026,7 +1020,7 @@ file names."
;; We cannot copy or rename directly.
((or (and equal-remote
- (tramp-get-connection-property v "direct-copy-failed" nil))
+ (tramp-get-connection-property v "direct-copy-failed"))
(and t1 (not (tramp-gvfs-file-name-p filename)))
(and t2 (not (tramp-gvfs-file-name-p newname))))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
@@ -1063,7 +1057,7 @@ file names."
(if (or (not equal-remote)
(and equal-remote
(tramp-get-connection-property
- v "direct-copy-failed" nil)))
+ v "direct-copy-failed")))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -1109,8 +1103,7 @@ file names."
(tramp-skeleton-delete-directory directory recursive trash
(if (and recursive (not (file-symlink-p directory)))
(mapc (lambda (file)
- (if (eq t (tramp-compat-file-attribute-type
- (file-attributes file)))
+ (if (eq t (file-attribute-type (file-attributes file)))
(delete-directory file recursive)
(delete-file file)))
(directory-files
@@ -1152,20 +1145,18 @@ file names."
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
+ (tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
;; If there is a default location, expand tilde.
- (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
- (save-match-data
- (tramp-gvfs-maybe-open-connection
- (make-tramp-file-name
- :method method :user user :domain domain
- :host host :port port :localname "/" :hop hop)))
- (setq localname
- (replace-match
- (tramp-get-connection-property v "default-location" "~")
- nil t localname 1)))
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
(string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
@@ -1184,8 +1175,8 @@ file names."
;; Do not keep "/..".
(when (string-match-p "^/\\.\\.?$" localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
localname
@@ -1345,32 +1336,29 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(or (cdr (assoc "standard::size" attributes)) "0")))
;; ... file mode flags
(setq res-filemodes
- (let ((n (cdr (assoc "unix::mode" attributes))))
- (if n
- (tramp-file-mode-from-int (string-to-number n))
- (format
- "%s%s%s%s------"
- (if dirp "d" (if res-symlink-target "l" "-"))
- (if (equal (cdr (assoc "access::can-read" attributes))
- "FALSE")
- "-" "r")
- (if (equal (cdr (assoc "access::can-write" attributes))
- "FALSE")
- "-" "w")
- (if (equal (cdr (assoc "access::can-execute" attributes))
- "FALSE")
- "-" "x")))))
+ (if-let ((n (cdr (assoc "unix::mode" attributes))))
+ (tramp-file-mode-from-int (string-to-number n))
+ (format
+ "%s%s%s%s------"
+ (if dirp "d" (if res-symlink-target "l" "-"))
+ (if (equal (cdr (assoc "access::can-read" attributes))
+ "FALSE")
+ "-" "r")
+ (if (equal (cdr (assoc "access::can-write" attributes))
+ "FALSE")
+ "-" "w")
+ (if (equal (cdr (assoc "access::can-execute" attributes))
+ "FALSE")
+ "-" "x"))))
;; ... inode and device
(setq res-inode
- (let ((n (cdr (assoc "unix::inode" attributes))))
- (if n
- (string-to-number n)
- (tramp-get-inode (tramp-dissect-file-name filename)))))
+ (if-let ((n (cdr (assoc "unix::inode" attributes))))
+ (string-to-number n)
+ (tramp-get-inode (tramp-dissect-file-name filename))))
(setq res-device
- (let ((n (cdr (assoc "unix::device" attributes))))
- (if n
- (string-to-number n)
- (tramp-get-device (tramp-dissect-file-name filename)))))
+ (if-let ((n (cdr (assoc "unix::device" attributes))))
+ (string-to-number n)
+ (tramp-get-device (tramp-dissect-file-name filename))))
;; Return data gathered.
(list
@@ -1472,7 +1460,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
`file-notify' events."
(let* ((events (process-get proc 'events))
(rest-string (process-get proc 'rest-string))
- (dd (with-current-buffer (process-buffer proc) default-directory))
+ (dd (tramp-get-default-directory (process-buffer proc)))
(ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
(when rest-string
(tramp-message proc 10 "Previous string:\n%s" rest-string))
@@ -1537,11 +1525,13 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(size (cdr (assoc "filesystem::size" attr)))
(used (cdr (assoc "filesystem::used" attr)))
(free (cdr (assoc "filesystem::free" attr))))
- (when (or size used free)
- (list (string-to-number (or size "0"))
- (string-to-number (or free "0"))
- (- (string-to-number (or size "0"))
- (string-to-number (or used "0"))))))))
+ (when (or size free)
+ (list (and size (string-to-number size))
+ (and free (string-to-number free))
+ ;; "mtp" connections do not return "filesystem::used".
+ (or (and size used
+ (- (string-to-number size) (string-to-number used)))
+ (and free (string-to-number free))))))))
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -1589,8 +1579,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(when (looking-at-p "gio: Operation not supported")
- (tramp-set-connection-property vec key nil)))
- nil))))
+ (tramp-set-connection-property vec key nil)))))))
(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
@@ -1611,27 +1600,45 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"%s" (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
+ nil
time)))))
+(defun tramp-gvfs-handle-get-home-directory (vec &optional _user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (let ((localname (tramp-get-connection-property vec "default-location"))
+ result)
+ (cond
+ ((zerop (length localname))
+ (tramp-get-connection-property (tramp-get-process vec) "share"))
+ ;; Google-drive.
+ ((not (string-prefix-p "/" localname))
+ (dolist (item
+ (tramp-gvfs-get-directory-attributes
+ (tramp-make-tramp-file-name vec "/"))
+ result)
+ (when (string-equal (cdr (assoc "name" item)) localname)
+ (setq result (concat "/" (car item))))))
+ (t localname))))
+
(defun tramp-gvfs-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
(if (equal id-format 'string)
(tramp-file-name-user vec)
(when-let ((localname
- (tramp-get-connection-property
- (tramp-get-process vec) "share" nil)))
- (tramp-compat-file-attribute-user-id
+ (tramp-get-connection-property (tramp-get-process vec) "share")))
+ (file-attribute-user-id
(file-attributes (tramp-make-tramp-file-name vec localname) id-format)))))
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
(when-let ((localname
- (tramp-get-connection-property
- (tramp-get-process vec) "share" nil)))
- (tramp-compat-file-attribute-group-id
+ (tramp-get-connection-property (tramp-get-process vec) "share")))
+ (file-attribute-group-id
(file-attributes (tramp-make-tramp-file-name vec localname) id-format))))
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
@@ -1668,7 +1675,7 @@ ID-FORMAT valid values are `string' and `integer'."
(concat (tramp-gvfs-get-remote-prefix v) localname)))
(when (string-equal "mtp" method)
(when-let
- ((media (tramp-get-connection-property v "media-device" nil)))
+ ((media (tramp-get-connection-property v "media-device")))
(setq method (tramp-media-device-method media)
host (tramp-media-device-host media)
port (tramp-media-device-port media))))
@@ -1743,7 +1750,7 @@ a downcased host name only."
(setq domain (read-string "Domain name: ")))
(tramp-message l 6 "%S %S %S %d" message user domain flags)
- (unless (tramp-get-connection-property l "first-password-request" nil)
+ (unless (tramp-get-connection-property l "first-password-request")
(tramp-clear-passwd l))
(setq password (tramp-read-passwd
@@ -1865,18 +1872,17 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices nil)
- (let ((v (tramp-get-connection-property
- (make-tramp-media-device
- :method method :host host :port port)
- "vector" nil)))
- (when v
- (setq method (tramp-file-name-method v)
- host (tramp-file-name-host v)
- port (tramp-file-name-port v)))))
+ (when-let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v))))
(when (member method tramp-gvfs-methods)
- (let ((v (make-tramp-file-name
- :method method :user user :domain domain
- :host host :port port)))
+ (let ((v (make-tramp-file-name
+ :method method :user user :domain domain
+ :host host :port port)))
(tramp-message
v 6 "%s %s"
signal-name (tramp-gvfs-stringify-dbus-message mount-info))
@@ -1910,15 +1916,14 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and
(defun tramp-gvfs-connection-mounted-p (vec)
"Check, whether the location is already mounted."
(or
- (tramp-get-file-property vec "/" "fuse-mountpoint" nil)
+ (tramp-get-file-property vec "/" "fuse-mountpoint")
(catch 'mounted
(dolist
(elt
(with-tramp-file-property vec "/" "list-mounts"
(with-tramp-dbus-call-method vec t
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts))
- nil)
+ tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts)))
;; Jump over the first elements of the mount info. Since there
;; were changes in the entries, we cannot access dedicated
;; elements.
@@ -1967,14 +1972,13 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices vec)
- (let ((v (tramp-get-connection-property
- (make-tramp-media-device
- :method method :host host :port port)
- "vector" nil)))
- (when v
- (setq method (tramp-file-name-method v)
- host (tramp-file-name-host v)
- port (tramp-file-name-port v)))))
+ (when-let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector")))
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v))))
(when (and
(string-equal method (tramp-file-name-method vec))
(string-equal user (tramp-file-name-user vec))
@@ -2230,7 +2234,7 @@ connection if a previous connection has died for some reason."
(tramp-error
vec 'file-error
"Timeout reached mounting %s@%s using %s" user host method)))
- (while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil))
+ (while (not (tramp-get-file-property vec "/" "fuse-mountpoint"))
(read-event nil nil 0.1)))
;; If `tramp-gvfs-handler-askquestion' has returned "No", it
@@ -2368,11 +2372,11 @@ It checks for registered GNOME Online Accounts."
(defun tramp-get-media-device (vec)
"Transform VEC into a `tramp-media-device' structure.
Check, that respective cache values do exist."
- (if-let ((media (tramp-get-connection-property vec "media-device" nil))
- (prop (tramp-get-connection-property media "vector" nil)))
+ (if-let ((media (tramp-get-connection-property vec "media-device"))
+ (prop (tramp-get-connection-property media "vector")))
media
(tramp-get-media-devices vec)
- (tramp-get-connection-property vec "media-device" nil)))
+ (tramp-get-connection-property vec "media-device")))
(defun tramp-get-media-devices (vec)
"Retrieve media devices, and cache them.
@@ -2417,9 +2421,9 @@ It checks for mounted media devices."
(lambda (key)
(and (tramp-media-device-p key)
(string-equal service (tramp-media-device-method key))
- (tramp-get-connection-property key "vector" nil)
+ (tramp-get-connection-property key "vector")
(list nil (tramp-file-name-host
- (tramp-get-connection-property key "vector" nil)))))
+ (tramp-get-connection-property key "vector")))))
(hash-table-keys tramp-cache-data)))
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index b5df9804ab4..226113d8800 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -39,6 +39,7 @@
(declare-function info-lookup->topic-value "info-look")
(declare-function info-lookup-maybe-add-help "info-look")
(declare-function recentf-cleanup "recentf")
+(declare-function shortdoc-add-function "shortdoc")
(declare-function tramp-dissect-file-name "tramp")
(declare-function tramp-file-name-equal-p "tramp")
(declare-function tramp-tramp-file-p "tramp")
@@ -49,6 +50,7 @@
(defvar info-lookup-alist)
(defvar ivy-completing-read-handlers-alist)
(defvar recentf-exclude)
+(defvar shortdoc--groups)
(defvar tramp-current-connection)
(defvar tramp-postfix-host-format)
(defvar tramp-use-ssh-controlmaster-options)
@@ -85,13 +87,6 @@ special handling of `substitute-in-file-name'."
"An overlay covering the shadowed part of the filename."
(format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
-;; Package rfn-eshadow is preloaded in Emacs, but for some reason,
-;; it only did (defvar rfn-eshadow-overlay) without giving it a global
-;; value, so it was only declared as dynamically-scoped within the
-;; rfn-eshadow.el file. This is now fixed in Emacs>26.1 but we still need
-;; this defvar here for older releases.
-(defvar rfn-eshadow-overlay)
-
(defun tramp-rfn-eshadow-update-overlay ()
"Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
This is intended to be used as a minibuffer `post-command-hook' for
@@ -113,7 +108,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
end))
(point-max))
(let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
- (rfn-eshadow-update-overlay-hook nil)
+ rfn-eshadow-update-overlay-hook
file-name-handler-alist)
(move-overlay rfn-eshadow-overlay (point-max) (point-max))
(rfn-eshadow-update-overlay))))))))
@@ -264,6 +259,33 @@ NAME must be equal to `tramp-current-connection'."
(delete (info-lookup->mode-cache 'symbol ',mode)
(info-lookup->topic-cache 'symbol))))))))
+;;; Integration of shortdoc.el:
+
+(with-eval-after-load 'shortdoc
+ (dolist (elem '((file-remote-p
+ :eval (file-remote-p "/ssh:user@host:/tmp/foo")
+ :eval (file-remote-p "/ssh:user@host:/tmp/foo" 'method))
+ (file-local-name
+ :eval (file-local-name "/ssh:user@host:/tmp/foo"))
+ (file-local-copy
+ :no-eval (file-local-copy "/ssh:user@host:/tmp/foo")
+ :eg-result "/tmp/tramp.8ihLbO"
+ :eval (file-local-copy "/tmp/foo"))))
+ (unless (assoc (car elem)
+ (member "Remote Files" (assq 'file shortdoc--groups)))
+ (shortdoc-add-function 'file "Remote Files" elem)))
+
+ (add-hook
+ 'tramp-integration-unload-hook
+ (lambda ()
+ (let ((glist (assq 'file shortdoc--groups)))
+ (while (and (consp glist)
+ (not (and (stringp (cadr glist))
+ (string-equal (cadr glist) "Remote Files"))))
+ (setq glist (cdr glist)))
+ (when (consp glist)
+ (setcdr glist nil))))))
+
;;; Integration of compile.el:
;; Compilation processes use `accept-process-output' such a way that
@@ -278,25 +300,21 @@ NAME must be equal to `tramp-current-connection'."
#'tramp-compile-disable-ssh-controlmaster-options)
(add-hook 'tramp-integration-unload-hook
(lambda ()
- (remove-hook 'compilation-start-hook
+ (remove-hook 'compilation-mode-hook
#'tramp-compile-disable-ssh-controlmaster-options))))
-;;; Default connection-local variables for Tramp:
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
+;;; Default connection-local variables for Tramp.
(defconst tramp-connection-local-default-system-variables
'((path-separator . ":")
(null-device . "/dev/null"))
"Default connection-local system variables for remote connections.")
-(tramp-compat-funcall
- 'connection-local-set-profile-variables
+(connection-local-set-profile-variables
'tramp-connection-local-default-system-profile
tramp-connection-local-default-system-variables)
-(tramp-compat-funcall
- 'connection-local-set-profiles
+(connection-local-set-profiles
'(:application tramp)
'tramp-connection-local-default-system-profile)
@@ -305,17 +323,229 @@ NAME must be equal to `tramp-current-connection'."
(shell-command-switch . "-c"))
"Default connection-local shell variables for remote connections.")
-(tramp-compat-funcall
- 'connection-local-set-profile-variables
+(connection-local-set-profile-variables
'tramp-connection-local-default-shell-profile
tramp-connection-local-default-shell-variables)
(with-eval-after-load 'shell
- (tramp-compat-funcall
- 'connection-local-set-profiles
+ (connection-local-set-profiles
'(:application tramp)
'tramp-connection-local-default-shell-profile))
+;; Tested with FreeBSD 12.2.
+(defconst tramp-bsd-process-attributes-ps-args
+ `("-acxww"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "euid"
+ "user"
+ "egid"
+ "egroup"
+ "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ",")
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("state"
+ "ppid"
+ "pgid"
+ "sid"
+ "tty"
+ "tpgid"
+ "minflt"
+ "majflt"
+ "time"
+ "pri"
+ "nice"
+ "vsz"
+ "rss"
+ "etimes"
+ "pcpu"
+ "pmem"
+ "args")
+ ","))
+ "List of arguments for \"ps\".
+See `tramp-process-attributes-ps-args'.")
+
+(defconst tramp-bsd-process-attributes-ps-format
+ '((pid . number)
+ (euid . number)
+ (user . string)
+ (egid . number)
+ (group . string)
+ (comm . 52)
+ (state . string)
+ (ppid . number)
+ (pgrp . number)
+ (sess . number)
+ (ttname . string)
+ (tpgid . number)
+ (minflt . number)
+ (majflt . number)
+ (time . tramp-ps-time)
+ (pri . number)
+ (nice . number)
+ (vsize . number)
+ (rss . number)
+ (etime . number)
+ (pcpu . number)
+ (pmem . number)
+ (args . nil))
+ "Alist of formats for \"ps\".
+See `tramp-process-attributes-ps-format'.")
+
+(defconst tramp-connection-local-bsd-ps-variables
+ `((tramp-process-attributes-ps-args
+ . ,tramp-bsd-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ,tramp-bsd-process-attributes-ps-format))
+ "Default connection-local ps variables for remote BSD connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-connection-local-bsd-ps-profile
+ tramp-connection-local-bsd-ps-variables)
+
+;; Tested with BusyBox v1.24.1.
+(defconst tramp-busybox-process-attributes-ps-args
+ `("-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "user"
+ "group"
+ "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ",")
+ "-o" "stat=abcde"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("ppid"
+ "pgid"
+ "tty"
+ "time"
+ "nice"
+ "etime"
+ "args")
+ ","))
+ "List of arguments for \"ps\".
+See `tramp-process-attributes-ps-args'.")
+
+(defconst tramp-busybox-process-attributes-ps-format
+ '((pid . number)
+ (user . string)
+ (group . string)
+ (comm . 52)
+ (state . 5)
+ (ppid . number)
+ (pgrp . number)
+ (ttname . string)
+ (time . tramp-ps-time)
+ (nice . number)
+ (etime . tramp-ps-time)
+ (args . nil))
+ "Alist of formats for \"ps\".
+See `tramp-process-attributes-ps-format'.")
+
+(defconst tramp-connection-local-busybox-ps-variables
+ `((tramp-process-attributes-ps-args
+ . ,tramp-busybox-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ,tramp-busybox-process-attributes-ps-format))
+ "Default connection-local ps variables for remote Busybox connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-connection-local-busybox-ps-profile
+ tramp-connection-local-busybox-ps-variables)
+
+;; Darwin (macOS).
+(defconst tramp-darwin-process-attributes-ps-args
+ `("-acxww"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "uid"
+ "user"
+ "gid"
+ "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ",")
+ "-o" "state=abcde"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("ppid"
+ "pgid"
+ "sess"
+ "tty"
+ "tpgid"
+ "minflt"
+ "majflt"
+ "time"
+ "pri"
+ "nice"
+ "vsz"
+ "rss"
+ "etime"
+ "pcpu"
+ "pmem"
+ "args")
+ ","))
+ "List of arguments for \"ps\".
+See `tramp-process-attributes-ps-args'.")
+
+(defconst tramp-darwin-process-attributes-ps-format
+ '((pid . number)
+ (euid . number)
+ (user . string)
+ (egid . number)
+ (comm . 52)
+ (state . 5)
+ (ppid . number)
+ (pgrp . number)
+ (sess . number)
+ (ttname . string)
+ (tpgid . number)
+ (minflt . number)
+ (majflt . number)
+ (time . tramp-ps-time)
+ (pri . number)
+ (nice . number)
+ (vsize . number)
+ (rss . number)
+ (etime . tramp-ps-time)
+ (pcpu . number)
+ (pmem . number)
+ (args . nil))
+ "Alist of formats for \"ps\".
+See `tramp-process-attributes-ps-format'.")
+
+(defconst tramp-connection-local-darwin-ps-variables
+ `((tramp-process-attributes-ps-args
+ . ,tramp-darwin-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ,tramp-darwin-process-attributes-ps-format))
+ "Default connection-local ps variables for remote Darwin connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-connection-local-darwin-ps-profile
+ tramp-connection-local-darwin-ps-variables)
+
+;; Preset default "ps" profile for local hosts, based on system type.
+
+(when-let ((local-profile
+ (cond ((eq system-type 'darwin)
+ 'tramp-connection-local-darwin-ps-profile)
+ ;; ... Add other system types here.
+ )))
+ (connection-local-set-profiles
+ `(:application tramp :machine ,(system-name))
+ local-profile)
+ (connection-local-set-profiles
+ '(:application tramp :machine "localhost")
+ local-profile))
+
(add-hook 'tramp-unload-hook
(lambda () (unload-feature 'tramp-integration 'force)))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 318df2de615..bbc76851318 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -71,7 +71,8 @@
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-rclone-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -110,7 +111,7 @@
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-fuse-handle-file-readable-p)
+ (file-readable-p . tramp-rclone-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-handle-file-selinux-context)
@@ -122,6 +123,7 @@
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -131,6 +133,7 @@
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-rclone-handle-rename-file)
(set-file-acl . ignore)
@@ -142,6 +145,7 @@
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
@@ -156,11 +160,10 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-rclone-file-name-p (filename)
- "Check if it's a FILENAME for rclone."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-rclone-method)))
+(defsubst tramp-rclone-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for rclone."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-rclone-method)))
;;;###tramp-autoload
(defun tramp-rclone-file-name-handler (operation &rest args)
@@ -223,7 +226,7 @@ file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -280,6 +283,12 @@ file names."
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
+(defun tramp-rclone-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (file-readable-p (tramp-fuse-local-file-name filename)))))
+
(defun tramp-rclone-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index b0e98a31e11..174fde720e4 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -34,8 +34,11 @@
(eval-when-compile (require 'cl-lib))
(require 'tramp)
+;; `dired-*' declarations can be removed, starting with Emacs 29.1.
+(declare-function dired-compress-file "dired-aux")
(declare-function dired-remove-file "dired-aux")
(defvar dired-compress-file-suffixes)
+;; Added in Emacs 28.1.
(defvar process-file-return-signal-string)
(defvar vc-handled-backends)
(defvar vc-bzr-program)
@@ -143,6 +146,12 @@ be auto-detected by Tramp.
The string is used in `tramp-methods'.")
+(defcustom tramp-use-scp-direct-remote-copying nil
+ "Whether to use direct copying between two remote hosts."
+ :group 'tramp
+ :version "29.1"
+ :type 'boolean)
+
;; Initialize `tramp-methods' with the supported methods.
;;;###tramp-autoload
(tramp--with-startup
@@ -179,7 +188,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k")
- ("%x") ("%y") ("-q") ("-r") ("%c")))
+ ("%x") ("%y") ("%z")
+ ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
(add-to-list 'tramp-methods
@@ -195,7 +205,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k")
- ("%x") ("%y") ("-q") ("-r") ("%c")))
+ ("%x") ("%y") ("%z")
+ ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
(add-to-list 'tramp-methods
@@ -301,7 +312,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)
- (tramp-session-timeout 300)))
+ (tramp-session-timeout 300)
+ (tramp-password-previous-hop t)))
(add-to-list 'tramp-methods
`("doas"
(tramp-login-program "doas")
@@ -309,7 +321,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)
- (tramp-session-timeout 300)))
+ (tramp-session-timeout 300)
+ (tramp-password-previous-hop t)))
(add-to-list 'tramp-methods
`("ksu"
(tramp-login-program "ksu")
@@ -949,7 +962,8 @@ Format specifiers \"%s\" are replaced before the script is used.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-sh-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sh-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-sh-handle-copy-directory)
@@ -961,6 +975,8 @@ Format specifiers \"%s\" are replaced before the script is used.")
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-sh-handle-directory-files-and-attributes)
+ ;; Starting with Emacs 29.1, `dired-compress-file' performed by
+ ;; default handler.
(dired-compress-file . tramp-sh-handle-dired-compress-file)
(dired-uncache . tramp-handle-dired-uncache)
(exec-path . tramp-sh-handle-exec-path)
@@ -1000,6 +1016,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-sh-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -1009,6 +1026,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-sh-handle-make-process)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
+ (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-sh-handle-process-file)
(rename-file . tramp-sh-handle-rename-file)
(set-file-acl . tramp-sh-handle-set-file-acl)
@@ -1020,6 +1038,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-sh-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sh-handle-get-remote-gid)
(tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
@@ -1127,8 +1146,8 @@ component is used as the target of the symlink."
;; Use Perl implementation.
((and (tramp-get-remote-perl v)
- (tramp-get-connection-property v "perl-file-spec" nil)
- (tramp-get-connection-property v "perl-cwd-realpath" nil))
+ (tramp-get-connection-property v "perl-file-spec")
+ (tramp-get-connection-property v "perl-cwd-realpath"))
(tramp-maybe-send-script
v tramp-perl-file-truename "tramp_perl_file_truename")
(setq result
@@ -1153,8 +1172,7 @@ component is used as the target of the symlink."
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop)))))
+ result)))))))
;; Basic functions.
@@ -1167,9 +1185,9 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-exists-p"
(or (not (null (tramp-get-file-property
- v localname "file-attributes-integer" nil)))
+ v localname "file-attributes-integer")))
(not (null (tramp-get-file-property
- v localname "file-attributes-string" nil)))
+ v localname "file-attributes-string")))
(tramp-send-command-and-check
v
(format
@@ -1349,7 +1367,7 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name f nil
(let* ((remote-file-name-inhibit-cache t)
(attr (file-attributes f))
- (modtime (or (tramp-compat-file-attribute-modification-time attr)
+ (modtime (or (file-attribute-modification-time attr)
tramp-time-doesnt-exist)))
(setq coding-system-used last-coding-system-used)
(if (not (tramp-compat-time-equal-p modtime tramp-time-dont-know))
@@ -1387,7 +1405,7 @@ of."
(with-parsed-tramp-file-name f nil
(let* ((remote-file-name-inhibit-cache t)
(attr (file-attributes f))
- (modtime (tramp-compat-file-attribute-modification-time attr))
+ (modtime (file-attribute-modification-time attr))
(mt (visited-file-modtime)))
(cond
@@ -1439,18 +1457,32 @@ of."
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
+ nil
time)))
(tramp-send-command-and-check
v (format
"env TZ=UTC %s %s %s %s"
(tramp-get-remote-touch v)
- (if (tramp-get-connection-property v "touch-t" nil)
+ (if (tramp-get-connection-property v "touch-t")
(format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
"")
(if (eq flag 'nofollow) "-h" "")
(tramp-shell-quote-argument localname)))))))
+(defun tramp-sh-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (when (tramp-send-command-and-check
+ vec (format
+ "echo %s"
+ (tramp-shell-quote-argument
+ (concat "~" (or user (tramp-file-name-user vec))))))
+ (with-current-buffer (tramp-get-buffer vec)
+ (goto-char (point-min))
+ (buffer-substring (point) (point-at-eol)))))
+
(defun tramp-sh-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
@@ -1636,14 +1668,14 @@ ID-FORMAT valid values are `string' and `integer'."
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
(and
- (= (tramp-compat-file-attribute-user-id attributes)
+ (= (file-attribute-user-id attributes)
(tramp-get-remote-uid v 'integer))
(or (not group)
;; On BSD-derived systems files always inherit the
;; parent directory's group, so skip the group-gid
;; test.
(tramp-check-remote-uname v "BSD\\|DragonFly\\|Darwin")
- (= (tramp-compat-file-attribute-group-id attributes)
+ (= (file-attribute-group-id attributes)
(tramp-get-remote-gid v 'integer)))))))))
;; Directory listings.
@@ -1653,8 +1685,7 @@ ID-FORMAT valid values are `string' and `integer'."
"Like `directory-files-and-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(unless (file-exists-p directory)
- (tramp-compat-file-missing
- (tramp-dissect-file-name directory) directory))
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
(when (file-directory-p directory)
(setq directory (expand-file-name directory))
(let* ((temp
@@ -1874,7 +1905,7 @@ ID-FORMAT valid values are `string' and `integer'."
target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
+ (tramp-error v 'file-missing dirname))
;; `copy-directory-create-symlink' exists since Emacs 28.1.
(if (and (bound-and-true-p copy-directory-create-symlink)
@@ -1968,7 +1999,7 @@ file names."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
- (length (tramp-compat-file-attribute-size
+ (length (file-attribute-size
(file-attributes (file-truename filename))))
(attributes (and preserve-extended-attributes
(file-extended-attributes filename)))
@@ -1976,7 +2007,7 @@ file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -2068,7 +2099,7 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
;; Check, whether file is too large. Emacs checks in `insert-file-1'
;; and `find-file-noselect', but that's not called here.
(abort-if-file-too-large
- (tramp-compat-file-attribute-size (file-attributes (file-truename filename)))
+ (file-attribute-size (file-attributes (file-truename filename)))
(symbol-name op) filename)
;; We must disable multibyte, because binary data shall not be
;; converted. We don't want the target file to be compressed, so we
@@ -2090,8 +2121,7 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
(when keep-date
(tramp-compat-set-file-times
newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
+ (file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(set-file-modes newname (tramp-default-file-modes filename))
@@ -2110,7 +2140,7 @@ as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
the uid and gid from FILENAME."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
- (file-times (tramp-compat-file-attribute-modification-time
+ (file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename)))
(with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -2254,202 +2284,211 @@ the uid and gid from FILENAME."
(op filename newname ok-if-already-exists keep-date)
"Invoke `scp' program to copy.
The method used must be an out-of-band method."
- (let* ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (orig-vec (tramp-dissect-file-name (if t1 filename newname)))
+ (let* ((v1 (and (tramp-tramp-file-p filename)
+ (tramp-dissect-file-name filename)))
+ (v2 (and (tramp-tramp-file-p newname)
+ (tramp-dissect-file-name newname)))
+ (v (or v1 v2))
copy-program copy-args copy-env copy-keep-date listener spec
options source target remote-copy-program remote-copy-args p)
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (if (and t1 t2)
-
- ;; Both are Tramp files. We shall optimize it when the
- ;; methods for FILENAME and NEWNAME are the same.
- (let* ((dir-flag (file-directory-p filename))
- (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
- (if dir-flag
- (setq tmpfile
- (expand-file-name
- (file-name-nondirectory newname) tmpfile)))
- (unwind-protect
- (progn
- (tramp-do-copy-or-rename-file-out-of-band
- op filename tmpfile ok-if-already-exists keep-date)
- (tramp-do-copy-or-rename-file-out-of-band
- 'rename tmpfile newname ok-if-already-exists keep-date))
- ;; Save exit.
- (ignore-errors
- (if dir-flag
- (delete-directory
- (expand-file-name ".." tmpfile) 'recursive)
- (delete-file tmpfile)))))
-
- ;; Check which ones of source and target are Tramp files.
- (setq source (funcall
- (if (and (string-equal method "rsync")
- (file-directory-p filename)
- (not (file-exists-p newname)))
- #'file-name-as-directory
- #'identity)
- (if t1
- (tramp-make-copy-program-file-name v)
- (tramp-compat-file-name-unquote filename)))
- target (if t2
- (tramp-make-copy-program-file-name v)
- (tramp-compat-file-name-unquote newname)))
-
- ;; Check for user. There might be an interactive setting.
- (setq user (or (tramp-file-name-user v)
- (tramp-get-connection-property v "login-as" nil)))
-
- ;; Check for listener port.
- (when (tramp-get-method-parameter v 'tramp-remote-copy-args)
- (setq listener (number-to-string (+ 50000 (random 10000))))
- (while
- (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener))
- (setq listener (number-to-string (+ 50000 (random 10000))))))
-
- ;; Compose copy command.
- (setq options
- (format-spec
- (tramp-ssh-controlmaster-options v)
- (format-spec-make
- ?t (tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" "")))
- spec (list
- ?h (or host "") ?u (or user "") ?p (or port "")
- ?r listener ?c options ?k (if keep-date " " "")
- ?n (concat "2>" (tramp-get-remote-null-device v))
- ?x (tramp-scp-strict-file-name-checking v)
- ?y (tramp-scp-force-scp-protocol v))
- copy-program (tramp-get-method-parameter v 'tramp-copy-program)
- copy-keep-date (tramp-get-method-parameter
- v 'tramp-copy-keep-date)
- copy-args
- ;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement for
- ;; the whole keep-date sublist.
- (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
- ;; `tramp-ssh-controlmaster-options' is a string instead
- ;; of a list. Unflatten it.
- copy-args
- (tramp-compat-flatten-tree
- (mapcar
- (lambda (x) (if (tramp-compat-string-search " " x)
- (split-string x) x))
- copy-args))
- copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
- remote-copy-program
- (tramp-get-method-parameter v 'tramp-remote-copy-program)
- remote-copy-args
- (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
-
- ;; Check for local copy program.
- (unless (executable-find copy-program)
- (tramp-error
- v 'file-error "Cannot find local copy program: %s" copy-program))
-
- ;; Install listener on the remote side. The prompt must be
- ;; consumed later on, when the process does not listen anymore.
- (when remote-copy-program
- (unless (with-tramp-connection-property
- v (concat "remote-copy-program-" remote-copy-program)
- (tramp-find-executable
- v remote-copy-program (tramp-get-remote-path v)))
- (tramp-error
- v 'file-error
- "Cannot find remote listener: %s" remote-copy-program))
- (setq remote-copy-program
- (mapconcat
- #'identity
- (append
- (list remote-copy-program) remote-copy-args
- (list (if t1 (concat "<" source) (concat ">" target)) "&"))
- " "))
- (tramp-send-command v remote-copy-program)
- (with-timeout
- (60 (tramp-error
- v 'file-error
- "Listener process not running on remote host: `%s'"
- remote-copy-program))
- (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
- (while (not (tramp-send-command-and-check v nil))
- (tramp-send-command
- v (format "netstat -l | grep -q :%s" listener)))))
+ (if (and v1 v2 (zerop (length (tramp-scp-direct-remote-copying v1 v2))))
- (with-temp-buffer
+ ;; Both are Tramp files. We cannot use direct remote copying.
+ (let* ((dir-flag (file-directory-p filename))
+ (tmpfile (tramp-compat-make-temp-file
+ (tramp-file-name-localname v1) dir-flag)))
+ (if dir-flag
+ (setq tmpfile
+ (expand-file-name
+ (file-name-nondirectory newname) tmpfile)))
(unwind-protect
- ;; The default directory must be remote.
- (let ((default-directory
- (file-name-directory (if t1 filename newname)))
- (process-environment (copy-sequence process-environment)))
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
- (when copy-env
- (tramp-message
- orig-vec 6 "%s=\"%s\""
- (car copy-env) (string-join (cdr copy-env) " "))
- (setenv (car copy-env) (string-join (cdr copy-env) " ")))
- (setq
- copy-args
- (append
- copy-args
- (if remote-copy-program
- (list (if t1 (concat ">" target) (concat "<" source)))
- (list source target)))
- ;; Use an asynchronous process. By this, password
- ;; can be handled. We don't set a timeout, because
- ;; the copying of large files can last longer than 60
- ;; secs.
- p (let ((default-directory tramp-compat-temporary-file-directory))
- (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- copy-program copy-args)))
- (tramp-message orig-vec 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector orig-vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
+ (progn
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename tmpfile ok-if-already-exists keep-date)
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'rename tmpfile newname ok-if-already-exists keep-date))
+ ;; Save exit.
+ (ignore-errors
+ (if dir-flag
+ (delete-directory
+ (expand-file-name ".." tmpfile) 'recursive)
+ (delete-file tmpfile)))))
+
+ ;; Check which ones of source and target are Tramp files.
+ (setq source (funcall
+ (if (and (string-equal (tramp-file-name-method v) "rsync")
+ (file-directory-p filename)
+ (not (file-exists-p newname)))
+ #'file-name-as-directory
+ #'identity)
+ (if v1
+ (tramp-make-copy-program-file-name v1)
+ (tramp-compat-file-name-unquote filename)))
+ target (if v2
+ (tramp-make-copy-program-file-name v2)
+ (tramp-compat-file-name-unquote newname)))
+
+ ;; Check for listener port.
+ (when (tramp-get-method-parameter v 'tramp-remote-copy-args)
+ (setq listener (number-to-string (+ 50000 (random 10000))))
+ (while
+ (zerop (tramp-call-process
+ v "nc" nil nil nil "-z" (tramp-file-name-host v) listener))
+ (setq listener (number-to-string (+ 50000 (random 10000))))))
+
+ ;; Compose copy command.
+ (setq options
+ (format-spec
+ (tramp-ssh-controlmaster-options v)
+ (format-spec-make
+ ?t (tramp-get-connection-property
+ (tramp-get-connection-process v) "temp-file" "")))
+ spec (list
+ ;; "%h" and "%u" do not happen in `tramp-copy-args'
+ ;; of `scp', so it is save to use `v'.
+ ?h (or (tramp-file-name-host v) "")
+ ?u (or (tramp-file-name-user v)
+ ;; There might be an interactive setting.
+ (tramp-get-connection-property v "login-as")
+ "")
+ ;; For direct remote copying, the port must be the
+ ;; same for source and target.
+ ?p (or (tramp-file-name-port v) "")
+ ?r listener ?c options ?k (if keep-date " " "")
+ ?n (concat "2>" (tramp-get-remote-null-device v))
+ ?x (tramp-scp-strict-file-name-checking v)
+ ?y (tramp-scp-force-scp-protocol v)
+ ?z (tramp-scp-direct-remote-copying v1 v2))
+ copy-program (tramp-get-method-parameter v 'tramp-copy-program)
+ copy-keep-date (tramp-get-method-parameter
+ v 'tramp-copy-keep-date)
+ copy-args
+ ;; " " has either been a replacement of "%k" (when
+ ;; keep-date argument is non-nil), or a replacement for
+ ;; the whole keep-date sublist.
+ (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
+ ;; `tramp-ssh-controlmaster-options' is a string instead
+ ;; of a list. Unflatten it.
+ copy-args
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x) (if (tramp-compat-string-search " " x)
+ (split-string x) x))
+ copy-args))
+ copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
+ remote-copy-program
+ (tramp-get-method-parameter v 'tramp-remote-copy-program)
+ remote-copy-args
+ (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
+
+ ;; Check for local copy program.
+ (unless (executable-find copy-program)
+ (tramp-error
+ v 'file-error "Cannot find local copy program: %s" copy-program))
+
+ ;; Install listener on the remote side. The prompt must be
+ ;; consumed later on, when the process does not listen anymore.
+ (when remote-copy-program
+ (unless (with-tramp-connection-property
+ v (concat "remote-copy-program-" remote-copy-program)
+ (tramp-find-executable
+ v remote-copy-program (tramp-get-remote-path v)))
+ (tramp-error
+ v 'file-error
+ "Cannot find remote listener: %s" remote-copy-program))
+ (setq remote-copy-program
+ (mapconcat
+ #'identity
+ (append
+ (list remote-copy-program) remote-copy-args
+ (list (if v1 (concat "<" source) (concat ">" target)) "&"))
+ " "))
+ (tramp-send-command v remote-copy-program)
+ (with-timeout
+ (60 (tramp-error
+ v 'file-error
+ "Listener process not running on remote host: `%s'"
+ remote-copy-program))
+ (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
+ (while (not (tramp-send-command-and-check v nil))
+ (tramp-send-command
+ v (format "netstat -l | grep -q :%s" listener)))))
+
+ (with-temp-buffer
+ (unwind-protect
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ ;; The default directory must be remote.
+ (let ((default-directory
+ (file-name-directory (if v1 filename newname)))
+ (process-environment (copy-sequence process-environment)))
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+ (when copy-env
+ (tramp-message
+ v 6 "%s=\"%s\""
+ (car copy-env) (string-join (cdr copy-env) " "))
+ (setenv (car copy-env) (string-join (cdr copy-env) " ")))
+ (setq
+ copy-args
+ (append
+ copy-args
+ (if remote-copy-program
+ (list (if v1 (concat ">" target) (concat "<" source)))
+ (list source target)))
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled. We don't set a timeout, because
+ ;; the copying of large files can last longer than
+ ;; 60 secs.
+ p (let ((default-directory
+ tramp-compat-temporary-file-directory))
+ (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ copy-program copy-args)))
+ (tramp-message v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; We must adapt `tramp-local-end-of-line' for sending
+ ;; the password. Also, we indicate that perhaps several
+ ;; password prompts might appear.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line)
+ (tramp-password-prompt-not-unique (and v1 v2)))
+ (tramp-process-actions
+ p v nil tramp-actions-copy-out-of-band)))))
+
+ ;; Clear the remote prompt.
+ (when (and remote-copy-program
+ (not (tramp-send-command-and-check v nil)))
+ ;; Houston, we have a problem! Likely, the listener is
+ ;; still running, so let's clear everything (but the
+ ;; cached password).
+ (tramp-cleanup-connection v 'keep-debug 'keep-password))))
+
+ ;; Handle KEEP-DATE argument.
+ (when (and keep-date (not copy-keep-date))
+ (tramp-compat-set-file-times
+ newname
+ (file-attribute-modification-time (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
+
+ ;; Set the mode.
+ (unless (and keep-date copy-keep-date)
+ (ignore-errors
+ (set-file-modes newname (tramp-default-file-modes filename)))))
- ;; We must adapt `tramp-local-end-of-line' for
- ;; sending the password.
- (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
- (tramp-process-actions
- p v nil tramp-actions-copy-out-of-band)))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Clear the remote prompt.
- (when (and remote-copy-program
- (not (tramp-send-command-and-check v nil)))
- ;; Houston, we have a problem! Likely, the listener is
- ;; still running, so let's clear everything (but the
- ;; cached password).
- (tramp-cleanup-connection v 'keep-debug 'keep-password))))
-
- ;; Handle KEEP-DATE argument.
- (when (and keep-date (not copy-keep-date))
- (tramp-compat-set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (unless ok-if-already-exists 'nofollow)))
-
- ;; Set the mode.
- (unless (and keep-date copy-keep-date)
- (ignore-errors
- (set-file-modes newname (tramp-default-file-modes filename)))))
-
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy)
- (if (file-regular-p filename)
- (delete-file filename)
- (delete-directory filename 'recursive))))))
+ ;; If the operation was `rename', delete the original file.
+ (unless (eq op 'copy)
+ (if (file-regular-p filename)
+ (delete-file filename)
+ (delete-directory filename 'recursive)))))
(defun tramp-sh-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -2493,42 +2532,58 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-dired-compress-file (file)
"Like `dired-compress-file' for Tramp files."
- ;; Code stolen mainly from dired-aux.el.
- (with-parsed-tramp-file-name file nil
- (tramp-flush-file-properties v localname)
- (let ((suffixes dired-compress-file-suffixes)
- suffix)
- ;; See if any suffix rule matches this file name.
- (while suffixes
- (let (case-fold-search)
- (if (string-match-p (car (car suffixes)) localname)
- (setq suffix (car suffixes) suffixes nil))
- (setq suffixes (cdr suffixes))))
-
- (cond ((file-symlink-p file) nil)
- ((and suffix (nth 2 suffix))
- ;; We found an uncompression rule.
- (with-tramp-progress-reporter
- v 0 (format "Uncompressing %s" file)
- (when (tramp-send-command-and-check
- v (concat (nth 2 suffix) " "
- (tramp-shell-quote-argument localname)))
- (dired-remove-file file)
- (string-match (car suffix) file)
- (concat (substring file 0 (match-beginning 0))))))
- (t
- ;; We don't recognize the file as compressed, so compress it.
- ;; Try gzip.
- (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
- (when (tramp-send-command-and-check
- v (concat "gzip -f "
- (tramp-shell-quote-argument localname)))
- (dired-remove-file file)
- (cond ((file-exists-p (concat file ".gz"))
- (concat file ".gz"))
- ((file-exists-p (concat file ".z"))
- (concat file ".z"))
- (t nil)))))))))
+ ;; Starting with Emacs 29.1, `dired-compress-file' is performed by
+ ;; default handler.
+ (if (>= emacs-major-version 29)
+ (tramp-run-real-handler #'dired-compress-file (list file))
+ ;; Code stolen mainly from dired-aux.el.
+ (with-parsed-tramp-file-name file nil
+ (tramp-flush-file-properties v localname)
+ (let ((suffixes dired-compress-file-suffixes)
+ suffix)
+ ;; See if any suffix rule matches this file name.
+ (while suffixes
+ (let (case-fold-search)
+ (if (string-match-p (car (car suffixes)) localname)
+ (setq suffix (car suffixes) suffixes nil))
+ (setq suffixes (cdr suffixes))))
+
+ (cond ((file-symlink-p file) nil)
+ ((and suffix (nth 2 suffix))
+ ;; We found an uncompression rule.
+ (with-tramp-progress-reporter
+ v 0 (format "Uncompressing %s" file)
+ (when (tramp-send-command-and-check
+ v (if (string-match-p "%[io]" (nth 2 suffix))
+ (replace-regexp-in-string
+ "%i" (tramp-shell-quote-argument localname)
+ (nth 2 suffix))
+ (concat (nth 2 suffix) " "
+ (tramp-shell-quote-argument localname))))
+ (unless (string-match-p "\\.tar\\.gz" file)
+ (dired-remove-file file))
+ (string-match (car suffix) file)
+ (concat (substring file 0 (match-beginning 0))))))
+ (t
+ ;; We don't recognize the file as compressed, so
+ ;; compress it. Try gzip.
+ (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
+ (when (tramp-send-command-and-check
+ v (if (file-directory-p file)
+ (format "tar -cf - %s | gzip -c9 > %s.tar.gz"
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname))
+ (tramp-shell-quote-argument localname))
+ (concat "gzip -f "
+ (tramp-shell-quote-argument localname))))
+ (unless (file-directory-p file)
+ (dired-remove-file file))
+ (catch 'found nil
+ (dolist (target (mapcar (lambda (suffix)
+ (concat file suffix))
+ '(".tar.gz" ".gz" ".z")))
+ (when (file-exists-p target)
+ (throw 'found target))))))))))))
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
@@ -2600,7 +2655,7 @@ The method used must be an out-of-band method."
;; We cannot use `insert-buffer-substring' because the Tramp
;; buffer changes its contents before insertion due to calling
;; `expand-file-name' and alike.
- (insert (with-current-buffer (tramp-get-buffer v) (buffer-string)))
+ (insert (tramp-get-buffer-string (tramp-get-buffer v)))
;; We must enable unibyte strings, because the "--dired"
;; output counts in bytes.
@@ -2712,38 +2767,32 @@ the result will be a local, non-Tramp, file name."
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
- ;; If connection is not established yet, run the real handler.
- (if (not (tramp-connectable-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ ;; If connection is not established yet, run the real handler.
+ (if (not (tramp-connectable-p v))
+ (tramp-run-real-handler #'expand-file-name (list name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "~/" localname)))
;; Tilde expansion if necessary. This needs a shell which
;; groks tilde expansion! The function `tramp-find-shell' is
;; supposed to find such a shell on the remote host. Please
;; tell me about it when this doesn't work on your system.
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
(let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
+ (fname (match-string 2 localname))
+ hname)
;; We cannot simply apply "~/", because under sudo "~/" is
;; expanded to the local user home directory but to the
;; root home directory. On the other hand, using always
;; the default user name for tilde expansion is not
;; appropriate either, because ssh and companions might
;; use a user name from the config file.
- (when (and (string-equal uname "~")
+ (when (and (zerop (length uname))
(string-match-p "\\`su\\(do\\)?\\'" method))
- (setq uname (concat uname user)))
- (setq uname
- (with-tramp-connection-property v uname
- (tramp-send-command
- v
- (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (buffer-substring (point) (point-at-eol)))))
- (setq localname (concat uname fname))))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; There might be a double slash, for example when "~/"
;; expands to "/". Remove this.
(while (string-match "//" localname)
@@ -2751,15 +2800,17 @@ the result will be a local, non-Tramp, file name."
;; Do not keep "/..".
(when (string-match-p "^/\\.\\.?$" localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
;; `default-directory' is bound, because on Windows there
;; would be problems with UNC shares or Cygwin mounts.
(let ((default-directory tramp-compat-temporary-file-directory))
(tramp-make-tramp-file-name
- v (tramp-drop-volume-letter
- (tramp-run-real-handler
- #'expand-file-name (list localname)))))))))
+ v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ localname
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ #'expand-file-name (list localname))))))))))
;;; Remote commands:
@@ -2825,6 +2876,7 @@ implementation will be used."
stderr (tramp-make-tramp-temp-name v)))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (orig-command command)
(program (car command))
(args (cdr command))
;; When PROGRAM matches "*sh", and the first arg is
@@ -2855,7 +2907,7 @@ implementation will be used."
;; `shell'. We discard hops, if existing, that's why
;; we cannot use `file-remote-p'.
(prompt (format "PS1=%s %s"
- (tramp-make-tramp-file-name v nil 'nohop)
+ (tramp-make-tramp-file-name v)
tramp-initial-end-of-output))
;; We use as environment the difference to toplevel
;; `process-environment'.
@@ -2924,91 +2976,103 @@ implementation will be used."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process'
- ;; could be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point-max))
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- (catch 'suppress
- ;; Set the pid of the remote shell. This is
- ;; needed when sending signals remotely.
- (let ((pid (tramp-send-command-and-read v "echo $$")))
- (setq p (tramp-get-connection-process v))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property p "remote-pid" pid))
- ;; Disable carriage return to newline
- ;; translation. This does not work on
- ;; macOS, see Bug#50748.
- (when (and (memq connection-type '(nil pipe))
- (not (tramp-check-remote-uname v "Darwin")))
- (tramp-send-command v "stty -icrnl"))
- ;; `tramp-maybe-open-connection' and
- ;; `tramp-send-command-and-read' could have
- ;; trashed the connection buffer. Remove this.
- (widen)
- (delete-region mark (point-max))
- (narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (process-get p 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'"
- name))))
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise,
+ ;; `make-process' could be called on the local
+ ;; host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save
+ ;; BUFFER contents. Clear also the
+ ;; modification time; otherwise we might be
+ ;; interrupted by `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (mark (point-max))
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ (catch 'suppress
+ ;; Set the pid of the remote shell. This is
+ ;; needed when sending signals remotely.
+ (let ((pid
+ (tramp-send-command-and-read v "echo $$")))
+ (setq p (tramp-get-connection-process v))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property
+ p "remote-pid" pid))
+ ;; Disable carriage return to newline
+ ;; translation. This does not work on
+ ;; macOS, see Bug#50748.
+ (when (and (memq connection-type '(nil pipe))
+ (not
+ (tramp-check-remote-uname v "Darwin")))
+ (tramp-send-command v "stty -icrnl"))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could have
+ ;; trashed the connection buffer. Remove this.
+ (widen)
+ (delete-region mark (point-max))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (process-get p 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'"
+ name))))
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors,
+ ;; because the process could have finished
+ ;; already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; We must flush them here already;
+ ;; otherwise `delete-file' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Kill stderr process and delete named pipe.
+ (when (bufferp stderr)
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (ignore-errors
+ (while (accept-process-output
+ (get-buffer-process stderr) 0 nil t))
+ (delete-process (get-buffer-process stderr)))
+ (ignore-errors
+ (delete-file remote-tmpstderr)))))
+ ;; Return process.
+ p)))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; Kill stderr process and delete named pipe.
- (when (bufferp stderr)
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (ignore-errors
- (while (accept-process-output
- (get-buffer-process stderr) 0 nil t))
- (delete-process (get-buffer-process stderr)))
- (ignore-errors
- (delete-file remote-tmpstderr)))))
- ;; Return process.
- p)))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))))
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))))))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -3016,7 +3080,7 @@ implementation will be used."
vec
(concat
"signal-strings-" (tramp-get-method-parameter vec 'tramp-remote-shell))
- (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+ (let ((default-directory (tramp-make-tramp-file-name vec 'noloc))
process-file-return-signal-string signals res result)
(setq signals
(append
@@ -3107,7 +3171,7 @@ implementation will be used."
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input 'nohop))
+ tmpinput (tramp-make-tramp-file-name v input))
(copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input)))
@@ -3139,7 +3203,7 @@ implementation will be used."
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
- tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
+ tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr destination))
(setq stderr (tramp-get-remote-null-device v)))))
@@ -3164,8 +3228,7 @@ implementation will be used."
(when outbuf
(with-current-buffer outbuf
(insert
- (with-current-buffer (tramp-get-connection-buffer v)
- (buffer-string))))
+ (tramp-get-buffer-string (tramp-get-connection-buffer v))))
(when (and display (get-buffer-window outbuf t)) (redisplay))))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
@@ -3208,9 +3271,9 @@ implementation will be used."
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (file-exists-p (file-truename filename))
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
- (let* ((size (tramp-compat-file-attribute-size
+ (let* ((size (file-attribute-size
(file-attributes (file-truename filename))))
(rem-enc (tramp-get-inline-coding v "remote-encoding" size))
(loc-dec (tramp-get-inline-coding v "local-decoding" size))
@@ -3286,255 +3349,197 @@ implementation will be used."
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer))))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
- (if (and (tramp-local-host-p v)
- ;; `file-writable-p' calls `file-expand-file-name'. We
- ;; cannot use `tramp-run-real-handler' therefore.
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))
- ;; Short track: if we are on the local host, we can run directly.
- (let ((create-lockfiles (not file-locked)))
- (write-region start end localname append 'no-message lockname))
-
- (let* ((modes (tramp-default-file-modes
- filename (and (eq mustbenew 'excl) 'nofollow)))
- ;; We use this to save the value of
- ;; `last-coding-system-used' after writing the tmp
- ;; file. At the end of the function, we set
- ;; `last-coding-system-used' to this saved value. This
- ;; way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose
- ;; this variable. This approach was snarfed from
- ;; ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really
- ;; needed if we use an encoding function, but currently
- ;; we use it always because this makes the logic
- ;; simpler. We must also set `temporary-file-directory',
- ;; because it could point to a remote directory.
- (temporary-file-directory tramp-compat-temporary-file-directory)
- (tmpfile (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename))))
-
- ;; If `append' is non-nil, we copy the file locally, and let
- ;; the native `write-region' implementation do the job.
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok))
-
- ;; We say `no-message' here because we don't want the
- ;; visited file modtime data to be clobbered from the temp
- ;; file. We call `set-visited-file-modtime' ourselves later
- ;; on. We must ensure that `file-coding-system-alist'
- ;; matches `tmpfile'.
- (let ((file-coding-system-alist
- (tramp-find-file-name-coding-system-alist filename tmpfile))
- create-lockfiles)
- (condition-case err
- (write-region start end tmpfile append 'no-message)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Now, `last-coding-system-used' has the right value. Remember it.
- (setq coding-system-used last-coding-system-used))
-
- ;; The permissions of the temporary file should be set. If
- ;; FILENAME does not exist (eq modes nil) it has been
- ;; renamed to the backup file. This case `save-buffer'
- ;; handles permissions.
- ;; Ensure that it is still readable.
- (when modes
- (set-file-modes tmpfile (logior (or modes 0) #o0400)))
-
- ;; This is a bit lengthy due to the different methods
- ;; possible for file transfer. First, we check whether the
- ;; method uses an scp program. If so, we call it.
- ;; Otherwise, both encoding and decoding command must be
- ;; specified. However, if the method _also_ specifies an
- ;; encoding function, then that is used for encoding the
- ;; contents of the tmp file.
- (let* ((size (tramp-compat-file-attribute-size
- (file-attributes tmpfile)))
- (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
- (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
- (cond
- ;; `copy-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (tramp-method-out-of-band-p v size))
- (if (and (not (stringp start))
- (= (or end (point-max)) (point-max))
- (= (or start (point-min)) (point-min))
- (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile))
- (progn
- (setq tramp-temp-buffer-file-name tmpfile)
- (condition-case err
- ;; We keep the local file for performance
- ;; reasons, useful for "rsync".
- (copy-file tmpfile filename t)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
- (setq tramp-temp-buffer-file-name nil)
- ;; Don't rename, in order to keep context in SELinux.
- (unwind-protect
- (copy-file tmpfile filename t)
- (delete-file tmpfile))))
-
- ;; Use inline file transfer.
- (rem-dec
- ;; Encode tmpfile.
+ (tramp-skeleton-write-region start end filename append visit lockname mustbenew
+ (if (and (tramp-local-host-p v)
+ ;; `file-writable-p' calls `file-expand-file-name'. We
+ ;; cannot use `tramp-run-real-handler' therefore.
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))
+ ;; Short track: if we are on the local host, we can run directly.
+ (let ((create-lockfiles (not file-locked)))
+ (write-region start end localname append 'no-message lockname))
+
+ (let* ((modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp file.
+ ;; At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic simpler.
+ ;; We must also set `temporary-file-directory', because
+ ;; it could point to a remote directory.
+ (temporary-file-directory
+ tramp-compat-temporary-file-directory)
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
+
+ ;; If `append' is non-nil, we copy the file locally, and let
+ ;; the native `write-region' implementation do the job.
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
+
+ ;; We say `no-message' here because we don't want the visited
+ ;; file modtime data to be clobbered from the temp file. We
+ ;; call `set-visited-file-modtime' ourselves later on. We
+ ;; must ensure that `file-coding-system-alist' matches
+ ;; `tmpfile'.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist filename tmpfile))
+ create-lockfiles)
+ (condition-case err
+ (write-region start end tmpfile append 'no-message)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Now, `last-coding-system-used' has the right value.
+ ;; Remember it.
+ (setq coding-system-used last-coding-system-used))
+
+ ;; The permissions of the temporary file should be set. If
+ ;; FILENAME does not exist (eq modes nil) it has been renamed
+ ;; to the backup file. This case `save-buffer' handles
+ ;; permissions. Ensure that it is still readable.
+ (when modes
+ (set-file-modes tmpfile (logior (or modes 0) #o0400)))
+
+ ;; This is a bit lengthy due to the different methods possible
+ ;; for file transfer. First, we check whether the method uses
+ ;; an scp program. If so, we call it. Otherwise, both
+ ;; encoding and decoding command must be specified. However,
+ ;; if the method _also_ specifies an encoding function, then
+ ;; that is used for encoding the contents of the tmp file.
+ (let* ((size (file-attribute-size (file-attributes tmpfile)))
+ (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
+ (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
+ (cond
+ ;; `copy-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (tramp-method-out-of-band-p v size))
+ (if (and (not (stringp start))
+ (= (or end (point-max)) (point-max))
+ (= (or start (point-min)) (point-min))
+ (tramp-get-method-parameter
+ v 'tramp-copy-keep-tmpfile))
+ (progn
+ (setq tramp-temp-buffer-file-name tmpfile)
+ (condition-case err
+ ;; We keep the local file for performance
+ ;; reasons, useful for "rsync".
+ (copy-file tmpfile filename t)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
+ (setq tramp-temp-buffer-file-name nil)
+ ;; Don't rename, in order to keep context in SELinux.
(unwind-protect
- (with-temp-buffer
- (set-buffer-multibyte nil)
- ;; Use encoding function or command.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Encoding local file `%s' using `%s'"
- tmpfile loc-enc)
- (if (functionp loc-enc)
- ;; The following `let' is a workaround for
- ;; the base64.el that comes with pgnus-0.84.
- ;; If both of the following conditions are
- ;; satisfied, it tries to write to a local
- ;; file in default-directory, but at this
- ;; point, default-directory is remote.
- ;; (`call-process-region' can't write to
- ;; remote files, it seems.) The file in
- ;; question is a tmp file anyway.
- (let ((coding-system-for-read 'binary)
- (default-directory
- tramp-compat-temporary-file-directory))
- (insert-file-contents-literally tmpfile)
- (funcall loc-enc (point-min) (point-max)))
-
- (unless (zerop (tramp-call-local-coding-command
- loc-enc tmpfile t))
- (tramp-error
- v 'file-error
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed")
- filename loc-enc))))
-
- ;; Send buffer into remote decoding command which
- ;; writes to remote file. Because this happens on
- ;; the remote host, we cannot use the function.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Decoding remote file `%s' using `%s'"
- filename rem-dec)
- (goto-char (point-max))
- (unless (bolp) (newline))
- (tramp-send-command
- v
- (format
- (concat rem-dec " <<'%s'\n%s%s")
- (tramp-shell-quote-argument localname)
- tramp-end-of-heredoc
- (buffer-string)
- tramp-end-of-heredoc))
- (tramp-barf-unless-okay
- v nil
- "Couldn't write region to `%s', decode using `%s' failed"
- filename rem-dec)
- ;; When `file-precious-flag' is set, the region is
- ;; written to a temporary file. Check that the
- ;; checksum is equal to that from the local tmpfile.
- (when file-precious-flag
- (erase-buffer)
- (and
- ;; cksum runs locally, if possible.
- (zerop (tramp-call-process v "cksum" tmpfile t))
- ;; cksum runs remotely.
- (tramp-send-command-and-check
- v
- (format
- "cksum <%s" (tramp-shell-quote-argument localname)))
- ;; ... they are different.
- (not
- (string-equal
- (buffer-string)
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string))))
- (tramp-error
- v 'file-error
- (concat "Couldn't write region to `%s',"
- " decode using `%s' failed")
- filename rem-dec)))))
-
- ;; Save exit.
- (delete-file tmpfile)))
+ (copy-file tmpfile filename t)
+ (delete-file tmpfile))))
- ;; That's not expected.
- (t
- (tramp-error
- v 'file-error
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program")
- method))))
+ ;; Use inline file transfer.
+ (rem-dec
+ ;; Encode tmpfile.
+ (unwind-protect
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ ;; Use encoding function or command.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Encoding local file `%s' using `%s'"
+ tmpfile loc-enc)
+ (if (functionp loc-enc)
+ ;; The following `let' is a workaround for the
+ ;; base64.el that comes with pgnus-0.84. If
+ ;; both of the following conditions are
+ ;; satisfied, it tries to write to a local
+ ;; file in default-directory, but at this
+ ;; point, default-directory is remote.
+ ;; (`call-process-region' can't write to
+ ;; remote files, it seems.) The file in
+ ;; question is a tmp file anyway.
+ (let ((coding-system-for-read 'binary)
+ (default-directory
+ tramp-compat-temporary-file-directory))
+ (insert-file-contents-literally tmpfile)
+ (funcall loc-enc (point-min) (point-max)))
+
+ (unless (zerop (tramp-call-local-coding-command
+ loc-enc tmpfile t))
+ (tramp-error
+ v 'file-error
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed")
+ filename loc-enc))))
+
+ ;; Send buffer into remote decoding command which
+ ;; writes to remote file. Because this happens on
+ ;; the remote host, we cannot use the function.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Decoding remote file `%s' using `%s'"
+ filename rem-dec)
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (tramp-send-command
+ v
+ (format
+ (concat rem-dec " <<'%s'\n%s%s")
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ (buffer-string)
+ tramp-end-of-heredoc))
+ (tramp-barf-unless-okay
+ v nil
+ "Couldn't write region to `%s', decode using `%s' failed"
+ filename rem-dec)
+ ;; When `file-precious-flag' is set, the region is
+ ;; written to a temporary file. Check that the
+ ;; checksum is equal to that from the local tmpfile.
+ (when file-precious-flag
+ (erase-buffer)
+ (and
+ ;; cksum runs locally, if possible.
+ (zerop (tramp-call-process v "cksum" tmpfile t))
+ ;; cksum runs remotely.
+ (tramp-send-command-and-check
+ v
+ (format
+ "cksum <%s"
+ (tramp-shell-quote-argument localname)))
+ ;; ... they are different.
+ (not
+ (string-equal
+ (buffer-string)
+ (tramp-get-buffer-string (tramp-get-buffer v))))
+ (tramp-error
+ v 'file-error
+ "Couldn't write region to `%s', decode using `%s' failed"
+ filename rem-dec)))))
- ;; Make `last-coding-system-used' have the right value.
- (when coding-system-used
- (setq last-coding-system-used coding-system-used))))
+ ;; Save exit.
+ (delete-file tmpfile)))
- (tramp-flush-file-properties v localname)
+ ;; That's not expected.
+ (t
+ (tramp-error
+ v 'file-error
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an scp program")
+ method))))
- ;; We must protect `last-coding-system-used', now we have set it
- ;; to its correct value.
- (let (last-coding-system-used (need-chown t))
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (let ((file-attr (file-attributes filename 'integer)))
- (set-visited-file-modtime
- ;; We must pass modtime explicitly, because FILENAME can
- ;; be different from (buffer-file-name), f.e. if
- ;; `file-precious-flag' is set.
- (or (tramp-compat-file-attribute-modification-time file-attr)
- (current-time)))
- (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
- (= (tramp-compat-file-attribute-group-id file-attr) gid))
- (setq need-chown nil))))
-
- ;; Set the ownership.
- (when need-chown
- (tramp-set-file-uid-gid filename uid gid))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))))
+ ;; Make `last-coding-system-used' have the right value.
+ (when coding-system-used
+ (setq last-coding-system-used coding-system-used))))))
(defvar tramp-vc-registered-file-names nil
"List used to collect file names, which are checked during `vc-registered'.")
@@ -3658,8 +3663,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(defun tramp-sh-file-name-handler-p (vec)
"Whether VEC uses a method from `tramp-sh-file-name-handler'."
(and (assoc (tramp-file-name-method vec) tramp-methods)
- (eq (tramp-find-foreign-file-name-handler
- (tramp-make-tramp-file-name vec nil 'nohop))
+ (eq (tramp-find-foreign-file-name-handler vec)
'tramp-sh-file-name-handler)))
;; This must be the last entry, because `identity' always matches.
@@ -3776,8 +3780,7 @@ Fall back to normal file name handler if no Tramp handler exists."
"Read output from \"gio monitor\" and add corresponding `file-notify' events."
(let ((events (process-get proc 'events))
(remote-prefix
- (with-current-buffer (process-buffer proc)
- (file-remote-p default-directory)))
+ (file-remote-p (tramp-get-default-directory (process-buffer proc))))
(rest-string (process-get proc 'rest-string))
pos)
(when rest-string
@@ -3973,7 +3976,7 @@ Only send the definition if it has not already been done."
;; We cannot let-bind (tramp-get-connection-process vec) because it
;; might be nil.
(let ((scripts (tramp-get-connection-property
- (tramp-get-connection-process vec) "scripts" nil)))
+ (tramp-get-connection-process vec) "scripts")))
(unless (member name scripts)
(with-tramp-progress-reporter
vec 5 (format-message "Sending script `%s'" name)
@@ -4223,7 +4226,7 @@ file exists and nonzero exit status otherwise."
(defun tramp-find-shell (vec)
"Open a shell on the remote host which groks tilde expansion."
;; If we are in `make-process', we don't need another shell.
- (unless (tramp-get-connection-property vec "process-name" nil)
+ (unless (tramp-get-connection-property vec "process-name")
(with-current-buffer (tramp-get-buffer vec)
(let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
shell)
@@ -4320,11 +4323,10 @@ process to set up. VEC specifies the connection."
;; connection properties. We start again with
;; `tramp-maybe-open-connection', it will be caught there.
(tramp-message vec 5 "Checking system information")
- (let* ((old-uname (tramp-get-connection-property vec "uname" nil))
+ (let* ((old-uname (tramp-get-connection-property vec "uname"))
(uname
;; If we are in `make-process', we don't need to recompute.
- (if (and old-uname
- (tramp-get-connection-property vec "process-name" nil))
+ (if (and old-uname (tramp-get-connection-property vec "process-name"))
old-uname
(tramp-set-connection-property
vec "uname"
@@ -4812,7 +4814,7 @@ Goes through the list `tramp-inline-compress-commands'."
((stringp tramp-scp-strict-file-name-checking)
tramp-scp-strict-file-name-checking)
- ;; Determine the options.
+ ;; Determine the option.
(t (setq tramp-scp-strict-file-name-checking "")
(let ((case-fold-search t))
(ignore-errors
@@ -4855,11 +4857,84 @@ Goes through the list `tramp-inline-compress-commands'."
(setq tramp-scp-force-scp-protocol "-O")))))))
tramp-scp-force-scp-protocol)))
+(defun tramp-scp-direct-remote-copying (vec1 vec2)
+ "Return the direct remote copying argument of the local scp."
+ (cond
+ ((or (not tramp-use-scp-direct-remote-copying) (null vec1) (null vec2)
+ (not (tramp-get-process vec1))
+ (not (equal (tramp-file-name-port vec1) (tramp-file-name-port vec2)))
+ (null (assoc "%z" (tramp-get-method-parameter vec1 'tramp-copy-args)))
+ (null (assoc "%z" (tramp-get-method-parameter vec2 'tramp-copy-args))))
+ "")
+
+ ((let ((case-fold-search t))
+ (and
+ ;; Check, whether "scp" supports "-R" option.
+ (with-tramp-connection-property nil "scp-R"
+ (when (executable-find "scp")
+ (with-temp-buffer
+ (tramp-call-process vec1 "scp" nil t nil "-R")
+ (goto-char (point-min))
+ (not (search-forward-regexp
+ "\\(illegal\\|unknown\\) option -- R" nil 'noerror)))))
+
+ ;; Check, that RemoteCommand is not used.
+ (with-tramp-connection-property
+ (tramp-get-process vec1) "ssh-remote-command"
+ (let ((command `("ssh" "-G" ,(tramp-file-name-host vec1))))
+ (with-temp-buffer
+ (tramp-call-process
+ vec1 tramp-encoding-shell nil t nil
+ tramp-encoding-command-switch
+ (mapconcat #'identity command " "))
+ (goto-char (point-min))
+ (not (search-forward "remotecommand" nil 'noerror)))))
+
+ ;; Check hostkeys.
+ (with-tramp-connection-property
+ (tramp-get-process vec1)
+ (concat "direct-remote-copying-"
+ (tramp-make-tramp-file-name vec2 'noloc))
+ (let ((command
+ (append
+ `("ssh" "-G" ,(tramp-file-name-host vec2) "|"
+ "grep" "-i" "^hostname" "|" "cut" "-d\" \"" "-f2" "|"
+ "ssh-keyscan" "-f" "-")
+ (when (tramp-file-name-port vec2)
+ `("-p" ,(tramp-file-name-port vec2)))))
+ found string)
+ (with-temp-buffer
+ ;; Check hostkey of VEC2, seen from VEC1.
+ (tramp-send-command vec1 (mapconcat #'identity command " "))
+ ;; Check hostkey of VEC2, seen locally.
+ (tramp-call-process
+ vec1 tramp-encoding-shell nil t nil tramp-encoding-command-switch
+ (mapconcat #'identity command " "))
+ (goto-char (point-min))
+ (while (and (not found) (not (eobp)))
+ (setq string
+ (buffer-substring
+ (line-beginning-position) (line-end-position))
+ string
+ (and
+ (string-match "^[^# ]+ \\S-+ \\(\\S-+\\)$" string)
+ (match-string 1 string))
+ found
+ (and string
+ (with-current-buffer (tramp-get-buffer vec1)
+ (goto-char (point-min))
+ (search-forward string nil 'noerror))))
+ (forward-line))
+ found)))))
+ "-R")
+
+ (t "-3")))
+
(defun tramp-timeout-session (vec)
"Close the connection VEC after a session timeout.
If there is just some editing, retry it after 5 seconds."
(if (and (tramp-get-connection-property
- (tramp-get-connection-process vec) "locked" nil)
+ (tramp-get-connection-process vec) "locked")
(tramp-file-name-equal-p vec (car tramp-current-connection)))
(progn
(tramp-message
@@ -4878,7 +4953,7 @@ connection if a previous connection has died for some reason."
(throw 'non-essential 'non-essential))
(let ((p (tramp-get-connection-process vec))
- (process-name (tramp-get-connection-property vec "process-name" nil))
+ (process-name (tramp-get-connection-property vec "process-name"))
(process-environment (copy-sequence process-environment))
(pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
@@ -4949,8 +5024,7 @@ connection if a previous connection has died for some reason."
(tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
(let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec))
- ;; Needed for `tramp-get-remote-null-device'.
- (previous-hop nil)
+ (previous-hop tramp-null-hop)
;; We will apply `tramp-ssh-controlmaster-options'
;; only for the first hop.
(options (tramp-ssh-controlmaster-options vec))
@@ -5035,9 +5109,14 @@ connection if a previous connection has died for some reason."
;; Set password prompt vector.
(tramp-set-connection-property
p "password-vector"
- (make-tramp-file-name
- :method l-method :user l-user :domain l-domain
- :host l-host :port l-port))
+ (if (tramp-get-method-parameter
+ hop 'tramp-password-previous-hop)
+ (let ((pv (copy-tramp-file-name previous-hop)))
+ (setf (tramp-file-name-method pv) l-method)
+ pv)
+ (make-tramp-file-name
+ :method l-method :user l-user :domain l-domain
+ :host l-host :port l-port)))
;; Set session timeout.
(when (tramp-get-method-parameter
@@ -5088,9 +5167,9 @@ connection if a previous connection has died for some reason."
previous-hop hop)))
;; Activate session timeout.
- (when (tramp-get-connection-property p "session-timeout" nil)
+ (when (tramp-get-connection-property p "session-timeout")
(run-at-time
- (tramp-get-connection-property p "session-timeout" nil) nil
+ (tramp-get-connection-property p "session-timeout") nil
#'tramp-timeout-session vec))
;; Make initial shell settings.
@@ -5112,7 +5191,7 @@ is meant to be used from `tramp-maybe-open-connection' only. The
function waits for output unless NOOUTPUT is set."
(unless neveropen (tramp-maybe-open-connection vec))
(let ((p (tramp-get-connection-process vec)))
- (when (tramp-get-connection-property p "remote-echo" nil)
+ (when (tramp-get-connection-property p "remote-echo")
;; We mark the command string that it can be erased in the output buffer.
(tramp-set-connection-property p "check-remote-echo" t)
;; If we put `tramp-echo-mark' after a trailing newline (which
@@ -5473,7 +5552,7 @@ Nonexistent directories are removed from spec."
(lambda (x)
(and
(stringp x)
- (file-directory-p (tramp-make-tramp-file-name vec x 'nohop))
+ (file-directory-p (tramp-make-tramp-file-name vec x))
x))
remote-path))))))
@@ -5879,7 +5958,7 @@ If no corresponding command is found, nil is returned."
(> size tramp-inline-compress-start-size))
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property (tramp-get-process vec) prop nil))))
+ (tramp-get-connection-property (tramp-get-process vec) prop))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
@@ -5899,7 +5978,7 @@ function cell is returned to be applied on a buffer."
(let ((coding
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property (tramp-get-process vec) prop nil)))
+ (tramp-get-connection-property (tramp-get-process vec) prop)))
(prop1 (if (tramp-compat-string-search "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
@@ -6015,9 +6094,6 @@ function cell is returned to be applied on a buffer."
;;
;; * Use lsh instead of ssh. (Alfred M. Szmidt)
;;
-;; * Optimize out-of-band copying when both methods are scp-like (not
-;; rsync).
-;;
;; * Keep a second connection open for out-of-band methods like scp or
;; rsync.
;;
@@ -6061,5 +6137,8 @@ function cell is returned to be applied on a buffer."
;; be to stipulate, as a directory or connection-local variable, an
;; additional rc file on the remote machine that is sourced every
;; time Tramp connects. <https://emacs.stackexchange.com/questions/62306>
+;;
+;; * Support hostname canonicalization in ~/.ssh/config.
+;; <https://stackoverflow.com/questions/70205232/>
;;; tramp-sh.el ends here
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index dfcb7162c80..b717c4dcc38 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -222,7 +222,8 @@ See `tramp-actions-before-shell' for more info.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-smb-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-smb-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-smb-handle-copy-directory)
@@ -273,6 +274,7 @@ See `tramp-actions-before-shell' for more info.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -282,6 +284,7 @@ See `tramp-actions-before-shell' for more info.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
+ (process-attributes . ignore)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
(set-file-acl . tramp-smb-handle-set-file-acl)
@@ -293,6 +296,7 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-smb-handle-get-home-directory)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
@@ -330,11 +334,10 @@ This can be used to disable echo etc."
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-smb-file-name-p (filename)
- "Check if it's a FILENAME for SMB servers."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-smb-method)))
+(defsubst tramp-smb-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for SMB servers."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-smb-method)))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
@@ -383,14 +386,13 @@ arguments to pass to the OPERATION."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v2 v2-localname)
- (unless
- (tramp-smb-send-command
- v1
- (format
- "%s \"%s\" \"%s\""
- (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
+ (unless (tramp-smb-send-command
+ v1
+ (format
+ "%s %s %s"
+ (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
+ (tramp-smb-shell-quote-localname v1)
+ (tramp-smb-shell-quote-localname v2)))
(tramp-error
v2 'file-error
"error with add-name-to-file, see buffer `%s' for details"
@@ -419,7 +421,7 @@ arguments to pass to the OPERATION."
target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
+ (tramp-error v 'file-missing dirname))
;; `copy-directory-create-symlink' exists since Emacs 28.1.
(if (and (bound-and-true-p copy-directory-create-symlink)
@@ -442,7 +444,7 @@ arguments to pass to the OPERATION."
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" dirname newname)
(unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
+ (tramp-error v 'file-missing dirname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
@@ -517,58 +519,57 @@ arguments to pass to the OPERATION."
"tar qx -")))))
(unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates always
- ;; complete paths. We must emulate the
- ;; directory structure, and symlink to the
- ;; real target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname
- (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this,
- ;; password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions
- p v nil tramp-smb-actions-with-tar)
-
- (while (process-live-p p)
- (sleep-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates
+ ;; always complete paths. We must emulate
+ ;; the directory structure, and symlink to
+ ;; the real target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname
+ (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions
+ p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sleep-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))))
+
+ ;; Save exit.
(when t1 (delete-directory tmpdir 'recursive))))
;; Handle KEEP-DATE argument.
(when keep-date
(tramp-compat-set-file-times
newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes dirname))
+ (file-attribute-modification-time (file-attributes dirname))
(unless ok-if-already-exists 'nofollow)))
;; Set the mode.
@@ -602,12 +603,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(copy-directory filename newname keep-date 'parents 'copy-contents)
(unless (file-exists-p filename)
- (tramp-compat-file-missing
+ (tramp-error
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
- filename))
+ 'file-missing filename))
- (if-let ((tmpfile (file-local-copy filename)))
+ ;; `file-local-copy' returns a file name also for a local file
+ ;; with `jka-compr-handler', so we cannot trust its result as
+ ;; indication for a remote file name.
+ (if-let ((tmpfile
+ (and (file-remote-p filename) (file-local-copy filename))))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
@@ -635,9 +640,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-error
v 'file-error "Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- (tramp-compat-file-name-unquote filename)
- (tramp-smb-get-localname v)))
+ v (format "put %s %s"
+ (tramp-smb-shell-quote-argument filename)
+ (tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))
@@ -645,8 +650,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when keep-date
(tramp-compat-set-file-times
newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
+ (file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive trash)
@@ -667,10 +671,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-flush-directory-properties v localname)
(unless (tramp-smb-send-command
v (format
- "%s \"%s\""
+ "%s %s"
(if (tramp-smb-get-cifs-capabilities v)
"posix_rmdir" "rmdir")
- (tramp-smb-get-localname v)))
+ (tramp-smb-shell-quote-localname v)))
;; Error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -693,9 +697,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(move-file-to-trash filename)
(unless (tramp-smb-send-command
v (format
- "%s \"%s\""
+ "%s %s"
(if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
- (tramp-smb-get-localname v)))
+ (tramp-smb-shell-quote-localname v)))
;; Error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -706,7 +710,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
(let ((result (mapcar #'directory-file-name
(file-name-all-completions "" directory))))
;; Discriminate with regexp.
@@ -744,28 +748,33 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
+ (tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We use the user name as share,
- ;; which is often the case in domains.
- (when (string-match "\\`/?~\\([^/]*\\)" localname)
- (setq localname
- (replace-match
- (if (zerop (length (match-string 1 localname)))
- user
- (match-string 1 localname))
- nil nil localname)))
- ;; Make the file name absolute.
+ ;; Tilde expansion if necessary.
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Tilde expansion is not possible.
+ (when (and (not tramp-tolerate-tilde)
+ (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+ (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; Do not keep "/..".
(when (string-match-p "^/\\.\\.?$" localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
- v (tramp-run-real-handler #'expand-file-name (list localname))))))
+ v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ localname
+ (tramp-run-real-handler #'expand-file-name (list localname)))))))
(defun tramp-smb-action-get-acl (proc vec)
"Read ACL data from connection buffer."
@@ -815,33 +824,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(concat "2>" (tramp-get-remote-null-device v)))))
(unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-get-acl)
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string)))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this,
+ ;; password can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-get-acl)
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string))))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -888,7 +895,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
(let* (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
- vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
+ vec (format "stat %s" (tramp-smb-shell-quote-localname vec)))
;; Loop the listing.
(with-current-buffer (tramp-get-connection-buffer vec)
@@ -962,7 +969,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (and (stringp id)
(tramp-smb-send-command
vec
- (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
+ (format
+ "readlink %s" (tramp-smb-shell-quote-localname vec))))
(goto-char (point-min))
(and (looking-at ".+ -> \\(.+\\)")
(setq id (match-string 1))))
@@ -976,13 +984,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name (file-truename filename) nil
(unless (file-exists-p (file-truename filename))
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(unless (tramp-smb-send-command
- v (format "get \"%s\" \"%s\""
- (tramp-smb-get-localname v) tmpfile))
+ v (format "get %s %s"
+ (tramp-smb-shell-quote-localname v)
+ (tramp-smb-shell-quote-argument tmpfile)))
;; Oops, an error. We shall cleanup.
(delete-file tmpfile)
(tramp-error
@@ -1015,7 +1024,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (tramp-smb-get-share v)
(tramp-message v 5 "file system info: %s" localname)
(tramp-smb-send-command
- v (format "du %s/*" (tramp-smb-get-localname v)))
+ v (format "du %s/*" (tramp-smb-shell-quote-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(let (total avail blocksize)
(goto-char (point-min))
@@ -1041,8 +1050,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
(tramp-compat-string-search
- "w"
- (or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
+ "w" (or (file-attribute-modes (file-attributes filename)) ""))
(let ((dir (file-name-directory filename)))
(and (file-exists-p dir)
(file-writable-p dir)))))
@@ -1147,11 +1155,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
- (or (tramp-compat-file-attribute-modes attr) (nth 1 x))
- (or (tramp-compat-file-attribute-link-number attr) 1)
- (or (tramp-compat-file-attribute-user-id attr) "nobody")
- (or (tramp-compat-file-attribute-group-id attr) "nogroup")
- (or (tramp-compat-file-attribute-size attr) (nth 2 x))
+ (or (file-attribute-modes attr) (nth 1 x))
+ (or (file-attribute-link-number attr) 1)
+ (or (file-attribute-user-id attr) "nobody")
+ (or (file-attribute-group-id attr) "nogroup")
+ (or (file-attribute-size attr) (nth 2 x))
(format-time-string
(if (time-less-p
;; Half a year.
@@ -1173,8 +1181,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Insert symlink.
(when (and (tramp-compat-string-search "l" switches)
- (stringp (tramp-compat-file-attribute-type attr)))
- (insert " -> " (tramp-compat-file-attribute-type attr))))
+ (stringp (file-attribute-type attr)))
+ (insert " -> " (file-attribute-type attr))))
(insert "\n")
(beginning-of-line)))
@@ -1206,18 +1214,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(unless (file-name-absolute-p directory)
(setq directory (expand-file-name directory default-directory)))
(with-parsed-tramp-file-name directory nil
- (let* ((file (tramp-smb-get-localname v)))
- (when (file-directory-p (file-name-directory directory))
- (tramp-smb-send-command
- v
- (if (tramp-smb-get-cifs-capabilities v)
- (format "posix_mkdir \"%s\" %o" file (default-file-modes))
- (format "mkdir \"%s\"" file)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname))
- (unless (file-directory-p directory)
- (tramp-error v 'file-error "Couldn't make directory %s" directory)))))
+ (when (file-directory-p (file-name-directory directory))
+ (tramp-smb-send-command
+ v (if (tramp-smb-get-cifs-capabilities v)
+ (format "posix_mkdir %s %o"
+ (tramp-smb-shell-quote-localname v) (default-file-modes))
+ (format "mkdir %s" (tramp-smb-shell-quote-localname v))))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname))
+ (unless (file-directory-p directory)
+ (tramp-error v 'file-error "Couldn't make directory %s" directory))))
(defun tramp-smb-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
@@ -1261,11 +1268,10 @@ component is used as the target of the symlink."
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
- (unless
- (tramp-smb-send-command
- v (format "symlink \"%s\" \"%s\""
- (tramp-compat-file-name-unquote target)
- (tramp-smb-get-localname v)))
+ (unless (tramp-smb-send-command
+ v (format "symlink %s %s"
+ (tramp-smb-shell-quote-argument target)
+ (tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error
"error with make-symbolic-link, see buffer `%s' for details"
@@ -1334,31 +1340,34 @@ component is used as the target of the symlink."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property
- v "process-buffer"
- (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
-
;; Call it.
(condition-case nil
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Preserve buffer contents.
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format "cd \"//%s%s\"" host (file-name-directory localname))))
- (tramp-smb-send-command v command)
- ;; Preserve command output.
- (narrow-to-region (point-max) (point-max))
- (let ((p (tramp-get-connection-process v)))
- (tramp-smb-send-command v "exit $lasterrorcode")
- (while (process-live-p p)
- (sleep-for 0.1)
- (setq ret (process-exit-status p))))
- (delete-region (point-min) (point-max))
- (widen))
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd //%s%s" host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (process-live-p p)
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen))))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
@@ -1373,11 +1382,10 @@ component is used as the target of the symlink."
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
(when tmpinput (delete-file tmpinput))
+ ;; FIXME: Does connection-property "process-buffer" still exist?
(unless outbuf
- (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
+ (kill-buffer (tramp-get-connection-property v "process-buffer")))
(when process-file-side-effects
(tramp-flush-directory-properties v ""))
@@ -1395,7 +1403,7 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -1423,9 +1431,9 @@ component is used as the target of the symlink."
v2 'file-error
"Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
- v2 (format "rename \"%s\" \"%s\""
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
+ v2 (format "rename %s %s"
+ (tramp-smb-shell-quote-localname v1)
+ (tramp-smb-shell-quote-localname v2)))
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
;; We must rename via copy.
@@ -1440,9 +1448,9 @@ component is used as the target of the symlink."
(unless (process-live-p proc)
;; Accept pending output.
(while (tramp-accept-process-output proc))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 10 "\n%s" (buffer-string))
- (throw 'tramp-action 'ok))))
+ (tramp-message
+ vec 10 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
+ (throw 'tramp-action 'ok)))
(defun tramp-smb-handle-set-file-acl (filename acl-string)
"Like `set-file-acl' for Tramp files."
@@ -1478,42 +1486,44 @@ component is used as the target of the symlink."
"||" "echo" "tramp_exit_status" "1")))
(unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-set-acl)
- ;; This is meant for traces, and returning from the
- ;; function. No error is propagated outside, due to
- ;; the `ignore-errors' closure.
- (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
- (tramp-error
- v 'file-error
- "Couldn't find exit status of `%s'" tramp-smb-acl-program))
- (skip-chars-forward "^ ")
- (when (zerop (read (current-buffer)))
- ;; Success.
- (tramp-set-file-property v localname "file-acl" acl-string)
- t)))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-set-acl)
+ ;; This is meant for traces, and returning from
+ ;; the function. No error is propagated
+ ;; outside, due to the `ignore-errors' closure.
+ (unless
+ (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'"
+ tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property
+ v localname "file-acl" acl-string)
+ t)))))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
@@ -1523,7 +1533,8 @@ component is used as the target of the symlink."
(when (tramp-smb-get-cifs-capabilities v)
(tramp-flush-file-properties v localname)
(unless (tramp-smb-send-command
- v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
+ v
+ (format "chmod %s %o" (tramp-smb-shell-quote-localname v) mode))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename))))))
@@ -1541,41 +1552,50 @@ component is used as the target of the symlink."
(command (string-join (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
- (i 0))
+ (i 0)
+ p)
(unwind-protect
- (save-excursion
- (save-restriction
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format
- "cd \"//%s%s\""
- host (file-name-directory localname))))
- (tramp-message v 6 "(%s); exit" command)
- (tramp-send-string v command)))
- ;; Return value.
- (tramp-get-connection-process v)))
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ (save-excursion
+ (save-restriction
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd //%s%s"
+ host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ (setq p (tramp-get-connection-process v))
+ (when program
+ (process-put p 'remote-command (cons program args))
+ (tramp-set-connection-property
+ p "remote-command" (cons program args)))
+ ;; Return value.
+ p))))
;; Save exit.
+ ;; FIXME: Does `tramp-get-connection-buffer' return the proper value?
(with-current-buffer (tramp-get-connection-buffer v)
(if (tramp-compat-string-search tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))
+ (set-buffer-modified-p bmp)))))))
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
@@ -1594,31 +1614,20 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(tramp-run-real-handler #'substitute-in-file-name (list filename))
(error filename))))
+(defun tramp-smb-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (let ((user (or user (tramp-file-name-user vec))))
+ (unless (zerop (length user))
+ (concat "/" user))))
+
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ (tramp-skeleton-write-region start end filename append visit lockname mustbenew
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the visited file
@@ -1631,37 +1640,11 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
(unwind-protect
(unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- tmpfile (tramp-smb-get-localname v)))
+ v (format "put %s %s"
+ (tramp-smb-shell-quote-argument tmpfile)
+ (tramp-smb-shell-quote-localname v)))
(tramp-error v 'file-error "Cannot write `%s'" filename))
- (delete-file tmpfile)))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (delete-file tmpfile))))))
;; Internal file name functions.
@@ -1717,7 +1700,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
(setq localname (or localname "/"))
(with-tramp-file-property v localname "file-entries"
(let* ((share (tramp-smb-get-share v))
- (cache (tramp-get-connection-property v "share-cache" nil))
+ (cache (tramp-get-connection-property v "share-cache"))
res entry)
(if (and (not share) cache)
@@ -1727,7 +1710,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
;; Read entries.
(if share
(tramp-smb-send-command
- v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
+ v (format "dir %s*" (tramp-smb-shell-quote-localname v)))
;; `tramp-smb-maybe-open-connection' lists also the share names.
(tramp-smb-maybe-open-connection v))
@@ -1931,7 +1914,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(if (and (tramp-smb-get-share vec)
(process-live-p (tramp-get-connection-process vec)))
(with-tramp-connection-property (tramp-get-process vec) "stat-capability"
- (tramp-smb-send-command vec "stat \"/\""))))
+ (tramp-smb-send-command vec "stat /"))))
;; Connection functions.
@@ -2046,7 +2029,7 @@ If ARGUMENT is non-nil, use it as argument for
(if (not (zerop (length user))) (concat user "@") "")
host (or share ""))
- (let* ((coding-system-for-read nil)
+ (let* (coding-system-for-read
(process-connection-type tramp-process-connection-type)
(p (let ((default-directory
tramp-compat-temporary-file-directory)
@@ -2191,6 +2174,10 @@ Removes smb prompt. Returns nil if an error message has appeared."
(let ((system-type 'ms-dos))
(tramp-unquote-shell-quote-argument s)))
+(defun tramp-smb-shell-quote-localname (vec)
+ "Call `tramp-smb-shell-quote-argument' on localname of VEC."
+ (tramp-smb-shell-quote-argument (tramp-smb-get-localname vec)))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index b229f589248..d7c918fbc83 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -74,7 +74,8 @@
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-sshfs-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -125,6 +126,7 @@
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-sshfs-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -134,6 +136,7 @@
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-sshfs-handle-process-file)
(rename-file . tramp-sshfs-handle-rename-file)
(set-file-acl . ignore)
@@ -145,6 +148,7 @@
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
@@ -159,11 +163,10 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-sshfs-file-name-p (filename)
- "Check if it's a FILENAME for sshfs."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-sshfs-method)))
+(defsubst tramp-sshfs-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for sshfs."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-sshfs-method)))
;;;###tramp-autoload
(defun tramp-sshfs-file-name-handler (operation &rest args)
@@ -263,7 +266,7 @@ arguments to pass to the OPERATION."
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input 'nohop))
+ tmpinput (tramp-make-tramp-file-name v input))
(copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input)))
@@ -370,48 +373,10 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
- (let (create-lockfiles)
- (write-region
- start end (tramp-fuse-local-file-name filename) append 'nomessage)
- (tramp-flush-file-properties v localname))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (tramp-skeleton-write-region start end filename append visit lockname mustbenew
+ (let (create-lockfiles)
+ (write-region
+ start end (tramp-fuse-local-file-name filename) append 'nomessage))))
;; File name conversions.
@@ -484,7 +449,7 @@ connection if a previous connection has died for some reason."
(funcall orig-fun)))
(add-function
- :around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
+ :around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
(add-hook 'tramp-sshfs-unload-hook
(lambda ()
(remove-function
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 06100fbde0d..420a593644f 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -45,7 +45,8 @@
(add-to-list 'tramp-methods
`(,tramp-sudoedit-method
(tramp-sudo-login (("sudo") ("-u" "%u") ("-S") ("-H")
- ("-p" "Password:") ("--")))))
+ ("-p" "Password:") ("--")))
+ (tramp-password-previous-hop t)))
(add-to-list 'tramp-default-user-alist '("\\`sudoedit\\'" nil "root"))
@@ -63,7 +64,8 @@ See `tramp-actions-before-shell' for more info.")
;;;###tramp-autoload
(defconst tramp-sudoedit-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
(byte-compiler-base-file-name . ignore)
(copy-directory . tramp-handle-copy-directory)
@@ -115,6 +117,7 @@ See `tramp-actions-before-shell' for more info.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -124,6 +127,7 @@ See `tramp-actions-before-shell' for more info.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-sudoedit-handle-rename-file)
(set-file-acl . tramp-sudoedit-handle-set-file-acl)
@@ -135,6 +139,7 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-sudoedit-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid)
(tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
@@ -142,17 +147,16 @@ See `tramp-actions-before-shell' for more info.")
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-sudoedit-handle-write-region))
+ (write-region . tramp-handle-write-region))
"Alist of handler functions for Tramp SUDOEDIT method.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-sudoedit-file-name-p (filename)
- "Check if it's a FILENAME for SUDOEDIT."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-sudoedit-method)))
+(defsubst tramp-sudoedit-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for SUDOEDIT."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-sudoedit-method)))
;;;###tramp-autoload
(defun tramp-sudoedit-file-name-handler (operation &rest args)
@@ -168,6 +172,12 @@ arguments to pass to the OPERATION."
(tramp-register-foreign-file-name-handler
#'tramp-sudoedit-file-name-p #'tramp-sudoedit-file-name-handler))
+;; Needed for `tramp-read-passwd'.
+(defconst tramp-sudoedit-null-hop
+ (make-tramp-file-name
+ :method tramp-sudoedit-method :user (user-login-name) :host tramp-system-name)
+"Connection hop which identifies the virtual hop before the first one.")
+
;; File name primitives.
@@ -233,7 +243,7 @@ absolute file names."
(let ((t1 (tramp-sudoedit-file-name-p filename))
(t2 (tramp-sudoedit-file-name-p newname))
- (file-times (tramp-compat-file-attribute-modification-time
+ (file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
@@ -247,7 +257,7 @@ absolute file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -362,17 +372,23 @@ the result will be a local, non-Tramp, file name."
(setq localname "~"))
(unless (file-name-absolute-p localname)
(setq localname (format "~%s/%s" user localname)))
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
(let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
- (when (string-equal uname "~")
- (setq uname (concat uname user)))
- (setq localname (concat uname fname))))
- ;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
- (setq localname "/"))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
- (tramp-make-tramp-file-name v (expand-file-name localname))))
+ (tramp-make-tramp-file-name
+ v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ localname
+ (tramp-run-real-handler
+ #'expand-file-name (list localname))))))
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
@@ -453,12 +469,13 @@ the result will be a local, non-Tramp, file name."
(if (file-directory-p (expand-file-name f directory))
(file-name-as-directory f)
f))
- (with-current-buffer (tramp-get-connection-buffer v)
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
- (split-string (buffer-string) "\n" 'omit)))))))))
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
+ (split-string
+ (tramp-get-buffer-string (tramp-get-connection-buffer v))
+ "\n" 'omit))))))))
(defun tramp-sudoedit-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
@@ -534,7 +551,7 @@ the result will be a local, non-Tramp, file name."
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
+ nil
time)))
(tramp-sudoedit-send-command
v "env" "TZ=UTC" "touch" "-t"
@@ -571,8 +588,7 @@ the result will be a local, non-Tramp, file name."
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop)))))
+ result)))))))
(defun tramp-sudoedit-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
@@ -692,6 +708,13 @@ component is used as the target of the symlink."
(tramp-flush-file-property v localname "file-selinux-context"))
t)))))
+(defun tramp-sudoedit-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (expand-file-name (concat "~" (or user (tramp-file-name-user vec)))))
+
(defun tramp-sudoedit-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
@@ -716,40 +739,6 @@ ID-FORMAT valid values are `string' and `integer'."
(or gid (tramp-get-remote-gid v 'integer)))
(tramp-unquote-file-local-name filename))))
-(defun tramp-sudoedit-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (let* ((uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer)))
- (flag (and (eq mustbenew 'excl) 'nofollow))
- (modes (tramp-default-file-modes filename flag))
- (attributes (file-extended-attributes filename)))
- (prog1
- (tramp-handle-write-region
- start end filename append visit lockname mustbenew)
-
- ;; Set the ownership, modes and extended attributes. This is
- ;; not performed in `tramp-handle-write-region'.
- (unless (and (= (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- uid)
- (= (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- gid))
- (tramp-set-file-uid-gid filename uid gid))
- (tramp-compat-set-file-modes filename modes flag)
- ;; We ignore possible errors, because ACL strings could be
- ;; incompatible.
- (when attributes
- (ignore-errors
- (set-file-extended-attributes filename attributes)))))))
-
;; Internal functions.
@@ -827,6 +816,7 @@ in case of error, t otherwise."
(process-put p 'vector vec)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop)
(tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
(tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
(prog1
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 88715e3230b..37259107147 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -257,6 +257,8 @@ pair of the form (KEY VALUE). The following KEYs are defined:
argument if it is supported.
- \"%y\" is replaced by the `tramp-scp-force-scp-protocol'
argument if it is supported.
+ - \"%z\" is replaced by the `tramp-scp-direct-remote-copying'
+ argument if it is supported.
The existence of `tramp-login-args', combined with the
absence of `tramp-copy-args', is an indication that the
@@ -315,14 +317,20 @@ pair of the form (KEY VALUE). The following KEYs are defined:
* `tramp-connection-timeout'
This is the maximum time to be spent for establishing a connection.
In general, the global default value shall be used, but for
- some methods, like \"su\" or \"sudo\", a shorter timeout
- might be desirable.
+ some methods, like \"doas\", \"su\" or \"sudo\", a shorter
+ timeout might be desirable.
* `tramp-session-timeout'
How long a Tramp connection keeps open before being disconnected.
- This is useful for methods like \"su\" or \"sudo\", which
+ This is useful for methods like \"doas\" or \"sudo\", which
shouldn't run an open connection in the background forever.
+ * `tramp-password-previous-hop'
+ The password for this connection is the same like the
+ password for the previous hop. If there is no previous hop,
+ the password of the local user is applied. This is needed
+ for methods like \"doas\", \"sudo\" or \"sudoedit\".
+
* `tramp-case-insensitive'
Whether the remote file system handles file names case insensitive.
Only a non-nil value counts, the default value nil means to
@@ -514,11 +522,12 @@ host runs a restricted shell, it shall be added to this list, too."
(concat
"\\`"
(regexp-opt
- (list "localhost" "localhost6" tramp-system-name "127.0.0.1" "::1") t)
+ `("localhost" "localhost4" "localhost6" ,tramp-system-name "127.0.0.1" "::1")
+ t)
"\\'")
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "27.1"
+ :version "29.1"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -754,11 +763,11 @@ The answer will be provided by `tramp-action-process-alive',
(defconst tramp-temp-name-prefix "tramp."
"Prefix to use for temporary files.
-If this is a relative file name (such as \"tramp.\"), it is considered
-relative to the directory name returned by the function
-`tramp-compat-temporary-file-directory' (which see). It may also be an
-absolute file name; don't forget to include a prefix for the filename
-part, though.")
+If this is a relative file name (such as \"tramp.\"), it is
+considered relative to the directory name returned by the
+function `temporary-file-directory' (which see). It may also be
+an absolute file name; don't forget to include a prefix for the
+filename part, though.")
(defconst tramp-temp-buffer-name " *tramp temp*"
"Buffer name for a temporary buffer.
@@ -825,11 +834,10 @@ to be set, depending on VALUE."
(tramp-register-file-name-handlers))
;; Initialize the Tramp syntax variables. We want to override initial
-;; value of `tramp-file-name-regexp'. Other Tramp syntax variables
-;; must be initialized as well to proper values. We do not call
+;; value of `tramp-file-name-regexp'. We do not call
;; `custom-set-variable', this would load Tramp via custom.el.
(tramp--with-startup
- (tramp-set-syntax 'tramp-syntax (tramp-compat-tramp-syntax)))
+ (tramp-set-syntax 'tramp-syntax tramp-syntax))
(defun tramp-syntax-values ()
"Return possible values of `tramp-syntax', a list."
@@ -839,9 +847,9 @@ to be set, depending on VALUE."
values))
(defun tramp-lookup-syntax (alist)
- "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax'.
-Raise an error if `tramp-syntax' is invalid."
- (or (cdr (assq (tramp-compat-tramp-syntax) alist))
+ "Look up a syntax string in ALIST according to `tramp-syntax'.
+Raise an error if it is invalid."
+ (or (cdr (assq tramp-syntax alist))
(error "Wrong `tramp-syntax' %s" tramp-syntax)))
(defconst tramp-prefix-format-alist
@@ -1376,7 +1384,8 @@ would require an immediate reread during filename completion, nil
means to use always cached values for the directory contents."
:type '(choice (const nil) (const t) integer))
(make-obsolete-variable
- 'tramp-completion-reread-directory-timeout 'remote-file-name-inhibit-cache "27.2")
+ 'tramp-completion-reread-directory-timeout
+ 'remote-file-name-inhibit-cache "27.2")
;;; Internal Variables:
@@ -1391,6 +1400,11 @@ Will be called once the password has been verified by successful
authentication.")
(put 'tramp-password-save-function 'tramp-suppress-trace t)
+(defvar tramp-password-prompt-not-unique nil
+ "Whether several passwords might be requested.
+This shouldn't be set explicitly. It is let-bound, for example
+during direct remote copying with scp.")
+
(defconst tramp-completion-file-name-handler-alist
'((file-name-all-completions
. tramp-completion-handle-file-name-all-completions)
@@ -1412,8 +1426,7 @@ calling HANDLER.")
;; internal data structure. Convenience functions for internal
;; data structure.
-;; The basic structure for remote file names. We use a list :type, in
-;; order to be compatible with Emacs 25. We must autoload it in
+;; The basic structure for remote file names. We must autoload it in
;; tramp-loaddefs.el, because some functions, which need it, wouldn't
;; work otherwise when unloading / reloading Tramp. (Bug#50869)
;;;###tramp-autoload
@@ -1428,6 +1441,11 @@ calling HANDLER.")
(put #'tramp-file-name-localname 'tramp-suppress-trace t)
(put #'tramp-file-name-hop 'tramp-suppress-trace t)
+;; Needed for `tramp-read-passwd' and `tramp-get-remote-null-device'.
+(defconst tramp-null-hop
+ (make-tramp-file-name :user (user-login-name) :host tramp-system-name)
+"Connection hop which identifies the virtual hop before the first one.")
+
(defun tramp-file-name-user-domain (vec)
"Return user and domain components of VEC."
(when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
@@ -1484,7 +1502,7 @@ entry does not exist, return nil."
(replace-regexp-in-string "^tramp-" "" (symbol-name param))))
(if (tramp-connection-property-p vec hash-entry)
;; We use the cached property.
- (tramp-get-connection-property vec hash-entry nil)
+ (tramp-get-connection-property vec hash-entry)
;; Use the static value from `tramp-methods'.
(when-let ((methods-entry
(assoc
@@ -1528,7 +1546,7 @@ of `process-file', `start-file-process', or `shell-command'."
(or (and (tramp-tramp-file-p name)
(string-match (nth 0 tramp-file-name-structure) name)
(match-string (nth 4 tramp-file-name-structure) name))
- (tramp-compat-file-local-name name)))
+ (file-local-name name)))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-unquote-file-local-name (name)
@@ -1675,6 +1693,18 @@ default values are used."
(put #'tramp-dissect-file-name 'tramp-suppress-trace t)
+(defun tramp-ensure-dissected-file-name (vec-or-filename)
+ "Return a `tramp-file-name' structure for VEC-OR-FILENAME.
+
+VEC-OR-FILENAME may be either a string or a `tramp-file-name'.
+If it's not a Tramp filename, return nil."
+ (cond
+ ((tramp-file-name-p vec-or-filename) vec-or-filename)
+ ((tramp-tramp-file-p vec-or-filename)
+ (tramp-dissect-file-name vec-or-filename))))
+
+(put #'tramp-ensure-dissected-file-name 'tramp-suppress-trace t)
+
(defun tramp-dissect-hop-name (name &optional nodefault)
"Return a `tramp-file-name' structure of `hop' part of NAME.
See `tramp-dissect-file-name' for details."
@@ -1709,13 +1739,10 @@ See `tramp-dissect-file-name' for details."
"Construct a Tramp file name from ARGS.
ARGS could have two different signatures. The first one is of
-type (VEC &optional LOCALNAME HOP).
+type (VEC &optional LOCALNAME).
If LOCALNAME is nil, the value in VEC is used. If it is a
symbol, a null localname will be used. Otherwise, LOCALNAME is
expected to be a string, which will be used.
-If HOP is nil, the value in VEC is used. If it is a symbol, a
-null hop will be used. Otherwise, HOP is expected to be a
-string, which will be used.
The other signature exists for backward compatibility. It has
the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
@@ -1731,8 +1758,13 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
hop (tramp-file-name-hop (car args)))
(when (cadr args)
(setq localname (and (stringp (cadr args)) (cadr args))))
- (when (cl-caddr args)
- (setq hop (and (stringp (cl-caddr args)) (cl-caddr args)))))
+ (when hop
+ (setq hop nil)
+ ;; Assure that the hops are in `tramp-default-proxies-alist'.
+ ;; In tramp-archive.el, the slot `hop' is used for the archive
+ ;; file name.
+ (unless (string-equal method "archive")
+ (tramp-add-hops (car args)))))
(t (setq method (nth 0 args)
user (nth 1 args)
@@ -1765,15 +1797,17 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
localname)))
(set-advertised-calling-convention
- #'tramp-make-tramp-file-name '(vec &optional localname hop) "27.1")
+ #'tramp-make-tramp-file-name '(vec &optional localname) "29.1")
(defun tramp-make-tramp-hop-name (vec)
"Construct a Tramp hop name from VEC."
- (replace-regexp-in-string
- tramp-prefix-regexp ""
+ (concat
+ (tramp-file-name-hop vec)
(replace-regexp-in-string
- (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
- (tramp-make-tramp-file-name vec 'noloc))))
+ tramp-prefix-regexp ""
+ (replace-regexp-in-string
+ (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
+ (tramp-make-tramp-file-name vec 'noloc)))))
(defun tramp-completion-make-tramp-file-name (method user host localname)
"Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME.
@@ -1804,10 +1838,10 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet."
;; as indication, whether a connection is active.
(tramp-set-connection-property
vec "process-buffer"
- (tramp-get-connection-property vec "process-buffer" nil))
+ (tramp-get-connection-property vec "process-buffer"))
(setq buffer-undo-list t
default-directory
- (tramp-make-tramp-file-name vec 'noloc 'nohop))
+ (tramp-make-tramp-file-name vec 'noloc))
(current-buffer)))))
(defun tramp-get-connection-buffer (vec &optional dont-create)
@@ -1815,14 +1849,14 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet."
Unless DONT-CREATE, the buffer is created when it doesn't exist yet.
In case a second asynchronous communication has been started, it is different
from `tramp-get-buffer'."
- (or (tramp-get-connection-property vec "process-buffer" nil)
+ (or (tramp-get-connection-property vec "process-buffer")
(tramp-get-buffer vec dont-create)))
(defun tramp-get-connection-name (vec)
"Get the connection name to be used for VEC.
In case a second asynchronous communication has been started, it is different
from the default one."
- (or (tramp-get-connection-property vec "process-name" nil)
+ (or (tramp-get-connection-property vec "process-name")
(tramp-buffer-name vec)))
(defun tramp-get-process (vec-or-proc)
@@ -1845,9 +1879,7 @@ from the default one."
If connection-local variables are not supported by this Emacs
version, the function does nothing."
(with-current-buffer (tramp-get-connection-buffer vec)
- ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
- (tramp-compat-funcall
- 'hack-connection-local-variables-apply
+ (hack-connection-local-variables-apply
`(:application tramp
:protocol ,(tramp-file-name-method vec)
:user ,(tramp-file-name-user-domain vec)
@@ -1858,14 +1890,27 @@ version, the function does nothing."
If connection-local variables are not supported by this Emacs
version, the function does nothing."
(when (tramp-tramp-file-p default-directory)
- ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
- (tramp-compat-funcall
- 'hack-connection-local-variables-apply
+ (hack-connection-local-variables-apply
`(:application tramp
:protocol ,(file-remote-p default-directory 'method)
:user ,(file-remote-p default-directory 'user)
:machine ,(file-remote-p default-directory 'host)))))
+(defsubst tramp-get-default-directory (buffer)
+ "Return `default-directory' of BUFFER."
+ (buffer-local-value 'default-directory buffer))
+
+(put #'tramp-get-default-directory 'tramp-suppress-trace t)
+
+(defsubst tramp-get-buffer-string (&optional buffer)
+ "Return contents of BUFFER.
+If BUFFER is not a buffer or a buffer name, return the contents
+of `current-buffer'."
+ (with-current-buffer (or buffer (current-buffer))
+ (substring-no-properties (buffer-string))))
+
+(put #'tramp-get-buffer-string 'tramp-suppress-trace t)
+
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC."
(let ((method (tramp-file-name-method vec))
@@ -1904,29 +1949,56 @@ The outline level is equal to the verbosity of the Tramp message."
(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
+;; This function takes action since Emacs 28.1, when
+;; `read-extended-command-predicate' is set to
+;; `command-completion-default-include-p'.
+(defun tramp-debug-buffer-command-completion-p (_symbol buffer)
+ "A predicate for Tramp interactive commands.
+They are completed by \"M-x TAB\" only in Tramp debug buffers."
+ (with-current-buffer buffer
+ (string-equal
+ (buffer-substring (point-min) (min (+ (point-min) 10) (point-max))) ";; Emacs:")))
+
+(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
+
+(defun tramp-setup-debug-buffer ()
+ "Function to setup debug buffers."
+ ;; (declare (completion tramp-debug-buffer-command-completion-p))
+ (interactive)
+ (set-buffer-file-coding-system 'utf-8)
+ (setq buffer-undo-list t)
+ ;; Activate `outline-mode'. This runs `text-mode-hook' and
+ ;; `outline-mode-hook'. We must prevent that local processes die.
+ ;; Yes: I've seen `flyspell-mode', which starts "ispell".
+ ;; `(custom-declare-variable outline-minor-mode-prefix ...)' raises
+ ;; on error in `(outline-mode)', we don't want to see it in the
+ ;; traces.
+ (let ((default-directory tramp-compat-temporary-file-directory))
+ (outline-mode))
+ (setq-local outline-level 'tramp-debug-outline-level)
+ (setq-local font-lock-keywords
+ ;; FIXME: This `(t FOO . BAR)' representation in
+ ;; `font-lock-keywords' is supposed to be an internal
+ ;; implementation "detail". Don't abuse it here!
+ `(t (eval ,tramp-debug-font-lock-keywords t)
+ ,(eval tramp-debug-font-lock-keywords t)))
+ ;; Do not edit the debug buffer.
+ (use-local-map special-mode-map)
+ ;; For debugging purposes.
+ (local-set-key "\M-n" 'clone-buffer)
+ (add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
+
+(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t)
+
+(function-put
+ #'tramp-setup-debug-buffer 'completion-predicate
+ #'tramp-debug-buffer-command-completion-p)
+
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer for VEC."
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
- (set-buffer-file-coding-system 'utf-8)
- (setq buffer-undo-list t)
- ;; Activate `outline-mode'. This runs `text-mode-hook' and
- ;; `outline-mode-hook'. We must prevent that local processes
- ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
- ;; `(custom-declare-variable outline-minor-mode-prefix ...)'
- ;; raises on error in `(outline-mode)', we don't want to see it
- ;; in the traces.
- (let ((default-directory tramp-compat-temporary-file-directory))
- (outline-mode))
- (setq-local outline-level 'tramp-debug-outline-level)
- (setq-local font-lock-keywords
- ;; FIXME: This `(t FOO . BAR)' representation in
- ;; `font-lock-keywords' is supposed to be an
- ;; internal implementation "detail". Don't abuse it here!
- `(t (eval ,tramp-debug-font-lock-keywords t)
- ,(eval tramp-debug-font-lock-keywords t)))
- ;; Do not edit the debug buffer.
- (use-local-map special-mode-map))
+ (tramp-setup-debug-buffer))
(current-buffer)))
(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
@@ -1988,9 +2060,7 @@ ARGUMENTS to actually emit the message (if applicable)."
(unless (bolp)
(insert "\n"))
;; Timestamp.
- (let ((now (current-time)))
- (insert (format-time-string "%T." now))
- (insert (format "%06d " (nth 2 now))))
+ (insert (format-time-string "%T.%6N "))
;; Calling Tramp function. We suppress compat and trace
;; functions from being displayed.
(let ((btn 1) btf fn)
@@ -2060,12 +2130,15 @@ applicable)."
;; Append connection buffer for error messages, if exists.
(when (= level 1)
(ignore-errors
- (with-current-buffer
- (if (processp vec-or-proc)
- (process-buffer vec-or-proc)
- (tramp-get-connection-buffer vec-or-proc 'dont-create))
- (setq fmt-string (concat fmt-string "\n%s")
- arguments (append arguments (list (buffer-string)))))))
+ (setq fmt-string (concat fmt-string "\n%s")
+ arguments
+ (append
+ arguments
+ `(,(tramp-get-buffer-string
+ (if (processp vec-or-proc)
+ (process-buffer vec-or-proc)
+ (tramp-get-connection-buffer
+ vec-or-proc 'dont-create))))))))
;; Translate proc to vec.
(when (processp vec-or-proc)
(setq vec-or-proc (process-get vec-or-proc 'vector))))
@@ -2078,15 +2151,17 @@ applicable)."
(put #'tramp-message 'tramp-suppress-trace t)
-(defsubst tramp-backtrace (&optional vec-or-proc)
+(defsubst tramp-backtrace (&optional vec-or-proc force)
"Dump a backtrace into the debug buffer.
-If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
-function is meant for debugging purposes."
- (when (>= tramp-verbose 10)
- (if vec-or-proc
- (tramp-message
- vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
- (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
+If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
+forces the backtrace even if `tramp-verbose' is less than 10.
+This function is meant for debugging purposes."
+ (let ((tramp-verbose (if force 10 tramp-verbose)))
+ (when (>= tramp-verbose 10)
+ (if vec-or-proc
+ (tramp-message
+ vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
+ (with-output-to-temp-buffer "*debug tramp*" (backtrace))))))
(put #'tramp-backtrace 'tramp-suppress-trace t)
@@ -2116,6 +2191,11 @@ FMT-STRING and ARGUMENTS."
(put #'tramp-error 'tramp-suppress-trace t)
+(defvar tramp-error-show-message-timeout 30
+ "Time to show the Tramp buffer in case of an error.
+If it is bound to nil, the buffer is not shown. This is used in
+tramp-tests.el.")
+
(defsubst tramp-error-with-buffer
(buf vec-or-proc signal fmt-string &rest arguments)
"Emit an error, and show BUF.
@@ -2127,12 +2207,13 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(and (tramp-file-name-p vec-or-proc)
(tramp-get-connection-buffer vec-or-proc))))
(vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
- (and buf (with-current-buffer buf
- (tramp-dissect-file-name default-directory))))))
+ (and buf (tramp-dissect-file-name
+ (tramp-get-default-directory buf))))))
(unwind-protect
(apply #'tramp-error vec-or-proc signal fmt-string arguments)
;; Save exit.
(when (and buf
+ (natnump tramp-error-show-message-timeout)
(not (zerop tramp-verbose))
;; Do not show when flagged from outside.
(not non-essential)
@@ -2146,7 +2227,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
;; Show buffer.
(pop-to-buffer buf)
(discard-input)
- (sit-for 30)))
+ (sit-for tramp-error-show-message-timeout)))
;; Reset timestamp. It would be wrong after waiting for a while.
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
@@ -2159,7 +2240,8 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
- (when (and (not (zerop tramp-verbose))
+ (when (and (natnump tramp-error-show-message-timeout)
+ (not (zerop tramp-verbose))
;; Do not show when flagged from outside.
(not non-essential)
;; Show only when Emacs has started already.
@@ -2169,7 +2251,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply #'message fmt-string arguments)
(discard-input)
- (sit-for 30)
+ (sit-for tramp-error-show-message-timeout)
;; Reset timestamp. It would be wrong after waiting for a while.
(when
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
@@ -2249,8 +2331,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(ignore ,@(mapcar #'car bindings))
,@body)))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
-
(defun tramp-progress-reporter-update (reporter &optional value suffix)
"Report progress of an operation for Tramp."
(let* ((parameters (cdr reporter))
@@ -2273,7 +2353,7 @@ without a visible progress reporter."
;; running, and when there is a minimum level.
(when-let ((pr (and (null tramp-inhibit-progress-reporter)
(<= ,level (min tramp-verbose 3))
- (make-progress-reporter ,message nil nil))))
+ (make-progress-reporter ,message))))
(run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
(unwind-protect
;; Execute the body.
@@ -2287,9 +2367,6 @@ without a visible progress reporter."
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
-
(defmacro with-tramp-file-property (vec file property &rest body)
"Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
FILE must be a local file name on a connection identified via VEC."
@@ -2306,8 +2383,6 @@ FILE must be a local file name on a connection identified via VEC."
value)
,@body))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
-
(defmacro with-tramp-connection-property (key property &rest body)
"Check in Tramp for property PROPERTY, otherwise execute BODY and set."
(declare (indent 2) (debug t))
@@ -2321,8 +2396,15 @@ FILE must be a local file name on a connection identified via VEC."
(tramp-set-connection-property ,key ,property value))
value))
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
+(defmacro with-tramp-saved-connection-property (key property &rest body)
+ "Save PROPERTY, run BODY, reset PROPERTY."
+ (declare (indent 2) (debug t))
+ `(let ((value (tramp-get-connection-property
+ ,key ,property tramp-cache-undefined)))
+ (unwind-protect (progn ,@body)
+ (if (eq value tramp-cache-undefined)
+ (tramp-flush-connection-property ,key ,property)
+ (tramp-set-connection-property ,key ,property value)))))
(defun tramp-drop-volume-letter (name)
"Cut off unnecessary drive letter from file NAME.
@@ -2417,7 +2499,7 @@ For definition of that list see `tramp-set-completion-function'."
(defun tramp-default-file-modes (filename &optional flag)
"Return file modes of FILENAME as integer.
-If optional FLAG is ‘nofollow’, do not follow FILENAME if it is a
+If optional FLAG is `nofollow', do not follow FILENAME if it is a
symbolic link. If the file modes of FILENAME cannot be
determined, return the value of `default-file-modes', without
execute permissions."
@@ -2459,6 +2541,7 @@ arguments to pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation)
+ (args (if (tramp-file-name-p (car args)) (cons nil (cdr args)) args))
signal-hook-function)
(apply operation args)))
@@ -2486,19 +2569,17 @@ Must be handled by the callers."
file-accessible-directory-p file-attributes
file-directory-p file-executable-p file-exists-p
file-local-copy file-modes file-name-as-directory
- file-name-directory file-name-nondirectory
- file-name-sans-versions file-notify-add-watch
- file-ownership-preserved-p file-readable-p
- file-regular-p file-remote-p file-selinux-context
- file-symlink-p file-truename file-writable-p
- find-backup-file-name get-file-buffer
+ file-name-case-insensitive-p file-name-directory
+ file-name-nondirectory file-name-sans-versions
+ file-notify-add-watch file-ownership-preserved-p
+ file-readable-p file-regular-p file-remote-p
+ file-selinux-context file-symlink-p file-truename
+ file-writable-p find-backup-file-name get-file-buffer
insert-directory insert-file-contents load
make-directory make-directory-internal set-file-acl
set-file-modes set-file-selinux-context set-file-times
substitute-in-file-name unhandled-file-name-directory
vc-registered
- ;; Emacs 26+ only.
- file-name-case-insensitive-p
;; Emacs 27+ only.
file-system-info
;; Emacs 28+ only.
@@ -2511,8 +2592,6 @@ Must be handled by the callers."
(nth 0 args)
default-directory))
;; STRING FILE.
- ;; Starting with Emacs 26.1, just the 2nd argument of
- ;; `make-symbolic-link' matters.
((eq operation 'make-symbolic-link) (nth 1 args))
;; FILE DIRECTORY resp FILE1 FILE2.
((member operation
@@ -2543,32 +2622,43 @@ Must be handled by the callers."
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
;; COMMAND.
((member operation
- '(process-file shell-command start-file-process
- ;; Emacs 26+ only.
- make-nearby-temp-file temporary-file-directory
+ '(make-nearby-temp-file process-file shell-command
+ start-file-process temporary-file-directory
;; Emacs 27+ only.
- exec-path make-process))
+ exec-path make-process
+ ;; Emacs 29+ only.
+ list-system-processes process-attributes))
default-directory)
;; PROC.
((member operation '(file-notify-rm-watch file-notify-valid-p))
(when (processp (nth 0 args))
- (with-current-buffer (process-buffer (nth 0 args))
- default-directory)))
+ (tramp-get-default-directory (process-buffer (nth 0 args)))))
;; VEC.
- ((member operation '(tramp-get-remote-gid tramp-get-remote-uid))
+ ((member operation
+ '(tramp-get-home-directory
+ tramp-get-remote-gid tramp-get-remote-uid))
(tramp-make-tramp-file-name (nth 0 args)))
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
-(defun tramp-find-foreign-file-name-handler (filename &optional _operation)
+(defun tramp-find-foreign-file-name-handler (vec &optional _operation)
"Return foreign file name handler if exists."
- (when (tramp-tramp-file-p filename)
+ (when (tramp-file-name-p vec)
(let ((handler tramp-foreign-file-name-handler-alist)
- elt res)
+ elt func res)
(while handler
(setq elt (car handler)
handler (cdr handler))
- (when (funcall (car elt) filename)
+ ;; Previously, this function was called with FILENAME, but now
+ ;; it's called with the VEC.
+ (when (condition-case nil
+ (funcall (setq func (car elt)) vec)
+ (error
+ (setcar elt #'ignore)
+ (unless (member 'remote-file-error debug-ignored-errors)
+ (tramp-error
+ vec 'remote-file-error
+ "Not a valid Tramp file name function `%s'" func))))
(setq handler nil
res (cdr elt))))
res)))
@@ -2587,7 +2677,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(with-parsed-tramp-file-name filename nil
(let ((current-connection tramp-current-connection)
(foreign
- (tramp-find-foreign-file-name-handler filename operation))
+ (tramp-find-foreign-file-name-handler v operation))
(signal-hook-function #'tramp-signal-hook-function)
result)
;; Set `tramp-current-connection'.
@@ -2634,6 +2724,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(tramp-message
v 5 "Non-essential received in operation %s"
(cons operation args))
+ (let ((tramp-verbose 10)) (tramp-backtrace v))
(tramp-run-real-handler operation args))
((eq result 'suppress)
(let ((inhibit-message t))
@@ -2771,8 +2862,9 @@ remote file names."
(defun tramp-register-foreign-file-name-handler
(func handler &optional append)
"Register (FUNC . HANDLER) in `tramp-foreign-file-name-handler-alist'.
-FUNC is the function, which determines whether HANDLER is to be called.
-Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
+FUNC is the function, which takes a dissected filename and determines
+whether HANDLER is to be called. Add operations defined in
+`HANDLER-alist' to `tramp-file-name-handler'."
(add-to-list
'tramp-foreign-file-name-handler-alist `(,func . ,handler) append)
;; Mark `operations' the handler is responsible for.
@@ -2824,18 +2916,14 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
(defun tramp-command-completion-p (_symbol buffer)
"A predicate for Tramp interactive commands.
They are completed by \"M-x TAB\" only if the current buffer is remote."
- (with-current-buffer buffer (tramp-tramp-file-p default-directory)))
+ (tramp-tramp-file-p (tramp-get-default-directory buffer)))
(defun tramp-connectable-p (vec-or-filename)
"Check, whether it is possible to connect the remote host w/o side-effects.
This is true, if either the remote host is already connected, or if we are
not in completion mode."
(let ((tramp-verbose 0)
- (vec
- (cond
- ((tramp-file-name-p vec-or-filename) vec-or-filename)
- ((tramp-tramp-file-p vec-or-filename)
- (tramp-dissect-file-name vec-or-filename)))))
+ (vec (tramp-ensure-dissected-file-name vec-or-filename)))
(or ;; We check this for the process related to
;; `tramp-buffer-name'; otherwise `start-file-process'
;; wouldn't run ever when `non-essential' is non-nil.
@@ -2881,7 +2969,7 @@ not in completion mode."
(m (tramp-find-method method user host))
all-user-hosts)
- (unless localname ;; Nothing to complete.
+ (unless localname ;; Nothing to complete.
(if (or user host)
@@ -3285,6 +3373,129 @@ User is always nil."
(forward-line 1)
result))
+;;; Skeleton macros for file name handler functions.
+
+(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body)
+ "Skeleton for `tramp-*-handle-delete-directory'.
+BODY is the backend specific code."
+ (declare (indent 3) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (if (and delete-by-moving-to-trash ,trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
+ (tramp-error
+ v 'file-error "Directory is not empty, not moving to trash")
+ (move-file-to-trash ,directory))
+ ,@body)
+ (tramp-flush-directory-properties v localname)))
+
+(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
+
+(defmacro tramp-skeleton-write-region
+ (start end filename append visit lockname mustbenew &rest body)
+ "Skeleton for `tramp-*-handle-write-region'.
+BODY is the backend specific code."
+ (declare (indent 7) (debug t))
+ ;; Sometimes, there is another file name handler responsible for
+ ;; VISIT, for example `jka-compr-handler'. We must respect this.
+ ;; See Bug#55166.
+ `(let* ((filename (expand-file-name ,filename))
+ (lockname (file-truename (or ,lockname filename)))
+ (handler (and (stringp ,visit)
+ (let ((inhibit-file-name-handlers
+ `(tramp-file-name-handler
+ tramp-crypt-file-name-handler
+ . inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'write-region))
+ (find-file-name-handler ,visit 'write-region)))))
+ (with-parsed-tramp-file-name filename nil
+ (if handler
+ (progn
+ (tramp-message
+ v 5 "Calling handler `%s' for visiting `%s'" handler ,visit)
+ (funcall
+ handler 'write-region
+ ,start ,end filename ,append ,visit lockname ,mustbenew))
+
+ (when (and ,mustbenew (file-exists-p filename)
+ (or (eq ,mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format
+ "File %s exists; overwrite anyway?" filename)))))
+ (tramp-error v 'file-already-exists filename))
+
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (uid (or (file-attribute-user-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (file-attribute-group-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-gid v 'integer)))
+ (attributes (file-extended-attributes filename))
+ (curbuf (current-buffer)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p
+ (file-name-nondirectory filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
+ ;; The body.
+ ,@body
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+
+ ;; We must protect `last-coding-system-used', now we have
+ ;; set it to its correct value.
+ (let (last-coding-system-used (need-chown t))
+ ;; Set file modification time.
+ (when (or (eq ,visit t) (stringp ,visit))
+ (when-let ((file-attr (file-attributes filename 'integer)))
+ (set-visited-file-modtime
+ ;; We must pass modtime explicitly, because FILENAME
+ ;; can be different from (buffer-file-name), f.e. if
+ ;; `file-precious-flag' is set.
+ (or (file-attribute-modification-time file-attr)
+ (current-time)))
+ (when (and (= (file-attribute-user-id file-attr) uid)
+ (= (file-attribute-group-id file-attr) gid))
+ (setq need-chown nil))))
+
+ ;; Set the ownership.
+ (when need-chown
+ (tramp-set-file-uid-gid filename uid gid)))
+
+ ;; Set extended attributes. We ignore possible errors,
+ ;; because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes filename attributes)))
+
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
+ ;; Sanity check.
+ (unless (equal curbuf (current-buffer))
+ (tramp-error
+ v 'file-error
+ "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
+
+ (when (and (null noninteractive)
+ (or (eq ,visit t) (string-or-null-p ,visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))))
+
+(put #'tramp-skeleton-write-region 'tramp-suppress-trace t)
+
;;; Common file name handler functions for different backends:
(defvar tramp-handle-file-local-copy-hook nil
@@ -3293,6 +3504,42 @@ User is always nil."
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-*-handle-write-region'.")
+(defvar tramp-tolerate-tilde nil
+ "Indicator, that not expandable tilde shall be tolerated.
+Let-bind it when necessary.")
+
+;; `directory-abbrev-apply' and `directory-abbrev-make-regexp' exists
+;; since Emacs 29.1. Since this handler isn't called for older
+;; Emacsen, it is save to invoke them via `tramp-compat-funcall'.
+(defun tramp-handle-abbreviate-file-name (filename)
+ "Like `abbreviate-file-name' for Tramp files."
+ (let* ((case-fold-search (file-name-case-insensitive-p filename))
+ (vec (tramp-dissect-file-name filename))
+ (tramp-tolerate-tilde t)
+ (home-dir
+ (if (let ((non-essential t)) (tramp-connectable-p vec))
+ ;; If a connection has already been established, get the
+ ;; home directory.
+ (tramp-get-home-directory vec)
+ ;; Otherwise, just use the cached value.
+ (tramp-get-connection-property vec "~"))))
+ (when home-dir
+ (setq home-dir
+ (tramp-compat-funcall
+ 'directory-abbrev-apply
+ (tramp-make-tramp-file-name vec home-dir))))
+ ;; If any elt of `directory-abbrev-alist' matches this name,
+ ;; abbreviate accordingly.
+ (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename))
+ ;; Abbreviate home directory.
+ (if (and home-dir
+ (string-match
+ (tramp-compat-funcall 'directory-abbrev-make-regexp home-dir)
+ filename))
+ (tramp-make-tramp-file-name
+ vec (concat "~" (substring filename (match-beginning 1))))
+ (tramp-make-tramp-file-name (tramp-dissect-file-name filename)))))
+
(defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(setq filename (file-truename filename))
@@ -3303,10 +3550,11 @@ User is always nil."
(if (file-directory-p filename)
#'file-accessible-directory-p #'file-readable-p)
filename)
- (tramp-error
- v 'file-error (format "%s: Permission denied, %s" string filename)))
- (tramp-compat-file-missing
- v (format "%s: No such file or directory, %s" string filename)))))
+ (tramp-compat-permission-denied
+ v (format "%s: Permission denied, %s" string filename)))
+ (tramp-error
+ v 'file-missing
+ (format "%s: No such file or directory, %s" string filename)))))
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
@@ -3340,7 +3588,7 @@ User is always nil."
;; `copy-directory' creates NEWNAME before running this check. So
;; we do it ourselves.
(unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
;; We must do it file-wise.
(tramp-run-real-handler
#'copy-directory
@@ -3361,7 +3609,7 @@ User is always nil."
(defun tramp-handle-directory-files (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
(when (file-directory-p directory)
(setq directory (file-name-as-directory (expand-file-name directory)))
(let ((temp (nreverse (file-name-all-completions "" directory)))
@@ -3393,10 +3641,6 @@ User is always nil."
(if (file-directory-p dir) dir (file-name-directory dir)) nil
(tramp-flush-directory-properties v localname)))
-(defvar tramp-tolerate-tilde nil
- "Indicator, that not expandable tilde shall be tolerated.
-Let-bind it when necessary.")
-
(defun tramp-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
@@ -3408,11 +3652,22 @@ Let-bind it when necessary.")
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
+ (tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Expand tilde. Usually, the methods applying this handler do
+ ;; not support tilde expansion. But users could declare a
+ ;; respective connection property. (Bug#53847)
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
(string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
@@ -3437,9 +3692,7 @@ Let-bind it when necessary.")
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- (eq (tramp-compat-file-attribute-type
- (file-attributes (file-truename filename)))
- t))
+ (eq (file-attribute-type (file-attributes (file-truename filename))) t))
(defun tramp-handle-file-equal-p (filename1 filename2)
"Like `file-equalp-p' for Tramp files."
@@ -3471,7 +3724,7 @@ Let-bind it when necessary.")
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
@@ -3479,7 +3732,7 @@ Let-bind it when necessary.")
(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
(when-let ((attrs (file-attributes filename))
- (mode-string (tramp-compat-file-attribute-modes attrs)))
+ (mode-string (file-attribute-modes attrs)))
(if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
(file-modes (file-truename filename))
(tramp-mode-string-to-int mode-string))))
@@ -3511,7 +3764,7 @@ Let-bind it when necessary.")
(tramp-get-method-parameter v 'tramp-case-insensitive)
;; There isn't. So we must check, in case there's a connection already.
- (and (file-remote-p filename nil 'connected)
+ (and (let ((non-essential t)) (tramp-connectable-p v))
(with-tramp-connection-property v "case-insensitive"
(ignore-errors
(with-tramp-progress-reporter v 5 "Checking case-insensitive"
@@ -3532,16 +3785,13 @@ Let-bind it when necessary.")
(directory-file-name
(file-name-directory candidate))))
;; Nothing found, so we must use a temporary file
- ;; for comparison. `make-nearby-temp-file' is added
- ;; to Emacs 26+ like `file-name-case-insensitive-p',
- ;; so there is no compatibility problem calling it.
+ ;; for comparison.
(unless (string-match-p
"[[:lower:]]" (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
- (file-name-directory filename)))
- (tramp-compat-funcall
- 'make-nearby-temp-file "tramp."))
+ (file-name-directory filename)))
+ (make-nearby-temp-file "tramp."))
candidate tmpfile))
;; Check for the existence of the same file with
;; upper case letters.
@@ -3602,9 +3852,8 @@ Let-bind it when necessary.")
((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
(t (time-less-p
- (tramp-compat-file-attribute-modification-time (file-attributes file2))
- (tramp-compat-file-attribute-modification-time
- (file-attributes file1))))))
+ (file-attribute-modification-time (file-attributes file2))
+ (file-attribute-modification-time (file-attributes file1))))))
(defun tramp-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
@@ -3623,17 +3872,17 @@ Let-bind it when necessary.")
;; Sometimes, `file-attributes' does not return a proper value
;; even if `file-exists-p' does.
(when-let ((attr (file-attributes filename)))
- (eq ?- (aref (tramp-compat-file-attribute-modes attr) 0)))))
+ (eq ?- (aref (file-attribute-modes attr) 0)))))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
;; We do not want traces in the debug buffer.
(let ((tramp-verbose (min tramp-verbose 3)))
(when (tramp-tramp-file-p filename)
- (let* ((v (tramp-dissect-file-name filename))
- (p (tramp-get-connection-process v))
+ (let* ((o (tramp-dissect-file-name filename))
+ (p (tramp-get-connection-process o))
(c (and (process-live-p p)
- (tramp-get-connection-property p "connected" nil))))
+ (tramp-get-connection-property p "connected"))))
;; We expand the file name only, if there is already a connection.
(with-parsed-tramp-file-name
(if c (expand-file-name filename) filename) nil
@@ -3645,7 +3894,8 @@ Let-bind it when necessary.")
((eq identification 'user) (tramp-file-name-user-domain v))
((eq identification 'host) (tramp-file-name-host-port v))
((eq identification 'localname) localname)
- ((eq identification 'hop) hop)
+ ;; Hop exists only in original dissected file name.
+ ((eq identification 'hop) (tramp-file-name-hop o))
(t (tramp-make-tramp-file-name v 'noloc)))))))))
(defun tramp-handle-file-selinux-context (_filename)
@@ -3655,7 +3905,7 @@ Let-bind it when necessary.")
(defun tramp-handle-file-symlink-p (filename)
"Like `file-symlink-p' for Tramp files."
- (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
+ (let ((x (file-attribute-type (file-attributes filename))))
(and (stringp x) x)))
(defun tramp-handle-file-truename (filename)
@@ -3696,8 +3946,7 @@ Let-bind it when necessary.")
(expand-file-name
symlink-target
(file-name-directory v2-localname))))
- v2-localname)
- 'nohop)))
+ v2-localname))))
(when (>= numchase numchase-limit)
(tramp-error
v1 'file-error
@@ -3744,7 +3993,7 @@ Let-bind it when necessary.")
(when (and (not tramp-allow-unsafe-temporary-files)
(not backup-inhibited)
(file-in-directory-p (car result) temporary-file-directory)
- (zerop (or (tramp-compat-file-attribute-user-id
+ (zerop (or (file-attribute-user-id
(file-attributes filename 'integer))
tramp-unknown-id-integer))
(not (with-tramp-connection-property
@@ -3801,7 +4050,7 @@ Let-bind it when necessary.")
(unwind-protect
(if (not (file-exists-p filename))
(let ((tramp-verbose (if visit 0 tramp-verbose)))
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(with-tramp-progress-reporter
v 3 (format-message "Inserting `%s'" filename)
@@ -3856,8 +4105,7 @@ Let-bind it when necessary.")
(cond
((stringp remote-copy)
(file-local-copy
- (tramp-make-tramp-file-name
- v remote-copy 'nohop)))
+ (tramp-make-tramp-file-name v remote-copy)))
((stringp tramp-temp-buffer-file-name)
(copy-file
filename tramp-temp-buffer-file-name 'ok)
@@ -3900,11 +4148,162 @@ Let-bind it when necessary.")
(or remote-copy (null tramp-temp-buffer-file-name)))
(delete-file local-copy))
(when (stringp remote-copy)
- (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop))))
+ (delete-file (tramp-make-tramp-file-name v remote-copy))))
;; Result.
(cons filename (cdr result)))))
+(defun tramp-ps-time ()
+ "Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\".
+Return it as number of seconds. Used in `tramp-process-attributes-ps-format'."
+ (search-forward-regexp "\\s-+")
+ (search-forward-regexp
+ (concat
+ "\\(?:" "\\(?:" "\\([0-9]+\\)-" "\\)?"
+ "\\([0-9]+\\):" "\\)?"
+ "\\([0-9]+\\):"
+ ;; Seconds can also be a floating point number.
+ "\\([0-9.]+\\)")
+ (line-end-position) 'noerror)
+ (+ (* 24 60 60 (string-to-number (or (match-string 1) "0")))
+ (* 60 60 (string-to-number (or (match-string 2) "0")))
+ (* 60 (string-to-number (or (match-string 3) "0")))
+ (string-to-number (or (match-string 4) "0"))))
+
+(defconst tramp-process-attributes-ps-args
+ `("-eww"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "euid"
+ "euser"
+ "egid"
+ "egroup"
+ "comm:80"
+ "state"
+ "ppid"
+ "pgrp"
+ "sess"
+ "tname"
+ "tpgid"
+ "min_flt"
+ "maj_flt"
+ "times"
+ "pri"
+ "nice"
+ "thcount"
+ "vsize"
+ "rss"
+ "etimes"
+ "pcpu"
+ "pmem"
+ "args")
+ ","))
+ "List of arguments for calling \"ps\".
+See `tramp-get-process-attributes'.
+
+This list is the default value on remote GNU/Linux systems.")
+
+(defconst tramp-process-attributes-ps-format
+ '((pid . number)
+ (euid . number)
+ (user . string)
+ (egid . number)
+ (group . string)
+ (comm . 80)
+ (state . string)
+ (ppid . number)
+ (pgrp . number)
+ (sess . number)
+ (ttname . string)
+ (tpgid . number)
+ (minflt . number)
+ (majflt . number)
+ (time . number)
+ (pri . number)
+ (nice . number)
+ (thcount . number)
+ (vsize . number)
+ (rss . number)
+ (etime . number)
+ (pcpu . number)
+ (pmem . number)
+ (args . nil))
+ "Alist where each element is a cons cell of the form `\(KEY . TYPE)'.
+KEY is a key (symbol) used in `process-attributes'. TYPE is the
+printed result for KEY of the \"ps\" command, it can be `number',
+`string', a number (string of that length), a symbol (a function
+to be applied), or nil (for the last column of the \"ps\" output.
+
+This alist is used to parse the output of calling \"ps\" in
+`tramp-get-process-attributes'.
+
+This alist is the default value on remote GNU/Linux systems.")
+
+(defun tramp-get-process-attributes (vec)
+ "Return all process attributes for connection VEC.
+Parsing the remote \"ps\" output is controlled by
+`tramp-process-attributes-ps-args' and
+`tramp-process-attributes-ps-format'.
+
+It is not guaranteed, that all process attributes as described in
+`process-attributes' are returned. The additional attribute
+`pid' shall be returned always."
+ ;; Since Emacs 27.1.
+ (when (fboundp 'connection-local-criteria-for-default-directory)
+ (with-tramp-file-property vec "/" "process-attributes"
+ (ignore-errors
+ (with-temp-buffer
+ (hack-connection-local-variables-apply
+ (connection-local-criteria-for-default-directory))
+ ;; (pop-to-buffer (current-buffer))
+ (when (zerop
+ (apply
+ #'process-file
+ "ps" nil t nil tramp-process-attributes-ps-args))
+ (let (result res)
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; (tramp-test-message
+ ;; "%s" (buffer-substring (point) (line-end-position)))
+ (when (save-excursion
+ (search-forward-regexp
+ "[[:digit:]]" (line-end-position) 'noerror))
+ (setq res nil)
+ (dolist (elt tramp-process-attributes-ps-format)
+ (push
+ (cons
+ (car elt)
+ (cond
+ ((eq (cdr elt) 'number) (read (current-buffer)))
+ ((eq (cdr elt) 'string)
+ (search-forward-regexp "\\S-+")
+ (match-string 0))
+ ((numberp (cdr elt))
+ (search-forward-regexp "\\s-+")
+ (search-forward-regexp ".+" (+ (point) (cdr elt)))
+ (string-trim (match-string 0)))
+ ((fboundp (cdr elt))
+ (funcall (cdr elt)))
+ ((null (cdr elt))
+ (search-forward-regexp "\\s-+")
+ (buffer-substring (point) (line-end-position)))
+ (t nil)))
+ res))
+ ;; `nice' could be `-'.
+ (setq res (rassq-delete-all '- res))
+ (push (append res) result))
+ (forward-line))
+ ;; Return result.
+ result)))))))
+
+(defun tramp-handle-list-system-processes ()
+ "Like `list-system-processes' for Tramp files."
+ (let ((v (tramp-dissect-file-name default-directory)))
+ (tramp-flush-file-property v "/" "process-attributes")
+ (mapcar (lambda (x) (cdr (assq 'pid x))) (tramp-get-process-attributes v))))
+
(defun tramp-get-lock-file (file)
"Read lockfile info of FILE.
Return nil when there is no lockfile."
@@ -3979,7 +4378,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(when (and (not tramp-allow-unsafe-temporary-files)
create-lockfiles
(file-in-directory-p lockname temporary-file-directory)
- (zerop (or (tramp-compat-file-attribute-user-id
+ (zerop (or (file-attribute-user-id
(file-attributes file 'integer))
tramp-unknown-id-integer))
(not (with-tramp-connection-property
@@ -3997,7 +4396,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(make-symbolic-link info lockname 'ok-if-already-exists)
(error
(with-file-modes #o0644
- (write-region info nil lockname)))))))))
+ (write-region info nil lockname nil 'no-message)))))))))
(defun tramp-handle-make-lock-file-name (file)
"Like `make-lock-file-name' for Tramp files."
@@ -4031,7 +4430,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
v 'file-error
"File `%s' does not include a `.el' or `.elc' suffix" file)))
(unless (or noerror (file-exists-p file))
- (tramp-compat-file-missing v file))
+ (tramp-error v 'file-missing file))
(if (not (file-exists-p file))
nil
(let ((signal-hook-function (unless noerror signal-hook-function))
@@ -4048,15 +4447,10 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(and (tramp-sh-file-name-handler-p vec)
(not (tramp-get-method-parameter vec 'tramp-copy-program))))
-(defun tramp-compute-multi-hops (vec)
- "Expands VEC according to `tramp-default-proxies-alist'."
- (let ((saved-tdpa tramp-default-proxies-alist)
- (target-alist `(,vec))
- (hops (or (tramp-file-name-hop vec) ""))
- (item vec)
- choices proxy)
-
- ;; Ad-hoc proxy definitions.
+(defun tramp-add-hops (vec)
+ "Add ad-hoc proxy definitions to `tramp-default-proxies-alist'."
+ (when-let ((hops (tramp-file-name-hop vec))
+ (item vec))
(dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
(let* ((host-port (tramp-file-name-host-port item))
(user-domain (tramp-file-name-user-domain item))
@@ -4073,9 +4467,19 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(add-to-list 'tramp-default-proxies-alist entry)
(setq item (tramp-dissect-file-name proxy))))
;; Save the new value.
- (when (and hops tramp-save-ad-hoc-proxies)
+ (when tramp-save-ad-hoc-proxies
(customize-save-variable
- 'tramp-default-proxies-alist tramp-default-proxies-alist))
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))))
+
+(defun tramp-compute-multi-hops (vec)
+ "Expands VEC according to `tramp-default-proxies-alist'."
+ (let ((saved-tdpa tramp-default-proxies-alist)
+ (target-alist `(,vec))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (tramp-add-hops vec)
;; Look for proxy hosts to be passed.
(setq choices tramp-default-proxies-alist)
@@ -4164,7 +4568,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for
(and ;; The method supports it.
(tramp-get-method-parameter v 'tramp-direct-async)
;; It has been indicated.
- (tramp-get-connection-property v "direct-async-process" nil)
+ (tramp-get-connection-property v "direct-async-process")
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
(= (length (tramp-compute-multi-hops v)) 1))
@@ -4215,6 +4619,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
+ (orig-command command)
(env (mapcar
(lambda (elt)
(when (tramp-compat-string-search "=" elt) elt))
@@ -4290,23 +4695,28 @@ substitution. SPEC-LIST is a list of char/value pairs used for
;; t. See Bug#51177.
(when filter
(set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
(tramp-message v 6 "%s" (string-join (process-command p) " "))
p))))))
(defun tramp-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
+ (_target linkname &optional _ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
This is the fallback implementation for backends which do not
support symbolic links."
- (if (tramp-tramp-file-p (expand-file-name linkname))
- (tramp-error
- (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
- "make-symbolic-link not supported")
- ;; This is needed prior Emacs 26.1, where TARGET has also be
- ;; checked for a file name handler.
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))))
+ (tramp-error
+ (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
+ "make-symbolic-link not supported"))
+
+(defun tramp-handle-process-attributes (pid)
+ "Like `process-attributes' for Tramp files."
+ (catch 'result
+ (dolist (elt (tramp-get-process-attributes
+ (tramp-dissect-file-name default-directory)))
+ (when (= (cdr (assq 'pid elt)) pid)
+ (throw 'result elt)))))
(defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
"Like `shell-command' for Tramp files."
@@ -4439,7 +4849,7 @@ support symbolic links."
(prog1
;; Run the process.
- (process-file-shell-command command nil buffer nil)
+ (process-file-shell-command command nil buffer)
;; Insert error messages if they were separated.
(when error-file
(with-current-buffer error-buffer
@@ -4521,7 +4931,7 @@ BUFFER might be a list, in this case STDERR is separated."
(unless time-list
(let ((remote-file-name-inhibit-cache t))
(setq time-list
- (or (tramp-compat-file-attribute-modification-time
+ (or (file-attribute-modification-time
(file-attributes (buffer-file-name)))
tramp-time-doesnt-exist))))
(unless (tramp-compat-time-equal-p time-list tramp-time-dont-know)
@@ -4545,7 +4955,7 @@ of."
t
(let* ((remote-file-name-inhibit-cache t)
(attr (file-attributes f))
- (modtime (tramp-compat-file-attribute-modification-time attr))
+ (modtime (file-attribute-modification-time attr))
(mt (visited-file-modtime)))
(cond
@@ -4562,35 +4972,10 @@ of."
(defun tramp-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (tmpfile (tramp-compat-make-temp-file filename))
+ (tramp-skeleton-write-region start end filename append visit lockname mustbenew
+ (let ((tmpfile (tramp-compat-make-temp-file filename))
(modes (tramp-default-file-modes
- filename (and (eq mustbenew 'excl) 'nofollow)))
- (uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer))))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ filename (and (eq mustbenew 'excl) 'nofollow))))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -4609,30 +4994,7 @@ of."
(error
(delete-file tmpfile)
(tramp-error
- v 'file-error "Couldn't write region to `%s'" filename)))
-
- (tramp-flush-file-properties v localname)
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Set the ownership.
- (tramp-set-file-uid-gid filename uid gid)
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ v 'file-error "Couldn't write region to `%s'" filename))))))
;; This is used in tramp-sh.el and tramp-sudoedit.el.
(defconst tramp-stat-marker "/////"
@@ -4698,8 +5060,8 @@ of."
(save-window-excursion
(pop-to-buffer (tramp-get-connection-buffer vec))
(read-string (match-string 0)))))))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-message vec 3 "Sending login name `%s'" user)
(tramp-send-string vec (concat user tramp-local-end-of-line)))
t)
@@ -4711,7 +5073,8 @@ of."
;; Let's check whether a wrong password has been sent already.
;; Sometimes, the process returns a new password request
;; immediately after rejecting the previous (wrong) one.
- (unless (tramp-get-connection-property vec "first-password-request" nil)
+ (unless (or tramp-password-prompt-not-unique
+ (tramp-get-connection-property vec "first-password-request"))
(tramp-clear-passwd vec))
(goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
@@ -4719,7 +5082,13 @@ of."
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
(process-send-string
- proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
+ proc
+ (concat
+ (funcall
+ (if tramp-password-prompt-not-unique
+ #'tramp-read-passwd-without-cache #'tramp-read-passwd)
+ proc)
+ tramp-local-end-of-line))
;; Hide password prompt.
(narrow-to-region (point-max) (point-max))))
t)
@@ -4742,8 +5111,8 @@ See also `tramp-action-yn'."
(unless (yes-or-no-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec (concat "yes" tramp-local-end-of-line)))
t)
@@ -4756,8 +5125,8 @@ See also `tramp-action-yesno'."
(unless (y-or-n-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec (concat "y" tramp-local-end-of-line)))
t)
@@ -4765,15 +5134,15 @@ See also `tramp-action-yesno'."
"Tell the remote host which terminal type to use.
The terminal type can be configured with `tramp-terminal-type'."
(tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))
t)
(defun tramp-action-confirm-message (_proc vec)
"Return RET in order to confirm the message."
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec tramp-local-end-of-line)
t)
@@ -4949,7 +5318,7 @@ performed successfully. Any other value means an error."
"Lock PROC for other communication, and run BODY.
Mostly useful to protect BODY from being interrupted by timers."
(declare (indent 1) (debug t))
- `(if (tramp-get-connection-property ,proc "locked" nil)
+ `(if (tramp-get-connection-property ,proc "locked")
;; Be kind for older Emacsen.
(if (member 'remote-file-error debug-ignored-errors)
(throw 'non-essential 'non-essential)
@@ -4961,9 +5330,6 @@ Mostly useful to protect BODY from being interrupted by timers."
,@body)
(tramp-flush-connection-property ,proc "locked"))))
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-locked-connection\\>"))
-
(defun tramp-accept-process-output (proc &optional timeout)
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
@@ -5005,7 +5371,7 @@ Erase echoed commands if exists."
;; Check whether we need to remove echo output. The max length of
;; the echo mark regexp is taken for search. We restrict the
;; search for the second echo mark to PIPE_BUF characters.
- (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
+ (when (and (tramp-get-connection-property proc "check-remote-echo")
(re-search-forward
tramp-echoed-echo-mark-regexp
(+ (point) (* 5 tramp-echo-mark-marker-length)) t))
@@ -5021,7 +5387,7 @@ Erase echoed commands if exists."
(delete-region begin (point))
(goto-char (point-min)))))
- (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil))
+ (when (or (not (tramp-get-connection-property proc "check-remote-echo"))
;; Sometimes, the echo string is suppressed on the remote side.
(not (string-equal
(substring-no-properties
@@ -5062,8 +5428,8 @@ nil."
;; The process could have timed out, for example due to session
;; timeout of sudo. The process buffer does not exist any longer then.
(ignore-errors
- (with-current-buffer (process-buffer proc)
- (tramp-message proc 6 "\n%s" (buffer-string))))
+ (tramp-message
+ proc 6 "\n%s" (tramp-get-buffer-string (process-buffer proc))))
(unless found
(if timeout
(tramp-error
@@ -5083,7 +5449,7 @@ The STRING is expected to use Unix line-endings, but the lines sent to
the remote host use line-endings as defined in the variable
`tramp-rsh-end-of-line'. The communication buffer is erased before sending."
(let* ((p (tramp-get-connection-process vec))
- (chunksize (tramp-get-connection-property p "chunksize" nil)))
+ (chunksize (tramp-get-connection-property p "chunksize")))
(unless p
(tramp-error
vec 'file-error "Can't send string to remote host -- not logged in"))
@@ -5121,7 +5487,7 @@ the remote host use line-endings as defined in the variable
(unless (process-live-p proc)
(let ((vec (process-get proc 'vector))
(buf (process-buffer proc))
- (prompt (tramp-get-connection-property proc "prompt" nil)))
+ (prompt (tramp-get-connection-property proc "prompt")))
(when vec
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
@@ -5285,10 +5651,12 @@ If FILENAME is remote, a file name handler is called."
(let* ((dir (file-name-directory filename))
(modes (file-modes dir)))
(when (and modes (not (zerop (logand modes #o2000))))
- (setq gid (tramp-compat-file-attribute-group-id (file-attributes dir)))))
+ (setq gid (file-attribute-group-id (file-attributes dir)))))
- (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
- (funcall handler #'tramp-set-file-uid-gid filename uid gid)
+ (if (tramp-tramp-file-p filename)
+ (funcall (if (tramp-crypt-file-name-p filename)
+ #'tramp-crypt-file-name-handler #'tramp-file-name-handler)
+ #'tramp-set-file-uid-gid filename uid gid)
;; On W32 systems, "chown" does not work.
(unless (memq system-type '(ms-dos windows-nt))
(let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
@@ -5314,8 +5682,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; `group-name' has been introduced with Emacs 27.1.
((and (fboundp 'group-name) (equal id-format 'string))
(tramp-compat-funcall 'group-name (group-gid)))
- ((tramp-compat-file-attribute-group-id
- (file-attributes "~/" id-format))))))
+ ((file-attribute-group-id (file-attributes "~/" id-format))))))
(defun tramp-get-local-locale (&optional vec)
"Determine locale, supporting UTF8 if possible.
@@ -5344,7 +5711,7 @@ VEC is used for tracing."
"Check `file-attributes' caches for VEC.
Return t if according to the cache access type ACCESS is known to
be granted."
- (let ((result nil)
+ (let (result
(offset (cond
((eq ?r access) 1)
((eq ?w access) 2)
@@ -5371,59 +5738,53 @@ be granted."
file-attr
(or
;; Not a symlink.
- (eq t (tramp-compat-file-attribute-type file-attr))
- (null (tramp-compat-file-attribute-type file-attr)))
+ (eq t (file-attribute-type file-attr))
+ (null (file-attribute-type file-attr)))
(or
;; World accessible.
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr)
- (+ offset 6)))
+ (eq access (aref (file-attribute-modes file-attr) (+ offset 6)))
;; User accessible and owned by user.
(and
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr) offset))
+ (eq access (aref (file-attribute-modes file-attr) offset))
(or (equal remote-uid unknown-id)
- (equal remote-uid
- (tramp-compat-file-attribute-user-id file-attr))
- (equal unknown-id
- (tramp-compat-file-attribute-user-id file-attr))))
+ (equal remote-uid (file-attribute-user-id file-attr))
+ (equal unknown-id (file-attribute-user-id file-attr))))
;; Group accessible and owned by user's principal group.
(and
(eq access
- (aref (tramp-compat-file-attribute-modes file-attr)
- (+ offset 3)))
+ (aref (file-attribute-modes file-attr) (+ offset 3)))
(or (equal remote-gid unknown-id)
- (equal remote-gid
- (tramp-compat-file-attribute-group-id file-attr))
- (equal unknown-id
- (tramp-compat-file-attribute-group-id
- file-attr))))))))))))
+ (equal remote-gid (file-attribute-group-id file-attr))
+ (equal unknown-id (file-attribute-group-id file-attr))))))))))))
+
+(defun tramp-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (concat "~" user)
+ (tramp-file-name-handler #'tramp-get-home-directory vec user))))
(defun tramp-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (or (when-let
- ((handler
- (find-file-name-handler
- (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
- (funcall handler #'tramp-get-remote-uid vec id-format))
- ;; Ensure there is a valid result.
- (and (equal id-format 'integer) tramp-unknown-id-integer)
- (and (equal id-format 'string) tramp-unknown-id-string))))
+ (or (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (tramp-file-name-handler #'tramp-get-remote-uid vec id-format)))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string)))
(defun tramp-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (or (when-let
- ((handler
- (find-file-name-handler
- (tramp-make-tramp-file-name vec) 'tramp-get-remote-gid)))
- (funcall handler #'tramp-get-remote-gid vec id-format))
- ;; Ensure there is a valid result.
- (and (equal id-format 'integer) tramp-unknown-id-integer)
- (and (equal id-format 'string) tramp-unknown-id-string))))
+ (or (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
+ (tramp-file-name-handler #'tramp-get-remote-gid vec id-format)))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string)))
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise.
@@ -5443,8 +5804,7 @@ This handles also chrooted environments, which are not regarded as local."
(null tramp-crypt-enabled)
;; The local temp directory must be writable for the other user.
(file-writable-p
- (tramp-make-tramp-file-name
- vec tramp-compat-temporary-file-directory 'nohop))
+ (tramp-make-tramp-file-name vec tramp-compat-temporary-file-directory))
;; On some systems, chown runs only for root.
(or (zerop (user-uid))
(zerop (tramp-get-remote-uid vec 'integer))))))
@@ -5538,7 +5898,7 @@ this file, if that variable is non-nil."
(when (and (not tramp-allow-unsafe-temporary-files)
auto-save-default
(file-in-directory-p result temporary-file-directory)
- (zerop (or (tramp-compat-file-attribute-user-id
+ (zerop (or (file-attribute-user-id
(file-attributes filename 'integer))
tramp-unknown-id-integer))
(not (with-tramp-connection-property
@@ -5574,8 +5934,7 @@ ALIST is of the form ((FROM . TO) ...)."
(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
"Like `make-nearby-temp-file' for Tramp files."
- (let ((temporary-file-directory
- (tramp-compat-temporary-file-directory-function)))
+ (let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))
;;; Compatibility functions section:
@@ -5598,14 +5957,12 @@ are written with verbosity of 6."
(with-temp-buffer
(setq result
(apply
- #'call-process program infile (or destination t) display args))
+ #'call-process program infile (or destination t) display args)
+ output (tramp-get-buffer-string destination))
;; `result' could also be an error string.
(when (stringp result)
(setq error result
- result 1))
- (with-current-buffer
- (if (bufferp destination) destination (current-buffer))
- (setq output (buffer-string))))
+ result 1)))
(error
(setq error (error-message-string err)
result 1)))
@@ -5636,10 +5993,10 @@ are written with verbosity of 6."
;; `result' could also be an error string.
(when (stringp result)
(signal 'file-error (list result)))
- (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
- (if (zerop result)
- (tramp-message vec 6 "%d" result)
- (tramp-message vec 6 "%d\n%s" result (buffer-string)))))
+ (if (zerop result)
+ (tramp-message vec 6 "%d" result)
+ (tramp-message
+ vec 6 "%d\n%s" result (tramp-get-buffer-string buffer))))
(error
(setq result 1)
(tramp-message vec 6 "%d\n%s" result (error-message-string err))))
@@ -5684,20 +6041,22 @@ verbosity of 6."
;; tramp-cache-read-persistent-data t)'" instead.
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
-Consults the auth-source package.
-Invokes `password-read' if available, `read-passwd' else."
+Consults the auth-source package."
(let* (;; If `auth-sources' contains "~/.authinfo.gpg", and
;; `exec-path' contains a relative file name like ".", it
;; could happen that the "gpg" command is not found. So we
;; adapt `default-directory'. (Bug#39389, Bug#39489)
(default-directory tramp-compat-temporary-file-directory)
(case-fold-search t)
- (key (tramp-make-tramp-file-name
- ;; In tramp-sh.el, we must use "password-vector" due to
- ;; multi-hop.
- (tramp-get-connection-property
- proc "password-vector" (process-get proc 'vector))
- 'noloc 'nohop))
+ ;; In tramp-sh.el, we must use "password-vector" due to
+ ;; multi-hop.
+ (vec (tramp-get-connection-property
+ proc "password-vector" (process-get proc 'vector)))
+ (key (tramp-make-tramp-file-name vec 'noloc))
+ (method (tramp-file-name-method vec))
+ (user (or (tramp-file-name-user-domain vec)
+ (tramp-get-connection-property key "login-as")))
+ (host (tramp-file-name-host-port vec))
(pw-prompt
(or prompt
(with-current-buffer (process-buffer proc)
@@ -5707,68 +6066,66 @@ Invokes `password-read' if available, `read-passwd' else."
(format "%s for %s " (capitalize (match-string 1)) key)))))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
;; Use connection-local value.
- (auth-sources (with-current-buffer (process-buffer proc) auth-sources))
+ (auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
;; We suspend the timers while reading the password.
(stimers (with-timeout-suspend))
auth-info auth-passwd)
(unwind-protect
- (with-parsed-tramp-file-name key nil
- (setq tramp-password-save-function nil
- user
- (or user (tramp-get-connection-property key "login-as" nil)))
- (prog1
- (or
- ;; See if auth-sources contains something useful.
- (ignore-errors
- (and (tramp-get-connection-property
- v "first-password-request" nil)
- ;; Try with Tramp's current method.
- (setq auth-info
- (car
- (auth-source-search
- :max 1
- (and user :user)
- (if domain
- (concat
- user tramp-prefix-domain-format domain)
- user)
- :host
- (if port
- (concat
- host tramp-prefix-port-format port)
- host)
- :port method
- :require (cons :secret (and user '(:user)))
- :create t))
- tramp-password-save-function
- (plist-get auth-info :save-function)
- auth-passwd (plist-get auth-info :secret)))
- (while (functionp auth-passwd)
- (setq auth-passwd (funcall auth-passwd)))
- auth-passwd)
-
- ;; Try the password cache. Exists since Emacs 26.1.
- (progn
- (setq auth-passwd (password-read pw-prompt key)
- tramp-password-save-function
- (lambda () (password-cache-add key auth-passwd)))
- auth-passwd)
-
- ;; Else, get the password interactively w/o cache.
- (read-passwd pw-prompt))
+ ;; We cannot use `with-parsed-tramp-file-name', because it
+ ;; expands the file name.
+ (or
+ (setq tramp-password-save-function nil)
+ ;; See if auth-sources contains something useful.
+ (ignore-errors
+ (and (tramp-get-connection-property vec "first-password-request")
+ ;; Try with Tramp's current method. If there is no
+ ;; user name, `:create' triggers to ask for. We
+ ;; suppress it.
+ (setq auth-info
+ (car
+ (auth-source-search
+ :max 1 :user user :host host :port method
+ :require (cons :secret (and user '(:user)))
+ :create (and user t)))
+ tramp-password-save-function
+ (plist-get auth-info :save-function)
+ auth-passwd
+ (tramp-compat-auth-info-password auth-info))))
+
+ ;; Try the password cache.
+ (progn
+ (setq auth-passwd (password-read pw-prompt key)
+ tramp-password-save-function
+ (lambda () (password-cache-add key auth-passwd)))
+ auth-passwd))
- ;; Workaround. Prior Emacs 28.1, auth-source has saved
- ;; empty passwords. See discussion in Bug#50399.
- (when (zerop (length auth-passwd))
- (setq tramp-password-save-function nil))
- (tramp-set-connection-property v "first-password-request" nil)))
+ ;; Workaround. Prior Emacs 28.1, auth-source has saved empty
+ ;; passwords. See discussion in Bug#50399.
+ (when (zerop (length auth-passwd))
+ (setq tramp-password-save-function nil))
+ (tramp-set-connection-property vec "first-password-request" nil)
;; Reenable the timers.
(with-timeout-unsuspend stimers))))
(put #'tramp-read-passwd 'tramp-suppress-trace t)
+(defun tramp-read-passwd-without-cache (proc &optional prompt)
+ "Read a password from user (compat function)."
+ ;; We suspend the timers while reading the password.
+ (let ((stimers (with-timeout-suspend)))
+ (unwind-protect
+ (password-read
+ (or prompt
+ (with-current-buffer (process-buffer proc)
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (match-string 0))))
+ ;; Reenable the timers.
+ (with-timeout-unsuspend stimers))))
+
+(put #'tramp-read-passwd-without-cache 'tramp-suppress-trace t)
+
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(let ((method (tramp-file-name-method vec))
@@ -5781,7 +6138,7 @@ Invokes `password-read' if available, `read-passwd' else."
(auth-source-forget
`(:max 1 ,(and user-domain :user) ,user-domain
:host ,host-port :port ,method))
- (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
+ (password-cache-remove (tramp-make-tramp-file-name vec 'noloc))))
(put #'tramp-clear-passwd 'tramp-suppress-trace t)
@@ -5868,40 +6225,60 @@ name of a process or buffer, or nil to default to the current buffer."
(while (tramp-accept-process-output proc 0))
(not (process-live-p proc))))))
-;; `interrupt-process-functions' exists since Emacs 26.1.
-(when (boundp 'interrupt-process-functions)
- (add-hook 'interrupt-process-functions #'tramp-interrupt-process)
+(add-hook 'interrupt-process-functions #'tramp-interrupt-process)
+(add-hook
+ 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))
+
+(defun tramp-signal-process (process sigcode &optional remote)
+ "Send PROCESS the signal with code SIGCODE.
+PROCESS may also be a number specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
+If PROCESS is a process object which contains the property
+`remote-pid', or PROCESS is a number and REMOTE is a remote file name,
+PROCESS is interpreted as process on the respective remote host, which
+will be the process to signal.
+SIGCODE may be an integer, or a symbol whose name is a signal name."
+ (let (pid vec)
+ (cond
+ ((processp process)
+ (setq pid (process-get process 'remote-pid)
+ vec (process-get process 'vector)))
+ ((numberp process)
+ (setq pid process
+ vec (and (stringp remote) (tramp-dissect-file-name remote))))
+ (t (signal 'wrong-type-argument (list #'processp process))))
+ (unless (or (numberp sigcode) (symbolp sigcode))
+ (signal 'wrong-type-argument (list #'numberp sigcode)))
+ ;; If it's a Tramp process, send SIGCODE remotely.
+ (when (and pid vec)
+ (tramp-message
+ vec 5 "Send signal %s to process %s with pid %s" sigcode process pid)
+ ;; This is for tramp-sh.el. Other backends do not support this (yet).
+ (if (tramp-compat-funcall
+ 'tramp-send-command-and-check
+ vec (format "\\kill -%s %d" sigcode pid))
+ 0 -1))))
+
+;; `signal-process-functions' exists since Emacs 29.1.
+(when (boundp 'signal-process-functions)
+ (add-hook 'signal-process-functions #'tramp-signal-process)
(add-hook
'tramp-unload-hook
(lambda ()
- (remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+ (remove-hook 'signal-process-functions #'tramp-signal-process))))
(defun tramp-get-remote-null-device (vec)
"Return null device on the remote host identified by VEC.
-If VEC is nil, return local null device."
- (if (null vec)
+If VEC is `tramp-null-hop', return local null device."
+ (if (equal vec tramp-null-hop)
null-device
(with-tramp-connection-property vec "null-device"
(let ((default-directory (tramp-make-tramp-file-name vec)))
(tramp-compat-null-device)))))
-(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body)
- "Skeleton for `tramp-*-handle-delete-directory'.
-BODY is the backend specific code."
- (declare (indent 3) (debug t))
- `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
- (if (and delete-by-moving-to-trash ,trash)
- ;; Move non-empty dir to trash only if recursive deletion was
- ;; requested.
- (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
- (tramp-error
- v 'file-error "Directory is not empty, not moving to trash")
- (move-file-to-trash ,directory))
- ,@body)
- (tramp-flush-directory-properties v localname)))
-
-(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
-
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
@@ -5940,5 +6317,11 @@ BODY is the backend specific code."
;; and friends, for most of the handlers this is the major
;; difference between the different backends. Other handlers but
;; *-process-file would profit from this as well.
+;;
+;; * Implement file name abbreviation for a different user. That is,
+;; (abbreviate-file-name "/ssh:user1@host:/home/user2") =>
+;; "/ssh:user1@host:~user2".
+;;
+;; * Implement file name abbreviation for user and host names.
;;; tramp.el ends here
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index c1d58a45f4f..68fd110ec00 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,8 +7,8 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.3
-;; Package-Requires: ((emacs "25.1"))
+;; Version: 2.6.0-pre
+;; Package-Requires: ((emacs "26.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.3"
+(defconst tramp-version "2.6.0-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -52,9 +52,9 @@
;; Suppress message from `emacs-repository-get-branch'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
- (debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
- source-directory)))
+ source-directory))
+ debug-on-error)
;; `emacs-repository-get-branch' has been introduced with Emacs 27.1.
(with-no-warnings
(and (stringp dir) (file-directory-p dir)
@@ -67,18 +67,18 @@
;; Suppress message from `emacs-repository-get-version'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
- (debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
- source-directory)))
+ source-directory))
+ debug-on-error)
(and (stringp dir) (file-directory-p dir)
(executable-find "git")
(emacs-repository-get-version dir))))
"The repository revision of the Tramp sources.")
;; Check for Emacs version.
-(let ((x (if (not (string-lessp emacs-version "25.1"))
+(let ((x (if (not (string-version-lessp emacs-version "26.1"))
"ok"
- (format "Tramp 2.5.3 is not fit for %s"
+ (format "Tramp 2.6.0-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 21c6f5dd9d0..b2ef47898cd 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -61,6 +61,13 @@
;;; Code:
+;; TODO:
+;; - Add a menu bar and tool bar for this library.
+;; - Add commands to create/delete link from the hotlist.
+;; - Add something like a bookmark folder in modern browsers.
+;; - Add a command that can open/follow all links in a folder.
+;; - Add tags for Web sites in the hotlist.
+
;;-------------------------------------------------------- Package Dependencies
(require 'browse-url)
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 95adf9f90a1..385dd80beba 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -1235,33 +1235,21 @@ changed with `comment-style'."
;; FIXME: maybe we should call uncomment depending on ARG.
(funcall comment-region-function beg end arg)))
-(defun comment-region-default-1 (beg end &optional arg noadjust)
- "Comment region between BEG and END.
-See `comment-region' for ARG. If NOADJUST, do not skip past
-leading/trailing space when determining the region to comment
-out."
+(defun comment-region-default-1 (beg end &optional arg)
(let* ((numarg (prefix-numeric-value arg))
(style (cdr (assoc comment-style comment-styles)))
(lines (nth 2 style))
(block (nth 1 style))
(multi (nth 0 style)))
- (if noadjust
- (when (bolp)
- (setq end (1- end)))
- ;; We use `chars' instead of `syntax' because `\n' might be
- ;; of end-comment syntax rather than of whitespace syntax.
- ;; sanitize BEG and END
- (goto-char beg)
- (skip-chars-forward " \t\n\r")
- (beginning-of-line)
- (setq beg (max beg (point)))
- (goto-char end)
- (skip-chars-backward " \t\n\r")
- (end-of-line)
- (setq end (min end (point)))
- (when (>= beg end)
- (error "Nothing to comment")))
+ ;; We use `chars' instead of `syntax' because `\n' might be
+ ;; of end-comment syntax rather than of whitespace syntax.
+ ;; sanitize BEG and END
+ (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
+ (setq beg (max beg (point)))
+ (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
+ (setq end (min end (point)))
+ (if (>= beg end) (error "Nothing to comment"))
;; sanitize LINES
(setq lines
diff --git a/lisp/notifications.el b/lisp/notifications.el
index 5ad64ff73b6..b58a1a02116 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -202,7 +202,7 @@ This function returns a notification id, an integer, which can be
used to manipulate the notification item with
`notifications-close-notification' or the `:replaces-id' argument
of another `notifications-notify' call."
- (with-demoted-errors
+ (with-demoted-errors "Notification error: %S"
(let ((bus (or (plist-get params :bus) :session))
(title (plist-get params :title))
(body (plist-get params :body))
diff --git a/lisp/novice.el b/lisp/novice.el
index 3512aed3645..3a3596e30f8 100644
--- a/lisp/novice.el
+++ b/lisp/novice.el
@@ -43,71 +43,65 @@ If nil, the feature is disabled, i.e., all commands work normally.")
;; because we won't get called otherwise.
;;;###autoload
(defun disabled-command-function (&optional cmd keys)
- (unless cmd (setq cmd this-command))
- (unless keys (setq keys (this-command-keys)))
- (let (char)
- (save-window-excursion
- (with-output-to-temp-buffer "*Disabled Command*" ;; (help-buffer)
- (if (or (eq (aref keys 0)
- (if (stringp keys)
- (aref "\M-x" 0)
- ?\M-x))
- (and (>= (length keys) 2)
- (eq (aref keys 0) meta-prefix-char)
- (eq (aref keys 1) ?x)))
- (princ (format "You have invoked the disabled command %s.\n" cmd))
- (princ (format "You have typed %s, invoking disabled command %s.\n"
- (key-description keys) cmd)))
- ;; Print any special message saying why the command is disabled.
- (if (stringp (get cmd 'disabled))
- (princ (get cmd 'disabled))
- (princ "It is disabled because new users often find it confusing.\n")
- (princ (substitute-command-keys
- "Here's the first part of its description:\n\n"))
- ;; Keep only the first paragraph of the documentation.
- (with-current-buffer "*Disabled Command*" ;; standard-output
- (goto-char (point-max))
- (let ((start (point)))
- (save-excursion
- (princ (or (condition-case ()
- (documentation cmd)
- (error nil))
- "<< not documented >>")))
- (if (search-forward "\n\n" nil t)
- (delete-region (match-beginning 0) (point-max)))
- (goto-char (point-max))
- (indent-rigidly start (point) 3))))
- (princ "\n\nDo you want to use this command anyway?\n\n")
- (princ (substitute-command-keys "You can now type
-y to try it and enable it (no questions if you use it again).
-n to cancel--don't try the command, and it remains disabled.
-SPC to try the command just this once, but leave it disabled.
-! to try it, and enable all disabled commands for this session only."))
- ;; Redundant since with-output-to-temp-buffer will do it anyway.
- ;; (with-current-buffer standard-output
- ;; (help-mode))
- )
- (fit-window-to-buffer (get-buffer-window "*Disabled Command*"))
- (message "Type y, n, ! or SPC (the space bar): ")
- (let ((cursor-in-echo-area t))
- (while (progn (setq char (read-event))
- (or (not (numberp char))
- (not (memq (downcase char)
- '(?! ?y ?n ?\s ?\C-g)))))
- (ding)
- (message "Please type y, n, ! or SPC (the space bar): "))))
- (setq char (downcase char))
+ (let* ((cmd (or cmd this-command))
+ (keys (or keys (this-command-keys)))
+ (help-string
+ (concat
+ (if (or (eq (aref keys 0)
+ (if (stringp keys)
+ (aref "\M-x" 0)
+ ?\M-x))
+ (and (>= (length keys) 2)
+ (eq (aref keys 0) meta-prefix-char)
+ (eq (aref keys 1) ?x)))
+ (format "You have invoked the disabled command %s.\n" cmd)
+ (substitute-command-keys
+ (format "You have typed \\`%s', invoking disabled command %s.\n"
+ (key-description keys) cmd)))
+ ;; Any special message saying why the command is disabled.
+ (if (stringp (get cmd 'disabled))
+ (get cmd 'disabled)
+ (concat
+ "It is disabled because new users often find it confusing.\n"
+ (substitute-command-keys
+ "Here's the first part of its description:\n\n")
+ ;; Keep only the first paragraph of the documentation.
+ (with-temp-buffer
+ (insert (condition-case ()
+ (documentation cmd)
+ (error "<< not documented >>")))
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (match-beginning 0) (point-max)))
+ (indent-rigidly (point-min) (point-max) 3)
+ (buffer-string))))
+ (substitute-command-keys "\n
+Do you want to use this command anyway?
+
+You can now type:
+ \\`y' to try it and enable it (no questions if you use it again).
+ \\`n' to cancel--don't try the command, and it remains disabled.
+ \\`SPC' to try the command just this once, but leave it disabled.
+ \\`!' to try it, and enable all disabled commands for this session only.")))
+ (char
+ (car (read-multiple-choice "Use this command?"
+ '((?y "yes")
+ (?n "no")
+ (?! "yes; enable for session")
+ (?\s "(space bar) yes; once"))
+ help-string
+ "*Disabled Command*"))))
(pcase char
- (?\C-g (setq quit-flag t))
- (?! (setq disabled-command-function nil))
- (?y
- (if (and user-init-file
- (not (string= "" user-init-file))
- (y-or-n-p "Enable command for future editing sessions also? "))
- (enable-command cmd)
- (put cmd 'disabled nil))))
- (or (char-equal char ?n)
- (call-interactively cmd))))
+ (?\C-g (setq quit-flag t))
+ (?! (setq disabled-command-function nil))
+ (?y
+ (if (and user-init-file
+ (not (string= "" user-init-file))
+ (y-or-n-p "Enable command for future editing sessions also? "))
+ (enable-command cmd)
+ (put cmd 'disabled nil))))
+ (unless (char-equal char ?n)
+ (call-interactively cmd))))
(defun en/disable-command (command disable)
(unless (commandp command)
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index b8f6cb5ad36..dfe5c369e2c 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -369,31 +369,29 @@ and, if `nxml-char-ref-display-glyph-flag' is non-nil, a glyph
corresponding to the referenced character following the character
reference.")
-(defvar nxml-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\M-\C-u" 'nxml-backward-up-element)
- (define-key map "\M-\C-d" 'nxml-down-element)
- (define-key map "\M-\C-n" 'nxml-forward-element)
- (define-key map "\M-\C-p" 'nxml-backward-element)
- (define-key map "\M-{" 'nxml-backward-paragraph)
- (define-key map "\M-}" 'nxml-forward-paragraph)
- (define-key map "\M-h" 'nxml-mark-paragraph)
- (define-key map "\C-c\C-f" 'nxml-finish-element)
- (define-key map "\C-c]" 'nxml-finish-element)
- (define-key map "\C-c/" 'nxml-finish-element)
- (define-key map "\C-c\C-m" 'nxml-split-element)
- (define-key map "\C-c\C-b" 'nxml-balanced-close-start-tag-block)
- (define-key map "\C-c\C-i" 'nxml-balanced-close-start-tag-inline)
- (define-key map "\C-c\C-x" 'nxml-insert-xml-declaration)
- (define-key map "\C-c\C-d" 'nxml-dynamic-markup-word)
- ;; u is for Unicode
- (define-key map "\C-c\C-u" 'nxml-insert-named-char)
- (define-key map "\C-c\C-o" nxml-outline-prefix-map)
- (define-key map [S-mouse-2] 'nxml-mouse-hide-direct-text-content)
- (define-key map "/" 'nxml-electric-slash)
- (define-key map "\M-\t" 'completion-at-point)
- map)
- "Keymap for `nxml-mode'.")
+(defvar-keymap nxml-mode-map
+ :doc "Keymap for `nxml-mode'."
+ "C-M-u" #'nxml-backward-up-element
+ "C-M-d" #'nxml-down-element
+ "C-M-n" #'nxml-forward-element
+ "C-M-p" #'nxml-backward-element
+ "M-{" #'nxml-backward-paragraph
+ "M-}" #'nxml-forward-paragraph
+ "M-h" #'nxml-mark-paragraph
+ "C-c C-f" #'nxml-finish-element
+ "C-c ]" #'nxml-finish-element
+ "C-c /" #'nxml-finish-element
+ "C-c C-m" #'nxml-split-element
+ "C-c C-b" #'nxml-balanced-close-start-tag-block
+ "C-c C-i" #'nxml-balanced-close-start-tag-inline
+ "C-c C-x" #'nxml-insert-xml-declaration
+ "C-c C-d" #'nxml-dynamic-markup-word
+ ;; u is for Unicode
+ "C-c C-u" #'nxml-insert-named-char
+ "C-c C-o" nxml-outline-prefix-map
+ "/" #'nxml-electric-slash
+ "M-TAB" #'completion-at-point
+ "S-<mouse-2>" #'nxml-mouse-hide-direct-text-content)
(defvar nxml-font-lock-keywords
'(nxml-fontify-matcher)
@@ -566,7 +564,8 @@ Many aspects this mode can be customized using
(font-lock-syntactic-face-function
. sgml-font-lock-syntactic-face)))
- (with-demoted-errors (rng-nxml-mode-init)))
+ (with-demoted-errors "RNG NXML error: %S"
+ (rng-nxml-mode-init)))
(defun nxml--buffer-substring-filter (string)
;; The `rng-state' property is huge, so don't copy it to the kill ring.
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 928338a6af9..1518122a79d 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -129,20 +129,18 @@ See the variable `nxml-section-element-name-regexp' for more details."
(defvar nxml-heading-scan-distance 1000
"Maximum distance from section to scan for heading.")
-(defvar nxml-outline-prefix-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-a" 'nxml-show-all)
- (define-key map "\C-t" 'nxml-hide-all-text-content)
- (define-key map "\C-r" 'nxml-refresh-outline)
- (define-key map "\C-c" 'nxml-hide-direct-text-content)
- (define-key map "\C-e" 'nxml-show-direct-text-content)
- (define-key map "\C-d" 'nxml-hide-subheadings)
- (define-key map "\C-s" 'nxml-show)
- (define-key map "\C-k" 'nxml-show-subheadings)
- (define-key map "\C-l" 'nxml-hide-text-content)
- (define-key map "\C-i" 'nxml-show-direct-subheadings)
- (define-key map "\C-o" 'nxml-hide-other)
- map))
+(defvar-keymap nxml-outline-prefix-map
+ "C-a" #'nxml-show-all
+ "C-t" #'nxml-hide-all-text-content
+ "C-r" #'nxml-refresh-outline
+ "C-c" #'nxml-hide-direct-text-content
+ "C-e" #'nxml-show-direct-text-content
+ "C-d" #'nxml-hide-subheadings
+ "C-s" #'nxml-show
+ "C-k" #'nxml-show-subheadings
+ "C-l" #'nxml-hide-text-content
+ "C-i" #'nxml-show-direct-subheadings
+ "C-o" #'nxml-hide-other)
;;; Commands for changing visibility
@@ -693,11 +691,9 @@ non-transparent child section."
(nxml-highlighted-qname (xmltok-end-tag-qname))
nxml-highlighted-greater-than))))
-(defvar nxml-outline-show-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-m" 'nxml-show-direct-text-content)
- (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content)
- map))
+(defvar-keymap nxml-outline-show-map
+ "RET" #'nxml-show-direct-text-content
+ "<mouse-2>" #'nxml-mouse-show-direct-text-content)
(defvar nxml-outline-show-help "mouse-2: show")
@@ -724,12 +720,10 @@ non-transparent child section."
(put 'nxml-outline-display-heading 'evaporate t)
(put 'nxml-outline-display-heading 'face 'nxml-heading)
-(defvar nxml-outline-hiding-tag-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'nxml-mouse-show-direct-subheadings)
- (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content)
- (define-key map "\C-m" 'nxml-show-direct-text-content)
- map))
+(defvar-keymap nxml-outline-hiding-tag-map
+ "<mouse-1>" #'nxml-mouse-show-direct-subheadings
+ "<mouse-2>" #'nxml-mouse-show-direct-text-content
+ "RET" #'nxml-show-direct-text-content)
(defvar nxml-outline-hiding-tag-help
"mouse-1: show subheadings, mouse-2: show text content")
@@ -739,12 +733,10 @@ non-transparent child section."
(put 'nxml-outline-display-hiding-tag 'keymap nxml-outline-hiding-tag-map)
(put 'nxml-outline-display-hiding-tag 'help-echo nxml-outline-hiding-tag-help)
-(defvar nxml-outline-showing-tag-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'nxml-mouse-hide-subheadings)
- (define-key map [mouse-2] 'nxml-mouse-show-direct-text-content)
- (define-key map "\C-m" 'nxml-show-direct-text-content)
- map))
+(defvar-keymap nxml-outline-showing-tag-map
+ "<mouse-1>" #'nxml-mouse-hide-subheadings
+ "<mouse-2>" #'nxml-mouse-show-direct-text-content
+ "RET" #'nxml-show-direct-text-content)
(defvar nxml-outline-showing-tag-help
"mouse-1: hide subheadings, mouse-2: show text content")
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el
index ff9eda3fd2a..56ba4480bfa 100644
--- a/lisp/nxml/nxml-parse.el
+++ b/lisp/nxml/nxml-parse.el
@@ -246,7 +246,7 @@ same way as well-formedness error."
parsed-attributes)))
(setq atts (cdr atts)))
;; We want to end up with the attributes followed by the
- ;; the namespace attributes in the same order as
+ ;; namespace attributes in the same order as
;; xmltok-attributes and xmltok-namespace-attributes respectively.
(when parsed-namespace-attributes
(setq parsed-attributes
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 3e24db64775..453c2b736dd 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -369,7 +369,7 @@ OVERRIDE is either nil, require or t."
(while (re-search-forward "\\\\x+{\\([[:xdigit:]]+\\)}"
(point-max)
t)
- (let* ((ch (decode-char 'ucs (string-to-number (match-string 1) 16))))
+ (let* ((ch (string-to-number (match-string 1) 16)))
(if (and ch (> ch 0))
(let ((begin (match-beginning 0))
(end (match-end 0)))
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 56ff3b66c0f..b9c980222e2 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -110,14 +110,14 @@
(defcustom rng-state-cache-distance 2000
"Distance in characters between each parsing and validation state cache."
- :type 'integer)
+ :type 'natnum)
(defcustom rng-validate-chunk-size 8000
"Number of characters in a RELAX NG validation chunk.
A validation chunk will be the smallest chunk that is at least this
size and ends with a tag. After validating a chunk, validation will
continue only if Emacs is still idle."
- :type 'integer)
+ :type 'natnum)
(defcustom rng-validate-delay 1.5
"Time in seconds that Emacs must be idle before starting a full validation.
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index c68f274e64f..ecdf510782a 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -943,7 +943,6 @@ and VALUE-END, otherwise a STRING giving the value."
(let ((n (string-to-number (buffer-substring-no-properties start end)
base)))
(cond ((and (integerp n) (xmltok-valid-char-p n))
- (setq n (xmltok-unicode-to-char n))
(and n (string n)))
(t
(xmltok-add-error "Invalid character code" start end)
@@ -971,11 +970,6 @@ and VALUE-END, otherwise a STRING giving the value."
(t (and (> n #xFFFF)
(< n #x110000)))))
-(defun xmltok-unicode-to-char (n)
- "Return the character corresponding to Unicode scalar value N.
-Return nil if unsupported in Emacs."
- (decode-char 'ucs n))
-
;;; Prolog parsing
(defvar xmltok-contains-doctype nil)
@@ -1766,6 +1760,10 @@ and `xmltok-namespace-attributes'."
xmltok-type))
(message "Scanned end of file")))
+;;; Obsolete
+
+(define-obsolete-function-alias 'xmltok-unicode-to-char #'identity "29.1")
+
(provide 'xmltok)
;;; xmltok.el ends here
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index b1877d18321..003410577a6 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -52,9 +52,6 @@
;; or a character translatable to such a character (i.e a character
;; for which `encode-char' will return non-nil).
;;
-;; Using unify-8859-on-decoding-mode is probably a good idea here
-;; (and generally with XML and other Unicode-oriented formats).
-;;
;; Unfortunately, this means that this package is currently useless
;; for CJK characters, since there's no mule-unicode charset for the
;; CJK ranges of Unicode. We should devise a workaround for this
@@ -290,7 +287,7 @@ and whose tail is ACCUM."
(defun xsdre-compile-single-char (ch)
(if (memq ch '(?. ?* ?+ ?? ?\[ ?\] ?^ ?$ ?\\))
(string ?\\ ch)
- (string (decode-char 'ucs ch))))
+ (string ch)))
(defun xsdre-char-class-to-range-list (cc)
"Return a range-list for a symbolic char-class CC."
@@ -407,10 +404,6 @@ consisting of a single char alternative delimited with []."
(cons last chars)
(cons last (cons ?- chars))))))
(setq range-list (cdr range-list)))
- (setq chars
- (mapcar (lambda (c)
- (decode-char 'ucs c))
- chars))
(when caret
(setq chars (cons ?^ chars)))
(when hyphen
diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el
deleted file mode 100644
index ca508a15544..00000000000
--- a/lisp/obsolete/abbrevlist.el
+++ /dev/null
@@ -1,56 +0,0 @@
-;;; abbrevlist.el --- list one abbrev table alphabetically ordered -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1986, 1992, 2001-2022 Free Software Foundation, Inc.
-;; Suggested by a previous version by Gildea.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: abbrev
-;; Package: emacs
-;; Obsolete-since: 24.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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-;;;###autoload
-(defun list-one-abbrev-table (abbrev-table output-buffer)
- "Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER."
- (with-output-to-temp-buffer output-buffer
- (save-excursion
- (let ((abbrev-list nil) (first-column 0))
- (set-buffer standard-output)
- (mapatoms
- (function (lambda (abbrev)
- (setq abbrev-list (cons abbrev abbrev-list))))
- abbrev-table)
- (setq abbrev-list (sort abbrev-list #'string-lessp))
- (while abbrev-list
- (if (> (+ first-column 40) (window-width))
- (progn
- (insert "\n")
- (setq first-column 0)))
- (indent-to first-column)
- (insert (symbol-name (car abbrev-list)))
- (indent-to (+ first-column 8))
- (insert (symbol-value (car abbrev-list)))
- (setq first-column (+ first-column 40))
- (setq abbrev-list (cdr abbrev-list)))))))
-
-(provide 'abbrevlist)
-
-;;; abbrevlist.el ends here
diff --git a/lisp/obsolete/assoc.el b/lisp/obsolete/assoc.el
deleted file mode 100644
index 76fcb4b78b8..00000000000
--- a/lisp/obsolete/assoc.el
+++ /dev/null
@@ -1,140 +0,0 @@
-;;; assoc.el --- insert/delete functions on association lists -*- lexical-binding: t -*-
-
-;; Copyright (C) 1996, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw <bwarsaw@cen.com>
-;; Keywords: extensions
-;; Obsolete-since: 24.3
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Association list utilities providing insertion, deletion, sorting
-;; fetching off key-value pairs in association lists.
-
-;;; Code:
-
-(defun asort (alist-symbol key)
- "Move a specified key-value pair to the head of an alist.
-The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
-head is one matching KEY. Returns the sorted list and doesn't affect
-the order of any other key-value pair. Side effect sets alist to new
-sorted list."
- (set alist-symbol
- (sort (copy-alist (symbol-value alist-symbol))
- (lambda (a _b) (equal (car a) key)))))
-
-
-(defun aelement (key value)
- "Make a list of a cons cell containing car of KEY and cdr of VALUE.
-The returned list is suitable for concatenating with an existing
-alist, via `nconc'."
- (list (cons key value)))
-
-
-(defun aheadsym (alist)
- "Return the key symbol at the head of ALIST."
- (car (car alist)))
-
-
-(defun anot-head-p (alist key)
- "Find out if a specified key-value pair is not at the head of an alist.
-The alist to check is specified by ALIST and the key-value pair is the
-one matching the supplied KEY. Returns nil if ALIST is nil, or if
-key-value pair is at the head of the alist. Returns t if key-value
-pair is not at the head of alist. ALIST is not altered."
- (not (equal (aheadsym alist) key)))
-
-
-(defun aput (alist-symbol key &optional value)
- "Insert a key-value pair into an alist.
-The alist is referenced by ALIST-SYMBOL. The key-value pair is made
-from KEY and optionally, VALUE. Returns the altered alist.
-
-If the key-value pair referenced by KEY can be found in the alist, and
-VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
-If VALUE is not supplied, or is nil, the key-value pair will not be
-modified, but will be moved to the head of the alist. If the key-value
-pair cannot be found in the alist, it will be inserted into the head
-of the alist (with value nil if VALUE is nil or not supplied)."
- (let ((elem (aelement key value))
- alist)
- (asort alist-symbol key)
- (setq alist (symbol-value alist-symbol))
- (cond ((null alist) (set alist-symbol elem))
- ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
- (value (setcar alist (car elem)) alist)
- (t alist))))
-
-
-(defun adelete (alist-symbol key)
- "Delete a key-value pair from the alist.
-Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
-is pair matching KEY. Returns the altered alist."
- (asort alist-symbol key)
- (let ((alist (symbol-value alist-symbol)))
- (cond ((null alist) nil)
- ((anot-head-p alist key) alist)
- (t (set alist-symbol (cdr alist))))))
-
-
-(defun aget (alist key &optional keynil-p)
- "Return the value in ALIST that is associated with KEY.
-Optional KEYNIL-P describes what to do if the value associated with
-KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is
-nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be
-returned.
-
-If no key-value pair matching KEY could be found in ALIST, or ALIST is
-nil then nil is returned. ALIST is not altered."
- (defvar assoc--copy)
- (let ((assoc--copy (copy-alist alist)))
- (cond ((null alist) nil)
- ((progn (asort 'assoc--copy key) ; dynamic binding
- (anot-head-p assoc--copy key)) nil)
- ((cdr (car assoc--copy)))
- (keynil-p nil)
- ((car (car assoc--copy)))
- (t nil))))
-
-
-(defun amake (alist-symbol keylist &optional valuelist)
- "Make an association list.
-The association list is attached to the alist referenced by
-ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
-associated with the value in VALUELIST with the same index. If
-VALUELIST is not supplied or is nil, then each key in KEYLIST is
-associated with nil.
-
-KEYLIST and VALUELIST should have the same number of elements, but
-this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining
-keys are associated with nil. If VALUELIST is larger than KEYLIST,
-extra values are ignored. Returns the created alist."
- (let ((keycar (car keylist))
- (keycdr (cdr keylist))
- (valcar (car valuelist))
- (valcdr (cdr valuelist)))
- (cond ((null keycdr)
- (aput alist-symbol keycar valcar))
- (t
- (amake alist-symbol keycdr valcdr)
- (aput alist-symbol keycar valcar))))
- (symbol-value alist-symbol))
-
-(provide 'assoc)
-
-;;; assoc.el ends here
diff --git a/lisp/autoarg.el b/lisp/obsolete/autoarg.el
index b0d6abe0207..8d5ded93421 100644
--- a/lisp/autoarg.el
+++ b/lisp/obsolete/autoarg.el
@@ -5,6 +5,7 @@
;; Author: Dave Love <fx@gnu.org>
;; Created: 1998-09-04
;; Keywords: abbrev, emulations
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el
index f36f5af4ef5..e58f475d1c2 100644
--- a/lisp/obsolete/cl-compat.el
+++ b/lisp/obsolete/cl-compat.el
@@ -52,6 +52,7 @@
;;; Keyword routines not supported by new package.
(defmacro defkeyword (x &optional doc)
+ (declare (indent defun))
(cl-list* 'defconst x (list 'quote x) (and doc (list doc))))
(defun keyword-of (sym)
diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el
index 40e05f0f45b..93f9dee4b4b 100644
--- a/lisp/obsolete/cl.el
+++ b/lisp/obsolete/cl.el
@@ -513,7 +513,8 @@ a temporary-variables list, a value-forms list, a store-variables list
See `gv-define-expander', and `gv-define-setter' for better and
simpler ways to define setf-methods."
(declare (debug
- (&define name cl-lambda-list cl-declarations-or-string def-body)))
+ (&define name cl-lambda-list cl-declarations-or-string def-body))
+ (indent defun))
`(progn
,@(if (stringp (car body))
(list `(put ',name 'setf-documentation ,(pop body))))
@@ -554,7 +555,8 @@ You can replace this form with `gv-define-setter'.
(&define name
[&or [symbolp &optional stringp]
[cl-lambda-list (symbolp)]]
- cl-declarations-or-string def-body)))
+ cl-declarations-or-string def-body))
+ (indent defun))
(if (and (listp arg1) (consp args))
;; Like `gv-define-setter' but with `cl-function'.
`(gv-define-expander ,name
@@ -615,7 +617,8 @@ arguments from ARGLIST using FUNC. For example:
You can replace this macro with `gv-letplace'."
(declare (debug
(&define name cl-lambda-list ;; should exclude &key
- symbolp &optional stringp)))
+ symbolp &optional stringp))
+ (indent defun))
(if (memq '&key arglist)
(error "&key not allowed in define-modify-macro"))
(require 'cl-macs) ;For cl--arglist-args.
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
deleted file mode 100644
index 1b4c39b159d..00000000000
--- a/lisp/obsolete/complete.el
+++ /dev/null
@@ -1,1122 +0,0 @@
-;;; complete.el --- partial completion mechanism plus other goodies -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1990-1993, 1999-2022 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Keywords: abbrev convenience
-;; Obsolete-since: 24.1
-;;
-;; Special thanks to Hallvard Furuseth for his many ideas and contributions.
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Extended completion for the Emacs minibuffer.
-;;
-;; The basic idea is that the command name or other completable text is
-;; divided into words and each word is completed separately, so that
-;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous
-;; each word is completed as much as possible and then the cursor is
-;; left at the first position where typing another letter will resolve
-;; the ambiguity.
-;;
-;; Word separators for this purpose are hyphen, space, and period.
-;; These would most likely occur in command names, Info menu items,
-;; and file names, respectively. But all word separators are treated
-;; alike at all times.
-;;
-;; This completion package replaces the old-style completer's key
-;; bindings for TAB, SPC, RET, and `?'. The old completer is still
-;; available on the Meta versions of those keys. If you set
-;; PC-meta-flag to nil, the old completion keys will be left alone
-;; and the partial completer will use the Meta versions of the keys.
-
-
-;; Usage: M-x partial-completion-mode. During completable minibuffer entry,
-;;
-;; TAB means to do a partial completion;
-;; SPC means to do a partial complete-word;
-;; RET means to do a partial complete-and-exit;
-;; ? means to do a partial completion-help.
-;;
-;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform
-;; original Emacs completions, and M-TAB etc. do partial completion.
-;; To do this, put the command,
-;;
-;; (setq PC-meta-flag nil)
-;;
-;; in your .emacs file. To load partial completion automatically, put
-;;
-;; (partial-completion-mode t)
-;;
-;; in your .emacs file, too. Things will be faster if you byte-compile
-;; this file when you install it.
-;;
-;; As an extra feature, in cases where RET would not normally
-;; complete (such as `C-x b'), the M-RET key will always do a partial
-;; complete-and-exit. Thus `C-x b f.c RET' will select or create a
-;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing
-;; buffer whose name matches that pattern (perhaps "filing.c").
-;; (PC-meta-flag does not affect this behavior; M-RET used to be
-;; undefined in this situation.)
-;;
-;; The regular M-TAB (lisp-complete-symbol) command also supports
-;; partial completion in this package.
-
-;; In addition, this package includes a feature for accessing include
-;; files. For example, `C-x C-f <sys/time.h> RET' reads the file
-;; /usr/include/sys/time.h. The variable PC-include-file-path is a
-;; list of directories in which to search for include files. Completion
-;; is supported in include file names.
-
-
-;;; Code:
-
-(defgroup partial-completion nil
- "Partial Completion of items."
- :prefix "pc-"
- :group 'minibuffer
- :group 'convenience)
-
-(defcustom PC-first-char 'find-file
- "Control how the first character of a string is to be interpreted.
-If nil, the first character of a string is not taken literally if it is a word
-delimiter, so that \".e\" matches \"*.e*\".
-If t, the first character of a string is always taken literally even if it is a
-word delimiter, so that \".e\" matches \".e*\".
-If non-nil and non-t, the first character is taken literally only for file name
-completion."
- :type '(choice (const :tag "delimiter" nil)
- (const :tag "literal" t)
- (other :tag "find-file" find-file)))
-
-(defcustom PC-meta-flag t
- "If non-nil, TAB means PC completion and M-TAB means normal completion.
-Otherwise, TAB means normal completion and M-TAB means Partial Completion."
- :type 'boolean)
-
-(defcustom PC-word-delimiters "-_. "
- "A string of characters treated as word delimiters for completion.
-Some arcane rules:
-If `]' is in this string, it must come first.
-If `^' is in this string, it must not come first.
-If `-' is in this string, it must come first or right after `]'.
-In other words, if S is this string, then `[S]' must be a valid Emacs regular
-expression (not containing character ranges like `a-z')."
- :type 'string)
-
-(defcustom PC-include-file-path '("/usr/include" "/usr/local/include")
- "A list of directories in which to look for include files.
-If nil, means use the colon-separated path in the variable $INCPATH instead."
- :type '(repeat directory))
-
-(defcustom PC-disable-includes nil
- "If non-nil, include-file support in \\[find-file] is disabled."
- :type 'boolean)
-
-(defvar PC-default-bindings t
- "If non-nil, default partial completion key bindings are suppressed.")
-
-(defvar PC-env-vars-alist nil
- "A list of the environment variable names and values.")
-
-
-(defun PC-bindings (bind)
- (let ((completion-map minibuffer-local-completion-map)
- (must-match-map minibuffer-local-must-match-map))
- (cond ((not bind)
- ;; These bindings are the default bindings. It would be better to
- ;; restore the previous bindings.
- (define-key read-expression-map "\e\t" #'completion-at-point)
-
- (define-key completion-map "\t" #'minibuffer-complete)
- (define-key completion-map " " #'minibuffer-complete-word)
- (define-key completion-map "?" #'minibuffer-completion-help)
-
- (define-key must-match-map "\r" #'minibuffer-complete-and-exit)
- (define-key must-match-map "\n" #'minibuffer-complete-and-exit)
-
- (define-key global-map [remap lisp-complete-symbol] nil))
- (PC-default-bindings
- (define-key read-expression-map "\e\t" #'PC-lisp-complete-symbol)
-
- (define-key completion-map "\t" #'PC-complete)
- (define-key completion-map " " #'PC-complete-word)
- (define-key completion-map "?" #'PC-completion-help)
-
- (define-key completion-map "\e\t" #'PC-complete)
- (define-key completion-map "\e " #'PC-complete-word)
- (define-key completion-map "\e\r" #'PC-force-complete-and-exit)
- (define-key completion-map "\e\n" #'PC-force-complete-and-exit)
- (define-key completion-map "\e?" #'PC-completion-help)
-
- (define-key must-match-map "\r" #'PC-complete-and-exit)
- (define-key must-match-map "\n" #'PC-complete-and-exit)
-
- (define-key must-match-map "\e\r" #'PC-complete-and-exit)
- (define-key must-match-map "\e\n" #'PC-complete-and-exit)
-
- (define-key global-map [remap lisp-complete-symbol] #'PC-lisp-complete-symbol)))))
-
-(defvar PC-do-completion-end nil
- "Internal variable used by `PC-do-completion'.")
-
-(make-variable-buffer-local 'PC-do-completion-end)
-
-(defvar PC-goto-end nil
- "Internal variable set in `PC-do-completion', used in
-`choose-completion-string-functions'.")
-
-(make-variable-buffer-local 'PC-goto-end)
-
-;;;###autoload
-(define-minor-mode partial-completion-mode
- "Toggle Partial Completion mode.
-
-When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is
-nil) is enhanced so that if some string is divided into words and each word is
-delimited by a character in `PC-word-delimiters', partial words are completed
-as much as possible and `*' characters are treated likewise in file names.
-
-For example, M-x p-c-m expands to M-x partial-completion-mode since no other
-command begins with that sequence of characters, and
-\\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no
-other file in that directory begins with that sequence of characters.
-
-Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted
-specially in \\[find-file]. For example,
-\\[find-file] <sys/time.h> RET finds the file `/usr/include/sys/time.h'.
-See also the variable `PC-include-file-path'.
-
-Partial Completion mode extends the meaning of `completion-auto-help' (which
-see), so that if it is neither nil nor t, Emacs shows the `*Completions*'
-buffer only on the second attempt to complete. That is, if TAB finds nothing
-to complete, the first TAB just says \"Next char not unique\" and the
-second TAB brings up the `*Completions*' buffer."
- :global t
- ;; Deal with key bindings...
- (PC-bindings partial-completion-mode)
- ;; Deal with include file feature...
- (cond ((not partial-completion-mode)
- (remove-hook 'find-file-not-found-functions
- #'PC-look-for-include-file))
- ((not PC-disable-includes)
- (add-hook 'find-file-not-found-functions #'PC-look-for-include-file)))
- ;; Adjust the completion selection in *Completion* buffers to the way
- ;; we work. The default minibuffer completion code only completes the
- ;; text before point and leaves the text after point alone (new in
- ;; Emacs-22). In contrast we use the whole text and we even sometimes
- ;; move point to a place before EOB, to indicate the first position where
- ;; there's a difference, so when the user uses choose-completion, we have
- ;; to trick choose-completion into replacing the whole minibuffer text
- ;; rather than only the text before point. --Stef
- (funcall
- (if partial-completion-mode #'add-hook #'remove-hook)
- 'choose-completion-string-functions
- (lambda (_choice buffer &rest _)
- ;; When completing M-: (lisp- ) with point before the ), it is
- ;; not appropriate to go to point-max (unlike the filename case).
- (if (and (not PC-goto-end)
- (minibufferp buffer))
- (goto-char (point-max))
- ;; Need a similar hack for the non-minibuffer-case -- gm.
- (when PC-do-completion-end
- (goto-char PC-do-completion-end)
- (setq PC-do-completion-end nil)))
- (setq PC-goto-end nil)
- nil))
- ;; Build the env-completion and mapping table.
- (when (and partial-completion-mode (null PC-env-vars-alist))
- (setq PC-env-vars-alist
- (mapcar (lambda (string)
- (let ((d (string-search "=" string)))
- (cons (concat "$" (substring string 0 d))
- (and d (substring string (1+ d))))))
- process-environment))))
-
-
-(defun PC-complete ()
- "Like minibuffer-complete, but allows \"b--di\"-style abbreviations.
-For example, \"M-x b--di\" would match `byte-recompile-directory', or any
-name which consists of three or more words, the first beginning with \"b\"
-and the third beginning with \"di\".
-
-The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and
-`beginning-of-defun', so this would produce a list of completions
-just like when normal Emacs completions are ambiguous.
-
-Word-delimiters for the purposes of Partial Completion are \"-\", \"_\",
-\".\", and SPC."
- (interactive)
- (if (PC-was-meta-key)
- (minibuffer-complete)
- ;; If the previous command was not this one,
- ;; never scroll, always retry completion.
- (or (eq last-command this-command)
- (setq minibuffer-scroll-window nil))
- (let ((window minibuffer-scroll-window))
- ;; If there's a fresh completion window with a live buffer,
- ;; and this command is repeated, scroll that window.
- (if (and window (window-buffer window)
- (buffer-name (window-buffer window)))
- (with-current-buffer (window-buffer window)
- (if (pos-visible-in-window-p (point-max) window)
- (set-window-start window (point-min) nil)
- (scroll-other-window)))
- (PC-do-completion nil)))))
-
-
-(defun PC-complete-word ()
- "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details.
-This can be bound to other keys, like `-' and `.', if you wish."
- (interactive)
- (if (eq (PC-was-meta-key) PC-meta-flag)
- (if (eq last-command-event ? )
- (minibuffer-complete-word)
- (self-insert-command 1))
- (self-insert-command 1)
- (if (eobp)
- (PC-do-completion 'word))))
-
-
-(defun PC-complete-space ()
- "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details.
-This is suitable for binding to other keys which should act just like SPC."
- (interactive)
- (if (eq (PC-was-meta-key) PC-meta-flag)
- (minibuffer-complete-word)
- (insert " ")
- (if (eobp)
- (PC-do-completion 'word))))
-
-
-(defun PC-complete-and-exit ()
- "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details."
- (interactive)
- (if (eq (PC-was-meta-key) PC-meta-flag)
- (minibuffer-complete-and-exit)
- (PC-do-complete-and-exit)))
-
-(defun PC-force-complete-and-exit ()
- "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details."
- (interactive)
- (let ((minibuffer-completion-confirm nil))
- (PC-do-complete-and-exit)))
-
-(defun PC-do-complete-and-exit ()
- (cond
- ((= (point-max) (minibuffer-prompt-end))
- ;; Duplicate the "bug" that Info-menu relies on...
- (exit-minibuffer))
- ((eq minibuffer-completion-confirm 'confirm)
- (if (or (eq last-command this-command)
- (test-completion (field-string)
- minibuffer-completion-table
- minibuffer-completion-predicate))
- (exit-minibuffer)
- (PC-temp-minibuffer-message " [Confirm]")))
- ((eq minibuffer-completion-confirm 'confirm-after-completion)
- ;; Similar to the above, but only if trying to exit immediately
- ;; after typing TAB (this catches most minibuffer typos).
- (if (and (memq last-command minibuffer-confirm-exit-commands)
- (not (test-completion (field-string)
- minibuffer-completion-table
- minibuffer-completion-predicate)))
- (PC-temp-minibuffer-message " [Confirm]")
- (exit-minibuffer)))
- (t
- (let ((flag (PC-do-completion 'exit)))
- (and flag
- (if (or (eq flag 'complete)
- (not minibuffer-completion-confirm))
- (exit-minibuffer)
- (PC-temp-minibuffer-message " [Confirm]")))))))
-
-
-(defun PC-completion-help ()
- "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details."
- (interactive)
- (if (eq (PC-was-meta-key) PC-meta-flag)
- (minibuffer-completion-help)
- (PC-do-completion 'help)))
-
-(defun PC-was-meta-key ()
- (or (/= (length (this-command-keys)) 1)
- (let ((key (aref (this-command-keys) 0)))
- (if (integerp key)
- (>= key 128)
- (not (null (memq 'meta (event-modifiers key))))))))
-
-
-(defvar PC-ignored-extensions 'empty-cache)
-(defvar PC-delims 'empty-cache)
-(defvar PC-ignored-regexp nil)
-(defvar PC-word-failed-flag nil)
-(defvar PC-delim-regex nil)
-(defvar PC-ndelims-regex nil)
-(defvar PC-delims-list nil)
-
-(defvar PC-completion-as-file-name-predicate
- (lambda () minibuffer-completing-file-name)
- "A function testing whether a minibuffer completion now will work filename-style.
-The function takes no arguments, and typically looks at the value
-of `minibuffer-completion-table' and the minibuffer contents.")
-
-;; Returns the sequence of non-delimiter characters that follow regexp in string.
-(defun PC-chunk-after (string regexp)
- (if (not (string-match regexp string))
- (let ((message "String %s didn't match regexp %s"))
- (message message string regexp)
- (error message string regexp)))
- (let ((result (substring string (match-end 0))))
- ;; result may contain multiple chunks
- (if (string-match PC-delim-regex result)
- (setq result (substring result 0 (match-beginning 0))))
- result))
-
-(defun test-completion-ignore-case (str table pred)
- "Like `test-completion', but ignores case when possible."
- ;; Binding completion-ignore-case to nil ensures, for compatibility with
- ;; standard completion, that the return value is exactly one of the
- ;; possibilities. Do this binding only if pred is nil, out of paranoia;
- ;; perhaps it is safe even if pred is non-nil.
- (if pred
- (test-completion str table pred)
- (let ((completion-ignore-case nil))
- (test-completion str table pred))))
-
-;; The following function is an attempt to work around two problems:
-
-;; (1) When complete.el was written, (try-completion "" '(("") (""))) used to
-;; return the value "". With a change from 2002-07-07 it returns t which caused
-;; `PC-lisp-complete-symbol' to fail with a "Wrong type argument: sequencep, t"
-;; error. `PC-try-completion' returns STRING in this case.
-
-;; (2) (try-completion "" '((""))) returned t before the above-mentioned change.
-;; Since `PC-chop-word' operates on the return value of `try-completion' this
-;; case might have provoked a similar error as in (1). `PC-try-completion'
-;; returns "" instead. I don't know whether this is a real problem though.
-
-;; Since `PC-try-completion' is not a guaranteed to fix these bugs reliably, you
-;; should try to look at the following discussions when you encounter problems:
-;; - emacs-pretest-bug ("Partial Completion" starting 2007-02-23),
-;; - emacs-devel ("[address-of-OP: Partial completion]" starting 2007-02-24),
-;; - emacs-devel ("[address-of-OP: EVAL and mouse selection in *Completions*]"
-;; starting 2007-03-05).
-(defun PC-try-completion (string alist &optional predicate)
- "Like `try-completion' but return STRING instead of t."
- (let ((result (try-completion string alist predicate)))
- (if (eq result t) string result)))
-
-(defvar completion-base-size)
-
-;; TODO document MODE magic...
-(defun PC-do-completion (&optional mode beg end goto-end)
- "Internal function to do the work of partial completion.
-Text to be completed lies between BEG and END. Normally when
-replacing text in the minibuffer, this function replaces up to
-point-max (as is appropriate for completing a file name). If
-GOTO-END is non-nil, however, it instead replaces up to END."
- (or beg (setq beg (minibuffer-prompt-end)))
- (or end (setq end (point-max)))
- (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal)
- 'PC-read-file-name-internal
- minibuffer-completion-table))
- (pred minibuffer-completion-predicate)
- (filename (funcall PC-completion-as-file-name-predicate))
- (dirname nil) ; non-nil only if a filename is being completed
- ;; The following used to be "(dirlength 0)" which caused the erasure of
- ;; the entire buffer text before `point' when inserting a completion
- ;; into a buffer.
- dirlength
- (str (buffer-substring beg end))
- (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
- (ambig nil)
- basestr origstr
- env-on
- regex
- p offset
- abbreviated
- (poss nil)
- helpposs
- (case-fold-search completion-ignore-case))
-
- ;; Check if buffer contents can already be considered complete
- (if (and (eq mode 'exit)
- (test-completion str table pred))
- 'complete
-
- ;; Do substitutions in directory names
- (and filename
- (setq basestr (or (file-name-directory str) ""))
- (setq dirlength (length basestr))
- ;; Do substitutions in directory names
- (setq p (substitute-in-file-name basestr))
- (not (string-equal basestr p))
- (setq str (concat p (file-name-nondirectory str)))
- (progn
- (delete-region beg end)
- (insert str)
- (setq end (+ beg (length str)))))
-
- ;; Prepare various delimiter strings
- (or (equal PC-word-delimiters PC-delims)
- (setq PC-delims PC-word-delimiters
- PC-delim-regex (concat "[" PC-delims "]")
- PC-ndelims-regex (concat "[^" PC-delims "]*")
- PC-delims-list (append PC-delims nil)))
-
- ;; Add wildcards if necessary
- (and filename
- (let ((dir (file-name-directory str))
- (file (file-name-nondirectory str))
- ;; The base dir for file-completion was passed in `predicate'.
- (default-directory (if (stringp pred) (expand-file-name pred)
- default-directory)))
- (while (and (stringp dir) (not (file-directory-p dir)))
- (setq dir (directory-file-name dir))
- (setq file (concat (replace-regexp-in-string
- PC-delim-regex "*\\&"
- (file-name-nondirectory dir))
- "*/" file))
- (setq dir (file-name-directory dir)))
- (setq origstr str str (concat dir file))))
-
- ;; Look for wildcard expansions in directory name
- (and filename
- (string-match "\\*.*/" str)
- (let ((pat str)
- ;; The base dir for file-completion was passed in `predicate'.
- (default-directory (if (stringp pred) (expand-file-name pred)
- default-directory))
- files)
- (setq p (1+ (string-match "/[^/]*\\'" pat)))
- (while (setq p (string-match PC-delim-regex pat p))
- (setq pat (concat (substring pat 0 p)
- "*"
- (substring pat p))
- p (+ p 2)))
- (setq files (file-expand-wildcards (concat pat "*")))
- (if files
- (let ((dir (file-name-directory (car files)))
- (p files))
- (while (and (setq p (cdr p))
- (equal dir (file-name-directory (car p)))))
- (if p
- (setq filename nil table nil
- pred (if (stringp pred) nil pred)
- ambig t)
- (delete-region beg end)
- (setq str (concat dir (file-name-nondirectory str)))
- (insert str)
- (setq end (+ beg (length str)))))
- (if origstr
- ;; If the wildcards were introduced by us, it's
- ;; possible that PC-read-file-name-internal can
- ;; still find matches for the original string
- ;; even if we couldn't, so remove the added
- ;; wildcards.
- (setq str origstr)
- (setq filename nil table nil
- pred (if (stringp pred) nil pred))))))
-
- ;; Strip directory name if appropriate
- (if filename
- (if incname
- (setq basestr (substring str incname)
- dirname (substring str 0 incname))
- (setq basestr (file-name-nondirectory str)
- dirname (file-name-directory str))
- ;; Make sure str is consistent with its directory and basename
- ;; parts. This is important on DOZe'NT systems when str only
- ;; includes a drive letter, like in "d:".
- (setq str (concat dirname basestr)))
- (setq basestr str))
-
- ;; Convert search pattern to a standard regular expression
- (setq regex (regexp-quote basestr)
- offset (if (and (> (length regex) 0)
- (not (eq (aref basestr 0) ?\*))
- (or (eq PC-first-char t)
- (and PC-first-char filename))) 1 0)
- p offset)
- (while (setq p (string-match PC-delim-regex regex p))
- (if (eq (aref regex p) ? )
- (setq regex (concat (substring regex 0 p)
- PC-ndelims-regex
- PC-delim-regex
- (substring regex (1+ p)))
- p (+ p (length PC-ndelims-regex) (length PC-delim-regex)))
- (let ((bump (if (memq (aref regex p)
- '(?$ ?^ ?\. ?* ?+ ?? ?\[ ?\] ?\\))
- -1 0)))
- (setq regex (concat (substring regex 0 (+ p bump))
- PC-ndelims-regex
- (substring regex (+ p bump)))
- p (+ p (length PC-ndelims-regex) 1)))))
- (setq p 0)
- (if filename
- (while (setq p (string-search "\\*" regex p))
- (setq regex (concat (substring regex 0 p)
- "[^/]*"
- (substring regex (+ p 2))))))
- ;;(setq the-regex regex)
- (setq regex (concat "\\`" regex))
-
- (and (> (length basestr) 0)
- (= (aref basestr 0) ?$)
- (setq env-on t
- table PC-env-vars-alist
- pred nil))
-
- ;; Find an initial list of possible completions
- (unless (setq p (string-match (concat PC-delim-regex
- (if filename "\\|\\*" ""))
- str
- (+ (length dirname) offset)))
-
- ;; Minibuffer contains no hyphens -- simple case!
- (setq poss (all-completions (if env-on basestr str)
- table
- pred))
- (unless (or poss (string-equal str ""))
- ;; Try completion as an abbreviation, e.g. "mvb" ->
- ;; "m-v-b" -> "multiple-value-bind", but only for
- ;; non-empty strings.
- (setq origstr str
- abbreviated t)
- (if filename
- (cond
- ;; "alpha" or "/alpha" -> expand whole path.
- ((string-match "^/?\\([A-Za-z0-9]+\\)$" str)
- (setq
- basestr ""
- p nil
- poss (file-expand-wildcards
- (concat "/"
- (mapconcat #'list (match-string 1 str) "*/")
- "*"))
- beg (1- beg)))
- ;; Alphanumeric trailer -> expand trailing file
- ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str)
- (setq regex (concat "\\`"
- (mapconcat #'list
- (match-string 2 str)
- "[A-Za-z0-9]*[^A-Za-z0-9]"))
- p (1+ (length (match-string 1 str))))))
- (setq regex (concat "\\`" (mapconcat (lambda (c)
- (regexp-quote (string c)))
- str "[^-]*-"))
- p 1))))
- (when p
- ;; Use all-completions to do an initial cull. This is a big win,
- ;; since all-completions is written in C!
- (let ((compl (all-completions (if env-on
- (file-name-nondirectory (substring str 0 p))
- (substring str 0 p))
- table
- pred)))
- (setq p compl)
- (when (and compl abbreviated)
- (if filename
- (progn
- (setq p nil)
- (dolist (x compl)
- (when (string-match regex x)
- (push x p)))
- (setq basestr (try-completion "" p)))
- (setq basestr (mapconcat #'list str "-"))
- (delete-region beg end)
- (setq end (+ beg (length basestr)))
- (insert basestr))))
- (while p
- (and (string-match regex (car p))
- (progn
- (set-text-properties 0 (length (car p)) '() (car p))
- (setq poss (cons (car p) poss))))
- (setq p (cdr p))))
-
- ;; If table had duplicates, they can be here.
- (delete-dups poss)
-
- ;; Handle completion-ignored-extensions
- (and filename
- (not (eq mode 'help))
- (let ((p2 poss))
-
- ;; Build a regular expression representing the extensions list
- (or (equal completion-ignored-extensions PC-ignored-extensions)
- (setq PC-ignored-regexp
- (concat "\\("
- (mapconcat
- #'regexp-quote
- (setq PC-ignored-extensions
- completion-ignored-extensions)
- "\\|")
- "\\)\\'")))
-
- ;; Check if there are any without an ignored extension.
- ;; Also ignore `.' and `..'.
- (setq p nil)
- (while p2
- (or (string-match PC-ignored-regexp (car p2))
- (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2))
- (setq p (cons (car p2) p)))
- (setq p2 (cdr p2)))
-
- ;; If there are "good" names, use them
- (and p (setq poss p))))
-
- ;; Now we have a list of possible completions
-
- (cond
-
- ;; No valid completions found
- ((null poss)
- (if (and (eq mode 'word)
- (not PC-word-failed-flag))
- (let ((PC-word-failed-flag t))
- (delete-char -1)
- (PC-do-completion 'word))
- (when abbreviated
- (delete-region beg end)
- (insert origstr))
- (beep)
- (PC-temp-minibuffer-message (if ambig
- " [Ambiguous dir name]"
- (if (eq mode 'help)
- " [No completions]"
- " [No match]")))
- nil))
-
- ;; More than one valid completion found
- ((or (cdr (setq helpposs poss))
- (memq mode '(help word)))
-
- ;; Is the actual string one of the possible completions?
- (setq p (and (not (eq mode 'help)) poss))
- (while (and p
- (not (string-equal (car p) basestr)))
- (setq p (cdr p)))
- (and p (null mode)
- (PC-temp-minibuffer-message " [Complete, but not unique]"))
- (if (and p
- (not (and (null mode)
- (eq this-command last-command))))
- t
-
- ;; If ambiguous, try for a partial completion
- (let ((improved nil)
- prefix
- (pt nil)
- (skip "\\`"))
-
- ;; Check if next few letters are the same in all cases
- (if (and (not (eq mode 'help))
- (setq prefix (PC-try-completion
- (PC-chunk-after basestr skip) poss)))
- (let ((first t) i)
- (if (eq mode 'word)
- (setq prefix (PC-chop-word prefix basestr)))
- (goto-char (+ beg (length dirname)))
- (while (and (progn
- (setq i 0) ; index into prefix string
- (while (< i (length prefix))
- (if (and (< (point) end)
- (or (eq (downcase (aref prefix i))
- (downcase (following-char)))
- (and (looking-at " ")
- (memq (aref prefix i)
- PC-delims-list))))
- ;; replace " " by the actual delimiter
- ;; or input char by prefix char
- (progn
- (delete-char 1)
- (insert (substring prefix i (1+ i))))
- ;; insert a new character
- (progn
- (and filename (looking-at "\\*")
- (progn
- (delete-char 1)
- (setq end (1- end))))
- (setq improved t)
- (insert (substring prefix i (1+ i)))
- (setq end (1+ end))))
- (setq i (1+ i)))
- (or pt (setq pt (point)))
- (looking-at PC-delim-regex))
- (setq skip (concat skip
- (regexp-quote prefix)
- PC-ndelims-regex)
- prefix (PC-try-completion
- (PC-chunk-after
- ;; not basestr, because that does
- ;; not reflect insertions
- (buffer-substring
- (+ beg (length dirname)) end)
- skip)
- (mapcar
- (lambda (x)
- (when (string-match skip x)
- (substring x (match-end 0))))
- poss)))
- (or (> i 0) (> (length prefix) 0))
- (or (not (eq mode 'word))
- (and first (> (length prefix) 0)
- (setq first nil
- prefix (substring prefix 0 1))))))
- (goto-char (if (eq mode 'word) end
- (or pt beg)))))
-
- (if (and (eq mode 'word)
- (not PC-word-failed-flag))
-
- (if improved
-
- ;; We changed it... would it be complete without the space?
- (if (test-completion (buffer-substring
- (field-beginning) (1- end))
- table pred)
- (delete-region (1- end) end)))
-
- (if improved
-
- ;; We changed it... enough to be complete?
- (and (eq mode 'exit)
- (test-completion-ignore-case (field-string) table pred))
-
- ;; If totally ambiguous, display a list of completions
- (if (or (eq completion-auto-help t)
- (and completion-auto-help
- (eq last-command this-command))
- (eq mode 'help))
- (let ((prompt-end (minibuffer-prompt-end)))
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list (sort helpposs #'string-lessp))
- (setq PC-do-completion-end end
- PC-goto-end goto-end)
- (with-current-buffer standard-output
- ;; Record which part of the buffer we are completing
- ;; so that choosing a completion from the list
- ;; knows how much old text to replace.
- ;; This was briefly nil in the non-dirname case.
- ;; However, if one calls PC-lisp-complete-symbol
- ;; on "(ne-f" with point on the hyphen, PC offers
- ;; all completions starting with "(ne", some of
- ;; which do not match the "-f" part (maybe it
- ;; should not, but it does). In such cases,
- ;; completion gets confused trying to figure out
- ;; how much to replace, so we tell it explicitly
- ;; (ie, the number of chars in the buffer before beg).
- ;;
- ;; Note that choose-completion-string-functions
- ;; plays around with point.
- (with-suppressed-warnings ((obsolete
- completion-base-size))
- (setq completion-base-size
- (if dirname
- dirlength
- (- beg prompt-end)))))))
- (PC-temp-minibuffer-message " [Next char not unique]"))
- ;; Expansion of filenames is not reversible,
- ;; so just keep the prefix.
- (when (and abbreviated filename)
- (delete-region (point) end))
- nil)))))
-
- ;; Only one possible completion
- (t
- (if (and (equal basestr (car poss))
- (not (and env-on filename))
- (not abbreviated))
- (if (null mode)
- (PC-temp-minibuffer-message " [Sole completion]"))
- (delete-region beg end)
- (insert (format "%s"
- (if filename
- (substitute-in-file-name (concat dirname (car poss)))
- (car poss)))))
- t)))))
-
-(defun PC-chop-word (new old)
- (let ((i -1)
- (j -1))
- (while (and (setq i (string-match PC-delim-regex old (1+ i)))
- (setq j (string-match PC-delim-regex new (1+ j)))))
- (if (and j
- (or (not PC-word-failed-flag)
- (setq j (string-match PC-delim-regex new (1+ j)))))
- (substring new 0 (1+ j))
- new)))
-
-(defvar PC-not-minibuffer nil)
-
-(defun PC-temp-minibuffer-message (message)
- "A Lisp version of `temp_minibuffer_message' from minibuf.c."
- (cond (PC-not-minibuffer
- (message "%s" message)
- (sit-for 2)
- (message ""))
- ((fboundp 'temp-minibuffer-message)
- (temp-minibuffer-message message))
- (t
- (let ((point-max (point-max)))
- (save-excursion
- (goto-char point-max)
- (insert message))
- (let ((inhibit-quit t))
- (sit-for 2)
- (delete-region point-max (point-max))
- (when quit-flag
- (setq quit-flag nil
- unread-command-events '(7))))))))
-
-;; Does not need to be buffer-local (?) because only used when one
-;; PC-l-c-s immediately follows another.
-(defvar PC-lisp-complete-end nil
- "Internal variable used by `PC-lisp-complete-symbol'.")
-
-(defun PC-lisp-complete-symbol ()
- "Perform completion on Lisp symbol preceding point.
-That symbol is compared against the symbols that exist
-and any additional characters determined by what is there
-are inserted.
-If the symbol starts just after an open-parenthesis,
-only symbols with function definitions are considered.
-Otherwise, all symbols with function definitions, values
-or properties are considered."
- (interactive)
- (let* ((end
- (save-excursion
- (with-syntax-table lisp-mode-syntax-table
- (skip-syntax-forward "_w")
- (point))))
- (beg (save-excursion
- (with-syntax-table lisp-mode-syntax-table
- (backward-sexp 1)
- (while (= (char-syntax (following-char)) ?\')
- (forward-char 1))
- (point))))
- (minibuffer-completion-table obarray)
- (minibuffer-completion-predicate
- (if (eq (char-after (1- beg)) ?\()
- 'fboundp
- (function (lambda (sym)
- (or (boundp sym) (fboundp sym)
- (symbol-plist sym))))))
- (PC-not-minibuffer t))
- ;; https://lists.gnu.org/r/emacs-devel/2007-03/msg01211.html
- ;;
- ;; This deals with cases like running PC-l-c-s on "M-: (n-f".
- ;; The first call to PC-l-c-s expands this to "(ne-f", and moves
- ;; point to the hyphen [1]. If one calls PC-l-c-s immediately after,
- ;; then without the last-command check, one is offered all
- ;; completions of "(ne", which is presumably not what one wants.
- ;;
- ;; This is arguably (at least, it seems to be the existing intended
- ;; behavior) what one _does_ want if point has been explicitly
- ;; positioned on the hyphen. Note that if PC-do-completion (qv) binds
- ;; completion-base-size to nil, then completion does not replace the
- ;; correct amount of text in such cases.
- ;;
- ;; Neither of these problems occur when using PC for filenames in the
- ;; minibuffer, because in that case PC-do-completion is called without
- ;; an explicit value for END, and so uses (point-max). This is fine for
- ;; a filename, because the end of the filename must be at the end of
- ;; the minibuffer. The same is not true for lisp symbols.
- ;;
- ;; [1] An alternate fix would be to not move point to the hyphen
- ;; in such cases, but that would make the behavior different from
- ;; that for filenames. It seems PC moves point to the site of the
- ;; first difference between the possible completions.
- ;;
- ;; Alternatively alternatively, maybe end should be computed in
- ;; the same way as beg. That would change the behavior though.
- (if (equal last-command 'PC-lisp-complete-symbol)
- (PC-do-completion nil beg PC-lisp-complete-end t)
- (if PC-lisp-complete-end
- (move-marker PC-lisp-complete-end end)
- (setq PC-lisp-complete-end (copy-marker end t)))
- (PC-do-completion nil beg end t))))
-
-(defun PC-complete-as-file-name ()
- "Perform completion on file names preceding point.
- Environment vars are converted to their values."
- (interactive)
- (let* ((end (point))
- (beg (if (re-search-backward "[^\\][ \t\n\"`'][^ \t\n\"`']"
- (point-min) t)
- (+ (point) 2)
- (point-min)))
- (minibuffer-completion-table 'PC-read-file-name-internal)
- (minibuffer-completion-predicate nil)
- (PC-not-minibuffer t))
- (goto-char end)
- (PC-do-completion nil beg end)))
-
-;; Facilities for loading C header files. This is independent from the
-;; main completion code. See also the variable `PC-include-file-path'
-;; at top of this file.
-
-(defun PC-look-for-include-file ()
- (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name))
- (let ((name (substring (buffer-file-name)
- (match-beginning 1) (match-end 1)))
- (punc (aref (buffer-file-name) (match-beginning 0)))
- (path nil)
- new-buf)
- (kill-buffer (current-buffer))
- (if (equal name "")
- (with-current-buffer (car (buffer-list))
- (save-excursion
- (beginning-of-line)
- (if (looking-at
- "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]")
- (setq name (buffer-substring (match-beginning 1)
- (match-end 1))
- punc (char-after (1- (match-beginning 1))))
- ;; Suggested by Frank Siebenlist:
- (if (or (looking-at
- "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"")
- (looking-at
- "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"")
- (looking-at
- "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]"))
- (progn
- (setq name (buffer-substring (match-beginning 1)
- (match-end 1))
- punc ?\<
- path load-path)
- (if (string-match "\\.elc$" name)
- (setq name (substring name 0 -1))
- (or (string-match "\\.el$" name)
- (setq name (concat name ".el")))))
- (error "Not on an #include line"))))))
- (or (string-match "\\.[[:alnum:]]+$" name)
- (setq name (concat name ".h")))
- (if (eq punc ?\<)
- (let ((path (or path (PC-include-file-path))))
- (while (and path
- (not (file-exists-p
- (concat (file-name-as-directory (car path))
- name))))
- (setq path (cdr path)))
- (if path
- (setq name (concat (file-name-as-directory (car path)) name))
- (error "No such include file: <%s>" name)))
- (let ((dir (with-current-buffer (car (buffer-list))
- default-directory)))
- (if (file-exists-p (concat dir name))
- (setq name (concat dir name))
- (error "No such include file: `%s'" name))))
- (setq new-buf (get-file-buffer name))
- (if new-buf
- ;; no need to verify last-modified time for this!
- (set-buffer new-buf)
- (set-buffer (create-file-buffer name))
- (erase-buffer)
- (insert-file-contents name t))
- ;; Returning non-nil with the new buffer current
- ;; is sufficient to tell find-file to use it.
- t)
- nil))
-
-(defun PC-include-file-path ()
- (or PC-include-file-path
- (let ((env (getenv "INCPATH"))
- (path nil)
- pos)
- (or env (error "No include file path specified"))
- (while (setq pos (string-match ":[^:]+$" env))
- (setq path (cons (substring env (1+ pos)) path)
- env (substring env 0 pos)))
- path)))
-
-;; This is adapted from lib-complete.el, by Mike Williams.
-(defun PC-include-file-all-completions (file search-path &optional full)
- "Return all completions for FILE in any directory on SEARCH-PATH.
-If optional third argument FULL is non-nil, returned pathnames should be
-absolute rather than relative to some directory on the SEARCH-PATH."
- (setq search-path
- (mapcar (lambda (dir)
- (if dir (file-name-as-directory dir) default-directory))
- search-path))
- (if (file-name-absolute-p file)
- ;; It's an absolute file name, so don't need search-path
- (progn
- (setq file (expand-file-name file))
- (file-name-all-completions
- (file-name-nondirectory file) (file-name-directory file)))
- (let ((subdir (file-name-directory file))
- (ndfile (file-name-nondirectory file))
- file-lists)
- ;; Append subdirectory part to each element of search-path
- (if subdir
- (setq search-path
- (mapcar (lambda (dir) (concat dir subdir))
- search-path)
- file nil))
- ;; Make list of completions in each directory on search-path
- (while search-path
- (let* ((dir (car search-path))
- (subdir (if full dir subdir)))
- (if (file-directory-p dir)
- (progn
- (setq file-lists
- (cons
- (mapcar (lambda (file) (concat subdir file))
- (file-name-all-completions ndfile
- (car search-path)))
- file-lists))))
- (setq search-path (cdr search-path))))
- ;; Compress out duplicates while building complete list (slloooow!)
- (let ((sorted (sort (apply #'nconc file-lists)
- (lambda (x y) (not (string-lessp x y)))))
- compressed)
- (while sorted
- (if (equal (car sorted) (car compressed)) nil
- (setq compressed (cons (car sorted) compressed)))
- (setq sorted (cdr sorted)))
- compressed))))
-
-(defun PC-read-file-name-internal (string pred action)
- "Extend `read-file-name-internal' to handle include files.
-This is only used by "
- (if (string-match "<\\([^\"<>]*\\)>?\\'" string)
- (let* ((name (match-string 1 string))
- (str2 (substring string (match-beginning 0)))
- (completion-table
- (mapcar (lambda (x)
- (format (if (string-match "/\\'" x) "<%s" "<%s>") x))
- (PC-include-file-all-completions
- name (PC-include-file-path)))))
- (cond
- ((not completion-table) nil)
- ((eq action 'lambda) (test-completion str2 completion-table nil))
- ((eq action nil) (PC-try-completion str2 completion-table nil))
- ((eq action t) (all-completions str2 completion-table nil))))
- (read-file-name-internal string pred action)))
-
-
-(provide 'complete)
-
-;;; complete.el ends here
diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el
index b8944e42609..8424c42b69c 100644
--- a/lisp/obsolete/crisp.el
+++ b/lisp/obsolete/crisp.el
@@ -231,27 +231,13 @@ does not load the scroll-all package."
;; The cut and paste routines are different between XEmacs and Emacs
;; so we need to set up aliases for the functions.
-
-(defalias 'crisp-set-clipboard
- (if (fboundp 'clipboard-kill-ring-save)
- 'clipboard-kill-ring-save
- 'copy-primary-selection))
-
-(defalias 'crisp-kill-region
- (if (fboundp 'clipboard-kill-region)
- 'clipboard-kill-region
- 'kill-primary-selection))
-
-(defalias 'crisp-yank-clipboard
- (if (fboundp 'clipboard-yank)
- 'clipboard-yank
- 'yank-clipboard-selection))
+(defalias 'crisp-set-clipboard 'clipboard-kill-ring-save)
+(defalias 'crisp-kill-region 'clipboard-kill-region)
+(defalias 'crisp-yank-clipboard 'clipboard-yank)
(defun crisp-region-active ()
"Compatibility function to test for an active region."
- (if (featurep 'xemacs)
- zmacs-region-active-p
- mark-active))
+ mark-active)
(defun crisp-version (&optional arg)
"Version number of the CRiSP emulator package.
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
deleted file mode 100644
index 80ded086545..00000000000
--- a/lisp/obsolete/cust-print.el
+++ /dev/null
@@ -1,674 +0,0 @@
-;;; cust-print.el --- handles print-level and print-circle -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1992, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Adapted-By: ESR
-;; Keywords: extensions
-;; Obsolete-since: 24.3
-
-;; LCD Archive Entry:
-;; cust-print|Daniel LaLiberte|liberte@holonexus.org
-;; |Handle print-level, print-circle and more.
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package provides a general print handler for prin1 and princ
-;; that supports print-level and print-circle, and by the way,
-;; print-length since the standard routines are being replaced. Also,
-;; to print custom types constructed from lists and vectors, use
-;; custom-print-list and custom-print-vector. See the documentation
-;; strings of these variables for more details.
-
-;; If the results of your expressions contain circular references to
-;; other parts of the same structure, the standard Emacs print
-;; subroutines may fail to print with an untrappable error,
-;; "Apparently circular structure being printed". If you only use cdr
-;; circular lists (where cdrs of lists point back; what is the right
-;; term here?), you can limit the length of printing with
-;; print-length. But car circular lists and circular vectors generate
-;; the above mentioned error in Emacs version 18. Version
-;; 19 supports print-level, but it is often useful to get a better
-;; print representation of circular and shared structures; the print-circle
-;; option may be used to print more concise representations.
-
-;; There are three main ways to use this package. First, you may
-;; replace prin1, princ, and some subroutines that use them by calling
-;; install-custom-print so that any use of these functions in
-;; Lisp code will be affected; you can later reset with
-;; uninstall-custom-print. Second, you may temporarily install
-;; these functions with the macro with-custom-print. Third, you
-;; could call the custom routines directly, thus only affecting the
-;; printing that requires them.
-
-;; Note that subroutines which call print subroutines directly will
-;; not use the custom print functions. In particular, the evaluation
-;; functions like eval-region call the print subroutines directly.
-;; Therefore, if you evaluate (aref circ-list 0), where circ-list is a
-;; circular list rather than an array, aref calls error directly which
-;; will jump to the top level instead of printing the circular list.
-
-;; Uninterned symbols are recognized when print-circle is non-nil,
-;; but they are not printed specially here. Use the cl-packages package
-;; to print according to print-gensym.
-
-;; Obviously the right way to implement this custom-print facility is
-;; in C or with hooks into the standard printer. Please volunteer
-;; since I don't have the time or need. More CL-like printing
-;; capabilities could be added in the future.
-
-;; Implementation design: we want to use the same list and vector
-;; processing algorithm for all versions of prin1 and princ, since how
-;; the processing is done depends on print-length, print-level, and
-;; print-circle. For circle printing, a preprocessing step is
-;; required before the final printing. Thanks to Jamie Zawinski
-;; for motivation and algorithms.
-
-
-;;; Code:
-
-(defgroup cust-print nil
- "Handles print-level and print-circle."
- :prefix "print-"
- :group 'lisp
- :group 'extensions)
-
-;; If using cl-packages:
-
-'(defpackage "cust-print"
- (:nicknames "CP" "custom-print")
- (:use "el")
- (:export
- print-level
- print-circle
-
- custom-print-install
- custom-print-uninstall
- custom-print-installed-p
- with-custom-print
-
- custom-prin1
- custom-princ
- custom-prin1-to-string
- custom-print
- custom-format
- custom-message
- custom-error
-
- custom-printers
- add-custom-printer
- ))
-
-'(in-package cust-print)
-
-;; Emacs 18 doesn't have defalias.
-;; Provide def for byte compiler.
-
-;; Variables:
-;;=========================================================
-
-;;(defvar print-length nil
-;; "*Controls how many elements of a list, at each level, are printed.
-;;This is defined by emacs.")
-
-(defcustom print-level nil
- "Controls how many levels deep a nested data object will print.
-
-If nil, printing proceeds recursively and may lead to
-max-lisp-eval-depth being exceeded or an error may occur:
-`Apparently circular structure being printed.'
-Also see `print-length' and `print-circle'.
-
-If non-nil, components at levels equal to or greater than `print-level'
-are printed simply as `#'. The object to be printed is at level 0,
-and if the object is a list or vector, its top-level components are at
-level 1."
- :type '(choice (const nil) integer))
-
-
-(defcustom print-circle nil
- "Controls the printing of recursive structures.
-
-If nil, printing proceeds recursively and may lead to
-`max-lisp-eval-depth' being exceeded or an error may occur:
-\"Apparently circular structure being printed.\" Also see
-`print-length' and `print-level'.
-
-If non-nil, shared substructures anywhere in the structure are printed
-with `#N=' before the first occurrence (in the order of the print
-representation) and `#N#' in place of each subsequent occurrence,
-where N is a positive decimal integer."
- :type 'boolean)
-
-
-(defcustom custom-print-vectors nil
- "Non-nil if printing of vectors should obey `print-level' and `print-length'."
- :type 'boolean)
-
-
-;; Custom printers
-;;==========================================================
-
-(defvar custom-printers nil
- ;; e.g. '((symbolp . pkg::print-symbol))
- "An alist for custom printing of any type.
-Pairs are of the form (PREDICATE . PRINTER). If PREDICATE is true
-for an object, then PRINTER is called with the object.
-PRINTER should print to `standard-output' using cust-print-original-princ
-if the standard printer is sufficient, or cust-print-prin for complex things.
-The PRINTER should return the object being printed.
-
-Don't modify this variable directly. Use `add-custom-printer' and
-`delete-custom-printer'")
-;; Should cust-print-original-princ and cust-print-prin be exported symbols?
-;; Or should the standard printers functions be replaced by
-;; CP ones in Emacs Lisp so that CP internal functions need not be called?
-
-(defun add-custom-printer (pred printer)
- "Add a pair of PREDICATE and PRINTER to `custom-printers'.
-Any pair that has the same PREDICATE is first removed."
- (setq custom-printers (cons (cons pred printer)
- (delq (assq pred custom-printers)
- custom-printers)))
- ;; Rather than updating here, we could wait until cust-print-top-level is called.
- (cust-print-update-custom-printers))
-
-(defun delete-custom-printer (pred)
- "Delete the custom printer associated with PREDICATE."
- (setq custom-printers (delq (assq pred custom-printers)
- custom-printers))
- (cust-print-update-custom-printers))
-
-
-(defun cust-print-use-custom-printer (_object)
- ;; Default function returns nil.
- nil)
-
-(defun cust-print-update-custom-printers ()
- ;; Modify the definition of cust-print-use-custom-printer
- (defalias 'cust-print-use-custom-printer
- ;; We don't really want to require the byte-compiler.
- ;; (byte-compile
- `(lambda (object)
- (cond
- ,@(mapcar (function
- (lambda (pair)
- `((,(car pair) object)
- (,(cdr pair) object))))
- custom-printers)
- ;; Otherwise return nil.
- (t nil)
- ))
- ;; )
- ))
-
-
-;; Saving and restoring emacs printing routines.
-;;====================================================
-
-(defun cust-print-set-function-cell (symbol-pair)
- (defalias (car symbol-pair)
- (symbol-function (car (cdr symbol-pair)))))
-
-(defun cust-print-original-princ (_object &optional _stream) nil) ; dummy def
-
-;; Save emacs routines.
-(if (not (fboundp 'cust-print-original-prin1))
- (mapc #'cust-print-set-function-cell
- '((cust-print-original-prin1 prin1)
- (cust-print-original-princ princ)
- (cust-print-original-print print)
- (cust-print-original-prin1-to-string prin1-to-string)
- (cust-print-original-format format)
- (cust-print-original-message message)
- (cust-print-original-error error))))
-(declare-function cust-print-original-format "cust-print")
-(declare-function cust-print-original-message "cust-print")
-
-(defun custom-print-install ()
- "Replace print functions with general, customizable, Lisp versions.
-The Emacs subroutines are saved away, and you can reinstall them
-by running `custom-print-uninstall'."
- (interactive)
- (mapc #'cust-print-set-function-cell
- '((prin1 custom-prin1)
- (princ custom-princ)
- (print custom-print)
- (prin1-to-string custom-prin1-to-string)
- (format custom-format)
- (message custom-message)
- (error custom-error)
- ))
- t)
-
-(defun custom-print-uninstall ()
- "Reset print functions to their Emacs subroutines."
- (interactive)
- (mapc #'cust-print-set-function-cell
- '((prin1 cust-print-original-prin1)
- (princ cust-print-original-princ)
- (print cust-print-original-print)
- (prin1-to-string cust-print-original-prin1-to-string)
- (format cust-print-original-format)
- (message cust-print-original-message)
- (error cust-print-original-error)
- ))
- t)
-
-(defalias 'custom-print-funcs-installed-p #'custom-print-installed-p)
-(defun custom-print-installed-p ()
- "Return t if custom-print is currently installed, nil otherwise."
- (eq (symbol-function 'custom-prin1) (symbol-function 'prin1)))
-
-(defmacro with-custom-print (&rest body)
- "Temporarily install the custom print package while executing BODY."
- (declare (debug t))
- `(unwind-protect
- (progn
- (custom-print-install)
- ,@body)
- (custom-print-uninstall)))
-(defalias 'with-custom-print-funcs #'with-custom-print)
-
-
-;; Lisp replacements for prin1 and princ, and for some subrs that use them
-;;===============================================================
-;; - so far only the printing and formatting subrs.
-
-(defun custom-prin1 (object &optional stream)
- "Output the printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `prin1'. It
-uses the appropriate printer depending on the values of `print-level'
-and `print-circle' (which see)."
- (cust-print-top-level object stream 'cust-print-original-prin1))
-
-
-(defun custom-princ (object &optional stream)
- "Output the printed representation of OBJECT, any Lisp object.
-No quoting characters are used; no delimiters are printed around
-the contents of strings.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `princ'."
- (cust-print-top-level object stream 'cust-print-original-princ))
-
-
-(defun custom-prin1-to-string (object &optional noescape)
- "Return a string containing the printed representation of OBJECT,
-any Lisp object. Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible, unless the optional
-second argument NOESCAPE is non-nil.
-
-This is the custom-print replacement for the standard `prin1-to-string'."
- (let ((buf (get-buffer-create " *custom-print-temp*")))
- ;; We must erase the buffer before printing in case an error
- ;; occurred during the last prin1-to-string and we are in debugger.
- (with-current-buffer buf
- (erase-buffer))
- ;; We must be in the current-buffer when the print occurs.
- (if noescape
- (custom-princ object buf)
- (custom-prin1 object buf))
- (with-current-buffer buf
- (buffer-string)
- ;; We could erase the buffer again, but why bother?
- )))
-
-
-(defun custom-print (object &optional stream)
- "Output the printed representation of OBJECT, with newlines around it.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `print'."
- (cust-print-original-princ "\n" stream)
- (custom-prin1 object stream)
- (cust-print-original-princ "\n" stream))
-
-
-(defun custom-format (fmt &rest args)
- "Format a string out of a control-string and arguments.
-The first argument is a control string. It, and subsequent arguments
-substituted into it, become the value, which is a string.
-It may contain %s or %d or %c to substitute successive following arguments.
-%s means print an argument as a string, %d means print as number in decimal,
-%c means print a number as a single character.
-The argument used by %s must be a string or a symbol;
-the argument used by %d, %b, %o, %x or %c must be a number.
-
-This is the custom-print replacement for the standard `format'. It
-calls the Emacs `format' after first making strings for list,
-vector, or symbol args. The format specification for such args should
-be `%s' in any case, so a string argument will also work. The string
-is generated with `custom-prin1-to-string', which quotes quotable
-characters."
- (apply #'cust-print-original-format fmt
- (mapcar (function (lambda (arg)
- (if (or (listp arg) (vectorp arg) (symbolp arg))
- (custom-prin1-to-string arg)
- arg)))
- args)))
-
-
-(defun custom-message (fmt &rest args)
- "Print a one-line message at the bottom of the screen.
-The first argument is a control string.
-It may contain %s or %d or %c to print successive following arguments.
-%s means print an argument as a string, %d means print as number in decimal,
-%c means print a number as a single character.
-The argument used by %s must be a string or a symbol;
-the argument used by %d or %c must be a number.
-
-This is the custom-print replacement for the standard `message'.
-See `custom-format' for the details."
- ;; It doesn't work to princ the result of custom-format as in:
- ;; (cust-print-original-princ (apply 'custom-format fmt args))
- ;; because the echo area requires special handling
- ;; to avoid duplicating the output.
- ;; cust-print-original-message does it right.
- (apply #'cust-print-original-message fmt
- (mapcar (function (lambda (arg)
- (if (or (listp arg) (vectorp arg) (symbolp arg))
- (custom-prin1-to-string arg)
- arg)))
- args)))
-
-
-(defun custom-error (fmt &rest args)
- "Signal an error, making error message by passing all args to `format'.
-
-This is the custom-print replacement for the standard `error'.
-See `custom-format' for the details."
- (signal 'error (list (apply #'custom-format fmt args))))
-
-
-
-;; Support for custom prin1 and princ
-;;=========================================
-
-;; Defs to quiet byte-compiler.
-(defvar circle-table)
-(defvar cust-print-current-level)
-
-(defun cust-print-original-printer (_object) nil) ; One of the standard printers.
-(defun cust-print-low-level-prin (_object) nil) ; Used internally.
-(defun cust-print-prin (_object) nil) ; Call this to print recursively.
-
-(defun cust-print-top-level (object stream emacs-printer)
- ;; Set up for printing.
- (let ((standard-output (or stream standard-output))
- ;; circle-table will be non-nil if anything is circular.
- (circle-table (and print-circle
- (cust-print-preprocess-circle-tree object)))
- (cust-print-current-level (or print-level -1)))
-
- (defalias 'cust-print-original-printer emacs-printer)
- (defalias 'cust-print-low-level-prin
- (cond
- ((or custom-printers
- circle-table
- print-level ; comment out for version 19
- ;; Emacs doesn't use print-level or print-length
- ;; for vectors, but custom-print can.
- (if custom-print-vectors
- (or print-level print-length)))
- 'cust-print-print-object)
- (t 'cust-print-original-printer)))
- (defalias 'cust-print-prin
- (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin))
-
- (cust-print-prin object)
- object))
-
-
-(defun cust-print-print-object (object)
- ;; Test object type and print accordingly.
- ;; Could be called as either cust-print-low-level-prin or cust-print-prin.
- (cond
- ((null object) (cust-print-original-printer object))
- ((cust-print-use-custom-printer object) object)
- ((consp object) (cust-print-list object))
- ((vectorp object) (cust-print-vector object))
- ;; All other types, just print.
- (t (cust-print-original-printer object))))
-
-
-(defun cust-print-print-circular (object)
- ;; Printer for `prin1' and `princ' that handles circular structures.
- ;; If OBJECT appears multiply, and has not yet been printed,
- ;; prefix with label; if it has been printed, use `#N#' instead.
- ;; Otherwise, print normally.
- (let ((tag (assq object circle-table)))
- (if tag
- (let ((id (cdr tag)))
- (if (> id 0)
- (progn
- ;; Already printed, so just print id.
- (cust-print-original-princ "#")
- (cust-print-original-princ id)
- (cust-print-original-princ "#"))
- ;; Not printed yet, so label with id and print object.
- (setcdr tag (- id)) ; mark it as printed
- (cust-print-original-princ "#")
- (cust-print-original-princ (- id))
- (cust-print-original-princ "=")
- (cust-print-low-level-prin object)
- ))
- ;; Not repeated in structure.
- (cust-print-low-level-prin object))))
-
-
-;;================================================
-;; List and vector processing for print functions.
-
-(defun cust-print-list (list)
- ;; Print a list using print-length, print-level, and print-circle.
- (if (= cust-print-current-level 0)
- (cust-print-original-princ "#")
- (let ((cust-print-current-level (1- cust-print-current-level)))
- (cust-print-original-princ "(")
- (let ((length (or print-length 0)))
-
- ;; Print the first element always (even if length = 0).
- (cust-print-prin (car list))
- (setq list (cdr list))
- (if list (cust-print-original-princ " "))
- (setq length (1- length))
-
- ;; Print the rest of the elements.
- (while (and list (/= 0 length))
- (if (and (listp list)
- (not (assq list circle-table)))
- (progn
- (cust-print-prin (car list))
- (setq list (cdr list)))
-
- ;; cdr is not a list, or it is in circle-table.
- (cust-print-original-princ ". ")
- (cust-print-prin list)
- (setq list nil))
-
- (setq length (1- length))
- (if list (cust-print-original-princ " ")))
-
- (if (and list (= length 0)) (cust-print-original-princ "..."))
- (cust-print-original-princ ")"))))
- list)
-
-
-(defun cust-print-vector (vector)
- ;; Print a vector according to print-length, print-level, and print-circle.
- (if (= cust-print-current-level 0)
- (cust-print-original-princ "#")
- (let ((cust-print-current-level (1- cust-print-current-level))
- (i 0)
- (len (length vector)))
- (cust-print-original-princ "[")
-
- (if print-length
- (setq len (min print-length len)))
- ;; Print the elements
- (while (< i len)
- (cust-print-prin (aref vector i))
- (setq i (1+ i))
- (if (< i (length vector)) (cust-print-original-princ " ")))
-
- (if (< i (length vector)) (cust-print-original-princ "..."))
- (cust-print-original-princ "]")
- ))
- vector)
-
-
-
-;; Circular structure preprocessing
-;;==================================
-
-(defun cust-print-preprocess-circle-tree (object)
- ;; Fill up the table.
- (let (;; Table of tags for each object in an object to be printed.
- ;; A tag is of the form:
- ;; ( <object> <nil-t-or-id-number> )
- ;; The id-number is generated after the entire table has been computed.
- ;; During walk through, the real circle-table lives in the cdr so we
- ;; can use setcdr to add new elements instead of having to setq the
- ;; variable sometimes (poor man's locf).
- (circle-table (list nil)))
- (cust-print-walk-circle-tree object)
-
- ;; Reverse table so it is in the order that the objects will be printed.
- ;; This pass could be avoided if we always added to the end of the
- ;; table with setcdr in walk-circle-tree.
- (setcdr circle-table (nreverse (cdr circle-table)))
-
- ;; Walk through the table, assigning id-numbers to those
- ;; objects which will be printed using #N= syntax. Delete those
- ;; objects which will be printed only once (to speed up assq later).
- (let ((rest circle-table)
- (id -1))
- (while (cdr rest)
- (let ((tag (car (cdr rest))))
- (cond ((cdr tag)
- (setcdr tag id)
- (setq id (1- id))
- (setq rest (cdr rest)))
- ;; Else delete this object.
- (t (setcdr rest (cdr (cdr rest))))))
- ))
- ;; Drop the car.
- (cdr circle-table)
- ))
-
-
-
-(defun cust-print-walk-circle-tree (object)
- (let (read-equivalent-p tag)
- (while object
- (setq read-equivalent-p
- (or (numberp object)
- (and (symbolp object)
- ;; Check if it is uninterned.
- (eq object (intern-soft (symbol-name object)))))
- tag (and (not read-equivalent-p)
- (assq object (cdr circle-table))))
- (cond (tag
- ;; Seen this object already, so note that.
- (setcdr tag t))
-
- ((not read-equivalent-p)
- ;; Add a tag for this object.
- (setcdr circle-table
- (cons (list object)
- (cdr circle-table)))))
- (setq object
- (cond
- (tag ;; No need to descend since we have already.
- nil)
-
- ((consp object)
- ;; Walk the car of the list recursively.
- (cust-print-walk-circle-tree (car object))
- ;; But walk the cdr with the above while loop
- ;; to avoid problems with max-lisp-eval-depth.
- ;; And it should be faster than recursion.
- (cdr object))
-
- ((vectorp object)
- ;; Walk the vector.
- (let ((i (length object))
- (j 0))
- (while (< j i)
- (cust-print-walk-circle-tree (aref object j))
- (setq j (1+ j))))))))))
-
-
-;; Example.
-;;=======================================
-
-'(progn
- (progn
- ;; Create some circular structures.
- (setq circ-sym (let ((x (make-symbol "FOO"))) (list x x)))
- (setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f))
- (setcar (nthcdr 3 circ-list) circ-list)
- (aset (nth 2 circ-list) 2 circ-list)
- (setq dotted-circ-list (list 'a 'b 'c))
- (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list)
- (setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7))
- (aset circ-vector 5 (make-symbol "-gensym-"))
- (setcar (cdr (aref circ-vector 4)) (aref circ-vector 5))
- nil)
-
- (install-custom-print)
- ;; (setq print-circle t)
-
- (let ((print-circle t))
- (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)")
- (error "Circular object with array printing")))
-
- (let ((print-circle t))
- (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)")
- (error "Circular object with array printing")))
-
- (let* ((print-circle t)
- (x (list 'p 'q))
- (y (list (list 'a 'b) x 'foo x)))
- (setcdr (cdr (cdr (cdr y))) (cdr y))
- (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))"
- )
- (error "Circular list example from CL manual")))
-
- (let ((print-circle nil))
- ;; cl-packages.el is required to print uninterned symbols like #:FOO.
- ;; (require 'cl-packages)
- (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)")
- (error "Uninterned symbols in list")))
- (let ((print-circle t))
- (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)")
- (error "Circular uninterned symbols in list")))
-
- (uninstall-custom-print)
- )
-
-(provide 'cust-print)
-
-;;; cust-print.el ends here
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/obsolete/eieio-compat.el
index 553b84af4fc..ead9352695c 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/obsolete/eieio-compat.el
@@ -5,6 +5,7 @@
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
;; Package: eieio
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -70,7 +71,8 @@ is appropriate to use. Uses `defmethod' to create methods, and calls
`defgeneric' for you. With this implementation the ARGS are
currently ignored. You can use `defgeneric' to apply specialized
top level documentation to a method."
- (declare (doc-string 3) (obsolete cl-defgeneric "25.1"))
+ (declare (doc-string 3) (obsolete cl-defgeneric "25.1")
+ (indent defun))
`(eieio--defalias ',method
(eieio--defgeneric-init-form
',method
@@ -103,6 +105,7 @@ Summary:
\"doc-string\"
body)"
(declare (doc-string 3) (obsolete cl-defmethod "25.1")
+ (indent defun)
(debug
(&define ; this means we are defining something
[&name sexp] ;Allow (setf ...) additionally to symbols.
@@ -246,30 +249,10 @@ Summary:
nil)
;;;###autoload
-(defun eieio-defmethod (method args)
- "Obsolete work part of an old version of the `defmethod' macro."
- (declare (obsolete cl-defmethod "24.1"))
- (eval `(defmethod ,method ,@args))
- method)
-
-;;;###autoload
-(defun eieio-defgeneric (method doc-string)
- "Obsolete work part of an old version of the `defgeneric' macro."
- (declare (obsolete cl-defgeneric "24.1"))
- (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
- ;; Return the method
- 'method)
-
-;;;###autoload
(defun eieio-defclass (cname superclasses slots options)
(declare (obsolete eieio-defclass-internal "25.1"))
(eval `(defclass ,cname ,superclasses ,slots ,@options)))
-
-;; Local Variables:
-;; generated-autoload-file: "eieio-loaddefs.el"
-;; End:
-
(provide 'eieio-compat)
;;; eieio-compat.el ends here
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
deleted file mode 100644
index 79ccf804409..00000000000
--- a/lisp/obsolete/erc-hecomplete.el
+++ /dev/null
@@ -1,218 +0,0 @@
-;;; erc-hecomplete.el --- Provides Nick name completion for ERC -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2001-2002, 2004, 2006-2022 Free Software Foundation,
-;; Inc.
-
-;; Author: Alex Schroeder <alex@gnu.org>
-;; URL: https://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
-;; Obsolete-since: 24.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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file is considered obsolete. It is recommended to use
-;; completion from erc-pcomplete instead.
-
-;; This file is based on hippie-expand, while the new file is based on
-;; pcomplete.
-
-;;; Code:
-
-(require 'erc)
-(require 'erc-match); for erc-pals
-(require 'hippie-exp); for the hippie expand stuff
-
-;;;###autoload (autoload 'erc-hecomplete-mode "erc-hecomplete" nil t)
-(define-erc-module hecomplete nil
- "Complete nick at point."
- ((add-hook 'erc-complete-functions #'erc-hecomplete))
- ((remove-hook 'erc-complete-functions #'erc-hecomplete)))
-
-(defun erc-hecomplete ()
- "Complete nick at point.
-See `erc-try-complete-nick' for more technical info.
-This function is obsolete, use `erc-pcomplete' instead."
- (interactive)
- (let ((hippie-expand-try-functions-list '(erc-try-complete-nick)))
- (hippie-expand nil)))
-
-(defgroup erc-hecomplete nil
- "Nick completion. It is recommended to use `erc-pcomplete' instead."
- :group 'erc)
-
-(defcustom erc-nick-completion 'all
- "Determine how the list of nicks is determined during nick completion.
-See `erc-complete-nick' for information on how to activate this.
-
-pals: Use `erc-pals'.
-all: All channel members.
-
-You may also provide your own function that returns a list of completions.
-One example is `erc-nick-completion-exclude-myself',
-or you may use an arbitrary lisp expression."
- :type '(choice (const :tag "List of pals" pals)
- (const :tag "All channel members" all)
- (const :tag "All channel members except yourself"
- erc-nick-completion-exclude-myself)
- (repeat :tag "List" (string :tag "Nick"))
- function
- sexp))
-
-(defcustom erc-nick-completion-ignore-case t
- "Non-nil means don't consider case significant in nick completion.
-Case will be automatically corrected when non-nil.
-For instance if you type \"dely TAB\" the word completes and changes to
-\"delYsid\"."
- :type 'boolean)
-
-(defun erc-nick-completion-exclude-myself ()
- "Get a list of all the channel members except you.
-
-This function returns a list of all the members in the channel, except
-your own nick. This way if you're named foo and someone is called foobar,
-typing \"f o TAB\" will directly give you foobar. Use this with
-`erc-nick-completion'."
- (remove
- (erc-current-nick)
- (erc-get-channel-nickname-list)))
-
-(defcustom erc-nick-completion-postfix ": "
- "When `erc-complete' is used in the first word after the prompt,
-add this string when a unique expansion was found."
- :type 'string)
-
-(defun erc-command-list ()
- "Return a list of strings of the defined user commands."
- (let ((case-fold-search nil))
- (mapcar (lambda (x)
- (concat "/" (downcase (substring (symbol-name x) 8))))
- (apropos-internal "erc-cmd-[A-Z]+"))))
-
-(defun erc-try-complete-nick (old)
- "Complete nick at point.
-This is a function to put on `hippie-expand-try-functions-list'.
-Then use \\[hippie-expand] to expand nicks.
-The type of completion depends on `erc-nick-completion'."
- (try-complete-erc-nick old (cond ((eq erc-nick-completion 'pals) erc-pals)
- ((eq erc-nick-completion 'all)
- (append
- (erc-get-channel-nickname-list)
- (erc-command-list)))
- ((functionp erc-nick-completion)
- (funcall erc-nick-completion))
- (t erc-nick-completion))))
-
-(defvar try-complete-erc-nick-window-configuration nil
- "The window configuration for `try-complete-erc-nick'.
-When called the first time, a window config is stored here,
-and when completion is done, the window config is restored
-from here. See `try-complete-erc-nick-restore' and
-`try-complete-erc-nick'.")
-
-(defun try-complete-erc-nick-restore ()
- "Restore window configuration."
- (if (not try-complete-erc-nick-window-configuration)
- (when (get-buffer "*Completions*")
- (delete-windows-on "*Completions*"))
- (set-window-configuration
- try-complete-erc-nick-window-configuration)
- (setq try-complete-erc-nick-window-configuration nil)))
-
-(defun try-complete-erc-nick (old completions)
- "Try to complete current word depending on `erc-try-complete-nick'.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string). It returns t if a new completion is found, nil otherwise. The
-second argument COMPLETIONS is a list of completions to use. Actually,
-it is only used when OLD is nil. It will be copied to `he-expand-list'
-on the first call. After that, it is no longer used.
-Window configurations are stored in
-`try-complete-erc-nick-window-configuration'."
- (let (expansion
- final
- (alist (if (consp (car completions))
- completions
- (mapcar (lambda (s)
- (if (and (erc-complete-at-prompt)
- (and (not (= (length s) 0))
- (not (eq (elt s 0) ?/))))
- (list (concat s erc-nick-completion-postfix))
- (list (concat s " "))))
- completions))) ; make alist if required
- (completion-ignore-case erc-nick-completion-ignore-case))
- (he-init-string (he-dabbrev-beg) (point))
- ;; If there is a string to complete, complete it using alist.
- ;; expansion is the possible expansion, or t. If expansion is t
- ;; or if expansion is the "real" thing, we are finished (final is
- ;; t). Take care -- expansion can also be nil!
- (unless (string= he-search-string "")
- (setq expansion (try-completion he-search-string alist)
- final (or (eq t expansion)
- (and expansion
- (eq t (try-completion expansion alist))))))
- (cond ((not expansion)
- ;; There is no expansion at all.
- (try-complete-erc-nick-restore)
- (he-reset-string)
- nil)
- ((eq t expansion)
- ;; The user already has the correct expansion.
- (try-complete-erc-nick-restore)
- (he-reset-string)
- t)
- ((and old (string= expansion he-search-string))
- ;; This is the second time around and nothing changed,
- ;; ie. the user tried to expand something incomplete
- ;; without making a choice -- hitting TAB twice, for
- ;; example.
- (try-complete-erc-nick-restore)
- (he-reset-string)
- nil)
- (final
- ;; The user has found the correct expansion.
- (try-complete-erc-nick-restore)
- (he-substitute-string expansion)
- t)
- (t
- ;; We found something but we are not finished. Show a
- ;; completions buffer. Substitute what we found and return
- ;; t.
- (setq try-complete-erc-nick-window-configuration
- (current-window-configuration))
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list (all-completions he-search-string alist)))
- (he-substitute-string expansion)
- t))))
-
-(defun erc-at-beginning-of-line-p (point &optional bol-func)
- (save-excursion
- (funcall (or bol-func
- 'erc-bol))
- (equal point (point))))
-
-(defun erc-complete-at-prompt ()
- "Return t if point is directly after `erc-prompt' when doing completion."
- (erc-at-beginning-of-line-p (he-dabbrev-beg)))
-
-(provide 'erc-hecomplete)
-
-;;; erc-hecomplete.el ends here
-;;
-;; Local Variables:
-;; indent-tabs-mode: t
-;; tab-width: 8
-;; End:
diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el
index 1ca7d5513a4..8f3928d5641 100644
--- a/lisp/obsolete/eudcb-ph.el
+++ b/lisp/obsolete/eudcb-ph.el
@@ -176,9 +176,7 @@ SERVER is either a string naming the server or a list (NAME PORT)."
(setq eudc-ph-process-buffer (get-buffer-create (format " *PH-%s*" host)))
(with-current-buffer eudc-ph-process-buffer
(erase-buffer)
- (setq eudc-ph-read-point (point))
- (and (featurep 'xemacs) (featurep 'mule)
- (set-buffer-file-coding-system 'binary t)))
+ (setq eudc-ph-read-point (point)))
(setq process (open-network-stream "ph" eudc-ph-process-buffer host port))
(if (null process)
(throw 'done nil))
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index 82dd58b40f1..1614935f03a 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -283,10 +283,7 @@ If a number, only buffers greater than this size have processing messages."
(other :tag "always" t)
(integer :tag "size")))
-(defvar fast-lock-save-faces
- (when (featurep 'xemacs)
- ;; XEmacs uses extents for everything, so we have to pick the right ones.
- font-lock-face-list)
+(defvar fast-lock-save-faces nil
"Faces that will be saved in a Font Lock cache file.
If nil, means information for all faces will be saved.")
@@ -707,35 +704,7 @@ See `fast-lock-get-face-properties'."
(while regions
(add-text-properties (nth 0 regions) (nth 1 regions) plist)
(setq regions (nthcdr 2 regions))))))))
-
-;; Functions for XEmacs:
-
-(unless (boundp 'font-lock-syntactic-keywords)
- (defvar font-lock-syntactic-keywords nil))
-
-(unless (boundp 'font-lock-inhibit-thing-lock)
- (defvar font-lock-inhibit-thing-lock nil))
-
-(unless (fboundp 'font-lock-compile-keywords)
- (defalias 'font-lock-compile-keywords #'identity))
-
-(unless (fboundp 'font-lock-eval-keywords)
- (defun font-lock-eval-keywords (keywords)
- (if (symbolp keywords)
- (font-lock-eval-keywords (if (fboundp keywords)
- (funcall keywords)
- (eval keywords t)))
- keywords)))
-
-(unless (fboundp 'font-lock-value-in-major-mode)
- (defun font-lock-value-in-major-mode (alist)
- (if (consp alist)
- (cdr (or (assq major-mode alist) (assq t alist)))
- alist)))
-
-(unless (fboundp 'current-message)
- (defun current-message ()
- ""))
+
;; Install ourselves:
diff --git a/lisp/obsolete/gs.el b/lisp/obsolete/gs.el
index 971e7d2640a..7bf324ceecf 100644
--- a/lisp/obsolete/gs.el
+++ b/lisp/obsolete/gs.el
@@ -116,7 +116,7 @@ FILE is the value to substitute for the place-holder `<file>'."
(/ (* 25.4 mm) 72.0)))
(declare-function x-change-window-property "xfns.c"
- (prop value &optional frame type format outer-p))
+ (prop value &optional frame type format outer-p window-id))
(defun gs-set-ghostview-window-prop (frame spec img-width img-height)
"Set the `GHOSTVIEW' window property of FRAME.
diff --git a/lisp/obsolete/info-edit.el b/lisp/obsolete/info-edit.el
index 6c1be1078ff..6c4c10ca6c2 100644
--- a/lisp/obsolete/info-edit.el
+++ b/lisp/obsolete/info-edit.el
@@ -33,7 +33,6 @@
(make-obsolete-variable 'Info-edit-mode-hook
"editing Info nodes by hand is not recommended." "24.4")
-(define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1")
(defvar Info-edit-mode-map (let ((map (make-sparse-keymap)))
(set-keymap-parent map text-mode-map)
(define-key map "\C-c\C-c" #'Info-cease-edit)
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 3afdf84d5b2..1929d1994e7 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -467,9 +467,7 @@ interfere with other minibuffer usage.")
(switch-to-buffer-other-window . iswitchb-buffer-other-window)
(switch-to-buffer-other-frame . iswitchb-buffer-other-frame)
(display-buffer . iswitchb-display-buffer)))
- (if (fboundp 'command-remapping)
- (define-key map (vector 'remap (car b)) (cdr b))
- (substitute-key-definition (car b) (cdr b) map global-map)))
+ (define-key map (vector 'remap (car b)) (cdr b)))
map)
"Global keymap for `iswitchb-mode'.")
@@ -977,17 +975,7 @@ Return the modified list with the last element prepended to it."
(set-buffer buf))
(with-output-to-temp-buffer temp-buf
- (if (featurep 'xemacs)
-
- ;; XEmacs extents are put on by default, doesn't seem to be
- ;; any way of switching them off.
- (display-completion-list (or iswitchb-matches iswitchb-buflist)
- :help-string "iswitchb "
- :activate-callback
- (lambda (_x _y _z)
- (message "doesn't work yet, sorry!")))
- ;; else running Emacs
- (display-completion-list (or iswitchb-matches iswitchb-buflist))))
+ (display-completion-list (or iswitchb-matches iswitchb-buflist)))
(setq iswitchb-common-match-inserted nil))))
;;; KILL CURRENT BUFFER
@@ -1076,8 +1064,7 @@ Return the modified list with the last element prepended to it."
;; then create a new buffer
(progn
(setq newbufcreated (get-buffer-create buf))
- (if (fboundp 'set-buffer-major-mode)
- (set-buffer-major-mode newbufcreated))
+ (set-buffer-major-mode newbufcreated)
(iswitchb-visit-buffer newbufcreated))
;; else won't create new buffer
(message "no buffer matching `%s'" buf))))
@@ -1326,9 +1313,7 @@ This is an example function which can be hooked on to
"Return non-nil if we should ignore case when matching.
See the variable `iswitchb-case' for details."
(if iswitchb-case
- (if (featurep 'xemacs)
- (isearch-no-upper-case-p iswitchb-text)
- (isearch-no-upper-case-p iswitchb-text t))))
+ (isearch-no-upper-case-p iswitchb-text t)))
;;;###autoload
(define-minor-mode iswitchb-mode
diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el
deleted file mode 100644
index 5b3a76e2f79..00000000000
--- a/lisp/obsolete/mailpost.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer -*- lexical-binding: t; -*-
-
-;; This is in the public domain
-;; since Delp distributed it in 1986 without a copyright notice.
-
-;; This file is part of GNU Emacs.
-
-;; Author: Gary Delp <delp@huey.Udel.Edu>
-;; Maintainer: emacs-devel@gnu.org
-;; Created: 13 Jan 1986
-;; Keywords: mail
-;; Obsolete-since: 24.3
-
-;;; Commentary:
-
-;; Yet another mail interface. this for the rmail system to provide
-;; the missing sendmail interface on systems without /usr/lib/sendmail,
-;; but with /usr/uci/post.
-
-;;; Code:
-
-(require 'mailalias)
-(require 'sendmail)
-
-;; (setq send-mail-function 'post-mail-send-it)
-
-(defun post-mail-send-it ()
- "The MH -post interface for `rmail-mail' to call.
-To use it, include \"(setq send-mail-function \\='post-mail-send-it)\" in
-site-init."
- (let ((errbuf (if mail-interactive
- (generate-new-buffer " post-mail errors")
- 0))
- temfile
- (tembuf (generate-new-buffer " post-mail temp"))
- (case-fold-search nil)
- delimline
- (mailbuf (current-buffer)))
- (unwind-protect
- (with-current-buffer tembuf
- (erase-buffer)
- (insert-buffer-substring mailbuf)
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- ;; Change header-delimiter to be what post-mail expects.
- (mail-sendmail-undelimit-header)
- (setq delimline (point-marker))
- (if mail-aliases
- (expand-mail-aliases (point-min) delimline))
- (goto-char (point-min))
- ;; ignore any blank lines in the header
- (while (and (re-search-forward "\n\n\n*" delimline t)
- (< (point) delimline))
- (replace-match "\n"))
- ;; Find and handle any Fcc fields.
- (let ((case-fold-search t))
- (goto-char (point-min))
- (if (re-search-forward "^Fcc:" delimline t)
- (mail-do-fcc delimline))
- ;; If there is a From and no Sender, put it a Sender.
- (goto-char (point-min))
- (and (re-search-forward "^From:" delimline t)
- (not (save-excursion
- (goto-char (point-min))
- (re-search-forward "^Sender:" delimline t)))
- (progn
- (forward-line 1)
- (insert "Sender: " (user-login-name) "\n")))
- ;; don't send out a blank subject line
- (goto-char (point-min))
- (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
- (replace-match ""))
- (if mail-interactive
- (with-current-buffer errbuf
- (erase-buffer))))
- (with-file-modes 384 (setq temfile (make-temp-file ",rpost")))
- (apply #'call-process
- (append (list (if (boundp 'post-mail-program)
- post-mail-program
- "/usr/uci/lib/mh/post")
- nil errbuf nil
- "-nofilter" "-msgid")
- (if mail-interactive '("-watch") '("-nowatch"))
- (list temfile)))
- (if mail-interactive
- (with-current-buffer errbuf
- (goto-char (point-min))
- (while (re-search-forward "\n\n* *" nil t)
- (replace-match "; "))
- (if (not (zerop (buffer-size)))
- (error "Sending...failed to %s"
- (buffer-substring (point-min) (point-max)))))))
- (kill-buffer tembuf)
- (if (bufferp errbuf)
- (switch-to-buffer errbuf)))))
-
-(provide 'mailpost)
-
-;;; mailpost.el ends here
diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el
deleted file mode 100644
index a9d6bfee604..00000000000
--- a/lisp/obsolete/mouse-sel.el
+++ /dev/null
@@ -1,731 +0,0 @@
-;;; mouse-sel.el --- multi-click selection support -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1993-1995, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Mike Williams <mdub@bigfoot.com>
-;; Keywords: mouse
-;; Obsolete-since: 24.3
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This module provides multi-click mouse support for GNU Emacs versions
-;; 19.18 and later. I've tried to make it behave more like standard X
-;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
-;; Basically:
-;;
-;; * Clicking mouse-1 starts (cancels) selection, dragging extends it.
-;;
-;; * Clicking or dragging mouse-3 extends the selection as well.
-;;
-;; * Double-clicking on word constituents selects words.
-;; Double-clicking on symbol constituents selects symbols.
-;; Double-clicking on quotes or parentheses selects sexps.
-;; Double-clicking on whitespace selects whitespace.
-;; Triple-clicking selects lines.
-;; Quad-clicking selects paragraphs.
-;;
-;; * Selecting sets the region & X primary selection, but does NOT affect
-;; the kill-ring. Because the mouse handlers set the primary selection
-;; directly, mouse-sel sets the variables interprogram-cut-function
-;; and interprogram-paste-function to nil.
-;;
-;; * Clicking mouse-2 inserts the contents of the primary selection at
-;; the mouse position (or point, if mouse-yank-at-point is non-nil).
-;;
-;; * Pressing mouse-2 while selecting or extending copies selection
-;; to the kill ring. Pressing mouse-1 or mouse-3 kills it.
-;;
-;; * Double-clicking mouse-3 also kills selection.
-;;
-;; * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
-;; & mouse-3, but operate on the X secondary selection rather than the
-;; primary selection and region.
-;;
-;; This module requires my thingatpt.el module, which it uses to find the
-;; bounds of words, lines, sexps, etc.
-;;
-;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
-;;
-;;--- Customization -------------------------------------------------------
-;;
-;; * You may want to use none or more of following:
-;;
-;; ;; Enable region highlight
-;; (transient-mark-mode 1)
-;;
-;; ;; But only in the selected window
-;; (setq highlight-nonselected-windows nil)
-;;
-;; ;; Enable pending-delete
-;; (delete-selection-mode 1)
-;;
-;; * You can control the way mouse-sel binds its keys by setting the value
-;; of mouse-sel-default-bindings before loading mouse-sel.
-;;
-;; (a) If mouse-sel-default-bindings = t (the default)
-;;
-;; Mouse sets and insert selection
-;; mouse-1 mouse-select
-;; mouse-2 mouse-insert-selection
-;; mouse-3 mouse-extend
-;;
-;; Selection/kill-ring interaction is disabled
-;; interprogram-cut-function = nil
-;; interprogram-paste-function = nil
-;;
-;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
-;;
-;; Mouse sets selection, and pastes from kill-ring
-;; mouse-1 mouse-select
-;; mouse-2 mouse-insert-selection
-;; mouse-3 mouse-extend
-;; In this mode, mouse-insert-selection just calls mouse-yank-at-click.
-;;
-;; Selection/kill-ring interaction is retained
-;; interprogram-cut-function = gui-select-text
-;; interprogram-paste-function = gui-selection-value
-;;
-;; What you lose is the ability to select some text in
-;; delete-selection-mode and yank over the top of it.
-;;
-;; (c) If mouse-sel-default-bindings = nil, no bindings are made.
-;;
-;; * By default, mouse-insert-selection (mouse-2) inserts the selection at
-;; the mouse position. You can tell it to insert at point instead with:
-;;
-;; (setq mouse-yank-at-point t)
-;;
-;; * I like to leave point at the end of the region nearest to where the
-;; mouse was, even though this makes region highlighting mis-leading (the
-;; cursor makes it look like one extra character is selected). You can
-;; disable this behavior with:
-;;
-;; (setq mouse-sel-leave-point-near-mouse nil)
-;;
-;; * By default, mouse-select cycles the click count after 4 clicks. That
-;; is, clicking mouse-1 five times has the same effect as clicking it
-;; once, clicking six times has the same effect as clicking twice, etc.
-;; Disable this behavior with:
-;;
-;; (setq mouse-sel-cycle-clicks nil)
-;;
-;; * The variables mouse-sel-{set,get}-selection-function control how the
-;; selection is handled. Under X Windows, these variables default so
-;; that the X primary selection is used. Under other windowing systems,
-;; alternate functions are used, which simply store the selection value
-;; in a variable.
-
-;;; Code:
-
-(require 'mouse)
-(require 'thingatpt)
-
-;;=== User Variables ======================================================
-
-(defgroup mouse-sel nil
- "Mouse selection enhancement."
- :group 'mouse)
-
-(defcustom mouse-sel-leave-point-near-mouse t
- "Leave point near last mouse position.
-If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
-of the region nearest to where the mouse last was.
-If nil, point will always be placed at the beginning of the region."
- :type 'boolean)
-
-(defcustom mouse-sel-cycle-clicks t
- "If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks."
- :type 'boolean)
-
-(defcustom mouse-sel-default-bindings t
- "Control mouse bindings."
- :type '(choice (const :tag "none" nil)
- (const :tag "cut and paste" interprogram-cut-paste)
- (other :tag "default bindings" t)))
-
-;;=== Key bindings ========================================================
-
-(defconst mouse-sel-bound-events
- '(;; Primary selection bindings.
- ;;
- ;; Bind keys to `ignore' instead of unsetting them because modes may
- ;; bind `down-mouse-1', for instance, without binding `mouse-1'.
- ;; If we unset `mouse-1', this leads to a bitch_at_user when the
- ;; mouse goes up because no matching binding is found for that.
- ([mouse-1] . ignore)
- ([drag-mouse-1] . ignore)
- ([mouse-3] . ignore)
- ([down-mouse-1] . mouse-select)
- ([down-mouse-3] . mouse-extend)
- ([mouse-2] . mouse-insert-selection)
- ;; Secondary selection bindings.
- ([M-mouse-1] . ignore)
- ([M-drag-mouse-1] . ignore)
- ([M-mouse-3] . ignore)
- ([M-down-mouse-1] . mouse-select-secondary)
- ([M-mouse-2] . mouse-insert-secondary)
- ([M-down-mouse-3] . mouse-extend-secondary))
- "An alist of events that `mouse-sel-mode' binds.")
-
-;;=== User Command ========================================================
-
-(defvar mouse-sel-original-bindings nil)
-
-(defalias 'mouse-sel--ignore #'ignore)
-
-;;;###autoload
-(define-minor-mode mouse-sel-mode
- "Toggle Mouse Sel mode.
-
-Mouse Sel mode is a global minor mode. When enabled, mouse
-selection is enhanced in various ways:
-
-- Double-clicking on symbol constituents selects symbols.
-Double-clicking on quotes or parentheses selects sexps.
-Double-clicking on whitespace selects whitespace.
-Triple-clicking selects lines.
-Quad-clicking selects paragraphs.
-
-- Selecting sets the region & X primary selection, but does NOT affect
-the `kill-ring', nor do the kill-ring functions change the X selection.
-Because the mouse handlers set the primary selection directly,
-mouse-sel sets the variables `interprogram-cut-function' and
-`interprogram-paste-function' to nil.
-
-- Clicking mouse-2 inserts the contents of the primary selection at
-the mouse position (or point, if `mouse-yank-at-point' is non-nil).
-
-- mouse-2 while selecting or extending copies selection to the
-kill ring; mouse-1 or mouse-3 kills it."
- :global t
- (if mouse-sel-mode
- (progn
- ;; If mouse-2 has never been done by the user, initialize the
- ;; `event-kind' property to ensure that `follow-link' clicks
- ;; are interpreted correctly.
- (put 'mouse-2 'event-kind 'mouse-click)
- (add-hook 'x-lost-selection-functions #'mouse-sel-lost-selection-hook)
- (when mouse-sel-default-bindings
- ;; Save original bindings and replace them with new ones.
- (setq mouse-sel-original-bindings
- (mapcar (lambda (binding)
- (let ((event (car binding)))
- (prog1 (cons event (lookup-key global-map event))
- (global-set-key event (cdr binding)))))
- mouse-sel-bound-events))
- ;; Update interprogram functions.
- (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
- (add-function :override interprogram-cut-function
- #'mouse-sel--ignore)
- (add-function :override interprogram-paste-function
- #'mouse-sel--ignore))))
-
- ;; Restore original bindings
- (remove-hook 'x-lost-selection-functions #'mouse-sel-lost-selection-hook)
- (dolist (binding mouse-sel-original-bindings)
- (global-set-key (car binding) (cdr binding)))
- ;; Restore the old values of these variables,
- ;; only if they were actually saved previously.
- (remove-function interprogram-cut-function #'mouse-sel--ignore)
- (remove-function interprogram-paste-function #'mouse-sel--ignore)))
-
-(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.3")
-
-;;=== Internal Variables/Constants ========================================
-
-(defvar mouse-sel-primary-thing nil
- "Type of PRIMARY selection in current buffer.")
-(make-variable-buffer-local 'mouse-sel-primary-thing)
-
-(defvar mouse-sel-secondary-thing nil
- "Type of SECONDARY selection in current buffer.")
-(make-variable-buffer-local 'mouse-sel-secondary-thing)
-
-;; Ensure that secondary overlay is defined
-(unless (overlayp mouse-secondary-overlay)
- (setq mouse-secondary-overlay (make-overlay 1 1))
- (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
-
-(defconst mouse-sel-primary-overlay
- (let ((ol (make-overlay (point-min) (point-min))))
- (delete-overlay ol)
- (overlay-put ol 'face 'region)
- ol)
- "An overlay which records the current primary selection.
-This is used by Mouse Sel mode only.")
-
-(defconst mouse-sel-selection-alist
- '((PRIMARY mouse-sel-primary-overlay mouse-sel-primary-thing)
- (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
- "Alist associating selections with variables.
-Each element is of the form:
-
- (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL)
-
-where SELECTION-NAME = name of selection
- OVERLAY-SYMBOL = name of variable containing overlay to use
- SELECTION-THING-SYMBOL = name of variable where the current selection
- type for this selection should be stored.")
-
-(defvar mouse-sel-set-selection-function
- (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
- 'gui-set-selection
- (lambda (selection value)
- (if (eq selection 'PRIMARY)
- (gui-select-text value)
- (gui-set-selection selection value))))
- "Function to call to set selection.
-Called with two arguments:
-
- SELECTION, the name of the selection concerned, and
- VALUE, the text to store.
-
-This sets the selection, unless `mouse-sel-default-bindings'
-is `interprogram-cut-paste'.")
-
-
-(defvar mouse-sel-get-selection-function
- (lambda (selection)
- (if (eq selection 'PRIMARY)
- (or (gui-selection-value)
- (bound-and-true-p x-last-selected-text-primary)
- gui--last-selected-text-primary)
- (gui-get-selection selection)))
- "Function to call to get the selection.
-Called with one argument:
-
- SELECTION: the name of the selection concerned.")
-
-;;=== Support/access functions ============================================
-
-(defun mouse-sel-determine-selection-thing (nclicks)
- "Determine what `thing' `mouse-sel' should operate on.
-The first argument is NCLICKS, is the number of consecutive
-mouse clicks at the same position.
-
-Double-clicking on word constituents selects words.
-Double-clicking on symbol constituents selects symbols.
-Double-clicking on quotes or parentheses selects sexps.
-Double-clicking on whitespace selects whitespace.
-Triple-clicking selects lines.
-Quad-clicking selects paragraphs.
-
-Feel free to re-define this function to support your own desired
-multi-click semantics."
- (let* ((next-char (char-after (point)))
- (char-syntax (if next-char (char-syntax next-char))))
- (if mouse-sel-cycle-clicks
- (setq nclicks (1+ (% (1- nclicks) 4))))
- (cond
- ((= nclicks 1) nil)
- ((= nclicks 3) 'line)
- ((>= nclicks 4) 'paragraph)
- ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
- ((memq next-char '(?\s ?\t ?\n)) 'whitespace)
- ((eq char-syntax ?_) 'symbol)
- ((eq char-syntax ?w) 'word))))
-
-(defun mouse-sel-set-selection (selection value)
- "Set the specified SELECTION to VALUE."
- (if mouse-sel-set-selection-function
- (funcall mouse-sel-set-selection-function selection value)
- (put 'mouse-sel-internal-selection selection value)))
-
-(defun mouse-sel-get-selection (selection)
- "Get the value of the specified SELECTION."
- (if mouse-sel-get-selection-function
- (funcall mouse-sel-get-selection-function selection)
- (get 'mouse-sel-internal-selection selection)))
-
-(defun mouse-sel-selection-overlay (selection)
- "Return overlay corresponding to SELECTION."
- (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist))))
- (or symbol (error "No overlay corresponding to %s selection" selection))
- (symbol-value symbol)))
-
-(defun mouse-sel-selection-thing (selection)
- "Return overlay corresponding to SELECTION."
- (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist))))
- (or symbol (error "No symbol corresponding to %s selection" selection))
- symbol))
-
-(defun mouse-sel-region-to-primary (orig-window)
- "Convert region to PRIMARY overlay and deactivate region.
-Argument ORIG-WINDOW specifies the window the cursor was in when the
-originating command was issued, and is used to determine whether the
-region was visible or not."
- (if transient-mark-mode
- (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))
- (cond
- ((and mark-active
- (or highlight-nonselected-windows
- (eq orig-window (selected-window))))
- ;; Region was visible, so convert region to overlay
- (move-overlay overlay (region-beginning) (region-end)
- (current-buffer)))
- ((eq orig-window (selected-window))
- ;; Point was visible, so set overlay at point
- (move-overlay overlay (point) (point) (current-buffer)))
- (t
- ;; Nothing was visible, so remove overlay
- (delete-overlay overlay)))
- (setq mark-active nil))))
-
-(defun mouse-sel-primary-to-region (&optional direction)
- "Convert PRIMARY overlay to region.
-Optional argument DIRECTION specifies the mouse drag direction: a value of
-1 indicates that the mouse was dragged left-to-right, otherwise it was
-dragged right-to-left."
- (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY))
- (start (overlay-start overlay))
- (end (overlay-end overlay)))
- (if (eq start end)
- (progn
- (if start (goto-char start))
- (deactivate-mark))
- (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
- (progn
- (goto-char end)
- (push-mark start 'nomsg 'active))
- (goto-char start)
- (push-mark end 'nomsg 'active)))
- (if transient-mark-mode (delete-overlay overlay))))
-
-(defmacro mouse-sel-eval-at-event-end (event &rest forms)
- "Evaluate forms at mouse position.
-Move to the end position of EVENT, execute FORMS, and restore original
-point and window."
- `(let ((posn (event-end ,event)))
- (if posn (mouse-minibuffer-check ,event))
- (if (and posn (not (windowp (posn-window posn))))
- (error "Cursor not in text area of window"))
- (let (orig-window orig-point-marker)
- (setq orig-window (selected-window))
- (if posn (select-window (posn-window posn)))
- (setq orig-point-marker (point-marker))
- (if (and posn (numberp (posn-point posn)))
- (goto-char (posn-point posn)))
- (unwind-protect
- (progn
- ,@forms)
- (goto-char (marker-position orig-point-marker))
- (move-marker orig-point-marker nil)
- (select-window orig-window)))))
-
-(put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
-
-;;=== Select ==============================================================
-
-(defun mouse-select (event)
- "Set region/selection using the mouse.
-
-Click sets point & mark to click position.
-Dragging extends region/selection.
-
-Multi-clicking selects word/lines/paragraphs, as determined by
-'mouse-sel-determine-selection-thing.
-
-Clicking mouse-2 while selecting copies selected text to the kill-ring.
-Clicking mouse-1 or mouse-3 kills the selected text.
-
-This should be bound to a down-mouse event."
- (interactive "@e")
- (let (select)
- (unwind-protect
- (setq select (mouse-select-internal 'PRIMARY event))
- (if (and select (listp select))
- (push (cons 'mouse-2 (cdr event)) unread-command-events)
- (mouse-sel-primary-to-region select)))))
-
-(defun mouse-select-secondary (event)
- "Set secondary selection using the mouse.
-
-Click sets the start of the secondary selection to click position.
-Dragging extends the secondary selection.
-
-Multi-clicking selects word/lines/paragraphs, as determined by
-'mouse-sel-determine-selection-thing.
-
-Clicking mouse-2 while selecting copies selected text to the kill-ring.
-Clicking mouse-1 or mouse-3 kills the selected text.
-
-This should be bound to a down-mouse event."
- (interactive "e")
- (mouse-select-internal 'SECONDARY event))
-
-(defun mouse-select-internal (selection event)
- "Set SELECTION using the mouse, with EVENT as the initial down-event.
-Normally, this returns the direction in which the selection was
-made: a value of 1 indicates that the mouse was dragged
-left-to-right, otherwise it was dragged right-to-left.
-
-However, if `mouse-1-click-follows-link' is non-nil and the
-subsequent mouse events specify following a link, this returns
-the final mouse-event. In that case, the selection is not set."
- (mouse-sel-eval-at-event-end event
- (let ((thing-symbol (mouse-sel-selection-thing selection))
- (overlay (mouse-sel-selection-overlay selection)))
- (set thing-symbol
- (mouse-sel-determine-selection-thing (event-click-count event)))
- (let ((object-bounds (bounds-of-thing-at-point
- (symbol-value thing-symbol))))
- (if object-bounds
- (progn
- (move-overlay overlay
- (car object-bounds) (cdr object-bounds)
- (current-buffer)))
- (move-overlay overlay (point) (point) (current-buffer)))))
- (catch 'follow-link
- (mouse-extend-internal selection event t))))
-
-;;=== Extend ==============================================================
-
-(defun mouse-extend (event)
- "Extend region/selection using the mouse."
- (interactive "e")
- (let ((orig-window (selected-window))
- direction)
- (select-window (posn-window (event-end event)))
- (unwind-protect
- (progn
- (mouse-sel-region-to-primary orig-window)
- (setq direction (mouse-extend-internal 'PRIMARY event)))
- (mouse-sel-primary-to-region direction))))
-
-(defun mouse-extend-secondary (event)
- "Extend secondary selection using the mouse."
- (interactive "e")
- (save-window-excursion
- (mouse-extend-internal 'SECONDARY event)))
-
-(defun mouse-extend-internal (selection &optional initial-event no-process)
- "Extend specified SELECTION using the mouse.
-Track mouse-motion events, adjusting the SELECTION appropriately.
-Optional argument INITIAL-EVENT specifies an initial down-mouse event.
-Optional argument NO-PROCESS means not to process the initial
-event.
-
-See documentation for mouse-select-internal for more details."
- (mouse-sel-eval-at-event-end initial-event
- (let ((orig-cursor-type
- (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
- (unwind-protect
-
- (let* ((thing-symbol (mouse-sel-selection-thing selection))
- (overlay (mouse-sel-selection-overlay selection))
- (orig-window (selected-window))
- (top (nth 1 (window-edges orig-window)))
- (bottom (nth 3 (window-edges orig-window)))
- (mark-active nil) ; inhibit normal region highlight
- (echo-keystrokes 0) ; don't echo mouse events
- min max
- direction
- event)
-
- ;; Get current bounds of overlay
- (if (eq (overlay-buffer overlay) (current-buffer))
- (setq min (overlay-start overlay)
- max (overlay-end overlay))
- (setq min (point)
- max min)
- (set thing-symbol nil))
-
-
- ;; Bar cursor
- (if (fboundp 'modify-frame-parameters)
- (modify-frame-parameters (selected-frame)
- '((cursor-type . bar))))
-
- ;; Handle dragging
- (track-mouse
-
- (while (if (and initial-event (not no-process))
- ;; Use initial event
- (prog1
- (setq event initial-event)
- (setq initial-event nil))
- (setq event (read-event))
- (and (consp event)
- (memq (car event) '(mouse-movement switch-frame))))
-
- (let ((selection-thing (symbol-value thing-symbol))
- (end (event-end event)))
-
- (cond
-
- ;; Ignore any movement outside the frame
- ((eq (car-safe event) 'switch-frame) nil)
- ((and (posn-window end)
- (not (eq (let ((posn-w (posn-window end)))
- (if (windowp posn-w)
- (window-frame posn-w)
- posn-w))
- (window-frame orig-window)))) nil)
-
- ;; Different window, same frame
- ((not (eq (posn-window end) orig-window))
- (let ((end-row (cdr (cdr (mouse-position)))))
- (cond
- ((and end-row (not (bobp)) (< end-row top))
- (mouse-scroll-subr orig-window (- end-row top)
- overlay max))
- ((and end-row (not (eobp)) (>= end-row bottom))
- (mouse-scroll-subr orig-window (1+ (- end-row bottom))
- overlay min))
- )))
-
- ;; On the mode line
- ((eq (posn-point end) 'mode-line)
- (mouse-scroll-subr orig-window 1 overlay min))
-
- ;; In original window
- (t (goto-char (posn-point end)))
-
- )
-
- ;; Determine direction of drag
- (cond
- ((and (not direction) (not (eq min max)))
- (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
- ((and (not (eq direction -1)) (<= (point) min))
- (setq direction -1))
- ((and (not (eq direction 1)) (>= (point) max))
- (setq direction 1)))
-
- (if (not selection-thing) nil
-
- ;; If dragging forward, goal is next character
- (if (and (eq direction 1) (not (eobp))) (forward-char 1))
-
- ;; Move to start/end of selected thing
- (let ((goal (point)))
- (goto-char (if (eq 1 direction) min max))
- (condition-case nil
- (progn
- (while (> (* direction (- goal (point))) 0)
- (forward-thing selection-thing direction))
- (let ((end (point)))
- (forward-thing selection-thing (- direction))
- (goto-char
- (if (> (* direction (- goal (point))) 0)
- end (point)))))
- (error))))
-
- ;; Move overlay
- (move-overlay overlay
- (if (eq 1 direction) min (point))
- (if (eq -1 direction) max (point))
- (current-buffer))
-
- ))) ; end track-mouse
-
- ;; Detect follow-link events
- (when (mouse-sel-follow-link-p initial-event event)
- (throw 'follow-link event))
-
- ;; Finish up after dragging
- (let ((overlay-start (overlay-start overlay))
- (overlay-end (overlay-end overlay)))
-
- ;; Set selection
- (if (not (eq overlay-start overlay-end))
- (mouse-sel-set-selection
- selection
- (buffer-substring overlay-start overlay-end)))
-
- ;; Handle copy/kill
- (let (this-command)
- (cond
- ((eq (event-basic-type last-input-event) 'mouse-2)
- (copy-region-as-kill overlay-start overlay-end)
- (read-event) (read-event))
- ((and (memq (event-basic-type last-input-event)
- '(mouse-1 mouse-3))
- (memq 'down (event-modifiers last-input-event)))
- (kill-region overlay-start overlay-end)
- (move-overlay overlay overlay-start overlay-start)
- (read-event) (read-event))
- ((and (eq (event-basic-type last-input-event) 'mouse-3)
- (memq 'double (event-modifiers last-input-event)))
- (kill-region overlay-start overlay-end)
- (move-overlay overlay overlay-start overlay-start)))))
-
- direction)
-
- ;; Restore cursor
- (if (fboundp 'modify-frame-parameters)
- (modify-frame-parameters
- (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
-
- ))))
-
-(defun mouse-sel-follow-link-p (initial final)
- "Return t if we should follow a link, given INITIAL and FINAL mouse events.
-See `mouse-1-click-follows-link' for details. Currently, Mouse
-Sel mode does not support using a `double' value to follow links
-using double-clicks."
- (and initial final mouse-1-click-follows-link
- (eq (car initial) 'down-mouse-1)
- (mouse-on-link-p (event-start initial))
- (= (posn-point (event-start initial))
- (posn-point (event-end final)))
- (= (event-click-count initial) 1)
- (or (not (integerp mouse-1-click-follows-link))
- (let ((t0 (posn-timestamp (event-start initial)))
- (t1 (posn-timestamp (event-end final))))
- (and (integerp t0) (integerp t1)
- (if (> mouse-1-click-follows-link 0)
- (<= (- t1 t0) mouse-1-click-follows-link)
- (< (- t0 t1) mouse-1-click-follows-link)))))))
-
-;;=== Paste ===============================================================
-
-(defun mouse-insert-selection (event arg)
- "Insert the contents of the PRIMARY selection at mouse click.
-If `mouse-yank-at-point' is non-nil, insert at point instead."
- (interactive "e\nP")
- (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
- (mouse-yank-at-click event arg)
- (mouse-insert-selection-internal 'PRIMARY event)))
-
-(defun mouse-insert-secondary (event)
- "Insert the contents of the SECONDARY selection at mouse click.
-If `mouse-yank-at-point' is non-nil, insert at point instead."
- (interactive "e")
- (mouse-insert-selection-internal 'SECONDARY event))
-
-(defun mouse-insert-selection-internal (selection event)
- "Insert the contents of the named SELECTION at mouse click.
-If `mouse-yank-at-point' is non-nil, insert at point instead."
- (unless mouse-yank-at-point
- (mouse-set-point event))
- (when mouse-sel-get-selection-function
- (push-mark (point) 'nomsg)
- (insert-for-yank
- (or (funcall mouse-sel-get-selection-function selection) ""))))
-
-;;=== Handle loss of selections ===========================================
-
-(defun mouse-sel-lost-selection-hook (selection)
- "Remove the overlay for a lost selection."
- (let ((overlay (mouse-sel-selection-overlay selection)))
- (delete-overlay overlay)))
-
-(provide 'mouse-sel)
-
-;;; mouse-sel.el ends here
diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el
deleted file mode 100644
index 70123e75375..00000000000
--- a/lisp/obsolete/old-emacs-lock.el
+++ /dev/null
@@ -1,102 +0,0 @@
-;;; old-emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1994, 1997, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Tom Wurgler <twurgler@goodyear.com>
-;; Created: 12/8/94
-;; Keywords: extensions, processes
-;; Obsolete-since: 24.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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This code sets a buffer-local variable to t if toggle-emacs-lock is run,
-;; then if the user attempts to exit Emacs, the locked buffer name will be
-;; displayed and the exit aborted. This is just a way of protecting
-;; yourself from yourself. For example, if you have a shell running a big
-;; program and exiting Emacs would abort that program, you may want to lock
-;; that buffer, then if you forget about it after a while, you won't
-;; accidentally exit Emacs. To unlock the buffer, just goto the buffer and
-;; run toggle-emacs-lock again.
-
-;;; Code:
-
-(defvar emacs-lock-from-exiting nil
- "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.")
-(make-variable-buffer-local 'emacs-lock-from-exiting)
-
-(defvar emacs-lock-buffer-locked nil
- "Whether a shell or telnet buffer was locked when its process was killed.")
-(make-variable-buffer-local 'emacs-lock-buffer-locked)
-(put 'emacs-lock-buffer-locked 'permanent-local t)
-
-(defun check-emacs-lock ()
- "Check if variable `emacs-lock-from-exiting' is t for any buffer.
-If any locked buffer is found, signal error and display the buffer's name."
- (save-excursion
- (dolist (buffer (buffer-list))
- (set-buffer buffer)
- (when emacs-lock-from-exiting
- (error "Emacs is locked from exit due to buffer: %s" (buffer-name))))))
-
-(defun toggle-emacs-lock ()
- "Toggle `emacs-lock-from-exiting' for the current buffer.
-See `check-emacs-lock'."
- (interactive)
- (setq emacs-lock-from-exiting (not emacs-lock-from-exiting))
- (if emacs-lock-from-exiting
- (message "Buffer is now locked")
- (message "Buffer is now unlocked")))
-
-(defun emacs-lock-check-buffer-lock ()
- "Check if variable `emacs-lock-from-exiting' is t for a buffer.
-If the buffer is locked, signal error and display its name."
- (when emacs-lock-from-exiting
- (error "Buffer `%s' is locked, can't delete it" (buffer-name))))
-
-; These next defuns make it so if you exit a shell that is locked, the lock
-; is shut off for that shell so you can exit Emacs. Same for telnet.
-; Also, if a shell or a telnet buffer was locked and the process killed,
-; turn the lock back on again if the process is restarted.
-
-(defun emacs-lock-shell-sentinel ()
- (set-process-sentinel
- (get-buffer-process (buffer-name)) (function emacs-lock-clear-sentinel)))
-
-(defun emacs-lock-clear-sentinel (_proc _str)
- (if emacs-lock-from-exiting
- (progn
- (setq emacs-lock-from-exiting nil)
- (setq emacs-lock-buffer-locked t)
- (message "Buffer is now unlocked"))
- (setq emacs-lock-buffer-locked nil)))
-
-(defun emacs-lock-was-buffer-locked ()
- (if emacs-lock-buffer-locked
- (setq emacs-lock-from-exiting t)))
-
-(unless noninteractive
- (add-hook 'kill-emacs-hook #'check-emacs-lock))
-(add-hook 'kill-buffer-hook #'emacs-lock-check-buffer-lock)
-(add-hook 'shell-mode-hook #'emacs-lock-was-buffer-locked)
-(add-hook 'shell-mode-hook #'emacs-lock-shell-sentinel)
-(add-hook 'telnet-mode-hook #'emacs-lock-was-buffer-locked)
-(add-hook 'telnet-mode-hook #'emacs-lock-shell-sentinel)
-
-(provide 'emacs-lock)
-
-;;; old-emacs-lock.el ends here
diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el
index e5c2e28de1d..82017f4dbcf 100644
--- a/lisp/obsolete/otodo-mode.el
+++ b/lisp/obsolete/otodo-mode.el
@@ -908,8 +908,7 @@ If INCLUDE-SEP is non-nil, return point after the separator."
;;;###autoload
(define-derived-mode todo-mode nil "TODO"
"Major mode for editing TODO lists."
- (when (featurep 'xemacs)
- (easy-menu-add todo-menu)))
+ nil)
(with-suppressed-warnings ((lexical date entry))
(defvar date)
diff --git a/lisp/obsolete/patcomp.el b/lisp/obsolete/patcomp.el
deleted file mode 100644
index 2c35cb07007..00000000000
--- a/lisp/obsolete/patcomp.el
+++ /dev/null
@@ -1,24 +0,0 @@
-;;; patcomp.el --- used by patch files to update Emacs releases -*- lexical-binding: t; -*-
-
-;; This file is part of GNU Emacs.
-
-;; Obsolete-since: 24.3
-
-;;; Commentary:
-
-;;; Code:
-
-(defun batch-byte-recompile-emacs ()
- "Recompile the Emacs `lisp' directory.
-This is used after installing the patches for a new version."
- (let ((load-path (list (expand-file-name "lisp"))))
- (byte-recompile-directory "lisp")))
-
-(defun batch-byte-compile-emacs ()
- "Compile new files installed in the Emacs `lisp' directory.
-This is used after installing the patches for a new version.
-It uses the command line arguments to specify the files to compile."
- (let ((load-path (list (expand-file-name "lisp"))))
- (batch-byte-compile)))
-
-;;; patcomp.el ends here
diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el
deleted file mode 100644
index 4c4bfb5b9c7..00000000000
--- a/lisp/obsolete/pc-mode.el
+++ /dev/null
@@ -1,56 +0,0 @@
-;;; pc-mode.el --- emulate certain key bindings used on PCs -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1995, 2001-2022 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: emulations
-;; Obsolete-since: 24.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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-;;;###autoload
-(defun pc-bindings-mode ()
- "Set up certain key bindings for PC compatibility.
-The keys affected are:
-Delete (and its variants) delete forward instead of backward.
-C-Backspace kills backward a word (as C-Delete normally would).
-M-Backspace does undo.
-Home and End move to beginning and end of line
-C-Home and C-End move to beginning and end of buffer.
-C-Escape does list-buffers."
-
- (interactive)
- (define-key function-key-map [delete] "\C-d")
- (define-key function-key-map [M-delete] [?\M-d])
- (define-key function-key-map [C-delete] [?\M-d])
- (global-set-key [C-M-delete] #'kill-sexp)
- (global-set-key [C-backspace] #'backward-kill-word)
- (global-set-key [M-backspace] #'undo)
-
- (global-set-key [C-escape] #'list-buffers)
-
- (global-set-key [home] #'beginning-of-line)
- (global-set-key [end] #'end-of-line)
- (global-set-key [C-home] #'beginning-of-buffer)
- (global-set-key [C-end] #'end-of-buffer))
-
-(provide 'pc-mode)
-
-;;; pc-mode.el ends here
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
deleted file mode 100644
index 922358bcd66..00000000000
--- a/lisp/obsolete/pc-select.el
+++ /dev/null
@@ -1,410 +0,0 @@
-;;; pc-select.el --- emulate mark, cut, copy and paste from Motif -*- lexical-binding: t; -*-
-;;; (or MAC GUI or MS-windoze (bah)) look-and-feel
-;;; including key bindings.
-
-;; Copyright (C) 1995-1997, 2000-2022 Free Software Foundation, Inc.
-
-;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
-;; Keywords: convenience emulations
-;; Created: 26 Sep 1995
-;; Obsolete-since: 24.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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package emulates the mark, copy, cut and paste look-and-feel of motif
-;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows).
-;; It modifies the keybindings of the cursor keys and the next, prior,
-;; home and end keys. They will modify mark-active.
-;; You can still get the old behavior of cursor moving with the
-;; control sequences C-f, C-b, etc.
-;; This package uses transient-mark-mode and
-;; delete-selection-mode.
-;;
-;; In addition to that all key-bindings from the pc-mode are
-;; done here too (as suggested by RMS).
-;;
-;; As I found out after I finished the first version, s-region.el tries
-;; to do the same.... But my code is a little more complete and using
-;; delete-selection-mode is very important for the look-and-feel.
-;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif
-;; compliant keybindings which I added. I had to modify them a little
-;; to add the -mark and -nomark functionality of cursor moving.
-;;
-;; Credits:
-;; Many thanks to all who made comments.
-;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism.
-;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer
-;; and end-of-buffer functions which I modified a little.
-;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup.
-;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com>
-;; for additional motif keybindings.
-;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report
-;; concerning setting of this-command.
-;; Dan Nicolaescu <done@ece.arizona.ro> suggested suppressing the
-;; scroll-up/scroll-down error.
-;; Eli Barzilay (eli@cs.bgu.ac.il) suggested the sexps functions and
-;; keybindings.
-;;
-;; Ok, some details about the idea of PC Selection mode:
-;;
-;; o The standard keys for moving around (right, left, up, down, home, end,
-;; prior, next, called "move-keys" from now on) will always de-activate
-;; the mark.
-;; o If you press "Shift" together with the "move-keys", the region
-;; you pass along is activated
-;; o You have the copy, cut and paste functions (as in many other programs)
-;; which will operate on the active region
-;; It was not possible to bind them to C-v, C-x and C-c for obvious
-;; emacs reasons.
-;; They will be bound according to the "old" behavior to S-delete (cut),
-;; S-insert (paste) and C-insert (copy). These keys do the same in many
-;; other programs.
-;;
-
-;;; Code:
-
-;; Customization:
-(defgroup pc-select nil
- "Emulate pc bindings."
- :prefix "pc-select"
- :group 'emulations)
-
-(define-obsolete-variable-alias 'pc-select-override-scroll-error
- 'scroll-error-top-bottom
- "24.1")
-(defcustom pc-select-override-scroll-error t
- "Non-nil means don't generate error on scrolling past edge of buffer.
-This variable applies in PC Selection mode only.
-The scroll commands normally generate an error if you try to scroll
-past the top or bottom of the buffer. This is annoying when selecting
-text with these commands. If you set this variable to non-nil, these
-errors are suppressed."
- :type 'boolean)
-
-(defcustom pc-select-selection-keys-only nil
- "Non-nil means only bind the basic selection keys when started.
-Other keys that emulate pc-behavior will be untouched.
-This gives mostly Emacs-like behavior with only the selection keys enabled."
- :type 'boolean)
-
-(defcustom pc-select-meta-moves-sexps nil
- "Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
- :type 'boolean)
-
-(defcustom pc-selection-mode-hook nil
- "The hook to run when PC Selection mode is toggled."
- :type 'hook)
-
-(defvar pc-select-saved-settings-alist nil
- "The values of the variables before PC Selection mode was toggled on.
-When PC Selection mode is toggled on, it sets quite a few variables
-for its own purposes. This alist holds the original values of the
-variables PC Selection mode had set, so that these variables can be
-restored to their original values when PC Selection mode is toggled off.")
-
-(defvar pc-select-map nil
- "The keymap used as the global map when PC Selection mode is on." )
-
-(defvar pc-select-saved-global-map nil
- "The global map that was in effect when PC Selection mode was toggled on.")
-
-(defvar pc-select-key-bindings-alist nil
- "This alist holds all the key bindings PC Selection mode sets.")
-
-(defvar pc-select-default-key-bindings nil
- "These key bindings always get set by PC Selection mode.")
-
-(defvar pc-select-extra-key-bindings
- ;; The following keybindings are for standard ISO keyboards
- ;; as they are used with IBM compatible PCs, IBM RS/6000,
- ;; MACs, many X-Stations and probably more.
- '(;; Commented out since it's been standard at least since Emacs-21.
- ;;([S-insert] . yank)
- ;;([C-insert] . copy-region-as-kill)
- ;;([S-delete] . kill-region)
-
- ;; The following bindings are useful on Sun Type 3 keyboards
- ;; They implement the Get-Delete-Put (copy-cut-paste)
- ;; functions from sunview on the L6, L8 and L10 keys
- ;; Sam Steingold <sds@gnu.org> says that f16 is copy and f18 is paste.
- ([f16] . copy-region-as-kill)
- ([f18] . yank)
- ([f20] . kill-region)
-
- ;; The following bindings are from Pete Forman.
- ([f6] . other-window) ; KNextPane F6
- ([C-delete] . kill-line) ; KEraseEndLine cDel
- ("\M-\d" . undo) ; KUndo aBS
-
- ;; The following binding is taken from pc-mode.el
- ;; as suggested by RMS.
- ;; I only used the one that is not covered above.
- ([C-M-delete] . kill-sexp)
- ;; Next line proposed by Eli Barzilay
- ([C-escape] . electric-buffer-list))
- "Key bindings to set only if `pc-select-selection-keys-only' is nil.")
-
-(defvar pc-select-meta-moves-sexps-key-bindings
- '((([M-right] . forward-sexp)
- ([M-left] . backward-sexp))
- (([M-right] . forward-word)
- ([M-left] . backward-word)))
- "The list of key bindings controlled by `pc-select-meta-moves-sexp'.
-The bindings in the car of this list get installed if
-`pc-select-meta-moves-sexp' is t, the bindings in the cadr of this
-list get installed otherwise.")
-
-;; This is for tty. We don't turn on normal-erase-is-backspace,
-;; but bind keys as pc-selection-mode did before
-;; normal-erase-is-backspace was invented, to keep us back
-;; compatible.
-(defvar pc-select-tty-key-bindings
- '(([delete] . delete-char) ; KDelete Del
- ([C-backspace] . backward-kill-word))
- "The list of key bindings controlled by `pc-select-selection-keys-only'.
-These key bindings get installed when running in a tty, but only if
-`pc-select-selection-keys-only' is nil.")
-
-(defvar pc-select-old-M-delete-binding nil
- "Holds the old mapping of [M-delete] in the `function-key-map'.
-This variable holds the value associated with [M-delete] in the
-`function-key-map' before PC Selection mode had changed that
-association.")
-
-;;;;
-;; misc
-;;;;
-
-(provide 'pc-select)
-
-(defun pc-select-define-keys (alist keymap)
- "Make KEYMAP have the key bindings specified in ALIST."
- (let ((lst alist))
- (while lst
- (define-key keymap (caar lst) (cdar lst))
- (setq lst (cdr lst)))))
-
-(defun pc-select-restore-keys (alist keymap saved-map)
- "Use ALIST to restore key bindings from SAVED-MAP into KEYMAP.
-Go through all the key bindings in ALIST, and, for each key
-binding, if KEYMAP and ALIST still agree on the key binding,
-restore the previous value of that key binding from SAVED-MAP."
- (let ((lst alist))
- (while lst
- (when (equal (lookup-key keymap (caar lst)) (cdar lst))
- (define-key keymap (caar lst) (lookup-key saved-map (caar lst))))
- (setq lst (cdr lst)))))
-
-(defmacro pc-select-add-to-alist (alist var val)
- "Ensure that ALIST contains the cons cell (VAR . VAL).
-If a cons cell whose car is VAR is already on the ALIST, update the
-cdr of that cell with VAL. Otherwise, make a new cons cell
-\(VAR . VAL), and prepend it onto ALIST."
- (let ((elt (make-symbol "elt")))
- `(let ((,elt (assq ',var ,alist)))
- (if ,elt
- (setcdr ,elt ,val)
- (setq ,alist (cons (cons ',var ,val) ,alist))))))
-
-(defmacro pc-select-save-and-set-var (var newval)
- "Set VAR to NEWVAL; save the old value.
-The old value is saved on the `pc-select-saved-settings-alist'."
- `(when (boundp ',var)
- (pc-select-add-to-alist pc-select-saved-settings-alist ,var ,var)
- (setq ,var ,newval)))
-
-(defmacro pc-select-save-and-set-mode (mode &optional arg mode-var)
- "Call the function MODE; save the old value of the variable MODE.
-MODE is presumed to be a function which turns on a minor mode. First,
-save the value of the variable MODE on `pc-select-saved-settings-alist'.
-Then, if ARG is specified, call MODE with ARG, otherwise call it with
-nil as an argument. If MODE-VAR is specified, save the value of the
-variable MODE-VAR (instead of the value of the variable MODE) on
-`pc-select-saved-settings-alist'."
- (unless mode-var (setq mode-var mode))
- `(when (fboundp ',mode)
- (pc-select-add-to-alist pc-select-saved-settings-alist
- ,mode-var ,mode-var)
- (,mode ,arg)))
-
-(defmacro pc-select-restore-var (var)
- "Restore the previous value of the variable VAR.
-Look up VAR's previous value in `pc-select-saved-settings-alist', and,
-if the value is found, set VAR to that value."
- (let ((elt (make-symbol "elt")))
- `(let ((,elt (assq ',var pc-select-saved-settings-alist)))
- (unless (null ,elt)
- (setq ,var (cdr ,elt))))))
-
-(defmacro pc-select-restore-mode (mode)
- "Restore the previous state (either on or off) of the minor mode MODE.
-Look up the value of the variable MODE on `pc-select-saved-settings-alist'.
-If the value is non-nil, call the function MODE with an argument of
-1, otherwise call it with an argument of -1."
- (let ((elt (make-symbol "elt")))
- `(when (fboundp ',mode)
- (let ((,elt (assq ',mode pc-select-saved-settings-alist)))
- (unless (null ,elt)
- (,mode (if (cdr ,elt) 1 -1)))))))
-
-
-;;;###autoload
-(define-minor-mode pc-selection-mode
- "Change mark behavior to emulate Motif, Mac or MS-Windows cut and paste style.
-
-This mode enables Delete Selection mode and Transient Mark mode.
-
-The arrow keys (and others) are bound to new functions
-which modify the status of the mark.
-
-The ordinary arrow keys disable the mark.
-The shift-arrow keys move, leaving the mark behind.
-
-C-LEFT and C-RIGHT move back or forward one word, disabling the mark.
-S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind.
-
-M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark.
-S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark
-behind. To control whether these keys move word-wise or sexp-wise set the
-variable `pc-select-meta-moves-sexps' after loading pc-select.el but before
-turning PC Selection mode on.
-
-C-DOWN and C-UP move back or forward a paragraph, disabling the mark.
-S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind.
-
-HOME moves to beginning of line, disabling the mark.
-S-HOME moves to beginning of line, leaving the mark behind.
-With Ctrl or Meta, these keys move to beginning of buffer instead.
-
-END moves to end of line, disabling the mark.
-S-END moves to end of line, leaving the mark behind.
-With Ctrl or Meta, these keys move to end of buffer instead.
-
-PRIOR or PAGE-UP scrolls and disables the mark.
-S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.
-
-S-DELETE kills the region (`kill-region').
-S-INSERT yanks text from the kill ring (`yank').
-C-INSERT copies the region into the kill ring (`copy-region-as-kill').
-
-In addition, certain other PC bindings are imitated (to avoid this, set
-the variable `pc-select-selection-keys-only' to t after loading pc-select.el
-but before calling PC Selection mode):
-
- F6 other-window
- DELETE delete-char
- C-DELETE kill-line
- M-DELETE kill-word
- C-M-DELETE kill-sexp
- C-BACKSPACE backward-kill-word
- M-BACKSPACE undo"
- ;; FIXME: bring pc-bindings-mode here ?
- :global t
-
- (if pc-selection-mode
- (if (null pc-select-key-bindings-alist)
- (progn
- (setq pc-select-saved-global-map (copy-keymap (current-global-map)))
- (setq pc-select-key-bindings-alist
- (append pc-select-default-key-bindings
- (if pc-select-selection-keys-only
- nil
- pc-select-extra-key-bindings)
- (if pc-select-meta-moves-sexps
- (car pc-select-meta-moves-sexps-key-bindings)
- (cadr pc-select-meta-moves-sexps-key-bindings))
- (if (or pc-select-selection-keys-only
- (eq window-system 'x)
- (memq system-type '(ms-dos windows-nt)))
- nil
- pc-select-tty-key-bindings)))
-
- (pc-select-define-keys pc-select-key-bindings-alist
- (current-global-map))
-
- (unless (or pc-select-selection-keys-only
- (eq window-system 'x)
- (memq system-type '(ms-dos windows-nt)))
- ;; it is not clear that we need the following line
- ;; I hope it doesn't do too much harm to leave it in, though...
- (setq pc-select-old-M-delete-binding
- (lookup-key function-key-map [M-delete]))
- (define-key function-key-map [M-delete] [?\M-d]))
-
- (when (and (not pc-select-selection-keys-only)
- (or (eq window-system 'x)
- (memq system-type '(ms-dos windows-nt)))
- (fboundp 'normal-erase-is-backspace-mode))
- (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1
- normal-erase-is-backspace))
- ;; the original author also had this above:
- ;; (setq-default normal-erase-is-backspace t)
- ;; However, the documentation for the variable says that
- ;; "setting it with setq has no effect", so I'm removing it.
-
- (pc-select-save-and-set-var highlight-nonselected-windows nil)
- (pc-select-save-and-set-var transient-mark-mode t)
- (pc-select-save-and-set-var shift-select-mode t)
- (pc-select-save-and-set-var mark-even-if-inactive t)
- (pc-select-save-and-set-mode delete-selection-mode 1))
- ;;else
- ;; If the user turned on pc-selection-mode a second time
- ;; do not clobber the values of the variables that were
- ;; saved from before pc-selection mode was activated --
- ;; just make sure the values are the way we like them.
- (pc-select-define-keys pc-select-key-bindings-alist
- (current-global-map))
- (unless (or pc-select-selection-keys-only
- (eq window-system 'x)
- (memq system-type '(ms-dos windows-nt)))
- ;; it is not clear that we need the following line
- ;; I hope it doesn't do too much harm to leave it in, though...
- (define-key function-key-map [M-delete] [?\M-d]))
- (when (and (not pc-select-selection-keys-only)
- (or (eq window-system 'x)
- (memq system-type '(ms-dos windows-nt)))
- (fboundp 'normal-erase-is-backspace-mode))
- (normal-erase-is-backspace-mode 1))
- (setq highlight-nonselected-windows nil)
- (transient-mark-mode 1)
- (setq mark-even-if-inactive t)
- (delete-selection-mode 1))
- ;;else
- (when pc-select-key-bindings-alist
- (when (and (not pc-select-selection-keys-only)
- (or (eq window-system 'x)
- (memq system-type '(ms-dos windows-nt))))
- (pc-select-restore-mode normal-erase-is-backspace-mode))
-
- (pc-select-restore-keys
- pc-select-key-bindings-alist (current-global-map)
- pc-select-saved-global-map)
-
- (pc-select-restore-var highlight-nonselected-windows)
- (pc-select-restore-var transient-mark-mode)
- (pc-select-restore-var shift-select-mode)
- (pc-select-restore-var mark-even-if-inactive)
- (pc-select-restore-mode delete-selection-mode)
- (and pc-select-old-M-delete-binding
- (define-key function-key-map [M-delete]
- pc-select-old-M-delete-binding))
- (setq pc-select-key-bindings-alist nil
- pc-select-saved-settings-alist nil))))
-(make-obsolete 'pc-selection-mode 'delete-selection-mode "24.1")
-
-;;; pc-select.el ends here
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index 7f2c6df16f6..5542e995c02 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -496,8 +496,7 @@
(defun pgg-parse-armor (string)
(with-temp-buffer
(buffer-disable-undo)
- (unless (featurep 'xemacs)
- (set-buffer-multibyte nil))
+ (set-buffer-multibyte nil)
(insert string)
(pgg-decode-armor-region (point-min)(point))))
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index 734392ff6a3..16ca4e1431b 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -376,8 +376,7 @@ signer's public key from `pgg-default-keyserver-address'."
(if (null signature) nil
(with-temp-buffer
(buffer-disable-undo)
- (unless (featurep 'xemacs)
- (set-buffer-multibyte nil))
+ (set-buffer-multibyte nil)
(insert-file-contents signature)
(cdr (assq 2 (pgg-decode-armor-region
(point-min)(point-max)))))))
diff --git a/lisp/net/rlogin.el b/lisp/obsolete/rlogin.el
index 98b660dcc43..6a06300ae35 100644
--- a/lisp/net/rlogin.el
+++ b/lisp/obsolete/rlogin.el
@@ -1,10 +1,10 @@
;;; rlogin.el --- remote login interface -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1995, 1997-1998, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: unix, comm
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -23,6 +23,9 @@
;;; Commentary:
+;; This library is obsolete.
+;; See: https://debbugs.gnu.org/56461
+
;; Support for remote logins using `rlogin'.
;; This program is layered on top of shell.el; the code here only accounts
;; for the variations needed to handle a remote process, e.g. directory
@@ -35,11 +38,6 @@
;;; Code:
-;; FIXME?
-;; Maybe this file should be obsolete.
-;; https://lists.gnu.org/r/emacs-devel/2013-02/msg00517.html
-;; It only adds rlogin-directory-tracking-mode. Is that useful?
-
(require 'comint)
(require 'shell)
@@ -118,19 +116,15 @@ this variable is set from that."
:type '(choice (const nil) string)
:group 'rlogin)
-(defvar rlogin-mode-map
- (let ((map (if (consp shell-mode-map)
- (cons 'keymap shell-mode-map)
- (copy-keymap shell-mode-map))))
- (define-key map "\C-c\C-c" 'rlogin-send-Ctrl-C)
- (define-key map "\C-c\C-d" 'rlogin-send-Ctrl-D)
- (define-key map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
- (define-key map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
- (define-key map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
- (define-key map "\C-i" 'rlogin-tab-or-complete)
- map)
- "Keymap for `rlogin-mode'.")
-
+(defvar-keymap rlogin-mode-map
+ :doc "Keymap for `rlogin-mode'."
+ :parent shell-mode-map
+ "C-c C-c" #'rlogin-send-Ctrl-C
+ "C-c C-d" #'rlogin-send-Ctrl-D
+ "C-c C-z" #'rlogin-send-Ctrl-Z
+ "C-c C-\\" #'rlogin-send-Ctrl-backslash
+ "C-d" #'rlogin-delchar-or-send-Ctrl-D
+ "TAB" #'rlogin-tab-or-complete)
(defvar rlogin-history nil)
diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el
deleted file mode 100644
index 9dfc9831f4e..00000000000
--- a/lisp/obsolete/s-region.el
+++ /dev/null
@@ -1,123 +0,0 @@
-;;; s-region.el --- set region using shift key -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1994-1995, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder <terra@diku.dk>
-;; Keywords: terminals
-;; Favorite-brand-of-beer: None, I hate beer.
-;; Obsolete-since: 24.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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Having loaded this code you can set the region by holding down the
-;; shift key and move the cursor to the other end of the region. The
-;; functionality provided by this code is similar to that provided by
-;; the editors of Borland International's compilers for ms-dos.
-
-;; Currently, s-region-move may be bound only to events that are vectors
-;; of length one and whose last element is a symbol. Also, the functions
-;; that are given this kind of overlay should be (interactive "p")
-;; functions.
-
-;; If the following keys are not already bound then...
-;; C-insert is bound to copy-region-as-kill
-;; S-delete is bound to kill-region
-;; S-insert is bound to yank
-
-;;; Code:
-
-(defvar s-region-overlay (make-overlay 1 1))
-(overlay-put s-region-overlay 'face 'region)
-(overlay-put s-region-overlay 'priority 1000000) ; for hilit19
-
-(defun s-region-unshift (key)
- "Remove shift modifier from last keypress KEY and return that as a key."
- (if (vectorp key)
- (let ((last (aref key (1- (length key)))))
- (if (symbolp last)
- (let* ((keyname (symbol-name last))
- (pos (string-match "S-" keyname)))
- (if pos
- ;; We skip all initial parts of the event assuming that
- ;; those are setting up the prefix argument to the command.
- (vector (intern (concat (substring keyname 0 pos)
- (substring keyname (+ 2 pos)))))
- (error "Non-shifted key: %S" key)))
- (error "Key does not end in a symbol: %S" key)))
- (error "Non-vector key: %S" key)))
-
-(defun s-region-move-p1 (&rest arg)
- "This is an overlay function to point-moving keys that are interactive \"p\"."
- (interactive "p")
- (apply (function s-region-move) arg))
-
-(defun s-region-move-p2 (&rest arg)
- "This is an overlay function to point-moving keys that are interactive \"P\"."
- (interactive "P")
- (apply (function s-region-move) arg))
-
-(defun s-region-move (&rest arg)
- (if (if mark-active (not (equal last-command 's-region-move)) t)
- (set-mark-command nil)
- (message "")) ; delete the "Mark set" message
- (setq this-command 's-region-move)
- (apply (key-binding (s-region-unshift (this-command-keys))) arg)
- (move-overlay s-region-overlay (mark) (point) (current-buffer))
- (sit-for 1)
- (delete-overlay s-region-overlay))
-
-(defun s-region-bind (keylist &optional map)
- "Bind shifted keys in KEYLIST to `s-region-move-p1' or `s-region-move-p2'.
-Each key in KEYLIST is shifted and bound to one of the `s-region-move'
-functions provided it is already bound to some command or other.
-Optional second argument MAP specifies keymap to add binding to, defaulting
-to global keymap."
- (let ((p2 (list 'scroll-up 'scroll-down
- 'beginning-of-buffer 'end-of-buffer)))
- (or map (setq map global-map))
- (while keylist
- (let* ((key (car keylist))
- (binding (key-binding key)))
- (if (commandp binding)
- (define-key
- map
- (vector (intern (concat "S-" (symbol-name (aref key 0)))))
- (cond ((memq binding p2)
- 's-region-move-p2)
- (t 's-region-move-p1)))))
- (setq keylist (cdr keylist)))))
-
-;; Single keys (plus modifiers) only!
-(s-region-bind
- (list [right] [left] [up] [down]
- [C-left] [C-right] [C-up] [C-down]
- [M-left] [M-right] [M-up] [M-down]
- [next] [previous] [home] [end]
- [C-next] [C-previous] [C-home] [C-end]
- [M-next] [M-previous] [M-home] [M-end]))
-
-(or (global-key-binding [C-insert])
- (global-set-key [C-insert] #'copy-region-as-kill))
-(or (global-key-binding [S-delete])
- (global-set-key [S-delete] #'kill-region))
-(or (global-key-binding [S-insert])
- (global-set-key [S-insert] #'yank))
-
-(provide 's-region)
-
-;;; s-region.el ends here
diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el
deleted file mode 100644
index f8722f6129e..00000000000
--- a/lisp/obsolete/sregex.el
+++ /dev/null
@@ -1,605 +0,0 @@
-;;; sregex.el --- symbolic regular expressions -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1997-1998, 2000-2022 Free Software Foundation, Inc.
-
-;; Author: Bob Glickstein <bobg+sregex@zanshin.com>
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: extensions
-;; Obsolete-since: 24.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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package allows you to write regular expressions using a
-;; totally new, Lisp-like syntax.
-
-;; A "symbolic regular expression" (sregex for short) is a Lisp form
-;; that, when evaluated, produces the string form of the specified
-;; regular expression. Here's a simple example:
-
-;; (sregexq (or "Bob" "Robert")) => "Bob\\|Robert"
-
-;; As you can see, an sregex is specified by placing one or more
-;; special clauses in a call to `sregexq'. The clause in this case is
-;; the `or' of two strings (not to be confused with the Lisp function
-;; `or'). The list of allowable clauses appears below.
-
-;; With sregex, it is never necessary to "escape" magic characters
-;; that are meant to be taken literally; that happens automatically.
-;; For example:
-
-;; (sregexq "M*A*S*H") => "M\\*A\\*S\\*H"
-
-;; It is also unnecessary to "group" parts of the expression together
-;; to overcome operator precedence; that also happens automatically.
-;; For example:
-
-;; (sregexq (opt (or "Bob" "Robert"))) => "\\(?:Bob\\|Robert\\)?"
-
-;; It *is* possible to group parts of the expression in order to refer
-;; to them with numbered backreferences:
-
-;; (sregexq (group (or "Go" "Run"))
-;; ", Spot, "
-;; (backref 1)) => "\\(Go\\|Run\\), Spot, \\1"
-
-;; `sregexq' is a macro. Each time it is used, it constructs a simple
-;; Lisp expression that then invokes a moderately complex engine to
-;; interpret the sregex and render the string form. Because of this,
-;; I don't recommend sprinkling calls to `sregexq' throughout your
-;; code, the way one normally does with string regexes (which are
-;; cheap to evaluate). Instead, it's wiser to precompute the regexes
-;; you need wherever possible instead of repeatedly constructing the
-;; same ones over and over. Example:
-
-;; (let ((field-regex (sregexq (opt "resent-")
-;; (or "to" "cc" "bcc"))))
-;; ...
-;; (while ...
-;; ...
-;; (re-search-forward field-regex ...)
-;; ...))
-
-;; The arguments to `sregexq' are automatically quoted, but the
-;; flipside of this is that it is not straightforward to include
-;; computed (i.e., non-constant) values in `sregexq' expressions. So
-;; `sregex' is a function that is like `sregexq' but which does not
-;; automatically quote its values. Literal sregex clauses must be
-;; explicitly quoted like so:
-
-;; (sregex '(or "Bob" "Robert")) => "Bob\\|Robert"
-
-;; but computed clauses can be included easily, allowing for the reuse
-;; of common clauses:
-
-;; (let ((dotstar '(0+ any))
-;; (whitespace '(1+ (syntax ?-)))
-;; (digits '(1+ (char (?0 . ?9)))))
-;; (sregex 'bol dotstar ":" whitespace digits)) => "^.*:\\s-+[0-9]+"
-
-;; To use this package in a Lisp program, simply (require 'sregex).
-
-;; Here are the clauses allowed in an `sregex' or `sregexq'
-;; expression:
-
-;; - a string
-;; This stands for the literal string. If it contains
-;; metacharacters, they will be escaped in the resulting regex
-;; (using `regexp-quote').
-
-;; - the symbol `any'
-;; This stands for ".", a regex matching any character except
-;; newline.
-
-;; - the symbol `bol'
-;; Stands for "^", matching the empty string at the beginning of a line
-
-;; - the symbol `eol'
-;; Stands for "$", matching the empty string at the end of a line
-
-;; - (group CLAUSE ...)
-;; Groups the given CLAUSEs using "\\(" and "\\)".
-
-;; - (sequence CLAUSE ...)
-
-;; Groups the given CLAUSEs; may or may not use "\\(?:" and "\\)".
-;; Clauses grouped by `sequence' do not count for purposes of
-;; numbering backreferences. Use `sequence' in situations like
-;; this:
-
-;; (sregexq (or "dog" "cat"
-;; (sequence (opt "sea ") "monkey")))
-;; => "dog\\|cat\\|\\(?:sea \\)?monkey"
-
-;; where a single `or' alternate needs to contain multiple
-;; subclauses.
-
-;; - (backref N)
-;; Matches the same string previously matched by the Nth "group" in
-;; the same sregex. N is a positive integer.
-
-;; - (or CLAUSE ...)
-;; Matches any one of the CLAUSEs by separating them with "\\|".
-
-;; - (0+ CLAUSE ...)
-;; Concatenates the given CLAUSEs and matches zero or more
-;; occurrences by appending "*".
-
-;; - (1+ CLAUSE ...)
-;; Concatenates the given CLAUSEs and matches one or more
-;; occurrences by appending "+".
-
-;; - (opt CLAUSE ...)
-;; Concatenates the given CLAUSEs and matches zero or one occurrence
-;; by appending "?".
-
-;; - (repeat MIN MAX CLAUSE ...)
-;; Concatenates the given CLAUSEs and constructs a regex matching at
-;; least MIN occurrences and at most MAX occurrences. MIN must be a
-;; non-negative integer. MAX must be a non-negative integer greater
-;; than or equal to MIN; or MAX can be nil to mean "infinity."
-
-;; - (char CHAR-CLAUSE ...)
-;; Creates a "character class" matching one character from the given
-;; set. See below for how to construct a CHAR-CLAUSE.
-
-;; - (not-char CHAR-CLAUSE ...)
-;; Creates a "character class" matching any one character not in the
-;; given set. See below for how to construct a CHAR-CLAUSE.
-
-;; - the symbol `bot'
-;; Stands for "\\`", matching the empty string at the beginning of
-;; text (beginning of a string or of a buffer).
-
-;; - the symbol `eot'
-;; Stands for "\\'", matching the empty string at the end of text.
-
-;; - the symbol `point'
-;; Stands for "\\=", matching the empty string at point.
-
-;; - the symbol `word-boundary'
-;; Stands for "\\b", matching the empty string at the beginning or
-;; end of a word.
-
-;; - the symbol `not-word-boundary'
-;; Stands for "\\B", matching the empty string not at the beginning
-;; or end of a word.
-
-;; - the symbol `bow'
-;; Stands for "\\<", matching the empty string at the beginning of a
-;; word.
-
-;; - the symbol `eow'
-;; Stands for "\\>", matching the empty string at the end of a word.
-
-;; - the symbol `wordchar'
-;; Stands for the regex "\\w", matching a word-constituent character
-;; (as determined by the current syntax table)
-
-;; - the symbol `not-wordchar'
-;; Stands for the regex "\\W", matching a non-word-constituent
-;; character.
-
-;; - (syntax CODE)
-;; Stands for the regex "\\sCODE", where CODE is a syntax table code
-;; (a single character). Matches any character with the requested
-;; syntax.
-
-;; - (not-syntax CODE)
-;; Stands for the regex "\\SCODE", where CODE is a syntax table code
-;; (a single character). Matches any character without the
-;; requested syntax.
-
-;; - (regex REGEX)
-;; This is a "trapdoor" for including ordinary regular expression
-;; strings in the result. Some regular expressions are clearer when
-;; written the old way: "[a-z]" vs. (sregexq (char (?a . ?z))), for
-;; instance.
-
-;; Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
-;; has one of the following forms:
-
-;; - a character
-;; Adds that character to the set.
-
-;; - a string
-;; Adds all the characters in the string to the set.
-
-;; - A pair (MIN . MAX)
-;; Where MIN and MAX are characters, adds the range of characters
-;; from MIN through MAX to the set.
-
-;;; To do:
-
-;; An earlier version of this package could optionally translate the
-;; symbolic regex into other languages' syntaxes, e.g. Perl. For
-;; instance, with Perl syntax selected, (sregexq (or "ab" "cd")) would
-;; yield "ab|cd" instead of "ab\\|cd". It might be useful to restore
-;; such a facility.
-
-;; - handle multibyte chars in sregex--char-aux
-;; - add support for character classes ([:blank:], ...)
-;; - add support for non-greedy operators *? and +?
-;; - bug: (sregexq (opt (opt ?a))) returns "a??" which is a non-greedy "a?"
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-
-;; Compatibility code for when we didn't have shy-groups
-(defvar sregex--current-sregex nil)
-(defun sregex-info () nil)
-(defmacro sregex-save-match-data (&rest forms) (cons 'save-match-data forms))
-(defun sregex-replace-match (r &optional f l str subexp _x)
- (replace-match r f l str subexp))
-(defun sregex-match-string (c &optional i _x) (match-string c i))
-(defun sregex-match-string-no-properties (count &optional in-string _sregex)
- (match-string-no-properties count in-string))
-(defun sregex-match-beginning (count &optional _sregex) (match-beginning count))
-(defun sregex-match-end (count &optional _sregex) (match-end count))
-(defun sregex-match-data (&optional _sregex) (match-data))
-(defun sregex-backref-num (n &optional _sregex) n)
-
-
-(defun sregex (&rest exps)
- "Symbolic regular expression interpreter.
-This is exactly like `sregexq' (q.v.) except that it evaluates all its
-arguments, so literal sregex clauses must be quoted. For example:
-
- (sregex \\='(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
-
-An argument-evaluating sregex interpreter lets you reuse sregex
-subexpressions:
-
- (let ((dotstar \\='(0+ any))
- (whitespace \\='(1+ (syntax ?-)))
- (digits \\='(1+ (char (?0 . ?9)))))
- (sregex \\='bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\""
- (sregex--sequence exps nil))
-
-(defmacro sregexq (&rest exps)
- "Symbolic regular expression interpreter.
-This macro allows you to specify a regular expression (regexp) in
-symbolic form, and converts it into the string form required by Emacs's
-regex functions such as `re-search-forward' and `looking-at'. Here is
-a simple example:
-
- (sregexq (or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
-
-As you can see, an sregex is specified by placing one or more special
-clauses in a call to `sregexq'. The clause in this case is the `or'
-of two strings (not to be confused with the Lisp function `or'). The
-list of allowable clauses appears below.
-
-With `sregex', it is never necessary to \"escape\" magic characters
-that are meant to be taken literally; that happens automatically.
-For example:
-
- (sregexq \"M*A*S*H\") => \"M\\\\*A\\\\*S\\\\*H\"
-
-It is also unnecessary to \"group\" parts of the expression together
-to overcome operator precedence; that also happens automatically.
-For example:
-
- (sregexq (opt (or \"Bob\" \"Robert\"))) => \"\\\\(Bob\\\\|Robert\\\\)?\"
-
-It *is* possible to group parts of the expression in order to refer
-to them with numbered backreferences:
-
- (sregexq (group (or \"Go\" \"Run\"))
- \", Spot, \"
- (backref 1)) => \"\\\\(Go\\\\|Run\\\\), Spot, \\\\1\"
-
-If `sregexq' needs to introduce its own grouping parentheses, it will
-automatically renumber your backreferences:
-
- (sregexq (opt \"resent-\")
- (group (or \"to\" \"cc\" \"bcc\"))
- \": \"
- (backref 1)) => \"\\\\(resent-\\\\)?\\\\(to\\\\|cc\\\\|bcc\\\\): \\\\2\"
-
-`sregexq' is a macro. Each time it is used, it constructs a simple
-Lisp expression that then invokes a moderately complex engine to
-interpret the sregex and render the string form. Because of this, I
-don't recommend sprinkling calls to `sregexq' throughout your code,
-the way one normally does with string regexes (which are cheap to
-evaluate). Instead, it's wiser to precompute the regexes you need
-wherever possible instead of repeatedly constructing the same ones
-over and over. Example:
-
- (let ((field-regex (sregexq (opt \"resent-\")
- (or \"to\" \"cc\" \"bcc\"))))
- ...
- (while ...
- ...
- (re-search-forward field-regex ...)
- ...))
-
-The arguments to `sregexq' are automatically quoted, but the
-flipside of this is that it is not straightforward to include
-computed (i.e., non-constant) values in `sregexq' expressions. So
-`sregex' is a function that is like `sregexq' but which does not
-automatically quote its values. Literal sregex clauses must be
-explicitly quoted like so:
-
- (sregex \\='(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
-
-but computed clauses can be included easily, allowing for the reuse
-of common clauses:
-
- (let ((dotstar \\='(0+ any))
- (whitespace \\='(1+ (syntax ?-)))
- (digits \\='(1+ (char (?0 . ?9)))))
- (sregex \\='bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\"
-
-Here are the clauses allowed in an `sregex' or `sregexq' expression:
-
-- a string
- This stands for the literal string. If it contains
- metacharacters, they will be escaped in the resulting regex
- (using `regexp-quote').
-
-- the symbol `any'
- This stands for \".\", a regex matching any character except
- newline.
-
-- the symbol `bol'
- Stands for \"^\", matching the empty string at the beginning of a line
-
-- the symbol `eol'
- Stands for \"$\", matching the empty string at the end of a line
-
-- (group CLAUSE ...)
- Groups the given CLAUSEs using \"\\\\(\" and \"\\\\)\".
-
-- (sequence CLAUSE ...)
-
- Groups the given CLAUSEs; may or may not use \"\\\\(\" and \"\\\\)\".
- Clauses grouped by `sequence' do not count for purposes of
- numbering backreferences. Use `sequence' in situations like
- this:
-
- (sregexq (or \"dog\" \"cat\"
- (sequence (opt \"sea \") \"monkey\")))
- => \"dog\\\\|cat\\\\|\\\\(?:sea \\\\)?monkey\"
-
- where a single `or' alternate needs to contain multiple
- subclauses.
-
-- (backref N)
- Matches the same string previously matched by the Nth \"group\" in
- the same sregex. N is a positive integer.
-
-- (or CLAUSE ...)
- Matches any one of the CLAUSEs by separating them with \"\\\\|\".
-
-- (0+ CLAUSE ...)
- Concatenates the given CLAUSEs and matches zero or more
- occurrences by appending \"*\".
-
-- (1+ CLAUSE ...)
- Concatenates the given CLAUSEs and matches one or more
- occurrences by appending \"+\".
-
-- (opt CLAUSE ...)
- Concatenates the given CLAUSEs and matches zero or one occurrence
- by appending \"?\".
-
-- (repeat MIN MAX CLAUSE ...)
- Concatenates the given CLAUSEs and constructs a regex matching at
- least MIN occurrences and at most MAX occurrences. MIN must be a
- non-negative integer. MAX must be a non-negative integer greater
- than or equal to MIN; or MAX can be nil to mean \"infinity.\"
-
-- (char CHAR-CLAUSE ...)
- Creates a \"character class\" matching one character from the given
- set. See below for how to construct a CHAR-CLAUSE.
-
-- (not-char CHAR-CLAUSE ...)
- Creates a \"character class\" matching any one character not in the
- given set. See below for how to construct a CHAR-CLAUSE.
-
-- the symbol `bot'
- Stands for \"\\\\\\=`\", matching the empty string at the beginning of
- text (beginning of a string or of a buffer).
-
-- the symbol `eot'
- Stands for \"\\\\'\", matching the empty string at the end of text.
-
-- the symbol `point'
- Stands for \"\\\\=\\=\", matching the empty string at point.
-
-- the symbol `word-boundary'
- Stands for \"\\\\b\", matching the empty string at the beginning or
- end of a word.
-
-- the symbol `not-word-boundary'
- Stands for \"\\\\B\", matching the empty string not at the beginning
- or end of a word.
-
-- the symbol `bow'
- Stands for \"\\\\=\\<\", matching the empty string at the beginning of a
- word.
-
-- the symbol `eow'
- Stands for \"\\\\=\\>\", matching the empty string at the end of a word.
-
-- the symbol `wordchar'
- Stands for the regex \"\\\\w\", matching a word-constituent character
- (as determined by the current syntax table)
-
-- the symbol `not-wordchar'
- Stands for the regex \"\\\\W\", matching a non-word-constituent
- character.
-
-- (syntax CODE)
- Stands for the regex \"\\\\sCODE\", where CODE is a syntax table code
- (a single character). Matches any character with the requested
- syntax.
-
-- (not-syntax CODE)
- Stands for the regex \"\\\\SCODE\", where CODE is a syntax table code
- (a single character). Matches any character without the
- requested syntax.
-
-- (regex REGEX)
- This is a \"trapdoor\" for including ordinary regular expression
- strings in the result. Some regular expressions are clearer when
- written the old way: \"[a-z]\" vs. (sregexq (char (?a . ?z))), for
- instance.
-
-Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
-has one of the following forms:
-
-- a character
- Adds that character to the set.
-
-- a string
- Adds all the characters in the string to the set.
-
-- A pair (MIN . MAX)
- Where MIN and MAX are characters, adds the range of characters
- from MIN through MAX to the set."
- `(apply 'sregex ',exps))
-
-(defun sregex--engine (exp combine)
- (cond
- ((stringp exp)
- (if (and combine
- (eq combine 'suffix)
- (/= (length exp) 1))
- (concat "\\(?:" (regexp-quote exp) "\\)")
- (regexp-quote exp)))
- ((symbolp exp)
- (cl-ecase exp
- (any ".")
- (bol "^")
- (eol "$")
- (wordchar "\\w")
- (not-wordchar "\\W")
- (bot "\\`")
- (eot "\\'")
- (point "\\=")
- (word-boundary "\\b")
- (not-word-boundary "\\B")
- (bow "\\<")
- (eow "\\>")))
- ((consp exp)
- (funcall (intern (concat "sregex--"
- (symbol-name (car exp))))
- (cdr exp)
- combine))
- (t (error "Invalid expression: %s" exp))))
-
-(defun sregex--sequence (exps combine)
- (if (= (length exps) 1) (sregex--engine (car exps) combine)
- (let ((re (mapconcat
- (lambda (e) (sregex--engine e 'concat))
- exps "")))
- (if (eq combine 'suffix)
- (concat "\\(?:" re "\\)")
- re))))
-
-(defun sregex--or (exps combine)
- (if (= (length exps) 1) (sregex--engine (car exps) combine)
- (let ((re (mapconcat
- (lambda (e) (sregex--engine e 'or))
- exps "\\|")))
- (if (not (eq combine 'or))
- (concat "\\(?:" re "\\)")
- re))))
-
-(defun sregex--group (exps _combine) (concat "\\(" (sregex--sequence exps nil) "\\)"))
-
-(defun sregex--backref (exps _combine) (concat "\\" (int-to-string (car exps))))
-(defun sregex--opt (exps _combine) (concat (sregex--sequence exps 'suffix) "?"))
-(defun sregex--0+ (exps _combine) (concat (sregex--sequence exps 'suffix) "*"))
-(defun sregex--1+ (exps _combine) (concat (sregex--sequence exps 'suffix) "+"))
-
-(defun sregex--char (exps _combine) (sregex--char-aux nil exps))
-(defun sregex--not-char (exps _combine) (sregex--char-aux t exps))
-
-(defun sregex--syntax (exps _combine) (format "\\s%c" (car exps)))
-(defun sregex--not-syntax (exps _combine) (format "\\S%c" (car exps)))
-
-(defun sregex--regex (exps combine)
- (if combine (concat "\\(?:" (car exps) "\\)") (car exps)))
-
-(defun sregex--repeat (exps _combine)
- (let* ((min (or (pop exps) 0))
- (minstr (number-to-string min))
- (max (pop exps)))
- (concat (sregex--sequence exps 'suffix)
- (concat "\\{" minstr ","
- (when max (number-to-string max)) "\\}"))))
-
-(defun sregex--char-range (start end)
- (let ((startc (char-to-string start))
- (endc (char-to-string end)))
- (cond
- ((> end (+ start 2)) (concat startc "-" endc))
- ((> end (+ start 1)) (concat startc (char-to-string (1+ start)) endc))
- ((> end start) (concat startc endc))
- (t startc))))
-
-(defun sregex--char-aux (complement args)
- ;; regex-opt does the same, we should join effort.
- (let ((chars (make-bool-vector 256 nil))) ; Yeah, right!
- (dolist (arg args)
- (cond ((integerp arg) (aset chars arg t))
- ((stringp arg) (mapc (lambda (c) (aset chars c t)) arg))
- ((consp arg)
- (let ((start (car arg))
- (end (cdr arg)))
- (when (> start end)
- (let ((tmp start)) (setq start end) (setq end tmp)))
- ;; now start <= end
- (let ((i start))
- (while (<= i end)
- (aset chars i t)
- (setq i (1+ i))))))))
- ;; now chars is a map of the characters in the class
- (let ((caret (aref chars ?^))
- (dash (aref chars ?-))
- (class (if (aref chars ?\]) "]" "")))
- (aset chars ?^ nil)
- (aset chars ?- nil)
- (aset chars ?\] nil)
-
- (let (start end)
- (dotimes (i 256)
- (if (aref chars i)
- (progn
- (unless start (setq start i))
- (setq end i)
- (aset chars i nil))
- (when start
- (setq class (concat class (sregex--char-range start end)))
- (setq start nil))))
- (if start
- (setq class (concat class (sregex--char-range start end)))))
-
- (if (> (length class) 0)
- (setq class (concat class (if caret "^") (if dash "-")))
- (setq class (concat class (if dash "-") (if caret "^"))))
- (if (and (not complement) (= (length class) 1))
- (regexp-quote class)
- (concat "[" (if complement "^") class "]")))))
-
-(provide 'sregex)
-
-;;; sregex.el ends here
diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el
index 6f0685d3dda..2f1f0e9773c 100644
--- a/lisp/obsolete/starttls.el
+++ b/lisp/obsolete/starttls.el
@@ -287,9 +287,6 @@ GnuTLS requires a port number."
starttls-gnutls-program
starttls-program))))
-(define-obsolete-function-alias 'starttls-any-program-available
- #'starttls-available-p "24.1")
-
(provide 'starttls)
;;; starttls.el ends here
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index c75675ab704..8c4ec8f7e09 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -650,12 +650,8 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
(setq tpu-mark-flag (if transient-mark-mode "" (if (tpu-mark) " @" " ")))
(force-mode-line-update))
-(cond ((featurep 'xemacs)
- (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line)
- (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))
- (t
- (add-hook 'activate-mark-hook 'tpu-update-mode-line)
- (add-hook 'deactivate-mark-hook 'tpu-update-mode-line)))
+(add-hook 'activate-mark-hook 'tpu-update-mode-line)
+(add-hook 'deactivate-mark-hook 'tpu-update-mode-line)
;;;
@@ -727,15 +723,13 @@ Otherwise sets the tpu-match markers to nil and returns nil."
"TPU-edt version of the mark function.
Return the appropriate value of the mark for the current
version of Emacs."
- (cond ((featurep 'xemacs) (mark (not zmacs-regions)))
- (t (and mark-active (mark (not transient-mark-mode))))))
+ (and mark-active (mark (not transient-mark-mode))))
(defun tpu-set-mark (pos)
"TPU-edt version of the `set-mark' function.
Sets the mark at POS and activates the region according to the
current version of Emacs."
- (set-mark pos)
- (when (featurep 'xemacs) (when pos (zmacs-activate-region))))
+ (set-mark pos))
(defun tpu-string-prompt (prompt history-symbol)
"Read a string with PROMPT."
@@ -2306,17 +2300,14 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll."
;;;
(defun tpu-load-xkeys (file)
"Load the TPU-edt X-windows key definitions FILE.
-If FILE is nil, try to load a default file. The default file names are
-`~/.tpu-lucid-keys' for XEmacs, and `~/.tpu-keys' for Emacs."
+If FILE is nil, try to load a default file. The default file name is
+`~/.tpu-keys'."
(interactive "fX key definition file: ")
(cond (file
(setq file (expand-file-name file)))
(tpu-xkeys-file
(setq file (expand-file-name tpu-xkeys-file)))
- ((featurep 'xemacs)
- (setq file (convert-standard-filename
- (expand-file-name "~/.tpu-lucid-keys"))))
- (t
+ (t
(setq file (convert-standard-filename
(expand-file-name "~/.tpu-keys")))
(and (not (file-exists-p file))
diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
index becaac29d8d..17aa73697bc 100644
--- a/lisp/obsolete/tpu-mapper.el
+++ b/lisp/obsolete/tpu-mapper.el
@@ -46,24 +46,14 @@
;;;
(defun tpu-map-key (ident descrip func gold-func)
(interactive)
- (if (featurep 'xemacs)
- (progn
- (setq tpu-key-seq (read-key-sequence
- (format "Press %s%s: " ident descrip))
- tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0))))
- (unless (equal tpu-key tpu-return)
- (set-buffer "Keys")
- (insert (format"(global-set-key %s %s)\n" tpu-key func))
- (set-buffer "Gold-Keys")
- (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))))
- (message "Press %s%s: " ident descrip)
- (setq tpu-key-seq (read-event)
- tpu-key (format "[%s]" tpu-key-seq))
- (unless (equal tpu-key tpu-return)
- (set-buffer "Keys")
- (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
- (set-buffer "Gold-Keys")
- (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))))
+ (message "Press %s%s: " ident descrip)
+ (setq tpu-key-seq (read-event)
+ tpu-key (format "[%s]" tpu-key-seq))
+ (unless (equal tpu-key tpu-return)
+ (set-buffer "Keys")
+ (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
+ (set-buffer "Gold-Keys")
+ (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)))
(set-buffer "Directions")
tpu-key)
@@ -103,8 +93,7 @@ your local X guru can try to figure out why the key is being ignored."
;; Make sure the window is big enough to display the instructions
- (if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36)
- (set-frame-size (selected-frame) 80 36))
+ (set-frame-size (selected-frame) 80 36)
;; Create buffers - Directions, Keys, Gold-Keys
@@ -162,14 +151,9 @@ your local X guru can try to figure out why the key is being ignored."
;; Save <CR> for future reference
- (cond
- ((featurep 'xemacs)
- (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
- (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
- (t
- (message "Hit carriage-return <CR> to continue ")
- (setq tpu-return-seq (read-event))
- (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))))
+ (message "Hit carriage-return <CR> to continue ")
+ (setq tpu-return-seq (read-event))
+ (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))
;; Build the keymap file
@@ -308,24 +292,14 @@ your local X guru can try to figure out why the key is being ignored."
;;
")
- (cond ((featurep 'xemacs)
- (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
- (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq))
- (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n")
- (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n")
- (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n")
- (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n"))
- (t
- (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))))
+ (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))
(append-to-buffer "Keys" 1 (point))
(set-buffer "Keys")
;; Save the key mapping program
- (let ((file
- (convert-standard-filename
- (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys"))))
+ (let ((file (convert-standard-filename "~/.tpu-keys")))
(set-visited-file-name
(read-file-name (format "Save key mapping to file (default %s): " file) "" file)))
(save-buffer)
diff --git a/lisp/mail/uce.el b/lisp/obsolete/uce.el
index 9e367dc6349..2cbbf5dc65d 100644
--- a/lisp/mail/uce.el
+++ b/lisp/obsolete/uce.el
@@ -5,6 +5,7 @@
;; Author: stanislav shalunov <shalunov@mccme.ru>
;; Created: 10 Dec 1996
;; Keywords: mail, uce, unsolicited commercial email
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
@@ -30,26 +31,8 @@
;; uce-reply-to-uce. Please let me know about your changes so I can
;; incorporate them. I'd appreciate it.
-;; -- !!! NOTE !!! ---------------------------------------------
-;;
-;; Replying to spam is at best pointless, but most likely actively
-;; harmful.
-;;
-;; - You will confirm that your email address is valid, thus ensuring
-;; you get more spam.
-;;
-;; - You will leak information and open yourself up for further
-;; attack. For example, they could use your \"geolocation\" to find
-;; your home address and phone number.
-;;
-;; - The sender address is likely fake.
-;;
-;; - You help them refine their methods of spamming.
-;;
-;; Therefore, we strongly recommend that you do not use this package.
-;; Use a spam filter instead, or just delete the spam.
-;;
-;; -------------------------------------------------------------
+;; NOTE: We don't recommend using this feature; see the message in
+;; 'uce-reply-to-uce' for the reasons.
;; The command uce-reply-to-uce, if called when the current message
;; buffer is a UCE, will setup a reply *mail* buffer as follows. It
@@ -234,6 +217,8 @@ These are mostly meant for headers that prevent delivery errors reporting."
(declare-function rmail-maybe-set-message-counters "rmail" ())
(declare-function rmail-toggle-header "rmail" (&optional arg))
+(defvar uce--usage-warning-displayed nil)
+
;;;###autoload
(defun uce-reply-to-uce (&optional _ignored)
"Compose a reply to unsolicited commercial email (UCE).
@@ -379,7 +364,32 @@ You might need to set `uce-mail-reader' before using this."
;; Run hooks before we leave buffer for editing. Reasonable usage
;; might be to set up special key bindings, replace standard
;; functions in mail-mode, etc.
- (run-hooks 'mail-setup-hook 'uce-setup-hook))))
+ (run-hooks 'mail-setup-hook 'uce-setup-hook)))
+ (unless uce--usage-warning-displayed
+ (setq uce--usage-warning-displayed t)
+ (pop-to-buffer (get-buffer-create "uce-reply-to-uce warning"))
+ (insert "\
+-- !!! NOTE !!! ---------------------------------------------
+
+Replying to spam is at best pointless, but most likely actively
+harmful.
+
+- You will confirm that your email address is valid, thus ensuring
+ you get more spam.
+
+- You will leak information and open yourself up for further
+ attack. For example, they could use your \"geolocation\" to find
+ your home address and phone number.
+
+- The sender address is likely fake.
+
+- You help them refine their methods of spamming.
+
+Therefore, we strongly recommend that you do not use this package.
+Use a spam filter instead, or just delete the spam.
+
+-------------------------------------------------------------
+")))
(defun uce-insert-ranting (&optional _ignored)
"Insert text of the usual reply to UCE into current buffer."
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index 7f7ed1260f0..537d65c6587 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -83,8 +83,6 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(repeat :tag "Argument List" :value ("") string))
:version "23.1")
-(define-obsolete-variable-alias 'vc-arch-command 'vc-arch-program "23.1")
-
(defcustom vc-arch-program
(let ((candidates '("tla" "baz")))
(while (and candidates (not (executable-find (car candidates))))
diff --git a/lisp/vc/vc-mtn.el b/lisp/obsolete/vc-mtn.el
index 20fbf92bb12..cd56b290072 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/obsolete/vc-mtn.el
@@ -5,6 +5,7 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc
;; Package: vc
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
diff --git a/lisp/vt-control.el b/lisp/obsolete/vt-control.el
index b80d3505b30..190ccbaa83c 100644
--- a/lisp/vt-control.el
+++ b/lisp/obsolete/vt-control.el
@@ -4,6 +4,7 @@
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: terminals
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
diff --git a/lisp/vt100-led.el b/lisp/obsolete/vt100-led.el
index a6a256a6a74..d741a112aa7 100644
--- a/lisp/vt100-led.el
+++ b/lisp/obsolete/vt100-led.el
@@ -5,6 +5,7 @@
;; Author: Howard Gayle
;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware
+;; Obsolete-since: 29.1
;; This file is part of GNU Emacs.
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index 427aba34150..c99d6a8ba71 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -166,7 +166,7 @@ source block, and the name of the temp file.")
(defvar-local org-babel-comint-async-chunk-callback nil
"Callback function to clean Babel async output results before insertion.
Its single argument is a string consisting of output from the
-comint process. It should return a string that will be be passed
+comint process. It should return a string that will be passed
to `org-babel-insert-result'.")
(defvar-local org-babel-comint-async-dangling nil
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 23ef162a7f3..04af84d2e44 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -480,7 +480,7 @@ value. The value can either be a string or a closure that
evaluates to a string. The closure is evaluated when the source
block is being evaluated (e.g. during execution or export), with
point at the source block. It is not possible to use an
-arbitrary function symbol (e.g. 'some-func), since org uses
+arbitrary function symbol (e.g. `some-func'), since org uses
lexical binding. To achieve the same functionality, call the
function within a closure (e.g. (lambda () (some-func))).
diff --git a/lisp/org/ob-julia.el b/lisp/org/ob-julia.el
index abddca36134..50a44bcf448 100644
--- a/lisp/org/ob-julia.el
+++ b/lisp/org/ob-julia.el
@@ -250,8 +250,8 @@ end")
(defun org-babel-julia-evaluate-external-process
(body result-type result-params column-names-p)
"Evaluate BODY in external julia process.
-If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+If RESULT-TYPE equals `output' then return standard output as a
+string. If RESULT-TYPE equals `value' then return the value of the
last statement in BODY, as elisp."
(cl-case result-type
(value
@@ -274,8 +274,8 @@ last statement in BODY, as elisp."
(defun org-babel-julia-evaluate-session
(session body result-type result-params column-names-p)
"Evaluate BODY in SESSION.
-If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+If RESULT-TYPE equals `output' then return standard output as a
+string. If RESULT-TYPE equals `value' then return the value of the
last statement in BODY, as elisp."
(cl-case result-type
(value
diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el
index 48de0dbad06..b6e78fb7fd8 100644
--- a/lisp/org/ob-lua.el
+++ b/lisp/org/ob-lua.el
@@ -395,7 +395,7 @@ fd:close()"
(org-babel-lua-table-or-string results)))))
(defun org-babel-lua-read-string (string)
- "Strip 's from around Lua string."
+ "Strip \\=' characters from around Lua string."
(org-unbracket-string "'" "'" string))
(provide 'ob-lua)
diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el
index 2f092998d8b..f6729e0ece7 100644
--- a/lisp/org/ob-table.el
+++ b/lisp/org/ob-table.el
@@ -84,7 +84,7 @@ is the equivalent of the following source code block:
#+end_src
NOTE: The quotation marks around the function name,
-'source-block', are optional.
+`source-block', are optional.
NOTE: By default, string variable names are interpreted as
references to source-code blocks, to force interpretation of a
diff --git a/lisp/org/oc.el b/lisp/org/oc.el
index eb5f519cb64..c4cd0268c7c 100644
--- a/lisp/org/oc.el
+++ b/lisp/org/oc.el
@@ -808,6 +808,8 @@ INFO is the export communication channel, as a property list."
(or (plist-get info :citations)
(letrec ((cites nil)
(tree (plist-get info :parse-tree))
+ (definition-cache (make-hash-table :test #'equal))
+ (definition-list nil)
(find-definition
;; Find definition for standard reference LABEL. At
;; this point, it is impossible to rely on
@@ -816,11 +818,21 @@ INFO is the export communication channel, as a property list."
;; un-processed citation objects. So we use
;; a simplified version of the function above.
(lambda (label)
- (org-element-map tree 'footnote-definition
- (lambda (d)
- (and (equal label (org-element-property :label d))
- (or (org-element-contents d) "")))
- info t)))
+ (or (gethash label definition-cache)
+ (org-element-map
+ (or definition-list
+ (setq definition-list
+ (org-element-map
+ tree
+ 'footnote-definition
+ #'identity info)))
+ 'footnote-definition
+ (lambda (d)
+ (and (equal label (org-element-property :label d))
+ (puthash label
+ (or (org-element-contents d) "")
+ definition-cache)))
+ info t))))
(search-cites
(lambda (data)
(org-element-map data '(citation footnote-reference)
@@ -834,7 +846,8 @@ INFO is the export communication channel, as a property list."
(_
(let ((label (org-element-property :label datum)))
(funcall search-cites
- (funcall find-definition label))))))
+ (funcall find-definition label)))))
+ nil)
info nil 'footnote-definition t))))
(funcall search-cites tree)
(let ((result (nreverse cites)))
diff --git a/lisp/org/ol-doi.el b/lisp/org/ol-doi.el
index 94585e4c3e5..56239f65d43 100644
--- a/lisp/org/ol-doi.el
+++ b/lisp/org/ol-doi.el
@@ -44,7 +44,7 @@ PATH is a the path to search for, as a string."
"Export a \"doi\" type link.
PATH is the DOI name. DESC is the description of the link, or
nil. BACKEND is a symbol representing the backend used for
-export. INFO is a a plist containing the export parameters."
+export. INFO is a plist containing the export parameters."
(let ((uri (concat org-link-doi-server-url path)))
(pcase backend
(`html
diff --git a/lisp/org/ol-eshell.el b/lisp/org/ol-eshell.el
index 1dee61b98b8..1ca2aa2b28b 100644
--- a/lisp/org/ol-eshell.el
+++ b/lisp/org/ol-eshell.el
@@ -46,7 +46,7 @@ followed by a colon."
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
(if (get-buffer eshell-buffer-name)
- (pop-to-buffer-same-window eshell-buffer-name)
+ (pop-to-buffer eshell-buffer-name display-comint-buffer-action)
(eshell))
(goto-char (point-max))
(eshell-kill-input)
diff --git a/lisp/org/ol-eww.el b/lisp/org/ol-eww.el
index 69bf1ba62dd..d1bb5195107 100644
--- a/lisp/org/ol-eww.el
+++ b/lisp/org/ol-eww.el
@@ -115,7 +115,7 @@ keep the structure of the Org file."
(setq transform-start (region-beginning))
(setq transform-end (region-end))
;; Deactivate mark if current mark is activate.
- (when (fboundp 'deactivate-mark) (deactivate-mark)))
+ (deactivate-mark))
(message "Transforming links...")
(save-excursion
(goto-char transform-start)
diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el
index 3806d95cdaf..beed216acf9 100644
--- a/lisp/org/ol-man.el
+++ b/lisp/org/ol-man.el
@@ -8,12 +8,12 @@
;;
;; This file is part of GNU Emacs.
;;
-;; This program is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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,
+;; 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.
diff --git a/lisp/org/ol-w3m.el b/lisp/org/ol-w3m.el
index 517329889c6..80d6811a5c5 100644
--- a/lisp/org/ol-w3m.el
+++ b/lisp/org/ol-w3m.el
@@ -72,7 +72,7 @@ so that it can be yanked into an Org buffer with links working correctly."
(setq transform-start (region-beginning))
(setq transform-end (region-end))
;; Deactivate mark if current mark is activate.
- (when (fboundp 'deactivate-mark) (deactivate-mark)))
+ (deactivate-mark))
(message "Transforming links...")
(save-excursion
(goto-char transform-start)
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index a03d85f618a..a0dad926bc2 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -1580,14 +1580,6 @@ non-nil."
nil nil nil))))
(org-link-store-props :type "calendar" :date cd)))
- ((eq major-mode 'w3-mode)
- (setq cpltxt (if (and (buffer-name)
- (not (string-match "Untitled" (buffer-name))))
- (buffer-name)
- (url-view-url t))
- link (url-view-url t))
- (org-link-store-props :type "w3" :url (url-view-url t)))
-
((eq major-mode 'image-mode)
(setq cpltxt (concat "file:"
(abbreviate-file-name buffer-file-name))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 71aac271f7b..a43b083d536 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -1615,7 +1615,7 @@ alpha-down Sort headlines alphabetically, reversed.
The different possibilities will be tried in sequence, and testing stops
if one comparison returns a \"not-equal\". For example, the default
- '(time-up category-keep priority-down)
+ `(time-up category-keep priority-down)'
means: Pull out all entries having a specified time of day and sort them,
in order to make a time schedule for the current day the first thing in the
agenda listing for the day. Of the entries without a time indication, keep
@@ -4124,7 +4124,7 @@ dimming them." ;FIXME: The arg isn't used, actually!
If the header at `org-hd-marker' is blocked according to
`org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
-'invisible and the header is not blocked by checkboxes, set the
+`invisible' and the header is not blocked by checkboxes, set the
text property `org-todo-blocked' to `invisible', otherwise set it
to t."
(when (get-text-property 0 'todo-state entry)
@@ -7399,7 +7399,7 @@ Argument ARG is the prefix argument."
When in a restricted subtree, remove it.
The restriction will span over the entire file if TYPE is `file',
-or if type is '(4), or if the cursor is before the first headline
+or if type is \\='(4), or if the cursor is before the first headline
in the file. Otherwise, only apply the restriction to the current
subtree."
(interactive "P")
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index bfead3aa5af..2fd9a9c74da 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -1816,10 +1816,13 @@ by their respective `org-store-link-plist' properties if present."
;; Load history list for current prompt.
(setq org-capture--prompt-history
(gethash prompt org-capture--prompt-history-table))
- (push (org-completing-read
- (concat (or prompt "Enter string")
- (and default (format " [%s]" default))
- ": ")
+ (push (org-completing-read
+ ;; `format-prompt' is new in Emacs 28.1.
+ (if (fboundp 'format-prompt)
+ (format-prompt (or prompt "Enter string") default)
+ (concat (or prompt "Enter string")
+ (and default (format " [%s]" default))
+ ": "))
completions
nil nil nil 'org-capture--prompt-history default)
strings)
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 081a6178345..fdc9818a5a8 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -219,8 +219,7 @@ Emacs initialization file."
(const :tag "Clock and history" t)
(const :tag "No persistence" nil)))
-(defcustom org-clock-persist-file (convert-standard-filename
- (concat user-emacs-directory "org-clock-save.el"))
+(defcustom org-clock-persist-file (locate-user-emacs-file "org-clock-save.el")
"File to save clock data to."
:group 'org-clock
:type 'string)
@@ -659,7 +658,6 @@ there is no recent clock to choose from."
(if (< i 10)
(+ i ?0)
(+ i (- ?A 10))) m))
- (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
(push s sel-list)))
(run-hooks 'org-clock-before-select-task-hook)
(goto-char (point-min))
@@ -2838,7 +2836,7 @@ a number of clock tables."
(pcase (if range (car range) (plist-get params :tstart))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
- (apply #'encode-time (list 0 0 org-extend-today-until d m y))))
+ (encode-time 0 0 org-extend-today-until d m y)))
(timestamp
(seconds-to-time
(org-matcher-time (or timestamp
@@ -2848,7 +2846,7 @@ a number of clock tables."
(pcase (if range (nth 1 range) (plist-get params :tend))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
- (apply #'encode-time (list 0 0 org-extend-today-until d m y))))
+ (encode-time 0 0 org-extend-today-until d m y)))
(timestamp (seconds-to-time (org-matcher-time timestamp))))))
(while (time-less-p start end)
(unless (bolp) (insert "\n"))
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index c26eb6f10ab..3e394fbab1c 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -39,7 +39,7 @@
(declare-function org-calendar-goto-agenda "org-agenda" ())
(declare-function org-align-tags "org" (&optional all))
(declare-function org-at-heading-p "org" (&optional ignored))
-(declare-function org-at-table.el-p "org" ())
+(declare-function org-at-table.el-p "org-table" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
@@ -199,8 +199,7 @@ extension beyond end of line was not controllable."
(defsubst file-attribute-modification-time (attributes)
"The modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of the last change to the file's contents, and
-is a list of integers (HIGH LOW USEC PSEC) in the same style
-as (current-time)."
+is a Lisp timestamp in the same style as `current-time'."
(nth 5 attributes)))
(unless (fboundp 'file-attribute-size)
@@ -239,7 +238,7 @@ This is a floating point number if the size is too large for an integer."
(if (fboundp 'string-collate-lessp)
(defalias 'org-string-collate-lessp
'string-collate-lessp)
- (defun org-string-collate-lessp (s1 s2 &rest _)
+ (defun org-string-collate-lessp (s1 s2 &optional _ _)
"Return non-nil if STRING1 is less than STRING2 in lexicographic order.
Case is significant."
(string< s1 s2)))
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 9db1406b3fb..20b5b030392 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -4391,6 +4391,7 @@ looking into captions:
;; every element it encounters.
(and (not (eq category 'elements))
(setq category 'elements))))))))
+ (--ignore-list (plist-get info :ignore-list))
--acc)
(letrec ((--walk-tree
(lambda (--data)
@@ -4400,7 +4401,7 @@ looking into captions:
(cond
((not --data))
;; Ignored element in an export context.
- ((and info (memq --data (plist-get info :ignore-list))))
+ ((and info (memq --data --ignore-list)))
;; List of elements or objects.
((not --type) (mapc --walk-tree --data))
;; Unconditionally enter parse trees.
diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el
index a5fea08882f..c7b4bde0d28 100644
--- a/lisp/org/org-feed.el
+++ b/lisp/org/org-feed.el
@@ -406,7 +406,7 @@ it can be a list structured like an entry in `org-feed-alist'."
;; Write the new status
;; We do this only now, in case something goes wrong above, so
- ;; that would would end up with a status that does not reflect
+ ;; that would end up with a status that does not reflect
;; which items truly have been handled
(org-feed-write-status inbox-pos drawer status)
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index b4acec7bdd7..7334050b8b4 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -196,8 +196,7 @@ the link."
:group 'org-id
:type 'boolean)
-(defcustom org-id-locations-file (convert-standard-filename
- (concat user-emacs-directory ".org-id-locations"))
+(defcustom org-id-locations-file (locate-user-emacs-file ".org-id-locations")
"The file for remembering in which file an ID was defined.
This variable is only relevant when `org-id-track-globally' is set."
:group 'org-id
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index b10725bd526..bb0562dde06 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -37,6 +37,7 @@
(declare-function org-mode "org" ())
(declare-function org-show-context "org" (&optional key))
(declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
+(declare-function org-time-convert-to-integer "org-compat" (time))
(defvar org-ts-regexp0)
(defvar ffap-url-regexp)
@@ -257,15 +258,16 @@ ignored in this case."
(defun org-file-newer-than-p (file time)
"Non-nil if FILE is newer than TIME.
-FILE is a filename, as a string, TIME is a list of integers, as
+FILE is a filename, as a string, TIME is a Lisp time value, as
returned by, e.g., `current-time'."
(and (file-exists-p file)
;; Only compare times up to whole seconds as some file-systems
;; (e.g. HFS+) do not retain any finer granularity. As
;; a consequence, make sure we return non-nil when the two
;; times are equal.
- (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2)
- (cl-subseq time 0 2)))))
+ (not (time-less-p (org-time-convert-to-integer
+ (nth 5 (file-attributes file)))
+ (org-time-convert-to-integer time)))))
(defun org-compile-file (source process ext &optional err-msg log-buf spec)
"Compile a SOURCE file using PROCESS.
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 20c20acc320..a590ff87f24 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -208,7 +208,7 @@ this function is called. Otherwise, the current major mode menu is used."
(interactive "@e \nP")
(if (and (= (event-click-count event) 1)
(or (not mark-active)
- (sit-for (/ double-click-time 1000.0))))
+ (sit-for (/ (mouse-double-click-time) 1000.0))))
(progn
(select-window (posn-window (event-start event)))
(when (not (org-mouse-mark-active))
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index bf84c99e042..4507fbe7ddc 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -280,7 +280,7 @@ When NORMALISE is non-nil, the count is divided by the number of values."
collect (cons n (/ (length m) normaliser)))))
(defun org--plot/prime-factors (value)
- "Return the prime decomposition of VALUE, e.g. for 12, '(3 2 2)."
+ "Return the prime decomposition of VALUE, e.g. for 12, \\='(3 2 2)."
(let ((factors '(1)) (i 1))
(while (/= 1 value)
(setq i (1+ i))
diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el
index 5ad73422efa..71d00a7a22b 100644
--- a/lisp/org/org-refile.el
+++ b/lisp/org/org-refile.el
@@ -577,7 +577,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(with-demoted-errors "Bookmark set error: %S"
(bookmark-set bookmark-name))))
(move-marker org-capture-last-stored-marker (point)))
- (when (fboundp 'deactivate-mark) (deactivate-mark))
+ (deactivate-mark)
(run-hooks 'org-after-refile-insert-hook)))
(unless org-refile-keep
(if regionp
@@ -640,11 +640,13 @@ this function appends the default value from
org-refile-target-table))
(completion-ignore-case t)
cdef
- (prompt (concat prompt
- (or (and (car org-refile-history)
- (concat " (default " (car org-refile-history) ")"))
- (and (assoc cbnex tbl) (setq cdef cbnex)
- (concat " (default " cbnex ")"))) ": "))
+ (prompt (let ((default (or (car org-refile-history)
+ (and (assoc cbnex tbl) (setq cdef cbnex)
+ cbnex))))
+ ;; `format-prompt' is new in Emacs 28.1.
+ (if (fboundp 'format-prompt)
+ (format-prompt prompt default)
+ (concat prompt " (default " default ": "))))
pa answ parent-target child parent old-hist)
(setq old-hist org-refile-history)
(setq answ (funcall cfunc prompt tbl nil (not new-nodes)
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 860fd6e5608..c301bc6af1a 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -5465,7 +5465,7 @@ The table is taken from the parameter TXT, or from the buffer at point."
(nreverse table)))))
(defun org-table-collapse-header (table &optional separator max-header-lines)
- "Collapse the lines before 'hline into a single header.
+ "Collapse the lines before `hline' into a single header.
The given TABLE is a list of lists as returned by `org-table-to-lisp'.
The leading lines before the first `hline' symbol are considered
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 06af12339ec..008230500d7 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -3301,7 +3301,7 @@ Replace format-specifiers in the command as noted below and use
%i: The LaTeX fragment to be converted.
For example, this could be used with LaTeXML as
-\"latexmlc 'literal:%i' --profile=math --preload=siunitx.sty 2>/dev/null\"."
+\"latexmlc \\='literal:%i\\=' --profile=math --preload=siunitx.sty 2>/dev/null\"."
:group 'org-latex
:package-version '(Org . "9.4")
:type '(choice
@@ -12160,7 +12160,7 @@ This works in the agenda, and also in an Org buffer."
(progn
(message "[s]et or [r]emove? ")
(equal (read-char-exclusive) ?r))))
- (when (fboundp 'deactivate-mark) (deactivate-mark))
+ (deactivate-mark)
(let ((agendap (equal major-mode 'org-agenda-mode))
l1 l2 m buf pos newhead (cnt 0))
(goto-char end)
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index 81ef002a052..9cf9125aebd 100644
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -2909,7 +2909,7 @@ Starred and \"displaymath\" environments are not numbered."
(defun org-html--unlabel-latex-environment (latex-frag)
"Change environment in LATEX-FRAG string to an unnumbered one.
-For instance, change an 'equation' environment to 'equation*'."
+For instance, change an `equation' environment to `equation*'."
(replace-regexp-in-string
"\\`[ \t]*\\\\begin{\\([^*]+?\\)}"
"\\1*"
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
index 7e40f5bcd0b..a3fe31d7b8f 100644
--- a/lisp/org/ox-icalendar.el
+++ b/lisp/org/ox-icalendar.el
@@ -824,8 +824,7 @@ as a communication channel."
(if (not (plist-get info :with-author)) ""
(org-export-data (plist-get info :author) info))
;; Timezone.
- (if (org-string-nw-p org-icalendar-timezone) org-icalendar-timezone
- (cadr (current-time-zone)))
+ (or (org-string-nw-p org-icalendar-timezone) (format-time-string "%Z"))
;; Description.
(org-export-data (plist-get info :title) info)
contents))
@@ -972,7 +971,7 @@ This function assumes major mode for current buffer is
(org-icalendar--vcalendar
org-icalendar-combined-name
user-full-name
- (or (org-string-nw-p org-icalendar-timezone) (cadr (current-time-zone)))
+ (or (org-string-nw-p org-icalendar-timezone) (format-time-string "%Z"))
org-icalendar-combined-description
contents)))
(run-hook-with-args 'org-icalendar-after-save-hook file)))
@@ -995,7 +994,7 @@ FILES is a list of files to build the calendar from."
user-full-name
;; Timezone.
(or (org-string-nw-p org-icalendar-timezone)
- (cadr (current-time-zone)))
+ (format-time-string "Z"))
;; Description.
org-icalendar-combined-description
;; Contents.
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index 636bd0d2ae3..51e2352b4e8 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -839,7 +839,7 @@ in `org-export-options-alist' or in export back-ends. In the
latter case, optional argument BACKEND has to be set to the
back-end where the option is defined, e.g.,
- (org-publish-find-property file :subtitle 'latex)
+ (org-publish-find-property file :subtitle \\='latex)
Return value may be a string or a list, depending on the type of
PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 2a3edaa500f..ae7e41e576b 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -1923,28 +1923,34 @@ Return a string."
(and (not greaterp)
(memq type org-element-recursive-objects)))
(contents
- (mapconcat
- (lambda (element) (org-export-data element info))
- (org-element-contents
- (if (or greaterp objectp) data
- ;; Elements directly containing
- ;; objects must have their indentation
- ;; normalized first.
- (org-element-normalize-contents
- data
- ;; When normalizing first paragraph
- ;; of an item or
- ;; a footnote-definition, ignore
- ;; first line's indentation.
- (and
- (eq type 'paragraph)
- (memq (org-element-type parent)
- '(footnote-definition item))
- (eq (car (org-element-contents parent))
- data)
- (eq (org-element-property :pre-blank parent)
- 0)))))
- "")))
+ (let ((export-buffer (current-buffer)))
+ (with-temp-buffer
+ (dolist (element (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing
+ ;; objects must have their indentation
+ ;; normalized first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing first paragraph
+ ;; of an item or
+ ;; a footnote-definition, ignore
+ ;; first line's indentation.
+ (and
+ (eq type 'paragraph)
+ (memq (org-element-type parent)
+ '(footnote-definition item))
+ (eq (car (org-element-contents parent))
+ data)
+ (eq (org-element-property :pre-blank parent)
+ 0))))))
+ (insert
+ ;; Use right local variable
+ ;; environment if there are, for
+ ;; example, #+BIND variables.
+ (with-current-buffer export-buffer
+ (org-export-data element info))))
+ (buffer-string)))))
(broken-link-handler
(funcall transcoder data
(if (not greaterp) contents
@@ -2956,11 +2962,12 @@ Return code as a string."
(mapcar (lambda (o) (and (eq (nth 4 o) 'parse) (nth 1 o)))
(append (org-export-get-all-options backend)
org-export-options-alist))))
- tree)
+ tree modified-tick)
;; Update communication channel and get parse tree. Buffer
;; isn't parsed directly. Instead, all buffer modifications
;; and consequent parsing are undertaken in a temporary copy.
(org-export-with-buffer-copy
+ (font-lock-mode -1)
;; Run first hook with current back-end's name as argument.
(run-hook-with-args 'org-export-before-processing-hook
(org-export-backend-name backend))
@@ -2972,6 +2979,7 @@ Return code as a string."
;; potentially invasive changes.
(org-set-regexps-and-options)
(org-update-radio-target-regexp)
+ (setq modified-tick (buffer-chars-modified-tick))
;; Possibly execute Babel code. Re-run a macro expansion
;; specifically for {{{results}}} since inline source blocks
;; may have generated some more. Refresh buffer properties
@@ -2979,8 +2987,10 @@ Return code as a string."
(when org-export-use-babel
(org-babel-exp-process-buffer)
(org-macro-replace-all '(("results" . "$1")) parsed-keywords)
- (org-set-regexps-and-options)
- (org-update-radio-target-regexp))
+ (unless (eq modified-tick (buffer-chars-modified-tick))
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp))
+ (setq modified-tick (buffer-chars-modified-tick)))
;; Run last hook with current back-end's name as argument.
;; Update buffer properties and radio targets one last time
;; before parsing.
@@ -2988,8 +2998,10 @@ Return code as a string."
(save-excursion
(run-hook-with-args 'org-export-before-parsing-hook
(org-export-backend-name backend)))
- (org-set-regexps-and-options)
- (org-update-radio-target-regexp)
+ (unless (eq modified-tick (buffer-chars-modified-tick))
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp))
+ (setq modified-tick (buffer-chars-modified-tick))
;; Update communication channel with environment.
(setq info
(org-combine-plists
@@ -3748,28 +3760,33 @@ definition can be found, raise an error."
(if (not label) (org-element-contents footnote-reference)
(let ((cache (or (plist-get info :footnote-definition-cache)
(let ((hash (make-hash-table :test #'equal)))
+ ;; Cache all the footnotes in document for
+ ;; later search.
+ (org-element-map (plist-get info :parse-tree)
+ '(footnote-definition footnote-reference)
+ (lambda (f)
+ ;; Skip any standard footnote reference
+ ;; since those cannot contain a
+ ;; definition.
+ (unless (eq (org-element-property :type f) 'standard)
+ (puthash
+ (cons :element (org-element-property :label f))
+ f
+ hash)))
+ info)
(plist-put info :footnote-definition-cache hash)
hash))))
(or
(gethash label cache)
(puthash label
- (org-element-map (plist-get info :parse-tree)
- '(footnote-definition footnote-reference)
- (lambda (f)
- (cond
- ;; Skip any footnote with a different label.
- ;; Also skip any standard footnote reference
- ;; with the same label since those cannot
- ;; contain a definition.
- ((not (equal (org-element-property :label f) label)) nil)
- ((eq (org-element-property :type f) 'standard) nil)
- ((org-element-contents f))
- ;; Even if the contents are empty, we can not
- ;; return nil since that would eventually raise
- ;; the error. Instead, return the equivalent
- ;; empty string.
- (t "")))
- info t)
+ (let ((hashed (gethash (cons :element label) cache)))
+ (when hashed
+ (or (org-element-contents hashed)
+ ;; Even if the contents are empty, we can not
+ ;; return nil since that would eventually raise
+ ;; the error. Instead, return the equivalent
+ ;; empty string.
+ "")))
cache)
(error "Definition not found for footnote %s" label))))))
@@ -4341,17 +4358,27 @@ significant."
(let* ((search-cells (org-export-string-to-search-cell
(org-element-property :path link)))
(link-cache (or (plist-get info :resolve-fuzzy-link-cache)
- (let ((table (make-hash-table :test #'eq)))
+ (let ((table (make-hash-table :test #'equal)))
+ ;; Cache all the element search cells.
+ (org-element-map (plist-get info :parse-tree)
+ (append pseudo-types '(target) org-element-all-elements)
+ (lambda (datum)
+ (dolist (cell (org-export-search-cells datum))
+ (if (gethash cell table)
+ (push datum (gethash cell table))
+ (puthash cell (list datum) table)))))
(plist-put info :resolve-fuzzy-link-cache table)
table)))
(cached (gethash search-cells link-cache 'not-found)))
(if (not (eq cached 'not-found)) cached
(let ((matches
- (org-element-map (plist-get info :parse-tree)
- (append pseudo-types '(target) org-element-all-elements)
- (lambda (datum)
- (and (org-export-match-search-cell-p datum search-cells)
- datum)))))
+ (let (result)
+ (dolist (search-cell search-cells)
+ (setq result
+ (nconc
+ result
+ (gethash search-cell link-cache))))
+ (delq nil result))))
(unless matches
(signal 'org-link-broken (list (org-element-property :path link))))
(puthash
@@ -4378,15 +4405,27 @@ tree or a file name. Assume LINK type is either \"id\" or
\"custom-id\". Throw an error if no match is found."
(let ((id (org-element-property :path link)))
;; First check if id is within the current parse tree.
- (or (org-element-map (plist-get info :parse-tree) 'headline
- (lambda (headline)
- (when (or (equal (org-element-property :ID headline) id)
- (equal (org-element-property :CUSTOM_ID headline) id))
- headline))
- info 'first-match)
- ;; Otherwise, look for external files.
- (cdr (assoc id (plist-get info :id-alist)))
- (signal 'org-link-broken (list id)))))
+ (or (let ((local-ids (or (plist-get info :id-local-cache)
+ (let ((table (make-hash-table :test #'equal)))
+ (org-element-map
+ (plist-get info :parse-tree)
+ 'headline
+ (lambda (headline)
+ (let ((id (org-element-property :ID headline))
+ (custom-id (org-element-property :CUSTOM_ID headline)))
+ (when id
+ (unless (gethash id table)
+ (puthash id headline table)))
+ (when custom-id
+ (unless (gethash custom-id table)
+ (puthash custom-id headline table)))))
+ info)
+ (plist-put info :id-local-cache table)
+ table))))
+ (gethash id local-ids))
+ ;; Otherwise, look for external files.
+ (cdr (assoc id (plist-get info :id-alist)))
+ (signal 'org-link-broken (list id)))))
(defun org-export-resolve-radio-link (link info)
"Return radio-target object referenced as LINK destination.
diff --git a/lisp/outline.el b/lisp/outline.el
index 00a557ca4e8..38a37fb74d3 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -1,7 +1,6 @@
;;; outline.el --- outline mode commands for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1986, 1993-1995, 1997, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1986-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: outlines
@@ -35,6 +34,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup outlines nil
"Support for hierarchical outlining."
:prefix "outline-"
@@ -180,7 +181,7 @@ in the file it applies to.")
This option controls, in Outline minor mode, where on a heading typing
the key sequences bound to visibility-cycling commands like `outline-cycle'
and `outline-cycle-buffer' will invoke those commands. By default, you can
-invoke these commands by typing `TAB' and `S-TAB' anywhere on a heading line,
+invoke these commands by typing \\`TAB' and \\`S-TAB' anywhere on a heading line,
but customizing this option can make those bindings be in effect only at
specific positions on the heading, like only at the line's beginning or
line's end. This allows these keys to be bound to their usual commands,
@@ -194,6 +195,7 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil."
(function :tag "Custom filter function"))
:version "28.1")
+(defvar outline-minor-mode-cycle)
(defun outline-minor-mode-cycle--bind (map key binding &optional filter)
(define-key map key
`(menu-item
@@ -202,8 +204,10 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil."
:filter
,(or filter
(lambda (cmd)
- (when (or (not (functionp outline-minor-mode-cycle-filter))
- (funcall outline-minor-mode-cycle-filter))
+ (when (and outline-minor-mode-cycle
+ (outline-on-heading-p t)
+ (or (not (functionp outline-minor-mode-cycle-filter))
+ (funcall outline-minor-mode-cycle-filter)))
cmd))))))
(defvar outline-minor-mode-cycle-map
@@ -228,16 +232,10 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil."
(defvar outline-font-lock-keywords
'(
;; Highlight headings according to the level.
- (eval . (list (concat "^\\(?:" outline-regexp "\\).+")
+ (eval . (list (concat "^\\(?:" outline-regexp "\\).*")
0 '(if outline-minor-mode
- (if outline-minor-mode-cycle
- (if outline-minor-mode-highlight
- (list 'face (outline-font-lock-face)
- 'keymap outline-minor-mode-cycle-map)
- (list 'face nil
- 'keymap outline-minor-mode-cycle-map))
- (if outline-minor-mode-highlight
- (list 'face (outline-font-lock-face))))
+ (if outline-minor-mode-highlight
+ (list 'face (outline-font-lock-face)))
(outline-font-lock-face))
(when outline-minor-mode
(pcase outline-minor-mode-highlight
@@ -281,6 +279,25 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil."
(defvar outline-font-lock-faces
[outline-1 outline-2 outline-3 outline-4
outline-5 outline-6 outline-7 outline-8])
+
+(defcustom outline-minor-mode-use-buttons nil
+ "If non-nil, use clickable buttons on the headings.
+Note that this feature is not meant to be used in editing
+buffers (yet) -- that will be amended in a future version.
+
+The `outline-minor-mode-buttons' variable specifies how the
+buttons should look."
+ :type 'boolean
+ :safe #'booleanp
+ :version "29.1")
+
+(defcustom outline-minor-mode-buttons
+ '(("▶️" "🔽" outline--valid-emoji-p)
+ ("▶" "▼" outline--valid-char-p))
+ "List of close/open pairs to use if using buttons."
+ :type 'sexp
+ :version "29.1")
+
(defvar outline-level #'outline-level
"Function of no args to compute a header's nesting level in an outline.
@@ -303,8 +320,11 @@ data reflects the `outline-regexp'.")
(defvar outline-mode-hook nil
"This hook is run when outline mode starts.")
-(defvar outline-blank-line nil
- "Non-nil means to leave unhidden blank line before heading.")
+(defcustom outline-blank-line nil
+ "Non-nil means to leave an unhidden blank line before headings."
+ :type 'boolean
+ :safe #'booleanp
+ :version "22.1")
;;;###autoload
(define-derived-mode outline-mode text-mode "Outline"
@@ -342,7 +362,8 @@ Turning on outline mode calls the value of `text-mode-hook' and then of
'(outline-font-lock-keywords t nil nil backward-paragraph))
(setq-local imenu-generic-expression
(list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
- (add-hook 'change-major-mode-hook #'outline-show-all nil t))
+ (add-hook 'change-major-mode-hook #'outline-show-all nil t)
+ (add-hook 'hack-local-variables-hook #'outline-apply-default-state nil t))
(defvar outline-minor-mode-map)
@@ -359,16 +380,16 @@ After that, changing the prefix key requires manipulating keymaps."
(defcustom outline-minor-mode-cycle nil
"Enable visibility-cycling commands on headings in `outline-minor-mode'.
-If enabled, typing `TAB' on a heading line cycles the visibility
+If enabled, typing \\`TAB' on a heading line cycles the visibility
state of that heading's body between `hide all', `headings only'
-and `show all' (`outline-cycle'), and typing `S-TAB' on a heading
+and `show all' (`outline-cycle'), and typing \\`S-TAB' on a heading
line likewise cycles the visibility state of the whole buffer
\(`outline-cycle-buffer').
Typing these keys anywhere outside heading lines invokes their default
bindings, per the current major mode."
:type 'boolean
+ :safe #'booleanp
:version "28.1")
-;;;###autoload(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp)
(defcustom outline-minor-mode-highlight nil
"Whether to highlight headings in `outline-minor-mode' using font-lock keywords.
@@ -385,8 +406,8 @@ outline font-lock faces to those of major mode."
(const :tag "Append outline font-lock faces to major mode's"
append)
(const :tag "Highlight with outline font-lock faces only if major mode doesn't" t))
+ :safe #'symbolp
:version "28.1")
-;;;###autoload(put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp)
(defun outline-minor-mode-highlight-buffer ()
;; Fallback to overlays when font-lock is unsupported.
@@ -402,8 +423,8 @@ outline font-lock faces to those of major mode."
(goto-char (match-beginning 0))
(not (get-text-property (point) 'face))))
(overlay-put overlay 'face (outline-font-lock-face)))
- (when outline-minor-mode-cycle
- (overlay-put overlay 'keymap outline-minor-mode-cycle-map)))
+ (when outline-minor-mode-use-buttons
+ (outline--insert-open-button)))
(goto-char (match-end 0))))))
;;;###autoload
@@ -412,11 +433,13 @@ outline font-lock faces to those of major mode."
See the command `outline-mode' for more information on this mode."
:lighter " Outl"
- :keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
- (cons outline-minor-mode-prefix outline-mode-prefix-map))
+ :keymap (easy-mmode-define-keymap
+ `(([menu-bar] . ,outline-minor-mode-menu-bar-map)
+ (,outline-minor-mode-prefix . ,outline-mode-prefix-map))
+ :inherit outline-minor-mode-cycle-map)
(if outline-minor-mode
(progn
- (when (or outline-minor-mode-cycle outline-minor-mode-highlight)
+ (when outline-minor-mode-highlight
(if (and global-font-lock-mode (font-lock-specified-p major-mode))
(progn
(font-lock-add-keywords nil outline-font-lock-keywords t)
@@ -428,8 +451,9 @@ See the command `outline-mode' for more information on this mode."
nil t)
(setq-local line-move-ignore-invisible t)
;; Cause use of ellipses for invisible text.
- (add-to-invisibility-spec '(outline . t)))
- (when (or outline-minor-mode-cycle outline-minor-mode-highlight)
+ (add-to-invisibility-spec '(outline . t))
+ (outline-apply-default-state))
+ (when outline-minor-mode-highlight
(if font-lock-fontified
(font-lock-remove-keywords nil outline-font-lock-keywords))
(remove-overlays nil nil 'outline-overlay t)
@@ -821,6 +845,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
(overlay-put o 'isearch-open-invisible
(or outline-isearch-open-invisible-function
#'outline-isearch-open-invisible))))
+ (outline--fix-up-all-buttons from to)
;; Seems only used by lazy-lock. I.e. obsolete.
(run-hooks 'outline-view-change-hook))
@@ -937,11 +962,80 @@ Note that this does not hide the lines preceding the first heading line."
(define-obsolete-function-alias 'show-all #'outline-show-all "25.1")
-(defun outline-hide-subtree ()
- "Hide everything after this heading at deeper levels."
- (interactive)
+(defun outline-hide-subtree (&optional event)
+ "Hide everything after this heading at deeper levels.
+If non-nil, EVENT should be a mouse event."
+ (interactive (list last-nonmenu-event))
+ (when (mouse-event-p event)
+ (mouse-set-point event))
+ (when (and outline-minor-mode-use-buttons outline-minor-mode)
+ (outline--insert-close-button))
(outline-flag-subtree t))
+(defun outline--make-button (type)
+ (cl-loop for (close open test) in outline-minor-mode-buttons
+ when (and (funcall test close) (funcall test open))
+ return (concat (if (eq type 'close)
+ close
+ open)
+ " " (buffer-substring (point) (1+ (point))))))
+
+(defun outline--valid-emoji-p (string)
+ (when-let ((font (and (display-multi-font-p)
+ (car (internal-char-font nil ?😀)))))
+ (font-has-char-p font (aref string 0))))
+
+(defun outline--valid-char-p (string)
+ (char-displayable-p (aref string 0)))
+
+(defun outline--make-button-overlay (type)
+ (let ((o (seq-find (lambda (o)
+ (overlay-get o 'outline-button))
+ (overlays-at (point)))))
+ (unless o
+ (setq o (make-overlay (point) (1+ (point))))
+ (overlay-put o 'follow-link 'mouse-face)
+ (overlay-put o 'mouse-face 'highlight)
+ (overlay-put o 'outline-button t))
+ (overlay-put o 'display (outline--make-button type))
+ o))
+
+(defun outline--insert-open-button ()
+ (save-excursion
+ (beginning-of-line)
+ (let ((o (outline--make-button-overlay 'open)))
+ (overlay-put o 'help-echo "Click to hide")
+ (overlay-put o 'keymap
+ (define-keymap
+ "RET" #'outline-hide-subtree
+ "<mouse-2>" #'outline-hide-subtree)))))
+
+(defun outline--insert-close-button ()
+ (save-excursion
+ (beginning-of-line)
+ (let ((o (outline--make-button-overlay 'close)))
+ (overlay-put o 'help-echo "Click to show")
+ (overlay-put o 'keymap
+ (define-keymap
+ "RET" #'outline-show-subtree
+ "<mouse-2>" #'outline-show-subtree)))))
+
+(defun outline--fix-up-all-buttons (&optional from to)
+ (when from
+ (save-excursion
+ (goto-char from)
+ (setq from (line-beginning-position))))
+ (when outline-minor-mode-use-buttons
+ (outline-map-region
+ (lambda ()
+ ;; `outline--cycle-state' will fail if we're in a totally
+ ;; collapsed buffer -- but in that case, we're not in a
+ ;; `show-all' situation.
+ (if (eq (ignore-errors (outline--cycle-state)) 'show-all)
+ (outline--insert-open-button)
+ (outline--insert-close-button)))
+ (or from (point-min)) (or to (point-max)))))
+
(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1")
(defun outline-hide-leaves ()
@@ -957,9 +1051,13 @@ Note that this does not hide the lines preceding the first heading line."
(define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1")
-(defun outline-show-subtree ()
+(defun outline-show-subtree (&optional event)
"Show everything after this heading at deeper levels."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (when (mouse-event-p event)
+ (mouse-set-point event))
+ (when (and outline-minor-mode-use-buttons outline-minor-mode)
+ (outline--insert-open-button))
(outline-flag-subtree nil))
(define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1")
@@ -1223,9 +1321,187 @@ convenient way to make a table of contents of the buffer."
(insert "\n\n"))))))
(kill-new (buffer-string)))))))
+(defcustom outline-default-state nil
+ "If non-nil, some headings are initially outlined.
+
+Note that the default state is applied when Outline major and
+minor modes are set or when the command
+`outline-apply-default-state' is called interactively.
+
+When nil, no default state is defined and
+`outline-apply-default-state' is a no-op.
+
+If equal to `outline-show-all', all text of buffer is shown.
+
+If equal to `outline-show-only-headings', show only headings,
+whatever their level is.
+
+If equal to a number, show only headings up to and including the
+corresponding level. See `outline-default-rules' to customize
+visibility of the subtree at that level.
+
+If equal to a lambda function or function name, this function is
+expected to toggle headings visibility, and will be
+called without arguments after the mode is enabled."
+ :version "29.1"
+ :type '(choice (const :tag "Disabled" nil)
+ (const :tag "Show all" outline-show-all)
+ (const :tag "Only headings" outline-show-only-headings)
+ (natnum :tag "Show headings up to level" :value 1)
+ (function :tag "Custom function")))
+
+(defcustom outline-default-rules nil
+ "Determines visibility of subtree starting at `outline-default-state' level.
+
+The rules apply if and only if `outline-default-state' is a
+number.
+
+When nil, the subtree is hidden unconditionally.
+
+When equal to a list, each element should be one of the following:
+
+- A cons cell with CAR `match-regexp' and CDR a regexp, the
+ subtree will be hidden when the outline heading match the
+ regexp.
+
+- `subtree-has-long-lines' to only show the heading branches when
+ long lines are detected in its subtree (see
+ `outline-default-long-line' for the definition of long lines).
+
+- `subtree-is-long' to only show the heading branches when its
+ subtree contains more than `outline-default-line-count' lines.
+
+- A cons cell of the form (custom-function . FUNCTION) where
+ FUNCTION is a lambda function or function name which will be
+ called without arguments with point at the beginning of the
+ heading and the match data set appropriately, the function
+ being expected to toggle the heading visibility."
+ :version "29.1"
+ :type '(choice (const :tag "Hide subtree" nil)
+ (set :tag "Show subtree unless"
+ (cons :tag "Heading match regexp"
+ (const match-regexp) string)
+ (const :tag "Subtree has long lines"
+ subtree-has-long-lines)
+ (const :tag "Subtree is long"
+ subtree-is-long)
+ (cons :tag "Custom function"
+ (const custom-function) function))))
+
+(defcustom outline-default-long-line 1000
+ "Minimal number of characters in a line for a heading to be outlined."
+ :version "29.1"
+ :type '(natnum :tag "Number of characters"))
+
+(defcustom outline-default-line-count 50
+ "Minimal number of lines for a heading to be outlined."
+ :version "29.1"
+ :type '(natnum :tag "Number of lines"))
+
+(defun outline-apply-default-state ()
+ "Apply the outline state defined by `outline-default-state'."
+ (interactive)
+ (cond
+ ((integerp outline-default-state)
+ (outline--show-headings-up-to-level outline-default-state))
+ ((functionp outline-default-state)
+ (funcall outline-default-state))))
+
+(defun outline-show-only-headings ()
+ "Show only headings."
+ (interactive)
+ (outline-show-all)
+ (outline-hide-region-body (point-min) (point-max)))
+
+(eval-when-compile (require 'so-long))
+(autoload 'so-long-detected-long-line-p "so-long")
+(defvar so-long-skip-leading-comments)
+(defvar so-long-threshold)
+(defvar so-long-max-lines)
+
+(defun outline--show-headings-up-to-level (level)
+ "Show only headings up to a LEVEL level.
+
+Like `outline-hide-sublevels' but, for each heading at level
+LEVEL, decides of subtree visibility according to
+`outline-default-rules'."
+ (if (not outline-default-rules)
+ (outline-hide-sublevels level)
+ (if (< level 1)
+ (error "Must keep at least one level of headers"))
+ (save-excursion
+ (let* (outline-view-change-hook
+ (beg (progn
+ (goto-char (point-min))
+ ;; Skip the prelude, if any.
+ (unless (outline-on-heading-p t) (outline-next-heading))
+ (point)))
+ (end (progn
+ (goto-char (point-max))
+ ;; Keep empty last line, if available.
+ (if (bolp) (1- (point)) (point))))
+ (heading-regexp
+ (cdr-safe
+ (assoc 'match-regexp outline-default-rules)))
+ (check-line-count
+ (memq 'subtree-is-long outline-default-rules))
+ (check-long-lines
+ (memq 'subtree-has-long-lines outline-default-rules))
+ (custom-function
+ (cdr-safe
+ (assoc 'custom-function outline-default-rules))))
+ (if (< end beg)
+ (setq beg (prog1 end (setq end beg))))
+ ;; First hide everything.
+ (outline-hide-sublevels level)
+ ;; Then unhide the top level headers.
+ (outline-map-region
+ (lambda ()
+ (let ((current-level (funcall outline-level)))
+ (when (< current-level level)
+ (outline-show-heading)
+ (outline-show-entry))
+ (when (= current-level level)
+ (cond
+ ((and heading-regexp
+ (let ((beg (point))
+ (end (progn (outline-end-of-heading) (point))))
+ (string-match-p heading-regexp (buffer-substring beg end))))
+ ;; hide entry when heading match regexp
+ (outline-hide-entry))
+ ((and check-line-count
+ (save-excursion
+ (let ((beg (point))
+ (end (progn (outline-end-of-subtree) (point))))
+ (<= outline-default-line-count (count-lines beg end)))))
+ ;; show only branches when line count of subtree >
+ ;; threshold
+ (outline-show-branches))
+ ((and check-long-lines
+ (save-excursion
+ (let ((beg (point))
+ (end (progn (outline-end-of-subtree) (point))))
+ (save-restriction
+ (narrow-to-region beg end)
+ (let ((so-long-skip-leading-comments nil)
+ (so-long-threshold outline-default-long-line)
+ (so-long-max-lines nil))
+ (so-long-detected-long-line-p))))))
+ ;; show only branches when long lines are detected
+ ;; in subtree
+ (outline-show-branches))
+ (custom-function
+ ;; call custom function if defined
+ (funcall custom-function))
+ (t
+ ;; if no previous clause succeeds, show subtree
+ (outline-show-subtree))))))
+ beg end)))
+ (run-hooks 'outline-view-change-hook)))
+
(defun outline--cycle-state ()
"Return the cycle state of current heading.
-Return either 'hide-all, 'headings-only, or 'show-all."
+Return either `hide-all', `headings-only', or `show-all'."
(save-excursion
(let (start end ov-list heading-end)
(outline-back-to-heading)
@@ -1320,7 +1596,8 @@ the heading lines in the buffer. It cycles them between `hide all',
(t
(outline-show-all)
(setq outline--cycle-buffer-state 'show-all)
- (message "Show all")))))
+ (message "Show all")))
+ (outline--fix-up-all-buttons)))
(defvar outline-navigation-repeat-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/paren.el b/lisp/paren.el
index 2793b3d6f2f..4c268dbf771 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -88,6 +88,28 @@ is not highlighted, the cursor being regarded as adequate to mark
its position."
:type 'boolean)
+(defcustom show-paren-context-when-offscreen nil
+ "If non-nil, show context around the opening paren if it is offscreen.
+The context is usually the line that contains the openparen,
+except if the openparen is on its own line, in which case the
+context includes the previous nonblank line.
+
+By default, the context is shown in the echo area.
+
+If set to the symbol `overlay', the context is shown in an
+overlay at the top-left of the window.
+
+If set to the symbol `child-frame', the context is shown in a
+child frame at the top-left of the window. You might want to
+customize the `child-frame-border' face (especially the
+background color) to give the child frame a distinguished border.
+On non-graphical frames, the context is shown in the echo area."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "In echo area" t)
+ (const :tag "In overlay" overlay)
+ (const :tag "In child-frame" child-frame))
+ :version "29.1")
+
(defvar show-paren--idle-timer nil)
(defvar show-paren--overlay
(let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol)
@@ -203,6 +225,13 @@ It is the default value of `show-paren-data-function'."
(let* ((temp (show-paren--locate-near-paren))
(dir (car temp))
(outside (cdr temp))
+ ;; If we're inside a comment, then we probably want to blink
+ ;; a matching parentheses in the comment. So don't ignore
+ ;; comments in that case.
+ (parse-sexp-ignore-comments
+ (if (ppss-comment-depth (syntax-ppss))
+ nil
+ parse-sexp-ignore-comments))
pos mismatch here-beg here-end)
;;
;; Find the other end of the sexp.
@@ -252,6 +281,136 @@ It is the default value of `show-paren-data-function'."
(if (= dir 1) pos (1+ pos))
mismatch)))))))
+(defvar show-paren--context-child-frame nil)
+
+(defun show-paren--context-child-frame-redirect-focus ()
+ "Redirect focus from child frame."
+ (redirect-frame-focus
+ show-paren--context-child-frame
+ (frame-parent show-paren--context-child-frame)))
+
+(defun show-paren--context-child-frame-buffer (text)
+ (with-current-buffer
+ (get-buffer-create " *show-paren context*")
+ ;; Redirect focus to parent.
+ (add-hook 'pre-command-hook
+ #'show-paren--delete-context-child-frame
+ nil t)
+ ;; Use an empty keymap.
+ (use-local-map (make-keymap))
+ (dolist (var '((mode-line-format . nil)
+ (header-line-format . nil)
+ (tab-line-format . nil)
+ (tab-bar-format . nil) ;; Emacs 28 tab-bar-format
+ (frame-title-format . "")
+ (truncate-lines . t)
+ (cursor-in-non-selected-windows . nil)
+ (cursor-type . nil)
+ (show-trailing-whitespace . nil)
+ (display-line-numbers . nil)
+ (left-fringe-width . nil)
+ (right-fringe-width . nil)
+ (left-margin-width . 0)
+ (right-margin-width . 0)
+ (fringes-outside-margins . 0)
+ (buffer-read-only . t)))
+ (set (make-local-variable (car var)) (cdr var)))
+ (let ((inhibit-modification-hooks t)
+ (inhibit-read-only t))
+ (erase-buffer)
+ (insert text)
+ (goto-char (point-min)))
+ (current-buffer)))
+
+(defvar show-paren--context-child-frame-parameters
+ `((visibility . nil)
+ (width . 0) (height . 0)
+ (min-width . t) (min-height . t)
+ (no-accept-focus . t)
+ (no-focus-on-map . t)
+ (border-width . 0)
+ (child-frame-border-width . 1)
+ (left-fringe . 0)
+ (right-fringe . 0)
+ (vertical-scroll-bars . nil)
+ (horizontal-scroll-bars . nil)
+ (menu-bar-lines . 0)
+ (tool-bar-lines . 0)
+ (tab-bar-lines . 0)
+ (no-other-frame . t)
+ (no-other-window . t)
+ (no-delete-other-windows . t)
+ (unsplittable . t)
+ (undecorated . t)
+ (cursor-type . nil)
+ (no-special-glyphs . t)
+ (desktop-dont-save . t)))
+
+(defun show-paren--delete-context-child-frame ()
+ (when show-paren--context-child-frame
+ (delete-frame show-paren--context-child-frame)
+ (setq show-paren--context-child-frame nil))
+ (remove-hook 'post-command-hook
+ #'show-paren--delete-context-child-frame))
+
+(defun show-paren--show-context-in-child-frame (text)
+ "Show TEXT in a child-frame at the top-left of the current window."
+ (let ((minibuffer (minibuffer-window (window-frame)))
+ (buffer (show-paren--context-child-frame-buffer text))
+ (x (window-pixel-left))
+ (y (window-pixel-top))
+ (window-min-height 1)
+ (window-min-width 1)
+ after-make-frame-functions)
+ (show-paren--delete-context-child-frame)
+ (setq show-paren--context-child-frame
+ (make-frame
+ `((parent-frame . ,(window-frame))
+ (minibuffer . ,minibuffer)
+ ,@show-paren--context-child-frame-parameters)))
+ (let ((win (frame-root-window show-paren--context-child-frame)))
+ (set-window-buffer win buffer)
+ (set-window-dedicated-p win t)
+ (set-frame-size show-paren--context-child-frame
+ (string-width text)
+ (length (string-lines text)))
+ (set-frame-position show-paren--context-child-frame x y)
+ (make-frame-visible show-paren--context-child-frame)
+ (add-hook 'post-command-hook
+ #'show-paren--delete-context-child-frame))))
+
+(defvar-local show-paren--context-overlay nil)
+
+(defun show-paren--delete-context-overlay ()
+ (when show-paren--context-overlay
+ (delete-overlay show-paren--context-overlay)
+ (setq show-paren--context-overlay nil))
+ (remove-hook 'post-command-hook #'show-paren--delete-overlays
+ 'local))
+
+(defun show-paren--show-context-in-overlay (text)
+ "Show TEXT in an overlay at the top-left of the current window."
+ (setq text (replace-regexp-in-string "\n" " " text))
+ (show-paren--delete-context-overlay)
+ (let* ((beg (window-start))
+ (end (save-excursion
+ (goto-char beg)
+ (line-end-position))))
+ (setq show-paren--context-overlay (make-overlay beg end)))
+ (overlay-put show-paren--context-overlay 'display text)
+ (overlay-put show-paren--context-overlay
+ 'face `(:box
+ ( :line-width (1 . -1)
+ :color ,(face-attribute 'shadow :foreground))))
+ (add-hook 'post-command-hook #'show-paren--delete-context-overlay
+ nil 'local))
+
+;; The last position of point for which `show-paren-function' was
+;; called. We track it in order to C-g away a context overlay or
+;; child-frame without having it pop up again after
+;; `show-paren-delay'.
+(defvar-local show-paren--last-pos nil)
+
(defun show-paren-function ()
"Highlight the parentheses until the next input arrives."
(let ((data (and show-paren-mode (funcall show-paren-data-function))))
@@ -260,7 +419,8 @@ It is the default value of `show-paren-data-function'."
;; If show-paren-mode is nil in this buffer or if not at a paren that
;; has a match, turn off any previous paren highlighting.
(delete-overlay show-paren--overlay)
- (delete-overlay show-paren--overlay-1))
+ (delete-overlay show-paren--overlay-1)
+ (setq show-paren--last-pos (point)))
;; Found something to highlight.
(let* ((here-beg (nth 0 data))
@@ -291,8 +451,8 @@ It is the default value of `show-paren-data-function'."
;; Otherwise, turn off any such highlighting.
(if (or (not here-beg)
(and (not show-paren-highlight-openparen)
- (> here-end (point))
- (<= here-beg (point))
+ (> here-end (point))
+ (<= here-beg (point))
(integerp there-beg)))
(delete-overlay show-paren--overlay-1)
(move-overlay show-paren--overlay-1
@@ -307,11 +467,32 @@ It is the default value of `show-paren-data-function'."
(delete-overlay show-paren--overlay)
(if highlight-expression
(move-overlay show-paren--overlay
- (if (< there-beg here-beg) here-end here-beg)
+ (if (< there-beg here-beg) here-end here-beg)
(if (< there-beg here-beg) there-beg there-end)
(current-buffer))
(move-overlay show-paren--overlay
there-beg there-end (current-buffer)))
+ ;; If `show-paren-context-when-offscreen' is non-nil and
+ ;; point is at a closing paren, show the context around the
+ ;; opening paren.
+ (let ((openparen (min here-beg there-beg)))
+ (when (and show-paren-context-when-offscreen
+ (not (eql show-paren--last-pos (point)))
+ (< there-beg here-beg)
+ (not (pos-visible-in-window-p openparen)))
+ (let ((context (blink-paren-open-paren-line-string
+ openparen))
+ (message-log-max nil))
+ (cond
+ ((and
+ (eq show-paren-context-when-offscreen 'child-frame)
+ (display-graphic-p))
+ (show-paren--show-context-in-child-frame context))
+ ((eq show-paren-context-when-offscreen 'overlay)
+ (show-paren--show-context-in-overlay context))
+ (show-paren-context-when-offscreen
+ (minibuffer-message "Matches %s" context))))))
+ (setq show-paren--last-pos (point))
;; Always set the overlay face, since it varies.
(overlay-put show-paren--overlay 'priority show-paren-priority)
(overlay-put show-paren--overlay 'face face))))))
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index d0ae9390e31..3c9bf1ec9d2 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -134,7 +134,7 @@ Return the new list."
"Add to TARGETS the list of target names in MAKEFILE and files it includes.
Return the new list."
(with-temp-buffer
- (with-demoted-errors ;Could be a directory or something.
+ (with-demoted-errors "Error inserting makefile: %S"
(insert-file-contents makefile))
(let ((filenames (when pcmpl-gnu-makefile-includes (pcmpl-gnu-make-includes))))
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 09ee17caafe..15b9880df85 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -189,6 +189,16 @@ and how is entirely up to the behavior of the
`pcomplete-parse-arguments-function'."
:type 'boolean)
+(defvar pcomplete-allow-modifications nil
+ "If non-nil, allow effects in `pcomplete-parse-arguments-function'.
+For the `pcomplete' command, it was common for functions in
+`pcomplete-parse-arguments-function' to make modifications to the
+buffer, like expanding variables are such.
+For `completion-at-point-functions', this is not an option any more, so
+this variable is used to tell `pcomplete-parse-arguments-function'
+whether it can do the modifications like it used to, or whether
+it should refrain from doing so.")
+
(defcustom pcomplete-parse-arguments-function
#'pcomplete-parse-buffer-arguments
"A function to call to parse the current line's arguments.
@@ -392,6 +402,9 @@ Same as `pcomplete' but using the standard completion UI."
;; imposing the pcomplete UI over the standard UI.
(catch 'pcompleted
(let* ((pcomplete-stub)
+ (buffer-read-only
+ ;; Make sure the function obeys `pcomplete-allow-modifications'.
+ (if pcomplete-allow-modifications buffer-read-only t))
pcomplete-seen pcomplete-norm-func
pcomplete-args pcomplete-last pcomplete-index
(pcomplete-autolist pcomplete-autolist)
@@ -526,6 +539,7 @@ completion functions list (it should occur fairly early in the list)."
pcomplete-last-completion-raw nil)
(catch 'pcompleted
(let* ((pcomplete-stub)
+ (pcomplete-allow-modifications t)
pcomplete-seen pcomplete-norm-func
pcomplete-args pcomplete-last pcomplete-index
(pcomplete-autolist pcomplete-autolist)
@@ -551,7 +565,8 @@ completion functions list (it should occur fairly early in the list)."
"Expand the textual value of the current argument.
This will modify the current buffer."
(interactive)
- (let ((pcomplete-expand-before-complete t))
+ (let ((pcomplete-expand-before-complete t)
+ (pcomplete-allow-modifications t))
(with-suppressed-warnings ((obsolete pcomplete))
(pcomplete))))
@@ -569,6 +584,7 @@ This will modify the current buffer."
This will modify the current buffer."
(interactive)
(let ((pcomplete-expand-before-complete t)
+ (pcomplete-allow-modifications t)
(pcomplete-expand-only-p t))
(with-suppressed-warnings ((obsolete pcomplete))
(pcomplete))
@@ -680,8 +696,8 @@ user actually typed in."
(match-string which arg)
(throw 'pcompleted nil))))
-(defalias 'pcomplete-match-beginning 'match-beginning)
-(defalias 'pcomplete-match-end 'match-end)
+(define-obsolete-function-alias 'pcomplete-match-beginning #'match-beginning "29.1")
+(define-obsolete-function-alias 'pcomplete-match-end #'match-end "29.1")
(defsubst pcomplete--test (pred arg)
"Perform a programmable completion predicate match."
@@ -786,25 +802,30 @@ this is `comint-dynamic-complete-functions'."
(let ((begin (pcomplete-begin 'last)))
(if (and (listp pcomplete-stub) ;??
(not pcomplete-expand-only-p))
- (let* ((completions pcomplete-stub) ;??
- (common-stub (car completions))
- (c completions)
- (len (length common-stub)))
- (while (and c (> len 0))
- (while (and (> len 0)
- (not (string=
- (substring common-stub 0 len)
- (substring (car c) 0
- (min (length (car c))
- len)))))
- (setq len (1- len)))
- (setq c (cdr c)))
- (setq pcomplete-stub (substring common-stub 0 len)
- pcomplete-autolist t)
- (when (and begin (> len 0) (not pcomplete-show-list))
- (delete-region begin (point))
- (pcomplete-insert-entry "" pcomplete-stub))
- (throw 'pcomplete-completions completions))
+ ;; If `pcomplete-stub' is a list, it means it's a list of
+ ;; completions computed during parsing, e.g. Eshell uses
+ ;; that to turn globs into lists of completions.
+ (if (not pcomplete-allow-modifications)
+ (let ((completions pcomplete-stub))
+ ;; FIXME: The mapping from what's in the buffer to the list
+ ;; of completions can be arbitrary and will often fail to be
+ ;; understood by the completion style. See bug#50470.
+ ;; E.g. `pcomplete-stub' may end up being "~/Down*"
+ ;; while the completions contain entries like
+ ;; "/home/<foo>/Downloads" which will fail to match the
+ ;; "~/Down*" completion pattern since the completion
+ ;; is neither told that it's a file nor a global pattern.
+ (setq pcomplete-stub (buffer-substring begin (point)))
+ (throw 'pcomplete-completions completions))
+ (let* ((completions pcomplete-stub)
+ (common-prefix (try-completion "" completions))
+ (len (length common-prefix)))
+ (setq pcomplete-stub common-prefix
+ pcomplete-autolist t)
+ (when (and begin (> len 0) (not pcomplete-show-list))
+ (delete-region begin (point))
+ (pcomplete-insert-entry "" pcomplete-stub))
+ (throw 'pcomplete-completions completions)))
(when expand-p
(if (stringp pcomplete-stub)
(when begin
@@ -1006,7 +1027,7 @@ Arguments NO-GANGING and ARGS-FOLLOW are currently ignored."
((eq arg-char ?*) (pcomplete-executables))
((eq arg-char ??) nil)
((eq arg-char ?.) (pcomplete-entries))
- ((eq arg-char ?\() (eval result))))))
+ ((eq arg-char ?\() (eval result t))))))
(setq index (1+ index))))))))
(defun pcomplete--here (&optional form stub paring form-only)
@@ -1040,7 +1061,7 @@ See the documentation for `pcomplete-here'."
(funcall form)
;; Old calling convention, might still be used by files
;; byte-compiled with the older code.
- (eval form)))))
+ (eval form t)))))
(defmacro pcomplete-here* (&optional form stub form-only)
@@ -1062,9 +1083,9 @@ See the documentation for `pcomplete-here'."
pcomplete-window-restore-timer nil))
(define-obsolete-function-alias 'pcomplete-event-matches-key-specifier-p
- 'eq "27.1")
+ #'eq "27.1")
-(define-obsolete-function-alias 'pcomplete-read-event 'read-event "27.1")
+(define-obsolete-function-alias 'pcomplete-read-event #'read-event "27.1")
(defun pcomplete-show-completions (completions)
"List in help buffer sorted COMPLETIONS.
@@ -1244,7 +1265,7 @@ If specific documentation can't be given, be generic."
(fboundp 'Info-goto-node))
(listp pcomplete-help)))
(if (listp pcomplete-help)
- (message "%s" (eval pcomplete-help))
+ (message "%s" (eval pcomplete-help t))
(save-window-excursion (info))
(declare-function Info-goto-node
"info" (nodename &optional fork strict-case))
diff --git a/lisp/pgtk-dnd.el b/lisp/pgtk-dnd.el
new file mode 100644
index 00000000000..f9532269d62
--- /dev/null
+++ b/lisp/pgtk-dnd.el
@@ -0,0 +1,396 @@
+;;; pgtk-dnd.el --- drag and drop support for GDK -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: window, drag, drop
+;; Package: emacs
+
+;; Significant portions taken from x-dnd.el.
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides the receiving side of the GDK drag and drop
+;; mechanism.
+
+;;; Code:
+
+(require 'dnd)
+
+;;; Customizable variables
+(defcustom pgtk-dnd-test-function #'pgtk-dnd-default-test-function
+ "The function drag and drop uses to determine if to accept or reject a drop.
+The function takes three arguments, WINDOW, ACTION and TYPES.
+WINDOW is where the mouse is when the function is called. WINDOW
+may be a frame if the mouse isn't over a real window (i.e. menu
+bar, tool bar or scroll bar). ACTION is the suggested action
+from the drag and drop source, one of the symbols move, copy,
+link or ask. TYPES is a vector of available types for the drop.
+
+Each element of TYPE should either be a string (containing the
+name of the type's X atom), or a symbol, whose name will be used.
+
+The function shall return nil to reject the drop or a cons with
+two values, the wanted action as car and the wanted type as cdr.
+The wanted action can be copy, move, link, ask or private.
+
+The default value for this variable is `pgtk-dnd-default-test-function'."
+ :version "22.1"
+ :type 'symbol
+ :group 'pgtk)
+
+(defcustom pgtk-dnd-types-alist
+ `((,(purecopy "text/uri-list") . pgtk-dnd-handle-uri-list)
+ (,(purecopy "FILE_NAME") . pgtk-dnd-handle-file-name)
+ (,(purecopy "UTF8_STRING") . pgtk-dnd-insert-utf8-text)
+ (,(purecopy "text/plain;charset=UTF-8") . pgtk-dnd-insert-utf8-text)
+ (,(purecopy "text/plain;charset=utf-8") . pgtk-dnd-insert-utf8-text)
+ (,(purecopy "text/plain") . dnd-insert-text)
+ (,(purecopy "COMPOUND_TEXT") . pgtk-dnd-insert-ctext)
+ (,(purecopy "STRING") . dnd-insert-text)
+ (,(purecopy "TEXT") . dnd-insert-text))
+ "Which function to call to handle a drop of that type.
+If the type for the drop is not present, or the function is nil,
+the drop is rejected. The function takes three arguments, WINDOW, ACTION
+and DATA. WINDOW is where the drop occurred, ACTION is the action for
+this drop (copy, move, link, private or ask) as determined by a previous
+call to `pgtk-dnd-test-function'. DATA is the drop data.
+The function shall return the action used (copy, move, link or private)
+if drop is successful, nil if not."
+ :version "22.1"
+ :type 'alist
+ :group 'pgtk)
+
+(defcustom pgtk-dnd-known-types
+ (mapcar 'purecopy '("text/uri-list"
+ "FILE_NAME"
+ "UTF8_STRING"
+ "text/plain;charset=UTF-8"
+ "text/plain;charset=utf-8"
+ "text/plain"
+ "COMPOUND_TEXT"
+ "STRING"
+ "TEXT"))
+ "The types accepted by default for dropped data.
+The types are chosen in the order they appear in the list."
+ :version "22.1"
+ :type '(repeat string)
+ :group 'pgtk)
+
+;; Internal variables
+
+(defvar pgtk-dnd-current-state nil
+ "The current state for a drop.
+This is an alist with one entry for each display. The value for each display
+is a vector that contains the state for drag and drop for that display.
+Elements in the vector are:
+Last buffer drag was in,
+last window drag was in,
+types available for drop,
+the action suggested by the source,
+the type we want for the drop,
+the action we want for the drop,
+any protocol specific data.")
+
+(declare-function pgtk-get-selection-internal "pgtkselect.c")
+(declare-function pgtk-register-dnd-targets "pgtkselect.c")
+
+(defvar pgtk-dnd-empty-state [nil nil nil nil nil nil nil])
+
+(defun pgtk-dnd-init-frame (&optional frame)
+ "Setup drag and drop for FRAME (i.e. create appropriate properties)."
+ (when (eq 'pgtk (window-system frame))
+ (pgtk-register-dnd-targets frame pgtk-dnd-known-types)))
+
+(defun pgtk-dnd-get-state-cons-for-frame (frame-or-window)
+ "Return the entry in `pgtk-dnd-current-state' for a frame or window."
+ (let* ((frame (if (framep frame-or-window) frame-or-window
+ (window-frame frame-or-window)))
+ (display (frame-parameter frame 'display)))
+ (if (not (assoc display pgtk-dnd-current-state))
+ (push (cons display (copy-sequence pgtk-dnd-empty-state))
+ pgtk-dnd-current-state))
+ (assoc display pgtk-dnd-current-state)))
+
+(defun pgtk-dnd-get-state-for-frame (frame-or-window)
+ "Return the state in `pgtk-dnd-current-state' for a frame or window."
+ (cdr (pgtk-dnd-get-state-cons-for-frame frame-or-window)))
+
+(defun pgtk-dnd-default-test-function (_window _action types)
+ "The default test function for drag and drop.
+WINDOW is where the mouse is when this function is called. It may be
+a frame if the mouse is over the menu bar, scroll bar or tool bar.
+ACTION is the suggested action from the source, and TYPES are the
+types the drop data can have. This function only accepts drops with
+types in `pgtk-dnd-known-types'. It always returns the action `copy'."
+ (let ((type (pgtk-dnd-choose-type types)))
+ (when type (cons 'copy type))))
+
+(defun pgtk-dnd-current-type (frame-or-window)
+ "Return the type we want the DND data to be in for the current drop.
+FRAME-OR-WINDOW is the frame or window that the mouse is over."
+ (aref (pgtk-dnd-get-state-for-frame frame-or-window) 4))
+
+(defun pgtk-dnd-forget-drop (frame-or-window)
+ "Remove all state for the last drop.
+FRAME-OR-WINDOW is the frame or window that the mouse is over."
+ (setcdr (pgtk-dnd-get-state-cons-for-frame frame-or-window)
+ (copy-sequence pgtk-dnd-empty-state)))
+
+(defun pgtk-dnd-maybe-call-test-function (window action)
+ "Call `pgtk-dnd-test-function' if something has changed.
+WINDOW is the window the mouse is over. ACTION is the suggested
+action from the source. If nothing has changed, return the last
+action and type we got from `pgtk-dnd-test-function'."
+ (let ((buffer (when (window-live-p window)
+ (window-buffer window)))
+ (current-state (pgtk-dnd-get-state-for-frame window)))
+ (unless (and (equal buffer (aref current-state 0))
+ (equal window (aref current-state 1))
+ (equal action (aref current-state 3)))
+ (save-current-buffer
+ (when buffer (set-buffer buffer))
+ (let* ((action-type (funcall pgtk-dnd-test-function
+ window
+ action
+ (aref current-state 2)))
+ (handler (cdr (assoc (cdr action-type) pgtk-dnd-types-alist))))
+ ;; Ignore action-type if we have no handler.
+ (setq current-state
+ (pgtk-dnd-save-state window
+ action
+ (when handler action-type)))))))
+ (let ((current-state (pgtk-dnd-get-state-for-frame window)))
+ (cons (aref current-state 5)
+ (aref current-state 4))))
+
+(defun pgtk-dnd-save-state (window action action-type &optional types extra-data)
+ "Save the state of the current drag and drop.
+WINDOW is the window the mouse is over. ACTION is the action suggested
+by the source. ACTION-TYPE is the result of calling `pgtk-dnd-test-function'.
+If given, TYPES are the types for the drop data that the source supports.
+EXTRA-DATA is data needed for a specific protocol."
+ (let ((current-state (pgtk-dnd-get-state-for-frame window)))
+ (aset current-state 5 (car action-type))
+ (aset current-state 4 (cdr action-type))
+ (aset current-state 3 action)
+ (when types (aset current-state 2 types))
+ (when extra-data (aset current-state 6 extra-data))
+ (aset current-state 1 window)
+ (aset current-state 0 (and (window-live-p window) (window-buffer window)))
+ (setcdr (pgtk-dnd-get-state-cons-for-frame window) current-state)))
+
+
+(defun pgtk-dnd-handle-moz-url (window action data)
+ "Handle one item of type text/x-moz-url.
+WINDOW is the window where the drop happened. ACTION is ignored.
+DATA is the moz-url, which is formatted as two strings separated by \\r\\n.
+The first string is the URL, the second string is the title of that URL.
+DATA is encoded in utf-16. Decode the URL and call `pgtk-dnd-handle-uri-list'."
+ ;; Mozilla and applications based on it use text/unicode, but it is
+ ;; impossible to tell if it is le or be. Use what the machine Emacs
+ ;; runs on uses. This loses if dropping between machines
+ ;; with different endian-ness, but it is the best we can do.
+ (let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))
+ (string (decode-coding-string data coding))
+ (strings (split-string string "[\r\n]" t))
+ ;; Can one drop more than one moz-url ?? Assume not.
+ (url (car strings)))
+ (pgtk-dnd-handle-uri-list window action url)))
+
+(defun pgtk-dnd-insert-utf8-text (window action text)
+ "Decode the UTF-8 text and insert it at point.
+TEXT is the text as a string, WINDOW is the window where the drop happened."
+ (dnd-insert-text window action (decode-coding-string text 'utf-8)))
+
+(defun pgtk-dnd-insert-utf16-text (window action text)
+ "Decode the UTF-16 text and insert it at point.
+TEXT is the text as a string, WINDOW is the window where the drop happened."
+ ;; See comment in pgtk-dnd-handle-moz-url about coding.
+ (let ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le)))
+ (dnd-insert-text window action (decode-coding-string text coding))))
+
+(defun pgtk-dnd-insert-ctext (window action text)
+ "Decode the compound text and insert it at point.
+TEXT is the text as a string, WINDOW is the window where the drop happened."
+ (dnd-insert-text window action
+ (decode-coding-string text
+ 'compound-text-with-extensions)))
+
+(defun pgtk-dnd-handle-uri-list (window action string)
+ "Split an uri-list into separate URIs and call `dnd-handle-one-url'.
+WINDOW is the window where the drop happened.
+STRING is the uri-list as a string. The URIs are separated by \\r\\n."
+ (let ((uri-list (split-string string "[\0\r\n]" t))
+ retval)
+ (dolist (bf uri-list)
+ ;; If one URL is handled, treat as if the whole drop succeeded.
+ (let ((did-action (dnd-handle-one-url window action bf)))
+ (when did-action (setq retval did-action))))
+ retval))
+
+(defun pgtk-dnd-handle-file-name (window action string)
+ "Convert file names to URLs and call `dnd-handle-one-url'.
+WINDOW is the window where the drop happened.
+STRING is the file names as a string, separated by nulls."
+ (let ((uri-list (split-string string "[\0\r\n]" t))
+ (coding (or file-name-coding-system
+ default-file-name-coding-system))
+ retval)
+ (dolist (bf uri-list)
+ ;; If one URL is handled, treat as if the whole drop succeeded.
+ (if coding (setq bf (encode-coding-string bf coding)))
+ (let* ((file-uri (concat "file://"
+ (mapconcat 'url-hexify-string
+ (split-string bf "/") "/")))
+ (did-action (dnd-handle-one-url window action file-uri)))
+ (when did-action (setq retval did-action))))
+ retval))
+
+
+(defun pgtk-dnd-choose-type (types &optional known-types)
+ "Choose which type we want to receive for the drop.
+TYPES are the types the source of the drop offers, a vector of type names
+as strings or symbols. Select among the types in `pgtk-dnd-known-types' or
+KNOWN-TYPES if given, and return that type name.
+If no suitable type is found, return nil."
+ (let* ((known-list (or known-types pgtk-dnd-known-types))
+ (first-known-type (car known-list))
+ (types-array types)
+ (found (when first-known-type
+ (catch 'done
+ (dotimes (i (length types-array))
+ (let* ((type (aref types-array i))
+ (typename (if (symbolp type)
+ (symbol-name type) type)))
+ (when (equal first-known-type typename)
+ (throw 'done first-known-type))))
+ nil))))
+
+ (if (and (not found) (cdr known-list))
+ (pgtk-dnd-choose-type types (cdr known-list))
+ found)))
+
+(defun pgtk-dnd-drop-data (event frame window data type)
+ "Drop one data item onto a frame.
+EVENT is the client message for the drop, FRAME is the frame the drop
+occurred on. WINDOW is the window of FRAME where the drop happened.
+DATA is the data received from the source, and type is the type for DATA,
+see `pgtk-dnd-types-alist').
+
+Returns the action used (move, copy, link, private) if drop was successful,
+nil if not."
+ (let* ((type-info (assoc type pgtk-dnd-types-alist))
+ (handler (cdr type-info))
+ (state (pgtk-dnd-get-state-for-frame frame))
+ (action (aref state 5))
+ (w (posn-window (event-start event))))
+ (when handler
+ (if (and (window-live-p w)
+ (not (window-minibuffer-p w))
+ (not (window-dedicated-p w)))
+ ;; If dropping in an ordinary window which we could use,
+ ;; let dnd-open-file-other-window specify what to do.
+ (progn
+ (when (and (not mouse-yank-at-point)
+ ;; If dropping on top of the mode line, insert
+ ;; the text at point instead.
+ (posn-point (event-start event)))
+ (goto-char (posn-point (event-start event))))
+ (funcall handler window action data))
+ ;; If we can't display the file here,
+ ;; make a new window for it.
+ (let ((dnd-open-file-other-window t))
+ (select-frame frame)
+ (funcall handler window action data))))))
+
+(defun pgtk-dnd-handle-drag-n-drop-event (event)
+ "Receive drag and drop events (X client messages).
+Currently XDND, Motif and old KDE 1.x protocols are recognized."
+ (interactive "e")
+ (let* ((client-message (car (cdr (cdr event))))
+ (window (posn-window (event-start event)))
+ (frame (if (framep window)
+ window
+ (window-frame window))))
+ (pgtk-dnd-handle-gdk event frame window client-message)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; GDK protocol.
+
+(declare-function pgtk-update-drop-status "pgtkselect.c")
+(declare-function pgtk-drop-finish "pgtkselect.c")
+
+(defun pgtk-dnd-handle-gdk (event frame window client-message)
+ "Handle drag-n-drop EVENT on FRAME.
+WINDOW should be the window the event happened on top of.
+CLIENT-MESSAGE is the detailed description of the drag-and-drop
+message."
+ (cond
+ ;; We can't handle `drag-leave' here, since that signal is also
+ ;; sent right before `drag-drop', and there is no reliable way to
+ ;; distinguish the two.
+ ((eq (car client-message) 'lambda) ; drag-motion
+ (let ((state (pgtk-dnd-get-state-for-frame frame)))
+ (unless (aref state 0) ;; This is actually an entry.
+ (pgtk-dnd-save-state window nil nil
+ (pgtk-get-selection-internal
+ (nth 1 client-message) 'TARGETS)
+ t)
+ (setq state (pgtk-dnd-get-state-for-frame frame)))
+ (let* ((action (nth 3 client-message))
+ (time (nth 2 client-message))
+ (action-type (pgtk-dnd-maybe-call-test-function window
+ action)))
+ ;; Get the selection contents now. GdkWaylandSelection
+ ;; becomes unavailable immediately after `drag-drop' is sent.
+ (let* ((current-type (pgtk-dnd-current-type window))
+ (current-action-type (car-safe (aref state 6))))
+ (when (and current-type
+ (not (equal current-action-type action-type)))
+ (aset state 6 (cons action-type
+ (pgtk-get-selection-internal
+ (nth 1 client-message)
+ (intern current-type))))))
+ (pgtk-update-drop-status (car action-type) time)
+ (dnd-handle-movement (event-start event)))))
+ ((eq (car client-message) 'quote) ; drag-drop
+ (let* ((state (pgtk-dnd-get-state-for-frame frame))
+ (timestamp (nth 2 client-message))
+ (value (and (pgtk-dnd-current-type window)
+ (or (cdr-safe (aref state 6))
+ (pgtk-get-selection-internal
+ (nth 1 client-message)
+ (intern (pgtk-dnd-current-type window))
+ timestamp))))
+ action)
+ (unwind-protect
+ (setq action (when value
+ (condition-case info
+ (pgtk-dnd-drop-data
+ event frame window value
+ (pgtk-dnd-current-type window))
+ (error
+ (message "Error: %s" info)
+ nil))))
+ (pgtk-drop-finish action timestamp (eq action 'move))
+ (pgtk-dnd-forget-drop window))))))
+
+(provide 'pgtk-dnd)
+
+;;; pgtk-dnd.el ends here
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 934812b0508..fc7e680c262 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -32,8 +32,10 @@
;;; Commentary:
-;; This package offers a global minor mode which makes mouse-wheel
-;; scroll a line smoothly.
+;; This file contains two somewhat related features.
+
+;; The first is a global minor mode which makes Emacs try to scroll
+;; each line smoothly.
;;
;; Scrolling a line up by `set-window-vscroll' and that by `scroll-up'
;; give similar display as shown below.
@@ -58,6 +60,25 @@
;; (set-window-vscroll nil vs t) (sit-for 0))
;; (scroll-up 1)
+;; The second is another global minor mode that redefines `wheel-up'
+;; and `wheel-down' to a command that tries to scroll the display
+;; according to the precise movement of a trackpad or mouse.
+
+;; But it operates in a much more intelligent manner than simply
+;; setting the vscroll. It will set window start to the position
+;; closest to the position at the top-left corner of the window if
+;; vscroll were set accordingly, in a smart and fast manner, and only
+;; set vscroll the rest of the way. There is no visible difference,
+;; but it is much faster, and doesn't move the display by a huge
+;; portion if vscroll is reset for some reason.
+
+;; It also tries to move point out of the way, so redisplay will not
+;; recenter the display as it scrolls. This works well almost all of
+;; the time, but is impossible to get right with images larger than
+;; the window they're displayed in. A feature that will allow
+;; redisplay to skip recentering is in the works, and will completely
+;; resolve this problem.
+
;;; Todo:
;;
;; Allowing pixel-level scrolling in Emacs requires a thorough review
@@ -67,6 +88,9 @@
;;; Code:
(require 'mwheel)
+(require 'subr-x)
+(require 'ring)
+(require 'cua-base)
(defvar pixel-wait 0
"Idle time on each step of pixel scroll specified in second.
@@ -90,6 +114,114 @@ is always with pixel resolution.")
(defvar pixel-last-scroll-time 0
"Time when the last scrolling was made, in second since the epoch.")
+(defvar mwheel-coalesce-scroll-events)
+
+(defvar pixel-scroll-precision-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [wheel-down] 'pixel-scroll-precision)
+ (define-key map [wheel-up] 'pixel-scroll-precision)
+ (define-key map [touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [mode-line wheel-down] 'pixel-scroll-precision)
+ (define-key map [mode-line wheel-up] 'pixel-scroll-precision)
+ (define-key map [mode-line touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [header-line wheel-down] 'pixel-scroll-precision)
+ (define-key map [header-line wheel-up] 'pixel-scroll-precision)
+ (define-key map [header-line touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [vertical-scroll-bar wheel-down] 'pixel-scroll-precision)
+ (define-key map [vertical-scroll-bar wheel-up] 'pixel-scroll-precision)
+ (define-key map [vertical-scroll-bar touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [tool-bar wheel-down] 'pixel-scroll-precision)
+ (define-key map [tool-bar wheel-up] 'pixel-scroll-precision)
+ (define-key map [tool-bar touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [left-margin wheel-down] 'pixel-scroll-precision)
+ (define-key map [left-margin wheel-up] 'pixel-scroll-precision)
+ (define-key map [left-margin touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [right-margin wheel-down] 'pixel-scroll-precision)
+ (define-key map [right-margin wheel-up] 'pixel-scroll-precision)
+ (define-key map [right-margin touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [left-fringe wheel-down] 'pixel-scroll-precision)
+ (define-key map [left-fringe wheel-up] 'pixel-scroll-precision)
+ (define-key map [left-fringe touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [right-fringe wheel-down] 'pixel-scroll-precision)
+ (define-key map [right-fringe wheel-up] 'pixel-scroll-precision)
+ (define-key map [right-fringe touch-end] 'pixel-scroll-start-momentum)
+ (define-key map [next] 'pixel-scroll-interpolate-down)
+ (define-key map [prior] 'pixel-scroll-interpolate-up)
+ map)
+ "The key map used by `pixel-scroll-precision-mode'.")
+
+(defcustom pixel-scroll-precision-use-momentum nil
+ "If non-nil, continue to scroll the display after wheel movement stops.
+This is only effective if supported by your mouse or touchpad."
+ :group 'mouse
+ :type 'boolean
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-momentum-tick 0.01
+ "Number of seconds between each momentum scroll."
+ :group 'mouse
+ :type 'float
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-momentum-seconds 1.75
+ "The maximum duration in seconds of momentum scrolling."
+ :group 'mouse
+ :type 'float
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-momentum-min-velocity 10.0
+ "The minimum scrolled pixels per second before momentum scrolling starts."
+ :group 'mouse
+ :type 'float
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-initial-velocity-factor (/ 0.0335 4)
+ "Factor applied to the initial velocity before momentum scrolling begins."
+ :group 'mouse
+ :type 'float
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-large-scroll-height nil
+ "Pixels that must be scrolled before an animation is performed.
+Nil means to not interpolate such scrolls."
+ :group 'mouse
+ :type '(choice (const :tag "Do not interpolate large scrolls" nil)
+ number)
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-interpolation-total-time 0.1
+ "The total time in seconds to spend interpolating a large scroll."
+ :group 'mouse
+ :type 'float
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-interpolation-factor 4.0
+ "A factor to apply to the distance of an interpolated scroll."
+ :group 'mouse
+ :type 'float
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-interpolation-between-scroll 0.001
+ "The number of seconds between each step of an interpolated scroll."
+ :group 'mouse
+ :type 'float
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-interpolate-page nil
+ "Whether or not to interpolate scrolling via the Page Down and Page Up keys.
+This is only effective when `pixel-scroll-precision-mode' is enabled."
+ :group 'scrolling
+ :type 'boolean
+ :version "29.1")
+
+(defcustom pixel-scroll-precision-interpolate-mice t
+ "Whether or not to interpolate scrolling from a mouse.
+If non-nil, scrolling from the mouse wheel of an actual mouse (as
+opposed to a touchpad) will cause Emacs to interpolate the scroll."
+ :group 'scrolling
+ :type 'boolean
+ :version "29.1")
+
(defun pixel-scroll-in-rush-p ()
"Return non-nil if next scroll should be non-smooth.
When scrolling request is delivered soon after the previous one,
@@ -323,28 +455,44 @@ returns nil."
(setq pos-list (cdr pos-list))))
visible-pos))
-(defun pixel-point-at-unseen-line ()
- "Return the character position of line above the selected window.
-The returned value is the position of the first character on the
-unseen line just above the scope of current window."
- (let* ((pos0 (window-start))
+(defun pixel-point-and-height-at-unseen-line ()
+ "Return the position and pixel height of line above the selected window.
+The returned value is a cons of the position of the first
+character on the unseen line just above the scope of current
+window, and the pixel height of that line."
+ (let* ((pos0 (save-excursion
+ (goto-char (window-start))
+ (unless (bobp)
+ (beginning-of-visual-line))
+ (point)))
(vscroll0 (window-vscroll nil t))
+ (line-height nil)
(pos
(save-excursion
(goto-char pos0)
(if (bobp)
(point-min)
- ;; When there's an overlay string at window-start,
- ;; (beginning-of-visual-line 0) stays put.
- (let ((ppos (point))
- (tem (beginning-of-visual-line 0)))
- (if (eq tem ppos)
- (vertical-motion -1))
- (point))))))
+ (vertical-motion -1)
+ (setq line-height
+ (cdr (window-text-pixel-size nil (point) pos0)))
+ (point)))))
;; restore initial position
(set-window-start nil pos0 t)
(set-window-vscroll nil vscroll0 t)
- pos))
+ (when (and line-height
+ (> (car (posn-x-y (posn-at-point pos0)))
+ (line-number-display-width t)))
+ (setq line-height (- line-height
+ (save-excursion
+ (goto-char pos0)
+ (line-pixel-height)))))
+ (cons pos line-height)))
+
+(defun pixel-point-at-unseen-line ()
+ "Return the character position of line above the selected window.
+The returned value is the position of the first character on the
+unseen line just above the scope of current window."
+ (car (pixel-point-and-height-at-unseen-line)))
(defun pixel-scroll-down-and-set-window-vscroll (vscroll)
"Scroll down a line and set VSCROLL in pixels.
@@ -354,5 +502,339 @@ Otherwise, redisplay will reset the window's vscroll."
(set-window-start nil (pixel-point-at-unseen-line) t)
(set-window-vscroll nil vscroll t))
+(defun pixel-scroll-precision-scroll-down-page (delta)
+ "Scroll the current window down by DELTA pixels.
+Note that this function doesn't work if DELTA is larger than
+the height of the current window."
+ (let* ((desired-pos (posn-at-x-y 0 (+ delta
+ (window-tab-line-height)
+ (window-header-line-height))))
+ (desired-start (posn-point desired-pos))
+ (current-vs (window-vscroll nil t))
+ (start-posn (unless (eq desired-start (window-start))
+ (posn-at-point desired-start)))
+ (desired-vscroll (if start-posn
+ (- delta (cdr (posn-x-y start-posn)))
+ (+ current-vs delta)))
+ (edges (window-edges nil t))
+ (usable-height (- (nth 3 edges)
+ (nth 1 edges)))
+ (next-pos (save-excursion
+ (goto-char desired-start)
+ (when (zerop (vertical-motion (1+ scroll-margin)))
+ (set-window-start nil desired-start)
+ (signal 'end-of-buffer nil))
+ (while (when-let ((posn (posn-at-point)))
+ (< (cdr (posn-x-y posn)) delta))
+ (when (zerop (vertical-motion 1))
+ (set-window-start nil desired-start)
+ (signal 'end-of-buffer nil)))
+ (point)))
+ (scroll-preserve-screen-position nil)
+ (auto-window-vscroll nil))
+ (when (and (or (< (point) next-pos))
+ (let ((pos-visibility (pos-visible-in-window-p next-pos nil t)))
+ (and pos-visibility
+ (or (eq (length pos-visibility) 2)
+ (when-let* ((posn (posn-at-point next-pos)))
+ (> (cdr (posn-object-width-height posn))
+ usable-height))))))
+ (goto-char next-pos))
+ (set-window-start nil (if (zerop (window-hscroll))
+ desired-start
+ (save-excursion
+ (goto-char desired-start)
+ (beginning-of-visual-line)
+ (point)))
+ t)
+ (set-window-vscroll nil desired-vscroll t t)))
+
+(defun pixel-scroll-precision-scroll-down (delta)
+ "Scroll the current window down by DELTA pixels."
+ (let ((max-height (- (window-text-height nil t)
+ (frame-char-height))))
+ (while (> delta max-height)
+ (pixel-scroll-precision-scroll-down-page max-height)
+ (setq delta (- delta max-height)))
+ (pixel-scroll-precision-scroll-down-page delta)))
+
+(defun pixel-scroll-precision-scroll-up-page (delta)
+ "Scroll the current window up by DELTA pixels.
+Note that this function doesn't work if DELTA is larger than
+the height of the current window."
+ (let* ((edges (window-edges nil t nil t))
+ (max-y (- (nth 3 edges)
+ (nth 1 edges)))
+ (usable-height max-y)
+ (posn (posn-at-x-y 0 (+ (window-tab-line-height)
+ (window-header-line-height)
+ (- max-y delta))))
+ (point (posn-point posn))
+ (up-point (save-excursion
+ (goto-char point)
+ (vertical-motion (- (1+ scroll-margin)))
+ (point))))
+ (when (> (point) up-point)
+ (when (let ((pos-visible (pos-visible-in-window-p up-point nil t)))
+ (or (eq (length pos-visible) 2)
+ (when-let* ((posn (posn-at-point up-point))
+ (edges (window-edges nil t))
+ (usable-height (- (nth 3 edges)
+ (nth 1 edges))))
+ (> (cdr (posn-object-width-height posn))
+ usable-height))))
+ (goto-char up-point)))
+ (let ((current-vscroll (window-vscroll nil t)))
+ (setq delta (- delta current-vscroll))
+ (set-window-vscroll nil 0 t t)
+ (when (> delta 0)
+ (let* ((start (window-start))
+ (dims (window-text-pixel-size nil (cons start (- delta))
+ start nil nil nil t))
+ (height (nth 1 dims))
+ (position (nth 2 dims)))
+ (set-window-start nil position t)
+ ;; If the line above is taller than the window height (i.e. there's
+ ;; a very tall image), keep point on it.
+ (when (> height usable-height)
+ (goto-char position))
+ (when (or (not position) (eq position start))
+ (signal 'beginning-of-buffer nil))
+ (setq delta (- delta height))))
+ (when (< delta 0)
+ (set-window-vscroll nil (- delta) t t)))))
+
+(defun pixel-scroll-precision-interpolate (delta &optional old-window)
+ "Interpolate a scroll of DELTA pixels.
+OLD-WINDOW is the window which will be selected when redisplay
+takes place, or nil for the current window. This results in the
+window being scrolled by DELTA pixels with an animation."
+ (let ((percentage 0)
+ (total-time pixel-scroll-precision-interpolation-total-time)
+ (factor pixel-scroll-precision-interpolation-factor)
+ (last-time (float-time))
+ (time-elapsed 0.0)
+ (between-scroll pixel-scroll-precision-interpolation-between-scroll)
+ (rem (window-parameter nil 'interpolated-scroll-remainder))
+ (time (window-parameter nil 'interpolated-scroll-remainder-time)))
+ (when (and rem time
+ (< (- (float-time) time) 1.0)
+ (eq (< delta 0) (< rem 0)))
+ (setq delta (+ delta rem)))
+ (if (or (null rem)
+ (eq (< delta 0) (< rem 0)))
+ (while-no-input
+ (unwind-protect
+ (while (< percentage 1)
+ (with-selected-window (or old-window
+ (selected-window))
+ (redisplay t))
+ (sleep-for between-scroll)
+ (setq time-elapsed (+ time-elapsed
+ (- (float-time) last-time))
+ percentage (/ time-elapsed total-time))
+ (let ((throw-on-input nil))
+ (if (< delta 0)
+ (pixel-scroll-precision-scroll-down
+ (ceiling (abs (* (* delta factor)
+ (/ between-scroll total-time)))))
+ (pixel-scroll-precision-scroll-up
+ (ceiling (* (* delta factor)
+ (/ between-scroll total-time))))))
+ (setq last-time (float-time)))
+ (if (< percentage 1)
+ (progn
+ (set-window-parameter nil 'interpolated-scroll-remainder
+ (* delta (- 1 percentage)))
+ (set-window-parameter nil 'interpolated-scroll-remainder-time
+ (float-time)))
+ (set-window-parameter nil
+ 'interpolated-scroll-remainder
+ nil)
+ (set-window-parameter nil
+ 'interpolated-scroll-remainder-time
+ nil))))
+ (set-window-parameter nil
+ 'interpolated-scroll-remainder
+ nil)
+ (set-window-parameter nil
+ 'interpolated-scroll-remainder-time
+ nil))))
+
+(defun pixel-scroll-precision-scroll-up (delta)
+ "Scroll the current window up by DELTA pixels."
+ (let ((max-height (- (window-text-height nil t)
+ (frame-char-height))))
+ (while (> delta max-height)
+ (pixel-scroll-precision-scroll-up-page max-height)
+ (setq delta (- delta max-height)))
+ (pixel-scroll-precision-scroll-up-page delta)))
+
+;; FIXME: This doesn't _always_ work when there's an image above the
+;; current line that is taller than the window, and scrolling can
+;; sometimes be jumpy in that case.
+(defun pixel-scroll-precision (event)
+ "Scroll the display vertically by pixels according to EVENT.
+Move the display up or down by the pixel deltas in EVENT to
+scroll the display according to the user's turning the mouse
+wheel."
+ (interactive "e")
+ (let ((window (mwheel-event-window event))
+ (current-window (selected-window)))
+ (when (framep window)
+ (setq window (frame-selected-window window)))
+ (if (and (nth 4 event))
+ (let ((delta (round (cdr (nth 4 event)))))
+ (unless (zerop delta)
+ (if (> (abs delta) (window-text-height window t))
+ (mwheel-scroll event nil)
+ (with-selected-window window
+ (if (or (and pixel-scroll-precision-interpolate-mice
+ (eq (device-class last-event-frame
+ last-event-device)
+ 'mouse))
+ (and pixel-scroll-precision-large-scroll-height
+ (> (abs delta)
+ pixel-scroll-precision-large-scroll-height)
+ (let* ((kin-state (pixel-scroll-kinetic-state))
+ (ring (aref kin-state 0))
+ (time (aref kin-state 1)))
+ (or (null time)
+ (> (- (float-time) time) 1.0)
+ (and (consp ring)
+ (ring-empty-p ring))))))
+ (progn
+ (let ((kin-state (pixel-scroll-kinetic-state)))
+ (aset kin-state 0 (make-ring 30))
+ (aset kin-state 1 nil))
+ (pixel-scroll-precision-interpolate delta current-window))
+ (condition-case nil
+ (progn
+ (if (< delta 0)
+ (pixel-scroll-precision-scroll-down (- delta))
+ (pixel-scroll-precision-scroll-up delta))
+ (pixel-scroll-accumulate-velocity delta))
+ ;; Do not ding at buffer limits. Show a message instead.
+ (beginning-of-buffer
+ (message (error-message-string '(beginning-of-buffer))))
+ (end-of-buffer
+ (message (error-message-string '(end-of-buffer))))))))))
+ (mwheel-scroll event nil))))
+
+(defun pixel-scroll-kinetic-state (&optional window)
+ "Return the kinetic scroll state of WINDOW.
+If WINDOW is nil, return the state of the current window.
+It is a vector of the form [ VELOCITY TIME SIGN ]."
+ (or (window-parameter window 'kinetic-state)
+ (set-window-parameter window 'kinetic-state
+ (vector (make-ring 30) nil nil))))
+
+(defun pixel-scroll-accumulate-velocity (delta)
+ "Accumulate DELTA into the current window's kinetic scroll state."
+ (let* ((state (pixel-scroll-kinetic-state))
+ (ring (aref state 0))
+ (time (aref state 1)))
+ (when (or (and time (> (- (float-time) time) 0.5))
+ (and (not (ring-empty-p ring))
+ (not (eq (< delta 0)
+ (aref state 2)))))
+ (aset state 0 (make-ring 30)))
+ (aset state 2 (< delta 0))
+ (ring-insert (aref state 0)
+ (cons (aset state 1 (float-time))
+ delta))))
+
+(defun pixel-scroll-calculate-velocity (state)
+ "Calculate velocity from the kinetic state vector STATE."
+ (let* ((ring (aref state 0))
+ (elts (ring-elements ring))
+ (total 0))
+ (dolist (tem elts)
+ (setq total (+ total (cdr tem))))
+ (* (/ total (- (float-time) (caar (last elts))))
+ pixel-scroll-precision-initial-velocity-factor)))
+
+(defun pixel-scroll-start-momentum (event)
+ "Start kinetic scrolling for the touch event EVENT."
+ (interactive "e")
+ (when pixel-scroll-precision-use-momentum
+ (let ((window (mwheel-event-window event))
+ (state nil))
+ (when (framep window)
+ (setq window (frame-selected-window window)))
+ (setq state (pixel-scroll-kinetic-state window))
+ (when (and (aref state 1)
+ (listp (aref state 0)))
+ (condition-case nil
+ (while-no-input
+ (unwind-protect (progn
+ (aset state 0 (pixel-scroll-calculate-velocity state))
+ (when (> (abs (aref state 0))
+ pixel-scroll-precision-momentum-min-velocity)
+ (let* ((velocity (aref state 0))
+ (original-velocity velocity)
+ (time-spent 0))
+ (if (> velocity 0)
+ (while (and (> velocity 0)
+ (<= time-spent
+ pixel-scroll-precision-momentum-seconds))
+ (when (> (round velocity) 0)
+ (with-selected-window window
+ (pixel-scroll-precision-scroll-up (round velocity))))
+ (setq velocity (- velocity
+ (/ original-velocity
+ (/ pixel-scroll-precision-momentum-seconds
+ pixel-scroll-precision-momentum-tick))))
+ (redisplay t)
+ (sit-for pixel-scroll-precision-momentum-tick)
+ (setq time-spent (+ time-spent
+ pixel-scroll-precision-momentum-tick))))
+ (while (and (< velocity 0)
+ (<= time-spent
+ pixel-scroll-precision-momentum-seconds))
+ (when (> (round (abs velocity)) 0)
+ (with-selected-window window
+ (pixel-scroll-precision-scroll-down (round
+ (abs velocity)))))
+ (setq velocity (+ velocity
+ (/ (abs original-velocity)
+ (/ pixel-scroll-precision-momentum-seconds
+ pixel-scroll-precision-momentum-tick))))
+ (redisplay t)
+ (sit-for pixel-scroll-precision-momentum-tick)
+ (setq time-spent (+ time-spent
+ pixel-scroll-precision-momentum-tick))))))
+ (aset state 0 (make-ring 30))
+ (aset state 1 nil)))
+ (beginning-of-buffer
+ (message (error-message-string '(beginning-of-buffer))))
+ (end-of-buffer
+ (message (error-message-string '(end-of-buffer)))))))))
+
+(defun pixel-scroll-interpolate-down ()
+ "Interpolate a scroll downwards by one page."
+ (interactive)
+ (if pixel-scroll-precision-interpolate-page
+ (pixel-scroll-precision-interpolate (- (window-text-height nil t)))
+ (cua-scroll-up)))
+
+(defun pixel-scroll-interpolate-up ()
+ "Interpolate a scroll upwards by one page."
+ (interactive)
+ (if pixel-scroll-precision-interpolate-page
+ (pixel-scroll-precision-interpolate (window-text-height nil t))
+ (cua-scroll-down)))
+
+;;;###autoload
+(define-minor-mode pixel-scroll-precision-mode
+ "Toggle pixel scrolling.
+When enabled, this minor mode allows to scroll the display
+precisely, according to the turning of the mouse wheel."
+ :global t
+ :group 'mouse
+ :keymap pixel-scroll-precision-mode-map
+ (setq mwheel-coalesce-scroll-events
+ (not pixel-scroll-precision-mode)))
+
(provide 'pixel-scroll)
;;; pixel-scroll.el ends here
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index dde0c4f08ff..8fe72ddf593 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -107,39 +107,37 @@
(defvar 5x5-buffer-name "*5x5*"
"Name of the 5x5 play buffer.")
-(defvar 5x5-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map t)
- (define-key map "?" #'describe-mode)
- (define-key map "\r" #'5x5-flip-current)
- (define-key map " " #'5x5-flip-current)
- (define-key map [up] #'5x5-up)
- (define-key map [down] #'5x5-down)
- (define-key map [left] #'5x5-left)
- (define-key map [tab] #'5x5-right)
- (define-key map [right] #'5x5-right)
- (define-key map [(control a)] #'5x5-bol)
- (define-key map [(control e)] #'5x5-eol)
- (define-key map [(control p)] #'5x5-up)
- (define-key map [(control n)] #'5x5-down)
- (define-key map [(control b)] #'5x5-left)
- (define-key map [(control f)] #'5x5-right)
- (define-key map [home] #'5x5-bol)
- (define-key map [end] #'5x5-eol)
- (define-key map [prior] #'5x5-first)
- (define-key map [next] #'5x5-last)
- (define-key map "r" #'5x5-randomize)
- (define-key map [(control c) (control r)] #'5x5-crack-randomly)
- (define-key map [(control c) (control c)] #'5x5-crack-mutating-current)
- (define-key map [(control c) (control b)] #'5x5-crack-mutating-best)
- (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
- (define-key map "n" #'5x5-new-game)
- (define-key map "s" #'5x5-solve-suggest)
- (define-key map "<" #'5x5-solve-rotate-left)
- (define-key map ">" #'5x5-solve-rotate-right)
- (define-key map "q" #'5x5-quit-game)
- map)
- "Local keymap for the 5x5 game.")
+(defvar-keymap 5x5-mode-map
+ :doc "Local keymap for the 5x5 game."
+ :suppress 'nodigits
+ "?" #'describe-mode
+ "RET" #'5x5-flip-current
+ "SPC" #'5x5-flip-current
+ "<up>" #'5x5-up
+ "<down>" #'5x5-down
+ "<left>" #'5x5-left
+ "<tab>" #'5x5-right
+ "<right>" #'5x5-right
+ "C-a" #'5x5-bol
+ "C-e" #'5x5-eol
+ "C-p" #'5x5-up
+ "C-n" #'5x5-down
+ "C-b" #'5x5-left
+ "C-f" #'5x5-right
+ "<home>" #'5x5-bol
+ "<end>" #'5x5-eol
+ "<prior>" #'5x5-first
+ "<next>" #'5x5-last
+ "r" #'5x5-randomize
+ "C-c C-r" #'5x5-crack-randomly
+ "C-c C-c" #'5x5-crack-mutating-current
+ "C-c C-b" #'5x5-crack-mutating-best
+ "C-c C-x" #'5x5-crack-xor-mutate
+ "n" #'5x5-new-game
+ "s" #'5x5-solve-suggest
+ "<" #'5x5-solve-rotate-left
+ ">" #'5x5-solve-rotate-right
+ "q" #'5x5-quit-game)
(defvar-local 5x5-solver-output nil
"List that is the output of an arithmetic solver.
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index 25f560e3203..4f4c936cd67 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -93,9 +93,17 @@
(unless (eolp) (delete-char 1))
(insert-char char 1))
-(defcustom animate-n-steps 10
+(defcustom animate-n-steps 20
"Number of steps `animate-string' will place a char before its last position."
- :type 'integer)
+ :type 'natnum
+ :version "29.1")
+
+(defcustom animate-total-added-delay 0.5
+ "Total number of seconds to wait in between steps.
+This is added to the total time it takes to run `animate-string'
+to ensure that the animation is not too fast to be seen."
+ :type 'float
+ :version "29.1")
(defvar animation-buffer-name nil
"String naming the default buffer for animations.
@@ -130,7 +138,7 @@ in the current window."
;; Make sure buffer is displayed starting at the beginning.
(set-window-start nil 1)
;; Display it, and wait just a little while.
- (sit-for .05)
+ (sit-for (/ (float animate-total-added-delay) (max animate-n-steps 1)))
;; Now undo the changes we made in the buffer.
(setq list-to-undo buffer-undo-list)
(while list-to-undo
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index 2eb2d12e29c..8db24c91276 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -85,32 +85,21 @@
(defvar bb-balls-placed nil
"List of already placed balls.")
-;; This is used below to remap existing bindings for cursor motion to
-;; blackbox-specific bindings in blackbox-mode-map. This is so that
-;; users who prefer non-default key bindings for cursor motion don't
-;; lose that when they play Blackbox.
-(defun blackbox-redefine-key (map oldfun newfun)
- "Redefine keys that run the function OLDFUN to run NEWFUN instead."
- (define-key map (vector 'remap oldfun) newfun))
-
-
-(defvar blackbox-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map t)
- (blackbox-redefine-key map 'backward-char 'bb-left)
- (blackbox-redefine-key map 'left-char 'bb-left)
- (blackbox-redefine-key map 'forward-char 'bb-right)
- (blackbox-redefine-key map 'right-char 'bb-right)
- (blackbox-redefine-key map 'previous-line 'bb-up)
- (blackbox-redefine-key map 'next-line 'bb-down)
- (blackbox-redefine-key map 'move-end-of-line 'bb-eol)
- (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol)
- (define-key map " " 'bb-romp)
- (define-key map "q" 'bury-buffer)
- (define-key map [insert] 'bb-romp)
- (define-key map [return] 'bb-done)
- (blackbox-redefine-key map 'newline 'bb-done)
- map))
+(defvar-keymap blackbox-mode-map
+ :suppress 'nodigits
+ "SPC" #'bb-romp
+ "q" #'bury-buffer
+ "<insert>" #'bb-romp
+ "<return>" #'bb-done
+ "<remap> <backward-char>" #'bb-left
+ "<remap> <left-char>" #'bb-left
+ "<remap> <forward-char>" #'bb-right
+ "<remap> <right-char>" #'bb-right
+ "<remap> <previous-line>" #'bb-up
+ "<remap> <next-line>" #'bb-down
+ "<remap> <move-end-of-line>" #'bb-eol
+ "<remap> <move-beginning-of-line>" #'bb-bol
+ "<remap> <newline>" #'bb-done)
;; Blackbox mode is suitable only for specially formatted data.
@@ -426,6 +415,11 @@ a reflection."
(insert c)
(backward-char 1)))
+(defun blackbox-redefine-key (map oldfun newfun)
+ "Redefine keys that run the function OLDFUN to run NEWFUN instead."
+ (declare (obsolete define-key "29.1"))
+ (define-key map (vector 'remap oldfun) newfun))
+
(provide 'blackbox)
;;; blackbox.el ends here
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 082f52d98c9..93fbc3b51b7 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -809,22 +809,21 @@ static char * dot3d_xpm[] = {
(bubbles--update-faces-or-images))
-(defvar bubbles-mode-map
- (let ((map (make-sparse-keymap 'bubbles-mode-map)))
- ;; (suppress-keymap map t)
- (define-key map "q" 'bubbles-quit)
- (define-key map "\n" 'bubbles-plop)
- (define-key map " " 'bubbles-plop)
- (define-key map [double-down-mouse-1] 'bubbles-plop)
- (define-key map [mouse-2] 'bubbles-plop)
- (define-key map "\C-m" 'bubbles-plop)
- (define-key map "u" 'bubbles-undo)
- (define-key map "p" 'previous-line)
- (define-key map "n" 'next-line)
- (define-key map "f" 'forward-char)
- (define-key map "b" 'backward-char)
- map)
- "Mode map for `bubbles'.")
+(defvar-keymap bubbles-mode-map
+ :doc "Mode map for `bubbles'."
+ :name 'bubbles-mode-map
+ "q" #'bubbles-quit
+ "C-j" #'bubbles-plop
+ "SPC" #'bubbles-plop
+ "C-m" #'bubbles-plop
+ "u" #'bubbles-undo
+ "p" #'previous-line
+ "n" #'next-line
+ "f" #'forward-char
+ "b" #'backward-char
+
+ "<double-down-mouse-1>" #'bubbles-plop
+ "<mouse-2>" #'bubbles-plop)
(easy-menu-define bubbles-menu bubbles-mode-map
"Menu for `bubbles'."
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index aeb4726bb9b..bb3369de5fc 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -138,36 +138,31 @@ the tail of the list."
(2 font-lock-string-face)))
"Font Lock keywords for Decipher mode.")
-(defvar decipher-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
- (define-key map "A" #'decipher-show-alphabet)
- (define-key map "C" #'decipher-complete-alphabet)
- (define-key map "D" #'decipher-digram-list)
- (define-key map "F" #'decipher-frequency-count)
- (define-key map "M" #'decipher-make-checkpoint)
- (define-key map "N" #'decipher-adjacency-list)
- (define-key map "R" #'decipher-restore-checkpoint)
- (define-key map "U" #'decipher-undo)
- (define-key map " " #'decipher-keypress)
- (define-key map [remap undo] #'decipher-undo)
- (define-key map [remap advertised-undo] #'decipher-undo)
- (let ((key ?a))
- (while (<= key ?z)
- (define-key map (vector key) #'decipher-keypress)
- (cl-incf key)))
- map)
- "Keymap for Decipher mode.")
-
-
-(defvar decipher-stats-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
- (define-key map "D" #'decipher-digram-list)
- (define-key map "F" #'decipher-frequency-count)
- (define-key map "N" #'decipher-adjacency-list)
- map)
- "Keymap for Decipher-Stats mode.")
+(defvar-keymap decipher-mode-map
+ :doc "Keymap for Decipher mode."
+ :suppress t
+ "A" #'decipher-show-alphabet
+ "C" #'decipher-complete-alphabet
+ "D" #'decipher-digram-list
+ "F" #'decipher-frequency-count
+ "M" #'decipher-make-checkpoint
+ "N" #'decipher-adjacency-list
+ "R" #'decipher-restore-checkpoint
+ "U" #'decipher-undo
+ "SPC" #'decipher-keypress
+ "<remap> <undo>" #'decipher-undo
+ "<remap> <advertised-undo>" #'decipher-undo)
+(let ((key ?a))
+ (while (<= key ?z)
+ (keymap-set decipher-mode-map (char-to-string key) #'decipher-keypress)
+ (cl-incf key)))
+
+(defvar-keymap decipher-stats-mode-map
+ :doc "Keymap for Decipher-Stats mode."
+ :suppress t
+ "D" #'decipher-digram-list
+ "F" #'decipher-frequency-count
+ "N" #'decipher-adjacency-list)
(defvar decipher-mode-syntax-table
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index a640f8ca66d..b93d768cbe3 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -126,11 +126,9 @@
(set what ww)
first))
-(defvar doctor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\n" 'doctor-read-print)
- (define-key map "\r" 'doctor-ret-or-read)
- map))
+(defvar-keymap doctor-mode-map
+ "C-j" #'doctor-read-print
+ "RET" #'doctor-ret-or-read)
(define-derived-mode doctor-mode text-mode "Doctor"
"Major mode for running the Doctor (Eliza) program.
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 07f27374df7..b859176bb47 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -898,7 +898,7 @@ Regular objects have whole numbers lower than 255.
Objects that cannot be taken but might move and are
described during room description are negative.
Stuff that is described and might change are 255, and are
-handled specially by 'dun-describe-room.")
+handled specially by `dun-describe-room'.")
(defconst dun-room-silents (list nil
(list obj-tree obj-coconut) ;; dead-end
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 256b4e19ce8..7a850b07ee4 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -343,11 +343,17 @@ format."
(gamegrid-colorize-glyph color))
((listp data)
(find-image data)) ;untested!
- ((vectorp data)
- (gamegrid-make-image-from-vector data)))))
+ ;; Remove when `gamegrid-make-image-from-vector' is removed:
+ ((vectorp data)
+ (lwarn 'gamegrid :warning
+ "Using obsolete XEmacs style \"glyph\"; \
+convert to an Emacs image-spec instead")
+ (with-suppressed-warnings ((obsolete gamegrid-make-image-from-vector))
+ (gamegrid-make-image-from-vector data))))))
(defun gamegrid-make-image-from-vector (vect)
"Convert an XEmacs style \"glyph\" to an image-spec."
+ (declare (obsolete nil "29.1"))
(let ((l (list 'image :type)))
(dotimes (n (length vect))
(setf l (nconc l (list (aref vect n)))))
@@ -452,6 +458,7 @@ format."
;; Adjust the height of the default face to the height of the
;; images. Unlike XEmacs, Emacs doesn't allow making the default
;; face buffer-local; so we do this with an overlay.
+ ;; FIXME: This is not correct. See face-remap.el.
(when (eq gamegrid-display-mode 'glyph)
(overlay-put (make-overlay (point-min) (point-max))
'face gamegrid-face))
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index c3323ac4527..6a0dc6a623c 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -554,54 +554,55 @@ buffer, it is replaced by the new value. See the documentation for
(gametree-hack-file-layout))
nil)
-;;;; Key bindings
-(defvar gametree-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-j" 'gametree-break-line-here)
- (define-key map "\C-c\C-v" 'gametree-insert-new-leaf)
- (define-key map "\C-c\C-m" 'gametree-merge-line)
- (define-key map "\C-c\C-r " 'gametree-layout-to-register)
- (define-key map "\C-c\C-r/" 'gametree-layout-to-register)
- (define-key map "\C-c\C-rj" 'gametree-apply-register-layout)
- (define-key map "\C-c\C-y" 'gametree-save-and-hack-layout)
- (define-key map "\C-c;" 'gametree-insert-score)
- (define-key map "\C-c^" 'gametree-compute-and-insert-score)
- map))
-
-(define-derived-mode gametree-mode outline-mode "GameTree"
- "Major mode for managing game analysis trees.
-Useful to postal and email chess (and, it is hoped, also checkers, go,
-shogi, etc.) players, it is a slightly modified version of Outline mode.
-
-\\{gametree-mode-map}"
- (auto-fill-mode 0)
- (add-hook 'write-contents-functions 'gametree-save-and-hack-layout nil t))
+
+;;;; Mouse commands
-;;;; Goodies for mousing users
(defun gametree-mouse-break-line-here (event)
(interactive "e")
(mouse-set-point event)
(gametree-break-line-here))
+
(defun gametree-mouse-show-children-and-entry (event)
(interactive "e")
(mouse-set-point event)
(gametree-show-children-and-entry))
+
(defun gametree-mouse-show-subtree (event)
(interactive "e")
(mouse-set-point event)
(outline-show-subtree))
+
(defun gametree-mouse-hide-subtree (event)
(interactive "e")
(mouse-set-point event)
(outline-hide-subtree))
-(define-key gametree-mode-map [M-down-mouse-2 M-mouse-2]
- 'gametree-mouse-break-line-here)
-(define-key gametree-mode-map [S-down-mouse-1 S-mouse-1]
- 'gametree-mouse-show-children-and-entry)
-(define-key gametree-mode-map [S-down-mouse-2 S-mouse-2]
- 'gametree-mouse-show-subtree)
-(define-key gametree-mode-map [S-down-mouse-3 S-mouse-3]
- 'gametree-mouse-hide-subtree)
+
+
+;;;; Key bindings
+
+(defvar-keymap gametree-mode-map
+ "C-c C-j" #'gametree-break-line-here
+ "C-c C-v" #'gametree-insert-new-leaf
+ "C-c C-m" #'gametree-merge-line
+ "C-c C-r SPC" #'gametree-layout-to-register
+ "C-c C-r /" #'gametree-layout-to-register
+ "C-c C-r j" #'gametree-apply-register-layout
+ "C-c C-y" #'gametree-save-and-hack-layout
+ "C-c ;" #'gametree-insert-score
+ "C-c ^" #'gametree-compute-and-insert-score
+ "M-<down-mouse-2> M-<mouse-2>" #'gametree-mouse-break-line-here
+ "S-<down-mouse-1> S-<mouse-1>" #'gametree-mouse-show-children-and-entry
+ "S-<down-mouse-2> S-<mouse-2>" #'gametree-mouse-show-subtree
+ "S-<down-mouse-3> S-<mouse-3>" #'gametree-mouse-hide-subtree)
+
+(define-derived-mode gametree-mode outline-mode "GameTree"
+ "Major mode for managing game analysis trees.
+Useful to postal and email chess (and, it is hoped, also checkers, go,
+shogi, etc.) players, it is a slightly modified version of Outline mode.
+
+\\{gametree-mode-map}"
+ (auto-fill-mode 0)
+ (add-hook 'write-contents-functions 'gametree-save-and-hack-layout nil t))
(provide 'gametree)
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 02aff75e157..f8822c30db1 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -100,65 +100,61 @@ SHOULD be at least 2 (MUST BE at least 1).")
"Number of lines between the Gomoku board and the top of the window.")
-(defvar gomoku-mode-map
- (let ((map (make-sparse-keymap)))
-
- ;; Key bindings for cursor motion.
- (define-key map "y" 'gomoku-move-nw) ; y
- (define-key map "u" 'gomoku-move-ne) ; u
- (define-key map "b" 'gomoku-move-sw) ; b
- (define-key map "n" 'gomoku-move-se) ; n
- (define-key map "h" 'gomoku-move-left) ; h
- (define-key map "l" 'gomoku-move-right) ; l
- (define-key map "j" 'gomoku-move-down) ; j
- (define-key map "k" 'gomoku-move-up) ; k
-
- (define-key map [kp-7] 'gomoku-move-nw)
- (define-key map [kp-9] 'gomoku-move-ne)
- (define-key map [kp-1] 'gomoku-move-sw)
- (define-key map [kp-3] 'gomoku-move-se)
- (define-key map [kp-4] 'gomoku-move-left)
- (define-key map [kp-6] 'gomoku-move-right)
- (define-key map [kp-2] 'gomoku-move-down)
- (define-key map [kp-8] 'gomoku-move-up)
-
- (define-key map "\C-b" 'gomoku-move-left) ; C-b
- (define-key map "\C-f" 'gomoku-move-right) ; C-f
- (define-key map "\C-n" 'gomoku-move-down) ; C-n
- (define-key map "\C-p" 'gomoku-move-up) ; C-p
-
- ;; Key bindings for entering Human moves.
- (define-key map "X" 'gomoku-human-plays) ; X
- (define-key map "x" 'gomoku-human-plays) ; x
- (define-key map " " 'gomoku-human-plays) ; SPC
- (define-key map "\C-m" 'gomoku-human-plays) ; RET
- (define-key map "\C-c\C-p" 'gomoku-human-plays) ; C-c C-p
- (define-key map "\C-c\C-b" 'gomoku-human-takes-back) ; C-c C-b
- (define-key map "\C-c\C-r" 'gomoku-human-resigns) ; C-c C-r
- (define-key map "\C-c\C-e" 'gomoku-emacs-plays) ; C-c C-e
-
- (define-key map [kp-enter] 'gomoku-human-plays)
- (define-key map [insert] 'gomoku-human-plays)
- (define-key map [down-mouse-1] 'gomoku-click)
- (define-key map [drag-mouse-1] 'gomoku-click)
- (define-key map [mouse-1] 'gomoku-click)
- (define-key map [down-mouse-2] 'gomoku-click)
- (define-key map [mouse-2] 'gomoku-mouse-play)
- (define-key map [drag-mouse-2] 'gomoku-mouse-play)
-
- (define-key map [remap backward-char] 'gomoku-move-left)
- (define-key map [remap left-char] 'gomoku-move-left)
- (define-key map [remap forward-char] 'gomoku-move-right)
- (define-key map [remap right-char] 'gomoku-move-right)
- (define-key map [remap previous-line] 'gomoku-move-up)
- (define-key map [remap next-line] 'gomoku-move-down)
- (define-key map [remap move-beginning-of-line] 'gomoku-beginning-of-line)
- (define-key map [remap move-end-of-line] 'gomoku-end-of-line)
- (define-key map [remap undo] 'gomoku-human-takes-back)
- (define-key map [remap advertised-undo] 'gomoku-human-takes-back)
- map)
-
- "Local keymap to use in Gomoku mode.")
+(defvar-keymap gomoku-mode-map
+ :doc "Local keymap to use in Gomoku mode."
+ ;; Key bindings for cursor motion.
+ "y" #'gomoku-move-nw
+ "u" #'gomoku-move-ne
+ "b" #'gomoku-move-sw
+ "n" #'gomoku-move-se
+ "h" #'gomoku-move-left
+ "l" #'gomoku-move-right
+ "j" #'gomoku-move-down
+ "k" #'gomoku-move-up
+
+ "<kp-7>" #'gomoku-move-nw
+ "<kp-9>" #'gomoku-move-ne
+ "<kp-1>" #'gomoku-move-sw
+ "<kp-3>" #'gomoku-move-se
+ "<kp-4>" #'gomoku-move-left
+ "<kp-6>" #'gomoku-move-right
+ "<kp-2>" #'gomoku-move-down
+ "<kp-8>" #'gomoku-move-up
+
+ "C-b" #'gomoku-move-left
+ "C-f" #'gomoku-move-right
+ "C-n" #'gomoku-move-down
+ "C-p" #'gomoku-move-up
+
+ ;; Key bindings for entering Human moves.
+ "X" #'gomoku-human-plays
+ "x" #'gomoku-human-plays
+ "SPC" #'gomoku-human-plays
+ "RET" #'gomoku-human-plays
+ "C-c C-p" #'gomoku-human-plays
+ "C-c C-b" #'gomoku-human-takes-back
+ "C-c C-r" #'gomoku-human-resigns
+ "C-c C-e" #'gomoku-emacs-plays
+
+ "<kp-enter>" #'gomoku-human-plays
+ "<insert>" #'gomoku-human-plays
+ "<down-mouse-1>" #'gomoku-click
+ "<drag-mouse-1>" #'gomoku-click
+ "<mouse-1>" #'gomoku-click
+ "<down-mouse-2>" #'gomoku-click
+ "<mouse-2>" #'gomoku-mouse-play
+ "<drag-mouse-2>" #'gomoku-mouse-play
+
+ "<remap> <backward-char>" #'gomoku-move-left
+ "<remap> <left-char>" #'gomoku-move-left
+ "<remap> <forward-char>" #'gomoku-move-right
+ "<remap> <right-char>" #'gomoku-move-right
+ "<remap> <previous-line>" #'gomoku-move-up
+ "<remap> <next-line>" #'gomoku-move-down
+ "<remap> <move-beginning-of-line>" #'gomoku-beginning-of-line
+ "<remap> <move-end-of-line>" #'gomoku-end-of-line
+ "<remap> <undo>" #'gomoku-human-takes-back
+ "<remap> <advertised-undo>" #'gomoku-human-takes-back)
(defvar gomoku-emacs-won ()
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 14624ddce23..68a82f5a9ef 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -1,6 +1,6 @@
;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
;; Maintainer: emacs-devel@gnu.org
@@ -29,44 +29,42 @@
;;
;; Other functions that may be useful are:
;;
-;; handwrite-10pt: sets the font size to 10 and finds corresponding
-;; values for the line spacing and the number of lines
-;; on a page.
-;; handwrite-11pt: which is similar
-;; handwrite-12pt: which is also similar
-;; handwrite-13pt: which is similar, too
+;; `handwrite-10pt': set the font size to 10 and find corresponding
+;; values for the line spacing and the number of lines
+;; on a page.
+;; `handwrite-11pt': which is similar
+;; `handwrite-12pt': which is also similar
+;; `handwrite-13pt': which is similar, too
;;
-;; handwrite-set-pagenumber: set and unset page numbering
+;; `handwrite-set-pagenumber': set and unset page numbering
;;
;;
;; If you are not satisfied with the type page there are a number of
;; variables you may want to set.
;;
-;; To use this, say "M-x handwrite" or type at your prompt
+;; To use this, say `M-x handwrite' or type at your prompt
;; "emacs -l handwrite.el".
;;
;; I tried to make it `iso_8859_1'-friendly, but there are some exotic
;; characters missing.
;;
;;
-;; Known bugs: -Page feeds do not do their work, but are ignored instead.
-;; -Tabs are not always properly displayed.
-;; -Handwrite may create corrupt PostScript if it encounters
-;; unknown characters.
+;; Known bugs:
+;; - Page feeds do not work, and are ignored instead.
+;; - Tabs are not always properly displayed.
+;; - Handwrite may create corrupt PostScript if it encounters
+;; unknown characters.
;;
;; Thanks to anyone who emailed me suggestions!
;;; Code:
-;; From ps-print.el
-(defvar ps-printer-name)
-(defvar ps-lpr-command)
-(defvar ps-lpr-switches)
+(require 'ps-print)
;; Variables
(defgroup handwrite nil
- "Turns your Emacs buffer into a handwritten document."
+ "Turn your Emacs buffer into a handwritten document."
:prefix "handwrite-"
:group 'games)
@@ -235,20 +233,13 @@ Variables: `handwrite-linespace' (default 12)
(while (search-forward "\f" nil t)
(replace-match "" nil t) )
(untabify textp (point-max)) ; this may result in strange tabs
- (if (y-or-n-p "Send this to the printer? ")
- (progn
- (require 'ps-print)
- (let* ((coding-system-for-write 'raw-text-unix)
- (ps-printer-name (or ps-printer-name
- (and (boundp 'printer-name)
- printer-name)))
- (ps-lpr-switches
- (if (stringp ps-printer-name)
- (list (concat "-P" ps-printer-name)))))
- (apply (or (and (boundp 'ps-print-region-function)
- ps-print-region-function)
- 'call-process-region)
- (point-min) (point-max) ps-lpr-command nil nil nil))))
+ (when (y-or-n-p "Send this to the printer? ")
+ (let* ((coding-system-for-write 'raw-text-unix)
+ (printer-name (or ps-printer-name printer-name))
+ (lpr-printer-switch ps-printer-name-option)
+ (print-region-function ps-print-region-function)
+ (lpr-command ps-lpr-command))
+ (lpr-print-region (point-min) (point-max) ps-lpr-switches nil)))
(message "")
(bury-buffer ())
(switch-to-buffer cur-buf)
@@ -264,8 +255,8 @@ Variables: `handwrite-linespace' (default 12)
(defun handwrite-10pt ()
"Specify 10-point output for `handwrite'.
-This sets `handwrite-fontsize' to 10 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'."
+Set `handwrite-fontsize' to 10 and find correct values for
+`handwrite-linespace' and `handwrite-numlines'."
(interactive)
(setq handwrite-fontsize 10)
(setq handwrite-linespace 11)
@@ -274,8 +265,8 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(defun handwrite-11pt ()
"Specify 11-point output for `handwrite'.
-This sets `handwrite-fontsize' to 11 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'."
+Set `handwrite-fontsize' to 11 and find correct values for
+`handwrite-linespace' and `handwrite-numlines'."
(interactive)
(setq handwrite-fontsize 11)
(setq handwrite-linespace 12)
@@ -284,8 +275,8 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(defun handwrite-12pt ()
"Specify 12-point output for `handwrite'.
-This sets `handwrite-fontsize' to 12 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'."
+Set `handwrite-fontsize' to 12 and find correct values for
+`handwrite-linespace' and `handwrite-numlines'."
(interactive)
(setq handwrite-fontsize 12)
(setq handwrite-linespace 13)
@@ -294,8 +285,8 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(defun handwrite-13pt ()
"Specify 13-point output for `handwrite'.
-This sets `handwrite-fontsize' to 13 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'."
+Set `handwrite-fontsize' to 13 and find correct values for
+`handwrite-linespace' and `handwrite-numlines'."
(interactive)
(setq handwrite-fontsize 13)
(setq handwrite-linespace 14)
diff --git a/lisp/play/morse.el b/lisp/play/morse.el
index 974e9fbc49c..5b7d343a79e 100644
--- a/lisp/play/morse.el
+++ b/lisp/play/morse.el
@@ -1,6 +1,6 @@
;;; morse.el --- convert text to morse code and back -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2022 Free Software Foundation, Inc.
;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
;; Keywords: games
@@ -22,11 +22,11 @@
;;; Commentary:
-;; Converts text to Morse code and back with M-x morse-region and
-;; M-x unmorse-region (though Morse code is no longer official :-().
+;; Convert plain text to Morse code and back with `M-x morse-region' and
+;; `M-x unmorse-region'.
-;; Converts text to NATO phonetic alphabet and back with M-x
-;; nato-region and M-x denato-region.
+;; Convert plain text to NATO spelling alphabet and back with
+;; `M-x nato-region' and `M-x denato-region'.
;;; Code:
@@ -142,14 +142,16 @@
("(" . "Open")
(")" . "Close")
("@" . "At"))
- "NATO phonetic alphabet.
+ "NATO spelling alphabet.
See “International Code of Signals” (INTERCO), United States
Edition, 1969 Edition (Revised 2003) available from National
-Geospatial-Intelligence Agency at URL `https://www.nga.mil/'")
+Geospatial-Intelligence Agency at <https://www.nga.mil/>.
+See also <https://en.wikipedia.org/wiki/NATO_phonetic_alphabet>.")
;;;###autoload
(defun morse-region (beg end)
- "Convert all text in a given region to morse code."
+ "Convert plain text in region to Morse code.
+See <https://en.wikipedia.org/wiki/Morse_code>."
(interactive "*r")
(if (integerp end)
(setq end (copy-marker end)))
@@ -172,7 +174,7 @@ Geospatial-Intelligence Agency at URL `https://www.nga.mil/'")
;;;###autoload
(defun unmorse-region (beg end)
- "Convert morse coded text in region to ordinary ASCII text."
+ "Convert Morse coded text in region to plain text."
(interactive "*r")
(if (integerp end)
(setq end (copy-marker end)))
@@ -194,7 +196,7 @@ Geospatial-Intelligence Agency at URL `https://www.nga.mil/'")
;;;###autoload
(defun nato-region (beg end)
- "Convert all text in a given region to NATO phonetic alphabet."
+ "Convert plain text in region to NATO spelling alphabet."
;; Copied from morse-region. -- ashawley 2009-02-10
(interactive "*r")
(if (integerp end)
@@ -218,7 +220,7 @@ Geospatial-Intelligence Agency at URL `https://www.nga.mil/'")
;;;###autoload
(defun denato-region (beg end)
- "Convert NATO phonetic alphabet in region to ordinary ASCII text."
+ "Convert NATO spelling alphabet text in region to plain text."
;; Copied from unmorse-region. -- ashawley 2009-02-10
(interactive "*r")
(if (integerp end)
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 860ba4817ec..1cacf01a20c 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -76,17 +76,12 @@ The value t means never ding, and `error' means only ding on wrong input."
"Hook to run upon entry to mpuz."
:type 'hook)
-(defvar mpuz-mode-map
- (let ((map (make-sparse-keymap)))
- (mapc (lambda (ch)
- (define-key map (char-to-string ch) 'mpuz-try-letter))
- "abcdefghijABCDEFGHIJ")
- (define-key map "\C-g" 'mpuz-offer-abort)
- (define-key map "?" 'describe-mode)
- map)
- "Local keymap to use in Mult Puzzle.")
-
-
+(defvar-keymap mpuz-mode-map
+ :doc "Local keymap to use in Mult Puzzle."
+ "C-g" #'mpuz-offer-abort
+ "?" #'describe-mode)
+(dolist (ch (mapcar #'char-to-string "abcdefghijABCDEFGHIJ"))
+ (keymap-set mpuz-mode-map ch #'mpuz-try-letter))
(define-derived-mode mpuz-mode fundamental-mode "Mult Puzzle"
:interactive nil
diff --git a/lisp/play/pong.el b/lisp/play/pong.el
index bc71e2a2666..79beeb72e2b 100644
--- a/lisp/play/pong.el
+++ b/lisp/play/pong.el
@@ -173,23 +173,23 @@
;;; Initialize maps
-(defvar pong-mode-map
- (let ((map (make-sparse-keymap 'pong-mode-map)))
- (define-key map [left] 'pong-move-left)
- (define-key map [right] 'pong-move-right)
- (define-key map [up] 'pong-move-up)
- (define-key map [down] 'pong-move-down)
- (define-key map pong-left-key 'pong-move-left)
- (define-key map pong-right-key 'pong-move-right)
- (define-key map pong-up-key 'pong-move-up)
- (define-key map pong-down-key 'pong-move-down)
- (define-key map pong-quit-key 'pong-quit)
- (define-key map pong-pause-key 'pong-pause)
- map)
- "Modemap for pong-mode.")
-
-(defvar pong-null-map
- (make-sparse-keymap 'pong-null-map) "Null map for pong-mode.")
+(defvar-keymap pong-mode-map
+ :doc "Modemap for pong-mode."
+ :name 'pong-mode-map
+ "<left>" #'pong-move-left
+ "<right>" #'pong-move-right
+ "<up>" #'pong-move-up
+ "<down>" #'pong-move-down
+ pong-left-key #'pong-move-left
+ pong-right-key #'pong-move-right
+ pong-up-key #'pong-move-up
+ pong-down-key #'pong-move-down
+ pong-quit-key #'pong-quit
+ pong-pause-key #'pong-pause)
+
+(defvar-keymap pong-null-map
+ :doc "Null map for pong-mode."
+ :name 'pong-null-map)
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index 1056b17c91b..d8074edfc4c 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -160,31 +160,28 @@ and then start moving it leftwards.")
;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar snake-mode-map
- (let ((map (make-sparse-keymap 'snake-mode-map)))
-
- (define-key map "n" 'snake-start-game)
- (define-key map "q" 'snake-end-game)
- (define-key map "p" 'snake-pause-game)
-
- (define-key map [left] 'snake-move-left)
- (define-key map [right] 'snake-move-right)
- (define-key map [up] 'snake-move-up)
- (define-key map [down] 'snake-move-down)
-
- (define-key map "\C-b" 'snake-move-left)
- (define-key map "\C-f" 'snake-move-right)
- (define-key map "\C-p" 'snake-move-up)
- (define-key map "\C-n" 'snake-move-down)
- map)
- "Keymap for Snake games.")
-
-(defvar snake-null-map
- (let ((map (make-sparse-keymap 'snake-null-map)))
- (define-key map "n" 'snake-start-game)
- (define-key map "q" 'quit-window)
- map)
- "Keymap for finished Snake games.")
+(defvar-keymap snake-mode-map
+ :doc "Keymap for Snake games."
+ :name 'snake-mode-map
+ "n" #'snake-start-game
+ "q" #'snake-end-game
+ "p" #'snake-pause-game
+
+ "<left>" #'snake-move-left
+ "<right>" #'snake-move-right
+ "<up>" #'snake-move-up
+ "<down>" #'snake-move-down
+
+ "C-b" #'snake-move-left
+ "C-f" #'snake-move-right
+ "C-p" #'snake-move-up
+ "C-n" #'snake-move-down)
+
+(defvar-keymap snake-null-map
+ :doc "Keymap for finished Snake games."
+ :name 'snake-null-map
+ "n" #'snake-start-game
+ "q" #'quit-window)
(defconst snake--menu-def
'("Snake"
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
index 2fc33fa2335..3c6d85b4094 100644
--- a/lisp/play/solitaire.el
+++ b/lisp/play/solitaire.el
@@ -40,48 +40,46 @@
"Hook to run upon entry to Solitaire."
:type 'hook)
-(defvar solitaire-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map special-mode-map)
-
- (define-key map "\C-f" 'solitaire-right)
- (define-key map "\C-b" 'solitaire-left)
- (define-key map "\C-p" 'solitaire-up)
- (define-key map "\C-n" 'solitaire-down)
- (define-key map "\r" 'solitaire-move)
- (define-key map [remap undo] 'solitaire-undo)
- (define-key map " " 'solitaire-do-check)
-
- (define-key map [right] 'solitaire-right)
- (define-key map [left] 'solitaire-left)
- (define-key map [up] 'solitaire-up)
- (define-key map [down] 'solitaire-down)
-
- (define-key map [S-right] 'solitaire-move-right)
- (define-key map [S-left] 'solitaire-move-left)
- (define-key map [S-up] 'solitaire-move-up)
- (define-key map [S-down] 'solitaire-move-down)
-
- (define-key map [kp-6] 'solitaire-right)
- (define-key map [kp-4] 'solitaire-left)
- (define-key map [kp-8] 'solitaire-up)
- (define-key map [kp-2] 'solitaire-down)
- (define-key map [kp-5] 'solitaire-center-point)
-
- (define-key map [S-kp-6] 'solitaire-move-right)
- (define-key map [S-kp-4] 'solitaire-move-left)
- (define-key map [S-kp-8] 'solitaire-move-up)
- (define-key map [S-kp-2] 'solitaire-move-down)
-
- (define-key map [kp-enter] 'solitaire-move)
- (define-key map [kp-0] 'solitaire-undo)
-
- ;; spoil it with s ;)
- (define-key map [?s] 'solitaire-solve)
-
- ;; (define-key map [kp-0] 'solitaire-hint) - Not yet provided ;)
- map)
- "Keymap for playing Solitaire.")
+(defvar-keymap solitaire-mode-map
+ :doc "Keymap for playing Solitaire."
+ :parent special-mode-map
+ "C-f" #'solitaire-right
+ "C-b" #'solitaire-left
+ "C-p" #'solitaire-up
+ "C-n" #'solitaire-down
+ "RET" #'solitaire-move
+ "SPC" #'solitaire-do-check
+
+ "<right>" #'solitaire-right
+ "<left>" #'solitaire-left
+ "<up>" #'solitaire-up
+ "<down>" #'solitaire-down
+
+ "S-<right>" #'solitaire-move-right
+ "S-<left>" #'solitaire-move-left
+ "S-<up>" #'solitaire-move-up
+ "S-<down>" #'solitaire-move-down
+
+ "<kp-6>" #'solitaire-right
+ "<kp-4>" #'solitaire-left
+ "<kp-8>" #'solitaire-up
+ "<kp-2>" #'solitaire-down
+ "<kp-5>" #'solitaire-center-point
+
+ "S-<kp-6>" #'solitaire-move-right
+ "S-<kp-4>" #'solitaire-move-left
+ "S-<kp-8>" #'solitaire-move-up
+ "S-<kp-2>" #'solitaire-move-down
+
+ "<kp-enter>" #'solitaire-move
+ "<kp-0>" #'solitaire-undo
+ "<remap> <undo>" #'solitaire-undo
+
+ ;; spoil it with s ;)
+ "s" #'solitaire-solve
+
+ ;; "[kp-0]" #'solitaire-hint - Not yet provided ;)
+ )
;; Solitaire mode is suitable only for specially formatted data.
(put 'solitaire-mode 'mode-class 'special)
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
index f2bdba1c2aa..ccff2e75b0a 100644
--- a/lisp/play/spook.el
+++ b/lisp/play/spook.el
@@ -49,7 +49,7 @@
(defcustom spook-phrase-default-count 15
"Default number of phrases to insert."
- :type 'integer)
+ :type 'natnum)
;;;###autoload
(defun spook ()
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 6fe82fa7fc9..a6bfea81ee1 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -95,27 +95,34 @@ If the return value is a number, it is used as the timer period."
(defcustom tetris-buffer-width 30
"Width of used portion of buffer."
- :type 'number)
+ :type 'natnum)
(defcustom tetris-buffer-height 22
"Height of used portion of buffer."
- :type 'number)
+ :type 'natnum)
(defcustom tetris-width 10
"Width of playing area."
- :type 'number)
+ :type 'natnum)
(defcustom tetris-height 20
"Height of playing area."
- :type 'number)
+ :type 'natnum)
(defcustom tetris-top-left-x 3
"X position of top left of playing area."
- :type 'number)
+ :type 'natnum)
(defcustom tetris-top-left-y 1
"Y position of top left of playing area."
- :type 'number)
+ :type 'natnum)
+
+(defcustom tetris-allow-repetitions t
+ "If non-nil, use a random selection for each shape.
+If nil, put the shapes into a bag and select without putting
+back (until empty, when the bag is repopulated."
+ :type 'boolean
+ :version "29.1")
(defvar tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width)
"X position of next shape.")
@@ -233,29 +240,28 @@ each one of its four blocks.")
(defvar-local tetris-pos-x 0)
(defvar-local tetris-pos-y 0)
(defvar-local tetris-paused nil)
+(defvar-local tetris--bag nil)
;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar tetris-mode-map
- (let ((map (make-sparse-keymap 'tetris-mode-map)))
- (define-key map "n" 'tetris-start-game)
- (define-key map "q" 'tetris-end-game)
- (define-key map "p" 'tetris-pause-game)
-
- (define-key map " " 'tetris-move-bottom)
- (define-key map [left] 'tetris-move-left)
- (define-key map [right] 'tetris-move-right)
- (define-key map [up] 'tetris-rotate-prev)
- (define-key map [down] 'tetris-move-down)
- map)
- "Keymap for Tetris games.")
-
-(defvar tetris-null-map
- (let ((map (make-sparse-keymap 'tetris-null-map)))
- (define-key map "n" 'tetris-start-game)
- (define-key map "q" 'quit-window)
- map)
- "Keymap for finished Tetris games.")
+(defvar-keymap tetris-mode-map
+ :doc "Keymap for Tetris games."
+ :name 'tetris-mode-map
+ "n" #'tetris-start-game
+ "q" #'tetris-end-game
+ "p" #'tetris-pause-game
+
+ "SPC" #'tetris-move-bottom
+ "<left>" #'tetris-move-left
+ "<right>" #'tetris-move-right
+ "<up>" #'tetris-rotate-prev
+ "<down>" #'tetris-move-down)
+
+(defvar-keymap tetris-null-map
+ :doc "Keymap for finished Tetris games."
+ :name 'tetris-null-map
+ "n" #'tetris-start-game
+ "q" #'quit-window)
(defconst tetris--menu-def
'("Tetris"
@@ -343,10 +349,23 @@ each one of its four blocks.")
(let ((period (tetris-get-tick-period)))
(if period (gamegrid-set-timer period))))
+(defun tetris--shuffle (sequence)
+ (cl-loop for i from (length sequence) downto 2
+ do (cl-rotatef (elt sequence (random i))
+ (elt sequence (1- i))))
+ sequence)
+
+(defun tetris--seven-bag ()
+ (when (not tetris--bag)
+ (setq tetris--bag (tetris--shuffle (list 0 1 2 3 4 5 6))))
+ (pop tetris--bag))
+
(defun tetris-new-shape ()
(setq tetris-shape tetris-next-shape)
(setq tetris-rot 0)
- (setq tetris-next-shape (random 7))
+ (setq tetris-next-shape (if tetris-allow-repetitions
+ (random 7)
+ (tetris--seven-bag)))
(setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2))
(setq tetris-pos-y 0)
(if (tetris-test-shape)
diff --git a/lisp/plstore.el b/lisp/plstore.el
index b37d39ce1b1..de3f828016a 100644
--- a/lisp/plstore.el
+++ b/lisp/plstore.el
@@ -107,6 +107,7 @@ symmetric encryption will be used."
:type '(choice (const nil) (repeat :tag "Recipient(s)" string))
:group 'plstore)
+;;;###autoload
(put 'plstore-encrypt-to 'safe-local-variable
(lambda (val)
(or (stringp val)
diff --git a/lisp/proced.el b/lisp/proced.el
index f451091332f..a27638d3679 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -29,10 +29,6 @@
;;
;; To do:
;; - Interactive temporary customizability of flags in `proced-grammar-alist'
-;; - Allow "sudo kill PID", "sudo renice PID"
-;; `proced-send-signal' operates on multiple processes one by one.
-;; With "sudo" we want to execute one "kill" or "renice" command
-;; for all marked processes. Is there a `sudo-call-process'?
;;
;; Thoughts and Ideas
;; - Currently, `process-attributes' returns the list of
@@ -55,12 +51,19 @@
:group 'unix
:prefix "proced-")
+(defcustom proced-show-remote-processes nil
+ "Whether processes of the remote host shall be shown.
+This happens only when `default-directory' is remote."
+ :version "29.1"
+ :type 'boolean)
+
(defcustom proced-signal-function #'signal-process
"Name of signal function.
It can be an elisp function (usually `signal-process') or a string specifying
the external command (usually \"kill\")."
:type '(choice (function :tag "function")
(string :tag "command")))
+(make-obsolete-variable 'proced-signal-function "no longer used." "29.1")
(defcustom proced-renice-command "renice"
"Name of renice command."
@@ -275,8 +278,8 @@ It can also be a list of keys appearing in `proced-grammar-alist'."
;; FIXME: is there a better name for filter `user' that does not coincide
;; with an attribute key?
(defcustom proced-filter-alist
- `((user (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'")))
- (user-running (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'"))
+ `((user (user . proced-user-name))
+ (user-running (user . proced-user-name)
(state . "\\`[Rr]\\'"))
(all)
(all-running (state . "\\`[Rr]\\'"))
@@ -366,7 +369,7 @@ May be used to revert the process listing."
;; Internal variables
-(defvar proced-available (not (null (list-system-processes)))
+(defvar proced-available t;(not (null (list-system-processes)))
"Non-nil means Proced is known to work on this system.")
(defvar-local proced-process-alist nil
@@ -565,6 +568,12 @@ Important: the match ends just after the marker.")
:help "Renice Marked Processes"]))
;; helper functions
+(defun proced-user-name (user)
+ "Check the `user' attribute with user name `proced' is running for."
+ (string-equal user (if (file-remote-p default-directory)
+ (file-remote-p default-directory 'user)
+ (user-real-login-name))))
+
(defun proced-marker-regexp ()
"Return regexp matching `proced-marker-char'."
;; `proced-marker-char' must appear in column zero
@@ -626,6 +635,7 @@ Return nil if point is not on a process line."
Type \\[proced] to start a Proced session. In a Proced buffer
type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands.
Type \\[proced-send-signal] to send signals to marked processes.
+Type \\[proced-renice] to renice marked processes.
The initial content of a listing is defined by the variable `proced-filter'
and the variable `proced-format'.
@@ -658,6 +668,7 @@ After displaying or updating a Proced buffer, Proced runs the normal hook
`proced-post-display-hook'.
\\{proced-mode-map}"
+ :interactive nil
(abbrev-mode 0)
(auto-fill-mode 0)
(setq buffer-read-only t
@@ -676,8 +687,13 @@ After displaying or updating a Proced buffer, Proced runs the normal hook
(defun proced (&optional arg)
"Generate a listing of UNIX system processes.
\\<proced-mode-map>
-If invoked with optional ARG, do not select the window displaying
-the process information.
+If invoked with optional non-negative ARG, do not select the
+window displaying the process information.
+
+If `proced-show-remote-processes' is non-nil or the command is
+invoked with a negative ARG `\\[universal-argument] \\[negative-argument]', \
+and `default-directory'
+points to a remote host, the system processes of that host are shown.
This function runs the normal hook `proced-post-display-hook'.
@@ -688,6 +704,11 @@ Proced buffers."
(error "Proced is not available on this system"))
(let ((buffer (get-buffer-create "*Proced*")) new)
(set-buffer buffer)
+ (when (and (file-remote-p default-directory)
+ (not
+ (or proced-show-remote-processes
+ (eq arg '-))))
+ (setq default-directory temporary-file-directory))
(setq new (zerop (buffer-size)))
(when new
(proced-mode)
@@ -721,7 +742,7 @@ Proced buffers."
With prefix ARG, update this buffer automatically if ARG is positive,
otherwise do not update. Sets the variable `proced-auto-update-flag'.
The time interval for updates is specified via `proced-auto-update-interval'."
- (interactive (list (or current-prefix-arg 'toggle)))
+ (interactive (list (or current-prefix-arg 'toggle)) proced-mode)
(setq proced-auto-update-flag
(cond ((eq arg 'toggle) (not proced-auto-update-flag))
(arg (> (prefix-numeric-value arg) 0))
@@ -733,19 +754,19 @@ The time interval for updates is specified via `proced-auto-update-interval'."
(defun proced-mark (&optional count)
"Mark the current (or next COUNT) processes."
- (interactive "p")
+ (interactive "p" proced-mode)
(proced-do-mark t count))
(defun proced-unmark (&optional count)
"Unmark the current (or next COUNT) processes."
- (interactive "p")
+ (interactive "p" proced-mode)
(proced-do-mark nil count))
(defun proced-unmark-backward (&optional count)
"Unmark the previous (or COUNT previous) processes."
;; Analogous to `dired-unmark-backward',
;; but `ibuffer-unmark-backward' behaves different.
- (interactive "p")
+ (interactive "p" proced-mode)
(proced-do-mark nil (- (or count 1))))
(defun proced-do-mark (mark &optional count)
@@ -762,7 +783,7 @@ The time interval for updates is specified via `proced-auto-update-interval'."
(defun proced-toggle-marks ()
"Toggle marks: marked processes become unmarked, and vice versa."
- (interactive)
+ (interactive nil proced-mode)
(let ((mark-re (proced-marker-regexp))
buffer-read-only)
(save-excursion
@@ -788,14 +809,14 @@ Otherwise move one line forward after inserting the mark."
"Mark all processes.
If `transient-mark-mode' is turned on and the region is active,
mark the region."
- (interactive)
+ (interactive nil proced-mode)
(proced-do-mark-all t))
(defun proced-unmark-all ()
"Unmark all processes.
If `transient-mark-mode' is turned on and the region is active,
unmark the region."
- (interactive)
+ (interactive nil proced-mode)
(proced-do-mark-all nil))
(defun proced-do-mark-all (mark)
@@ -830,14 +851,14 @@ mark the region."
(defun proced-mark-children (ppid &optional omit-ppid)
"Mark child processes of process PPID.
Also mark process PPID unless prefix OMIT-PPID is non-nil."
- (interactive (list (proced-pid-at-point) current-prefix-arg))
+ (interactive (list (proced-pid-at-point) current-prefix-arg) proced-mode)
(proced-mark-process-alist
(proced-filter-children proced-process-alist ppid omit-ppid)))
(defun proced-mark-parents (cpid &optional omit-cpid)
"Mark parent processes of process CPID.
Also mark CPID unless prefix OMIT-CPID is non-nil."
- (interactive (list (proced-pid-at-point) current-prefix-arg))
+ (interactive (list (proced-pid-at-point) current-prefix-arg) proced-mode)
(proced-mark-process-alist
(proced-filter-parents proced-process-alist cpid omit-cpid)))
@@ -870,7 +891,7 @@ If `transient-mark-mode' is turned on and the region is active,
omit the processes in region.
If QUIET is non-nil suppress status message.
Returns count of omitted lines."
- (interactive "P")
+ (interactive "P" proced-mode)
(let ((mark-re (proced-marker-regexp))
(count 0)
buffer-read-only)
@@ -947,7 +968,8 @@ Set variable `proced-filter' to SCHEME. Revert listing."
(interactive
(let ((scheme (completing-read "Filter: "
proced-filter-alist nil t)))
- (list (if (string= "" scheme) nil (intern scheme)))))
+ (list (if (string= "" scheme) nil (intern scheme))))
+ proced-mode)
;; only update if necessary
(unless (eq proced-filter scheme)
(setq proced-filter scheme)
@@ -1057,7 +1079,7 @@ Each parent process is followed by its child processes.
The process tree inherits the chosen sorting order of the process listing,
that is, child processes of the same parent process are sorted using
the selected sorting order."
- (interactive (list (or current-prefix-arg 'toggle)))
+ (interactive (list (or current-prefix-arg 'toggle)) proced-mode)
(setq proced-tree-flag
(cond ((eq arg 'toggle) (not proced-tree-flag))
(arg (> (prefix-numeric-value arg) 0))
@@ -1140,7 +1162,7 @@ This command refines an already existing process listing generated initially
based on the value of the variable `proced-filter'. It does not change
this variable. It does not revert the listing. If you frequently need
a certain refinement, consider defining a new filter in `proced-filter-alist'."
- (interactive (list last-input-event))
+ (interactive (list last-input-event) proced-mode)
(if event (posn-set-point (event-end event)))
(let ((key (get-text-property (point) 'proced-key))
(pid (get-text-property (point) 'proced-pid)))
@@ -1269,7 +1291,8 @@ in the mode line, using \"+\" or \"-\" for ascending or descending order."
nil t)))
(list (if (string= "" scheme) nil (intern scheme))
;; like 'toggle in `define-derived-mode'
- (or current-prefix-arg 'no-arg))))
+ (or current-prefix-arg 'no-arg)))
+ proced-mode)
(setq proced-descend
;; If `proced-sort-interactive' is called repeatedly for the same
@@ -1290,37 +1313,37 @@ in the mode line, using \"+\" or \"-\" for ascending or descending order."
(defun proced-sort-pcpu (&optional arg)
"Sort Proced buffer by percentage CPU time (%CPU).
Prefix ARG controls sort order, see `proced-sort-interactive'."
- (interactive (list (or current-prefix-arg 'no-arg)))
+ (interactive (list (or current-prefix-arg 'no-arg)) proced-mode)
(proced-sort-interactive 'pcpu arg))
(defun proced-sort-pmem (&optional arg)
"Sort Proced buffer by percentage memory usage (%MEM).
Prefix ARG controls sort order, see `proced-sort-interactive'."
- (interactive (list (or current-prefix-arg 'no-arg)))
+ (interactive (list (or current-prefix-arg 'no-arg)) proced-mode)
(proced-sort-interactive 'pmem arg))
(defun proced-sort-pid (&optional arg)
"Sort Proced buffer by PID.
Prefix ARG controls sort order, see `proced-sort-interactive'."
- (interactive (list (or current-prefix-arg 'no-arg)))
+ (interactive (list (or current-prefix-arg 'no-arg)) proced-mode)
(proced-sort-interactive 'pid arg))
(defun proced-sort-start (&optional arg)
"Sort Proced buffer by time the command started (START).
Prefix ARG controls sort order, see `proced-sort-interactive'."
- (interactive (list (or current-prefix-arg 'no-arg)))
+ (interactive (list (or current-prefix-arg 'no-arg)) proced-mode)
(proced-sort-interactive 'start arg))
(defun proced-sort-time (&optional arg)
"Sort Proced buffer by CPU time (TIME).
Prefix ARG controls sort order, see `proced-sort-interactive'."
- (interactive (list (or current-prefix-arg 'no-arg)))
+ (interactive (list (or current-prefix-arg 'no-arg)) proced-mode)
(proced-sort-interactive 'time arg))
(defun proced-sort-user (&optional arg)
"Sort Proced buffer by USER.
Prefix ARG controls sort order, see `proced-sort-interactive'."
- (interactive (list (or current-prefix-arg 'no-arg)))
+ (interactive (list (or current-prefix-arg 'no-arg)) proced-mode)
(proced-sort-interactive 'user arg))
(defun proced-sort-header (event &optional arg)
@@ -1329,7 +1352,7 @@ EVENT is a mouse event with starting position in the header line.
It is converted to the corresponding attribute key.
This command updates the variable `proced-sort'.
Prefix ARG controls sort order, see `proced-sort-interactive'."
- (interactive (list last-input-event (or last-prefix-arg 'no-arg)))
+ (interactive (list last-input-event (or last-prefix-arg 'no-arg)) proced-mode)
(let* ((start (event-start event))
(obj (posn-object start))
col key)
@@ -1403,7 +1426,7 @@ Replace newline characters by \"^J\" (two characters)."
;; If none of the alternatives is non-nil, the attribute is ignored
;; in the listing.
(let ((standard-attributes
- (car (proced-process-attributes (list (emacs-pid)))))
+ (car (proced-process-attributes (list-system-processes))))
new-format fmi)
(if (and proced-tree-flag
(assq 'ppid standard-attributes))
@@ -1535,7 +1558,8 @@ With prefix REVERT non-nil revert listing."
(let ((scheme (completing-read "Format: "
proced-format-alist nil t)))
(list (if (string= "" scheme) nil (intern scheme))
- current-prefix-arg)))
+ current-prefix-arg))
+ proced-mode)
;; only update if necessary
(when (or (not (eq proced-format scheme)) revert)
(setq proced-format scheme)
@@ -1567,7 +1591,7 @@ Suppress status information if QUIET is nil.
After updating a displayed Proced buffer run the normal hook
`proced-post-display-hook'."
;; This is the main function that generates and updates the process listing.
- (interactive "P")
+ (interactive "P" proced-mode)
(setq revert (or revert (not proced-process-alist)))
(or quiet (message (if revert "Updating process information..."
"Updating process display...")))
@@ -1773,11 +1797,12 @@ supported but discouraged. It will be removed in a future version of Emacs."
`(:annotation-function
,(lambda (s) (cdr (assoc s proced-signal-list))))))
(proced-with-processes-buffer process-alist
- (list (completing-read (concat "Send signal [" pnum
- "] (default TERM): ")
+ (list (completing-read (format-prompt "Send signal [%s]"
+ "TERM" pnum)
proced-signal-list
nil nil nil nil "TERM")
- process-alist))))
+ process-alist)))
+ proced-mode)
(unless (and signal process-alist)
;; Discouraged usage (supported for backward compatibility):
@@ -1798,8 +1823,8 @@ supported but discouraged. It will be removed in a future version of Emacs."
`(:annotation-function
,(lambda (s) (cdr (assoc s proced-signal-list))))))
(proced-with-processes-buffer process-alist
- (setq signal (completing-read (concat "Send signal [" pnum
- "] (default TERM): ")
+ (setq signal (completing-read (format-prompt "Send signal [%s]"
+ "TERM" pnum)
proced-signal-list
nil nil nil nil "TERM"))))))
@@ -1816,7 +1841,8 @@ supported but discouraged. It will be removed in a future version of Emacs."
(dolist (process process-alist)
(condition-case err
(unless (zerop (funcall
- proced-signal-function (car process) signal))
+ proced-signal-function (car process) signal
+ (file-remote-p default-directory)))
(proced-log "%s\n" (cdr process))
(push (cdr process) failures))
(error ; catch errors from failed signals
@@ -1828,7 +1854,7 @@ supported but discouraged. It will be removed in a future version of Emacs."
(dolist (process process-alist)
(with-temp-buffer
(condition-case nil
- (unless (zerop (call-process
+ (unless (zerop (process-file
proced-signal-function nil t nil
signal (number-to-string (car process))))
(proced-log (current-buffer))
@@ -1862,14 +1888,15 @@ the normal hook `proced-after-send-signal-hook'."
(let ((process-alist (proced-marked-processes)))
(proced-with-processes-buffer process-alist
(list (read-number "New priority: ")
- process-alist))))
+ process-alist)))
+ proced-mode)
(if (numberp priority)
(setq priority (number-to-string priority)))
(let (failures)
(dolist (process process-alist)
(with-temp-buffer
(condition-case nil
- (unless (zerop (call-process
+ (unless (zerop (process-file
proced-renice-command nil t nil
priority (number-to-string (car process))))
(proced-log (current-buffer))
@@ -1894,7 +1921,7 @@ the normal hook `proced-after-send-signal-hook'."
"Pop up a buffer with error log output from Proced.
A group of errors from a single command ends with a formfeed.
Thus, use \\[backward-page] to find the beginning of a group of errors."
- (interactive)
+ (interactive nil proced-mode)
(if (get-buffer proced-log-buffer)
(save-selected-window
;; move `proced-log-buffer' to the front of the buffer list
@@ -1946,7 +1973,7 @@ STRING is an overall summary of the failures."
(defun proced-help ()
"Provide help for the Proced user."
- (interactive)
+ (interactive nil proced-mode)
(proced-why)
(if (eq last-command 'proced-help)
(describe-mode)
@@ -1956,7 +1983,7 @@ STRING is an overall summary of the failures."
"Undo in a Proced buffer.
This doesn't recover killed processes, it just undoes changes in the Proced
buffer. You can use it to recover marks."
- (interactive)
+ (interactive nil proced-mode)
(let (buffer-read-only)
(undo))
(message "Change in Proced buffer undone.
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 94c24c62aa6..8670e5786a4 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -38,7 +38,7 @@
(defcustom profiler-sampling-interval 1000000
"Default sampling interval in nanoseconds."
- :type 'integer
+ :type 'natnum
:group 'profiler)
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 4bc6de0c759..d6e2ab8a87a 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -2437,7 +2437,6 @@ the default language."
#'antlr-imenu-create-index-function)
(set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test
(and antlr-imenu-name ; there should be a global variable...
- (fboundp 'imenu-add-to-menubar)
(imenu-add-to-menubar
(if (stringp antlr-imenu-name) antlr-imenu-name "Index")))
(antlr-set-tabs))
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 370fb1b80b4..aaf063b5174 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -24,16 +24,16 @@
;;; Commentary:
;; This mode was written by Eric S. Raymond <esr@snark.thyrsus.com>,
-;; inspired by an earlier asm-mode by Martin Neitzel.
+;; inspired by an earlier `asm-mode' by Martin Neitzel.
-;; This major mode is based on prog mode. It defines a private abbrev table
-;; that can be used to save abbrevs for assembler mnemonics. It binds just
-;; five keys:
+;; This major mode is based on `prog-mode'. It defines a private
+;; abbrev table that can be used to save abbrevs for assembler
+;; mnemonics. It binds just five keys:
;;
;; TAB tab to next tab stop
;; : outdent preceding label, tab to tab stop
;; comment char place or move comment
-;; asm-comment-char specifies which character this is;
+;; `asm-comment-char' specifies which character this is;
;; you can use a different character in different
;; Asm mode buffers.
;; C-j, C-m newline and tab to tab stop
@@ -41,9 +41,9 @@
;; Code is indented to the first tab stop level.
;; This mode runs two hooks:
-;; 1) An asm-mode-set-comment-hook before the part of the initialization
-;; depending on asm-comment-char, and
-;; 2) an asm-mode-hook at the end of initialization.
+;; 1) `asm-mode-set-comment-hook' before the part of the initialization
+;; depending on `asm-comment-char', and
+;; 2) `asm-mode-hook' at the end of initialization.
;;; Code:
@@ -68,13 +68,11 @@
"Abbrev table used while in Asm mode.")
(define-abbrev-table 'asm-mode-abbrev-table ())
-(defvar asm-mode-map
- (let ((map (make-sparse-keymap)))
- ;; Note that the comment character isn't set up until asm-mode is called.
- (define-key map ":" 'asm-colon)
- (define-key map "\C-c;" 'comment-region)
- map)
- "Keymap for Asm mode.")
+(defvar-keymap asm-mode-map
+ :doc "Keymap for Asm mode."
+ ;; Note that the comment character isn't set up until asm-mode is called.
+ ":" #'asm-colon
+ "C-c ;" #'comment-region)
(easy-menu-define asm-mode-menu asm-mode-map
"Menu for Asm mode."
@@ -130,7 +128,7 @@ Special commands:
(setq-local tab-always-indent nil)
(run-hooks 'asm-mode-set-comment-hook)
- ;; Make our own local child of asm-mode-map
+ ;; Make our own local child of `asm-mode-map'
;; so we can define our own comment character.
(use-local-map (nconc (make-sparse-keymap) asm-mode-map))
(local-set-key (vector asm-comment-char) #'asm-comment)
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 7ef2500e46b..6bac297a298 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -71,8 +71,8 @@
"doskey" "echo" "endlocal" "erase" "fc" "find" "findstr" "format"
"ftype" "label" "md" "mkdir" "more" "move" "net" "path" "pause"
"popd" "prompt" "pushd" "rd" "ren" "rename" "replace" "rmdir" "set"
- "setlocal" "shift" "sort" "subst" "time" "title" "tree" "type"
- "ver" "vol" "xcopy"))
+ "setlocal" "setx" "shift" "sort" "subst" "time" "title" "tree"
+ "type" "ver" "vol" "xcopy"))
(CONTROLFLOW
'("call" "cmd" "defined" "do" "else" "equ" "exist" "exit" "for" "geq"
"goto" "gtr" "if" "in" "leq" "lss" "neq" "not" "start"))
@@ -82,7 +82,7 @@
(2 font-lock-constant-face t))
("^:[^:].*"
. 'bat-label-face)
- ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)"
+ ("\\_<\\(defined\\|set\\|setx\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)"
(2 font-lock-variable-name-face))
("%~\\([0-9]\\)"
(1 font-lock-variable-name-face))
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 0a2d5ed796b..d3626dbaf01 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -40,12 +40,10 @@
;; Somewhat arbitrary, by analogy with eg goto-address.
:group 'comm)
-(defvar bug-reference-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'bug-reference-push-button)
- (define-key map (kbd "C-c RET") 'bug-reference-push-button)
- map)
- "Keymap used by bug reference buttons.")
+(defvar-keymap bug-reference-map
+ :doc "Keymap used by bug reference buttons."
+ "<mouse-2>" #'bug-reference-push-button
+ "C-c RET" #'bug-reference-push-button)
;; E.g., "https://gcc.gnu.org/PR%s"
(defvar bug-reference-url-format nil
@@ -269,9 +267,9 @@ via the internet it might also be http.")
;; pull/17 page if 17 is a PR. Explicit user/project#17 links to
;; possibly different projects are also supported.
(cl-defmethod bug-reference--build-forge-setup-entry
- (host-domain (_forge-type (eql github)) protocol)
+ (host-domain (_forge-type (eql 'github)) protocol)
`(,(concat "[/@]" (regexp-quote host-domain)
- "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
+ "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'")
"\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>"
,(lambda (groups)
(let ((ns-project (nth 1 groups)))
@@ -285,9 +283,9 @@ via the internet it might also be http.")
;; namespace/project#18 or namespace/project!17 references to possibly
;; different projects are also supported.
(cl-defmethod bug-reference--build-forge-setup-entry
- (host-domain (_forge-type (eql gitlab)) protocol)
+ (host-domain (_forge-type (eql 'gitlab)) protocol)
`(,(concat "[/@]" (regexp-quote host-domain)
- "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
+ "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'")
"\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>"
,(lambda (groups)
(let ((ns-project (nth 1 groups)))
@@ -302,9 +300,9 @@ via the internet it might also be http.")
;; Gitea: The systematics is exactly as for Github projects.
(cl-defmethod bug-reference--build-forge-setup-entry
- (host-domain (_forge-type (eql gitea)) protocol)
+ (host-domain (_forge-type (eql 'gitea)) protocol)
`(,(concat "[/@]" (regexp-quote host-domain)
- "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
+ "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'")
"\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>"
,(lambda (groups)
(let ((ns-project (nth 1 groups)))
@@ -323,7 +321,7 @@ via the internet it might also be http.")
;; repo without tracker, or a repo with a tracker using a different
;; name, etc. So we can only try to make a good guess.
(cl-defmethod bug-reference--build-forge-setup-entry
- (host-domain (_forge-type (eql sourcehut)) protocol)
+ (host-domain (_forge-type (eql 'sourcehut)) protocol)
`(,(concat "[/@]\\(?:git\\|hg\\)." (regexp-quote host-domain)
"[/:]\\(~[.A-Za-z0-9_/-]+\\)")
"\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>"
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 8298d5fef04..e14f5b9058f 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -202,6 +202,58 @@ Works with: arglist-cont-nonempty, arglist-close."
(skip-chars-forward " \t"))
(vector (current-column)))))))
+(defun c-lineup-argcont-1 (elem)
+ ;; Move to the start of the current arg and return non-nil, otherwise
+ ;; return nil.
+ (beginning-of-line)
+
+ (when (eq (car elem) 'arglist-cont-nonempty)
+ ;; Our argument list might not be the innermost one. If it
+ ;; isn't, go back to the first position in it. We do this by
+ ;; stepping back over open parens until we get to the open paren
+ ;; of our argument list.
+ (let ((open-paren (c-langelem-2nd-pos c-syntactic-element))
+ (paren-state (c-parse-state)))
+ (while (not (eq (car paren-state) open-paren))
+ (unless (consp (car paren-state)) ;; ignore matched braces
+ (goto-char (car paren-state)))
+ (setq paren-state (cdr paren-state)))))
+
+ (let ((start (point)) c)
+
+ (when (bolp)
+ ;; Previous line ending in a comma means we're the start of an
+ ;; argument. This should quickly catch most cases not for us.
+ ;; This case is only applicable if we're the innermost arglist.
+ (c-backward-syntactic-ws)
+ (setq c (char-before)))
+
+ (unless (eq c ?,)
+ ;; In a gcc asm, ":" on the previous line means the start of an
+ ;; argument. And lines starting with ":" are not for us, don't
+ ;; want them to indent to the preceding operand.
+ (let ((gcc-asm (save-excursion
+ (goto-char start)
+ (c-in-gcc-asm-p))))
+ (unless (and gcc-asm
+ (or (eq c ?:)
+ (save-excursion
+ (goto-char start)
+ (looking-at "[ \t]*:"))))
+
+ (c-lineup-argcont-scan (if gcc-asm ?:))
+ t)))))
+
+(defun c-lineup-argcont-scan (&optional other-match)
+ ;; Find the start of an argument, for `c-lineup-argcont'.
+ (when (zerop (c-backward-token-2 1 t))
+ (let ((c (char-after)))
+ (if (or (eq c ?,) (eq c other-match))
+ (progn
+ (forward-char)
+ (c-forward-syntactic-ws))
+ (c-lineup-argcont-scan other-match)))))
+
;; Contributed by Kevin Ryde <user42@zip.com.au>.
(defun c-lineup-argcont (elem)
"Line up a continued argument.
@@ -217,56 +269,30 @@ but of course only between operand specifications, not in the expressions
for the operands.
Works with: arglist-cont, arglist-cont-nonempty."
-
(save-excursion
- (beginning-of-line)
+ (when (c-lineup-argcont-1 elem)
+ (vector (current-column)))))
- (when (eq (car elem) 'arglist-cont-nonempty)
- ;; Our argument list might not be the innermost one. If it
- ;; isn't, go back to the last position in it. We do this by
- ;; stepping back over open parens until we get to the open paren
- ;; of our argument list.
- (let ((open-paren (c-langelem-2nd-pos c-syntactic-element))
- (paren-state (c-parse-state)))
- (while (not (eq (car paren-state) open-paren))
- (unless (consp (car paren-state)) ;; ignore matched braces
- (goto-char (car paren-state)))
- (setq paren-state (cdr paren-state)))))
-
- (let ((start (point)) c)
-
- (when (bolp)
- ;; Previous line ending in a comma means we're the start of an
- ;; argument. This should quickly catch most cases not for us.
- ;; This case is only applicable if we're the innermost arglist.
- (c-backward-syntactic-ws)
- (setq c (char-before)))
-
- (unless (eq c ?,)
- ;; In a gcc asm, ":" on the previous line means the start of an
- ;; argument. And lines starting with ":" are not for us, don't
- ;; want them to indent to the preceding operand.
- (let ((gcc-asm (save-excursion
- (goto-char start)
- (c-in-gcc-asm-p))))
- (unless (and gcc-asm
- (or (eq c ?:)
- (save-excursion
- (goto-char start)
- (looking-at "[ \t]*:"))))
-
- (c-lineup-argcont-scan (if gcc-asm ?:))
- (vector (current-column))))))))
+(defun c-lineup-argcont-+ (langelem)
+ "Indent an argument continuation `c-basic-offset' in from the first argument.
-(defun c-lineup-argcont-scan (&optional other-match)
- ;; Find the start of an argument, for `c-lineup-argcont'.
- (when (zerop (c-backward-token-2 1 t))
- (let ((c (char-after)))
- (if (or (eq c ?,) (eq c other-match))
- (progn
- (forward-char)
- (c-forward-syntactic-ws))
- (c-lineup-argcont-scan other-match)))))
+This first argument is that on a previous line at the same level of nesting.
+
+foo (xyz, uvw, aaa + bbb + ccc
+ + ddd + eee + fff); <- c-lineup-argcont-+
+ <--> c-basic-offset
+
+Only continuation lines like this are touched, nil being returned
+on lines which are the start of an argument.
+
+Works with: arglist-cont, arglist-cont-nonempty."
+ (save-excursion
+ (when (c-lineup-argcont-1 langelem) ; Check we've got a continued argument...
+ ;; ... but ignore the position found.
+ (goto-char (c-langelem-2nd-pos c-syntactic-element))
+ (forward-char)
+ (c-forward-syntactic-ws)
+ (vector (+ (current-column) c-basic-offset)))))
(defun c-lineup-arglist-intro-after-paren (_langelem)
"Line up a line to just after the open paren of the surrounding paren
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 188d5a8a837..9ea1557391b 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -56,6 +56,8 @@
;; Silence the byte compiler.
(cc-bytecomp-defvar c-new-BEG)
(cc-bytecomp-defvar c-new-END)
+(cc-bytecomp-defun c-restore-string-fences)
+(cc-bytecomp-defun c-clear-string-fences)
;; Some functions in cc-engine that are used below. There's a cyclic
;; dependency so it can't be required here. (Perhaps some functions
@@ -934,7 +936,7 @@
;; It prepares the buffer for font
;; locking, hence must get called before `font-lock-after-change-function'.
;;
- ;; This function is the AWK value of `c-before-font-lock-function'.
+ ;; This function is the AWK value of `c-before-font-lock-functions'.
;; It does hidden buffer changes.
(c-save-buffer-state ()
(setq c-new-END (c-awk-end-of-change-region beg end old-len))
@@ -1109,29 +1111,30 @@ nor helpful.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
(interactive "p")
- (or arg (setq arg 1))
- (save-match-data
- (c-save-buffer-state ; ensures the buffer is writable.
- nil
- (let ((found t)) ; Has the most recent regexp search found b-of-defun?
- (if (>= arg 0)
- ;; Go back one defun each time round the following loop. (For +ve arg)
- (while (and found (> arg 0) (not (eq (point) (point-min))))
- ;; Go back one "candidate" each time round the next loop until one
- ;; is genuinely a beginning-of-defun.
- (while (and (setq found (search-backward-regexp
- "^[^#} \t\n\r]" (point-min) 'stop-at-limit))
- (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#)))))
- (setq arg (1- arg)))
- ;; The same for a -ve arg.
- (if (not (eq (point) (point-max))) (forward-char 1))
- (while (and found (< arg 0) (not (eq (point) (point-max)))) ; The same for -ve arg.
- (while (and (setq found (search-forward-regexp
- "^[^#} \t\n\r]" (point-max) 'stop-at-limit))
- (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#)))))
- (setq arg (1+ arg)))
- (if found (goto-char (match-beginning 0))))
- (eq arg 0)))))
+ (c-with-string-fences
+ (or arg (setq arg 1))
+ (save-match-data
+ (c-save-buffer-state ; ensures the buffer is writable.
+ nil
+ (let ((found t)) ; Has the most recent regexp search found b-of-defun?
+ (if (>= arg 0)
+ ;; Go back one defun each time round the following loop. (For +ve arg)
+ (while (and found (> arg 0) (not (eq (point) (point-min))))
+ ;; Go back one "candidate" each time round the next loop until one
+ ;; is genuinely a beginning-of-defun.
+ (while (and (setq found (search-backward-regexp
+ "^[^#} \t\n\r]" (point-min) 'stop-at-limit))
+ (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#)))))
+ (setq arg (1- arg)))
+ ;; The same for a -ve arg.
+ (if (not (eq (point) (point-max))) (forward-char 1))
+ (while (and found (< arg 0) (not (eq (point) (point-max)))) ; The same for -ve arg.
+ (while (and (setq found (search-forward-regexp
+ "^[^#} \t\n\r]" (point-max) 'stop-at-limit))
+ (not (memq (c-awk-get-NL-prop-prev-line) '(?\$ ?\} ?\#)))))
+ (setq arg (1+ arg)))
+ (if found (goto-char (match-beginning 0))))
+ (eq arg 0))))))
(defun c-awk-forward-awk-pattern ()
;; Point is at the start of an AWK pattern (which may be null) or function
@@ -1187,39 +1190,40 @@ no explicit action; see function `c-awk-beginning-of-defun'.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
(interactive "p")
- (or arg (setq arg 1))
- (save-match-data
- (c-save-buffer-state
- nil
- (let ((start-point (point)) end-point)
- ;; Strategy: (For +ve ARG): If we're not already at a beginning-of-defun,
- ;; move backwards to one.
- ;; Repeat [(i) move forward to end-of-current-defun (see below);
- ;; (ii) If this isn't it, move forward to beginning-of-defun].
- ;; We start counting ARG only when step (i) has passed the original point.
- (when (> arg 0)
- ;; Try to move back to a beginning-of-defun, if not already at one.
- (if (not (c-awk-beginning-of-defun-p))
- (when (not (c-awk-beginning-of-defun 1)) ; No bo-defun before point.
- (goto-char start-point)
- (c-awk-beginning-of-defun -1))) ; if this fails, we're at EOB, tough!
- ;; Now count forward, one defun at a time
- (while (and (not (eobp))
- (c-awk-end-of-defun1)
- (if (> (point) start-point) (setq arg (1- arg)) t)
- (> arg 0)
- (c-awk-beginning-of-defun -1))))
-
- (when (< arg 0)
- (setq end-point start-point)
- (while (and (not (bobp))
- (c-awk-beginning-of-defun 1)
- (if (< (setq end-point (if (bobp) (point)
- (save-excursion (c-awk-end-of-defun1))))
- start-point)
- (setq arg (1+ arg)) t)
- (< arg 0)))
- (goto-char (min start-point end-point)))))))
+ (c-with-string-fences
+ (or arg (setq arg 1))
+ (save-match-data
+ (c-save-buffer-state
+ nil
+ (let ((start-point (point)) end-point)
+ ;; Strategy: (For +ve ARG): If we're not already at a beginning-of-defun,
+ ;; move backwards to one.
+ ;; Repeat [(i) move forward to end-of-current-defun (see below);
+ ;; (ii) If this isn't it, move forward to beginning-of-defun].
+ ;; We start counting ARG only when step (i) has passed the original point.
+ (when (> arg 0)
+ ;; Try to move back to a beginning-of-defun, if not already at one.
+ (if (not (c-awk-beginning-of-defun-p))
+ (when (not (c-awk-beginning-of-defun 1)) ; No bo-defun before point.
+ (goto-char start-point)
+ (c-awk-beginning-of-defun -1))) ; if this fails, we're at EOB, tough!
+ ;; Now count forward, one defun at a time
+ (while (and (not (eobp))
+ (c-awk-end-of-defun1)
+ (if (> (point) start-point) (setq arg (1- arg)) t)
+ (> arg 0)
+ (c-awk-beginning-of-defun -1))))
+
+ (when (< arg 0)
+ (setq end-point start-point)
+ (while (and (not (bobp))
+ (c-awk-beginning-of-defun 1)
+ (if (< (setq end-point (if (bobp) (point)
+ (save-excursion (c-awk-end-of-defun1))))
+ start-point)
+ (setq arg (1+ arg)) t)
+ (< arg 0)))
+ (goto-char (min start-point end-point))))))))
(cc-provide 'cc-awk) ; Changed from 'awk-mode, ACM 2002/5/21
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index f42f82e53bb..82268f49433 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -49,6 +49,8 @@
; which looks at this.
(cc-bytecomp-defun electric-pair-post-self-insert-function)
(cc-bytecomp-defvar c-indent-to-body-directives)
+(cc-bytecomp-defun c-restore-string-fences)
+(cc-bytecomp-defun c-clear-string-fences)
(defvar c-syntactic-context)
;; Indentation / Display syntax functions
@@ -210,35 +212,36 @@ and takes care to set the indentation before calling
"Show syntactic information for current line.
With universal argument, inserts the analysis as a comment on that line."
(interactive "P")
- (let* ((c-parsing-error nil)
- (syntax (if (boundp 'c-syntactic-context)
- ;; Use `c-syntactic-context' in the same way as
- ;; `c-indent-line', to be consistent.
- c-syntactic-context
- (c-save-buffer-state nil
- (c-guess-basic-syntax)))))
- (if (not (consp arg))
- (let (elem pos ols)
- (message "Syntactic analysis: %s" syntax)
- (unwind-protect
- (progn
- (while syntax
- (setq elem (pop syntax))
- (when (setq pos (c-langelem-pos elem))
- (push (c-put-overlay pos (1+ pos)
- 'face 'highlight)
- ols))
- (when (setq pos (c-langelem-2nd-pos elem))
- (push (c-put-overlay pos (1+ pos)
- 'face 'secondary-selection)
- ols)))
- (sit-for 10))
- (while ols
- (c-delete-overlay (pop ols)))))
- (indent-for-comment)
- (insert-and-inherit (format "%s" syntax))
- ))
- (c-keep-region-active))
+ (c-with-string-fences
+ (let* ((c-parsing-error nil)
+ (syntax (if (boundp 'c-syntactic-context)
+ ;; Use `c-syntactic-context' in the same way as
+ ;; `c-indent-line', to be consistent.
+ c-syntactic-context
+ (c-save-buffer-state nil
+ (c-guess-basic-syntax)))))
+ (if (not (consp arg))
+ (let (elem pos ols)
+ (message "Syntactic analysis: %s" syntax)
+ (unwind-protect
+ (progn
+ (while syntax
+ (setq elem (pop syntax))
+ (when (setq pos (c-langelem-pos elem))
+ (push (c-put-overlay pos (1+ pos)
+ 'face 'highlight)
+ ols))
+ (when (setq pos (c-langelem-2nd-pos elem))
+ (push (c-put-overlay pos (1+ pos)
+ 'face 'secondary-selection)
+ ols)))
+ (sit-for 10))
+ (while ols
+ (c-delete-overlay (pop ols)))))
+ (indent-for-comment)
+ (insert-and-inherit (format "%s" syntax))
+ ))
+ (c-keep-region-active)))
(defun c-syntactic-information-on-region (from to)
"Insert a comment with the syntactic analysis on every line in the region."
@@ -414,23 +417,25 @@ argument is supplied, or `c-hungry-delete-key' is nil, or point is
inside a literal then the function in the variable
`c-backspace-function' is called."
(interactive "*P")
- (if (c-save-buffer-state ()
- (or (not c-hungry-delete-key)
- arg
- (c-in-literal)))
- (funcall c-backspace-function (prefix-numeric-value arg))
- (c-hungry-delete-backwards)))
+ (c-with-string-fences
+ (if (c-save-buffer-state ()
+ (or (not c-hungry-delete-key)
+ arg
+ (c-in-literal)))
+ (funcall c-backspace-function (prefix-numeric-value arg))
+ (c-hungry-delete-backwards))))
(defun c-hungry-delete-backwards ()
"Delete the preceding character or all preceding whitespace
back to the previous non-whitespace character.
See also \\[c-hungry-delete-forward]."
(interactive)
- (let ((here (point)))
- (c-skip-ws-backward)
- (if (/= (point) here)
- (delete-region (point) here)
- (funcall c-backspace-function 1))))
+ (c-with-string-fences
+ (let ((here (point)))
+ (c-skip-ws-backward)
+ (if (/= (point) here)
+ (delete-region (point) here)
+ (funcall c-backspace-function 1)))))
(defalias 'c-hungry-backspace 'c-hungry-delete-backwards)
@@ -442,23 +447,26 @@ argument is supplied, or `c-hungry-delete-key' is nil, or point is
inside a literal then the function in the variable `c-delete-function'
is called."
(interactive "*P")
- (if (c-save-buffer-state ()
- (or (not c-hungry-delete-key)
- arg
- (c-in-literal)))
- (funcall c-delete-function (prefix-numeric-value arg))
- (c-hungry-delete-forward)))
+ (c-with-string-fences
+ (if
+ (c-save-buffer-state ()
+ (or (not c-hungry-delete-key)
+ arg
+ (c-in-literal)))
+ (funcall c-delete-function (prefix-numeric-value arg))
+ (c-hungry-delete-forward))))
(defun c-hungry-delete-forward ()
"Delete the following character or all following whitespace
up to the next non-whitespace character.
See also \\[c-hungry-delete-backwards]."
(interactive)
- (let ((here (point)))
- (c-skip-ws-forward)
- (if (/= (point) here)
- (delete-region (point) here)
- (funcall c-delete-function 1))))
+ (c-with-string-fences
+ (let ((here (point)))
+ (c-skip-ws-forward)
+ (if (/= (point) here)
+ (delete-region (point) here)
+ (funcall c-delete-function 1)))))
;; This function is only used in XEmacs.
(defun c-electric-delete (arg)
@@ -519,7 +527,8 @@ function to control that."
(defmacro c--call-post-self-insert-hook-more-safely ()
;; Call post-self-insert-hook, if such exists. See comment for
- ;; `c--call-post-self-insert-hook-more-safely-1'.
+ ;; `c--call-post-self-insert-hook-more-safely-1'. This macro should be
+ ;; invoked OUTSIDE of `c-with-string-fences'.
(if (boundp 'post-self-insert-hook)
'(c--call-post-self-insert-hook-more-safely-1)
'(progn)))
@@ -530,30 +539,30 @@ If `c-electric-flag' is set, handle it specially according to the variable
`c-electric-pound-behavior'. If a numeric ARG is supplied, or if point is
inside a literal or a macro, nothing special happens."
(interactive "*P")
- (if (c-save-buffer-state ()
- (or arg
- (not c-electric-flag)
- (not (memq 'alignleft c-electric-pound-behavior))
- (save-excursion
- (skip-chars-backward " \t")
- (not (bolp)))
- (save-excursion
- (and (= (forward-line -1) 0)
- (progn (end-of-line)
- (eq (char-before) ?\\))))
- (c-in-literal)))
- ;; do nothing special
- (let (post-self-insert-hook) ; Disable random functionality.
- (self-insert-command (prefix-numeric-value arg)))
- ;; place the pound character at the left edge
- (let ((pos (- (point-max) (point)))
- (bolp (bolp)))
- (beginning-of-line)
- (delete-horizontal-space)
- (insert (c-last-command-char))
- (and (not bolp)
- (goto-char (- (point-max) pos)))
- ))
+ (c-with-string-fences
+ (if (c-save-buffer-state ()
+ (or arg
+ (not c-electric-flag)
+ (not (memq 'alignleft c-electric-pound-behavior))
+ (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (save-excursion
+ (and (= (forward-line -1) 0)
+ (progn (end-of-line)
+ (eq (char-before) ?\\))))
+ (c-in-literal)))
+ ;; do nothing special
+ (let (post-self-insert-hook) ; Disable random functionality.
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; place the pound character at the left edge
+ (let ((pos (- (point-max) (point)))
+ (bolp (bolp)))
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (insert (c-last-command-char))
+ (and (not bolp)
+ (goto-char (- (point-max) pos))))))
(c--call-post-self-insert-hook-more-safely))
(defun c-point-syntax ()
@@ -883,25 +892,26 @@ settings of `c-cleanup-list' are done."
(interactive "*P")
(let (safepos literal
- ;; We want to inhibit blinking the paren since this would be
- ;; most disruptive. We'll blink it ourselves later on.
- (old-blink-paren blink-paren-function)
- blink-paren-function case-fold-search
- (at-eol (looking-at "[ \t]*\\\\?$"))
- (active-region (and (fboundp 'use-region-p) (use-region-p)))
- got-pair-} electric-pair-deletion)
-
- (c-save-buffer-state ()
- (setq safepos (c-safe-position (point) (c-parse-state))
- literal (c-in-literal safepos)))
-
- ;; Insert the brace. Note that expand-abbrev might reindent
- ;; the line here if there's a preceding "else" or something.
- (let (post-self-insert-hook) ; the only way to get defined functionality
- ; from `self-insert-command'.
- (self-insert-command (prefix-numeric-value arg)))
-
- ;; Emulate `electric-pair-mode'.
+ ;; We want to inhibit blinking the paren since this would be
+ ;; most disruptive. We'll blink it ourselves later on.
+ (old-blink-paren blink-paren-function)
+ blink-paren-function case-fold-search
+ (at-eol (looking-at "[ \t]*\\\\?$"))
+ (active-region (and (fboundp 'use-region-p) (use-region-p)))
+ got-pair-} electric-pair-deletion)
+
+ (c-with-string-fences
+ (c-save-buffer-state ()
+ (setq safepos (c-safe-position (point) (c-parse-state))
+ literal (c-in-literal safepos)))
+
+ ;; Insert the brace. Note that expand-abbrev might reindent
+ ;; the line here if there's a preceding "else" or something.
+ (let (post-self-insert-hook) ; the only way to get defined functionality
+ ; from `self-insert-command'.
+ (self-insert-command (prefix-numeric-value arg))))
+
+ ;; Emulate `electric-pair-mode', outside of `c-with-string-fences'.
(when (and (boundp 'electric-pair-mode)
electric-pair-mode)
(let ((size (buffer-size))
@@ -912,30 +922,31 @@ settings of `c-cleanup-list' are done."
(eq (char-after) ?}))
electric-pair-deletion (< (buffer-size) size))))
- ;; Perform any required CC Mode electric actions.
- (cond
- ((or literal arg (not c-electric-flag) active-region))
- ((not at-eol)
- (c-indent-line))
- (electric-pair-deletion
- (c-indent-line)
- (c-do-brace-electrics 'ignore nil))
- (t (c-do-brace-electrics nil nil)
- (when got-pair-}
+ (c-with-string-fences
+ ;; Perform any required CC Mode electric actions.
+ (cond
+ ((or literal arg (not c-electric-flag) active-region))
+ ((not at-eol)
+ (c-indent-line))
+ (electric-pair-deletion
+ (c-indent-line)
+ (c-do-brace-electrics 'ignore nil))
+ (t (c-do-brace-electrics nil nil)
+ (when got-pair-}
+ (save-excursion
+ (forward-char)
+ (c-do-brace-electrics 'assume 'ignore))
+ (c-indent-line))))
+
+ ;; blink the paren
+ (and (eq (c-last-command-char) ?\})
+ (not executing-kbd-macro)
+ old-blink-paren
(save-excursion
- (forward-char)
- (c-do-brace-electrics 'assume 'ignore))
- (c-indent-line))))
-
- ;; blink the paren
- (and (eq (c-last-command-char) ?\})
- (not executing-kbd-macro)
- old-blink-paren
- (save-excursion
- (c-save-buffer-state nil
- (c-backward-syntactic-ws safepos))
- (funcall old-blink-paren)))
- (c--call-post-self-insert-hook-more-safely)))
+ (c-save-buffer-state nil
+ (c-backward-syntactic-ws safepos))
+ (funcall old-blink-paren)))))
+ (c--call-post-self-insert-hook-more-safely))
(defun c-electric-slash (arg)
"Insert a slash character.
@@ -956,39 +967,40 @@ If a numeric ARG is supplied, point is inside a literal, or
`c-syntactic-indentation' is nil or `c-electric-flag' is nil, indentation
is inhibited."
(interactive "*P")
- (let ((literal (c-save-buffer-state () (c-in-literal)))
- indentp
- ;; shut this up
- (c-echo-syntactic-information-p nil))
+ (c-with-string-fences
+ (let ((literal (c-save-buffer-state () (c-in-literal)))
+ indentp
+ ;; shut this up
+ (c-echo-syntactic-information-p nil))
- ;; comment-close-slash cleanup? This DOESN'T need `c-electric-flag' or
- ;; `c-syntactic-indentation' set.
- (when (and (not arg)
- (eq literal 'c)
- (memq 'comment-close-slash c-cleanup-list)
- (eq (c-last-command-char) ?/)
- (looking-at (concat "[ \t]*\\("
- (regexp-quote comment-end) "\\)?$"))
- ; (eq c-block-comment-ender "*/") ; C-style comments ALWAYS end in */
- (save-excursion
- (save-restriction
- (narrow-to-region (point-min) (point))
- (back-to-indentation)
- (looking-at (concat c-current-comment-prefix "[ \t]*$")))))
- (delete-region (progn (forward-line 0) (point))
- (progn (end-of-line) (point)))
- (insert-char ?* 1)) ; the / comes later. ; Do I need a t (retain sticky properties) here?
-
- (setq indentp (and (not arg)
- c-syntactic-indentation
- c-electric-flag
- (eq (c-last-command-char) ?/)
- (eq (char-before) (if literal ?* ?/))))
- (let (post-self-insert-hook) ; Disable random functionality.
- (self-insert-command (prefix-numeric-value arg)))
- (if indentp
- (indent-according-to-mode))
- (c--call-post-self-insert-hook-more-safely)))
+ ;; comment-close-slash cleanup? This DOESN'T need `c-electric-flag' or
+ ;; `c-syntactic-indentation' set.
+ (when (and (not arg)
+ (eq literal 'c)
+ (memq 'comment-close-slash c-cleanup-list)
+ (eq (c-last-command-char) ?/)
+ (looking-at (concat "[ \t]*\\("
+ (regexp-quote comment-end) "\\)?$"))
+ ; (eq c-block-comment-ender "*/") ; C-style comments ALWAYS end in */
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (back-to-indentation)
+ (looking-at (concat c-current-comment-prefix "[ \t]*$")))))
+ (delete-region (progn (forward-line 0) (point))
+ (progn (end-of-line) (point)))
+ (insert-char ?* 1)) ; the / comes later. ; Do I need a t (retain sticky properties) here?
+
+ (setq indentp (and (not arg)
+ c-syntactic-indentation
+ c-electric-flag
+ (eq (c-last-command-char) ?/)
+ (eq (char-before) (if literal ?* ?/))))
+ (let (post-self-insert-hook) ; Disable random functionality.
+ (self-insert-command (prefix-numeric-value arg)))
+ (if indentp
+ (indent-according-to-mode))))
+ (c--call-post-self-insert-hook-more-safely))
(defun c-electric-star (arg)
"Insert a star character.
@@ -999,26 +1011,26 @@ supplied, point is inside a literal, or `c-syntactic-indentation' is nil,
this indentation is inhibited."
(interactive "*P")
- (let (post-self-insert-hook) ; Disable random functionality.
- (self-insert-command (prefix-numeric-value arg)))
- ;; if we are in a literal, or if arg is given do not reindent the
- ;; current line, unless this star introduces a comment-only line.
- (if (c-save-buffer-state ()
- (and c-syntactic-indentation
- c-electric-flag
- (not arg)
- (eq (c-in-literal) 'c)
- (eq (char-before) ?*)
- (save-excursion
- (forward-char -1)
- (skip-chars-backward "*")
- (if (eq (char-before) ?/)
- (forward-char -1))
- (skip-chars-backward " \t")
- (bolp))))
- (let (c-echo-syntactic-information-p) ; shut this up
- (indent-according-to-mode))
- )
+ (c-with-string-fences
+ (let (post-self-insert-hook) ; Disable random functionality.
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; if we are in a literal, or if arg is given do not reindent the
+ ;; current line, unless this star introduces a comment-only line.
+ (if (c-save-buffer-state ()
+ (and c-syntactic-indentation
+ c-electric-flag
+ (not arg)
+ (eq (c-in-literal) 'c)
+ (eq (char-before) ?*)
+ (save-excursion
+ (forward-char -1)
+ (skip-chars-backward "*")
+ (if (eq (char-before) ?/)
+ (forward-char -1))
+ (skip-chars-backward " \t")
+ (bolp))))
+ (let (c-echo-syntactic-information-p) ; shut this up
+ (indent-according-to-mode))))
(c--call-post-self-insert-hook-more-safely))
(defun c-electric-semi&comma (arg)
@@ -1039,60 +1051,61 @@ reindented unless `c-syntactic-indentation' is nil.
semicolon following a defun might be cleaned up, depending on the
settings of `c-cleanup-list'."
(interactive "*P")
- (let* (lim literal c-syntactic-context
- (here (point))
- ;; shut this up
- (c-echo-syntactic-information-p nil))
-
- (c-save-buffer-state ()
- (setq lim (c-most-enclosing-brace (c-parse-state))
- literal (c-in-literal lim)))
-
- (let (post-self-insert-hook) ; Disable random functionality.
- (self-insert-command (prefix-numeric-value arg)))
-
- (if (and c-electric-flag (not literal) (not arg))
- ;; do all cleanups and newline insertions if c-auto-newline is on.
- (if (or (not c-auto-newline)
- (not (looking-at "[ \t]*\\\\?$")))
- (if c-syntactic-indentation
- (c-indent-line))
- ;; clean ups: list-close-comma or defun-close-semi
- (let ((pos (- (point-max) (point))))
- (if (c-save-buffer-state ()
- (and (or (and
- (eq (c-last-command-char) ?,)
- (memq 'list-close-comma c-cleanup-list))
- (and
- (eq (c-last-command-char) ?\;)
- (memq 'defun-close-semi c-cleanup-list)))
- (progn
- (forward-char -1)
- (c-skip-ws-backward)
- (eq (char-before) ?}))
- ;; make sure matching open brace isn't in a comment
- (not (c-in-literal lim))))
- (delete-region (point) here))
- (goto-char (- (point-max) pos)))
- ;; reindent line
- (when c-syntactic-indentation
- (setq c-syntactic-context (c-guess-basic-syntax))
- (c-indent-line c-syntactic-context))
- ;; check to see if a newline should be added
- (let ((criteria c-hanging-semi&comma-criteria)
- answer add-newline-p)
- (while criteria
- (setq answer (funcall (car criteria)))
- ;; only nil value means continue checking
- (if (not answer)
- (setq criteria (cdr criteria))
- (setq criteria nil)
- ;; only 'stop specifically says do not add a newline
- (setq add-newline-p (not (eq answer 'stop)))
- ))
- (if add-newline-p
- (c-newline-and-indent)))))
- (c--call-post-self-insert-hook-more-safely)))
+ (c-with-string-fences
+ (let* (lim literal c-syntactic-context
+ (here (point))
+ ;; shut this up
+ (c-echo-syntactic-information-p nil))
+
+ (c-save-buffer-state ()
+ (setq lim (c-most-enclosing-brace (c-parse-state))
+ literal (c-in-literal lim)))
+
+ (let (post-self-insert-hook) ; Disable random functionality.
+ (self-insert-command (prefix-numeric-value arg)))
+
+ (if (and c-electric-flag (not literal) (not arg))
+ ;; do all cleanups and newline insertions if c-auto-newline is on.
+ (if (or (not c-auto-newline)
+ (not (looking-at "[ \t]*\\\\?$")))
+ (if c-syntactic-indentation
+ (c-indent-line))
+ ;; clean ups: list-close-comma or defun-close-semi
+ (let ((pos (- (point-max) (point))))
+ (if (c-save-buffer-state ()
+ (and (or (and
+ (eq (c-last-command-char) ?,)
+ (memq 'list-close-comma c-cleanup-list))
+ (and
+ (eq (c-last-command-char) ?\;)
+ (memq 'defun-close-semi c-cleanup-list)))
+ (progn
+ (forward-char -1)
+ (c-skip-ws-backward)
+ (eq (char-before) ?}))
+ ;; make sure matching open brace isn't in a comment
+ (not (c-in-literal lim))))
+ (delete-region (point) here))
+ (goto-char (- (point-max) pos)))
+ ;; reindent line
+ (when c-syntactic-indentation
+ (setq c-syntactic-context (c-guess-basic-syntax))
+ (c-indent-line c-syntactic-context))
+ ;; check to see if a newline should be added
+ (let ((criteria c-hanging-semi&comma-criteria)
+ answer add-newline-p)
+ (while criteria
+ (setq answer (funcall (car criteria)))
+ ;; only nil value means continue checking
+ (if (not answer)
+ (setq criteria (cdr criteria))
+ (setq criteria nil)
+ ;; only 'stop specifically says do not add a newline
+ (setq add-newline-p (not (eq answer 'stop)))
+ ))
+ (if add-newline-p
+ (c-newline-and-indent)))))))
+ (c--call-post-self-insert-hook-more-safely))
(defun c-electric-colon (arg)
"Insert a colon.
@@ -1113,89 +1126,90 @@ reindented unless `c-syntactic-indentation' is nil.
`c-cleanup-list'."
(interactive "*P")
- (let* ((bod (c-point 'bod))
- (literal (c-save-buffer-state () (c-in-literal bod)))
- newlines is-scope-op
- ;; shut this up
- (c-echo-syntactic-information-p nil))
- (let (post-self-insert-hook) ; Disable random functionality.
- (self-insert-command (prefix-numeric-value arg)))
- ;; Any electric action?
- (if (and c-electric-flag (not literal) (not arg))
- ;; Unless we're at EOL, only re-indentation happens.
- (if (not (looking-at "[ \t]*\\\\?$"))
- (if c-syntactic-indentation
- (indent-according-to-mode))
-
- ;; scope-operator clean-up?
- (let ((pos (- (point-max) (point)))
- (here (point)))
- (if (c-save-buffer-state () ; Why do we need this? [ACM, 2003-03-12]
- (and c-auto-newline
- (memq 'scope-operator c-cleanup-list)
- (eq (char-before) ?:)
- (progn
- (forward-char -1)
- (c-skip-ws-backward)
- (eq (char-before) ?:))
- (not (c-in-literal))
- (not (eq (char-after (- (point) 2)) ?:))))
- (progn
- (delete-region (point) (1- here))
- (setq is-scope-op t)))
- (goto-char (- (point-max) pos)))
-
- ;; indent the current line if it's done syntactically.
- (if c-syntactic-indentation
- ;; Cannot use the same syntax analysis as we find below,
- ;; since that's made with c-syntactic-indentation-in-macros
- ;; always set to t.
- (indent-according-to-mode))
-
- ;; Calculate where, if anywhere, we want newlines.
- (c-save-buffer-state
- ((c-syntactic-indentation-in-macros t)
- (c-auto-newline-analysis t)
- ;; Turn on syntactic macro analysis to help with auto newlines
- ;; only.
- (syntax (c-guess-basic-syntax))
- (elem syntax))
- ;; Translate substatement-label to label for this operation.
- (while elem
- (if (eq (car (car elem)) 'substatement-label)
- (setcar (car elem) 'label))
- (setq elem (cdr elem)))
- ;; some language elements can only be determined by checking
- ;; the following line. Let's first look for ones that can be
- ;; found when looking on the line with the colon
- (setq newlines
- (and c-auto-newline
- (or (c-lookup-lists '(case-label label access-label)
- syntax c-hanging-colons-alist)
- (c-lookup-lists '(member-init-intro inher-intro)
- (progn
- (insert ?\n)
- (unwind-protect
- (c-guess-basic-syntax)
- (delete-char -1)))
- c-hanging-colons-alist)))))
- ;; does a newline go before the colon? Watch out for already
- ;; non-hung colons. However, we don't unhang them because that
- ;; would be a cleanup (and anti-social).
- (if (and (memq 'before newlines)
- (not is-scope-op)
- (save-excursion
- (skip-chars-backward ": \t")
- (not (bolp))))
- (let ((pos (- (point-max) (point))))
- (forward-char -1)
- (c-newline-and-indent)
- (goto-char (- (point-max) pos))))
- ;; does a newline go after the colon?
- (if (and (memq 'after (cdr-safe newlines))
- (not is-scope-op))
- (c-newline-and-indent))))
- (c--call-post-self-insert-hook-more-safely)))
+ (c-with-string-fences
+ (let* ((bod (c-point 'bod))
+ (literal (c-save-buffer-state () (c-in-literal bod)))
+ newlines is-scope-op
+ ;; shut this up
+ (c-echo-syntactic-information-p nil))
+ (let (post-self-insert-hook) ; Disable random functionality.
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; Any electric action?
+ (if (and c-electric-flag (not literal) (not arg))
+ ;; Unless we're at EOL, only re-indentation happens.
+ (if (not (looking-at "[ \t]*\\\\?$"))
+ (if c-syntactic-indentation
+ (indent-according-to-mode))
+
+ ;; scope-operator clean-up?
+ (let ((pos (- (point-max) (point)))
+ (here (point)))
+ (if (c-save-buffer-state () ; Why do we need this? [ACM, 2003-03-12]
+ (and c-auto-newline
+ (memq 'scope-operator c-cleanup-list)
+ (eq (char-before) ?:)
+ (progn
+ (forward-char -1)
+ (c-skip-ws-backward)
+ (eq (char-before) ?:))
+ (not (c-in-literal))
+ (not (eq (char-after (- (point) 2)) ?:))))
+ (progn
+ (delete-region (point) (1- here))
+ (setq is-scope-op t)))
+ (goto-char (- (point-max) pos)))
+
+ ;; indent the current line if it's done syntactically.
+ (if c-syntactic-indentation
+ ;; Cannot use the same syntax analysis as we find below,
+ ;; since that's made with c-syntactic-indentation-in-macros
+ ;; always set to t.
+ (indent-according-to-mode))
+
+ ;; Calculate where, if anywhere, we want newlines.
+ (c-save-buffer-state
+ ((c-syntactic-indentation-in-macros t)
+ (c-auto-newline-analysis t)
+ ;; Turn on syntactic macro analysis to help with auto newlines
+ ;; only.
+ (syntax (c-guess-basic-syntax))
+ (elem syntax))
+ ;; Translate substatement-label to label for this operation.
+ (while elem
+ (if (eq (car (car elem)) 'substatement-label)
+ (setcar (car elem) 'label))
+ (setq elem (cdr elem)))
+ ;; some language elements can only be determined by checking
+ ;; the following line. Let's first look for ones that can be
+ ;; found when looking on the line with the colon
+ (setq newlines
+ (and c-auto-newline
+ (or (c-lookup-lists '(case-label label access-label)
+ syntax c-hanging-colons-alist)
+ (c-lookup-lists '(member-init-intro inher-intro)
+ (progn
+ (insert ?\n)
+ (unwind-protect
+ (c-guess-basic-syntax)
+ (delete-char -1)))
+ c-hanging-colons-alist)))))
+ ;; does a newline go before the colon? Watch out for already
+ ;; non-hung colons. However, we don't unhang them because that
+ ;; would be a cleanup (and anti-social).
+ (if (and (memq 'before newlines)
+ (not is-scope-op)
+ (save-excursion
+ (skip-chars-backward ": \t")
+ (not (bolp))))
+ (let ((pos (- (point-max) (point))))
+ (forward-char -1)
+ (c-newline-and-indent)
+ (goto-char (- (point-max) pos))))
+ ;; does a newline go after the colon?
+ (if (and (memq 'after (cdr-safe newlines))
+ (not is-scope-op))
+ (c-newline-and-indent))))))
+ (c--call-post-self-insert-hook-more-safely))
(defun c-electric-lt-gt (arg)
"Insert a \"<\" or \">\" character.
@@ -1209,74 +1223,75 @@ finishes a C++ style stream operator in C++ mode. Exceptions are when a
numeric argument is supplied, or the point is inside a literal."
(interactive "*P")
- (let ((literal (c-save-buffer-state () (c-in-literal)))
- template-delim include-delim
+ (let (template-delim include-delim
(c-echo-syntactic-information-p nil)
final-pos found-delim case-fold-search)
- (let (post-self-insert-hook) ; Disable random functionality.
- (self-insert-command (prefix-numeric-value arg)))
- (setq final-pos (point))
+ (c-with-string-fences
+ (let (post-self-insert-hook) ; Disable random functionality.
+ (self-insert-command (prefix-numeric-value arg)))
+ (setq final-pos (point))
;;;; 2010-01-31: There used to be code here to put a syntax-table text
;;;; property on the new < or > and its mate (if any) when they are template
;;;; parens. This is now done in an after-change function.
- (when (and (not arg) (not literal))
- ;; Have we got a delimiter on a #include directive?
- (beginning-of-line)
- (setq include-delim
- (and
- (looking-at c-cpp-include-key)
- (if (eq (c-last-command-char) ?<)
- (eq (match-end 0) (1- final-pos))
- (goto-char (1- final-pos))
- (skip-chars-backward "^<>" (c-point 'bol))
- (eq (char-before) ?<))))
- (goto-char final-pos)
-
- ;; Indent the line if appropriate.
- (when (and c-electric-flag c-syntactic-indentation c-recognize-<>-arglists)
- (setq found-delim
+ (when (and (not arg)
+ (not (c-save-buffer-state () (c-in-literal))))
+ ;; Have we got a delimiter on a #include directive?
+ (beginning-of-line)
+ (setq include-delim
+ (and
+ (looking-at c-cpp-include-key)
(if (eq (c-last-command-char) ?<)
- ;; If a <, basically see if it's got "template" before it .....
- (or (and (progn
- (backward-char)
- (= (point)
- (progn (c-beginning-of-current-token) (point))))
- (progn
- (c-backward-token-2)
- (looking-at c-opt-<>-sexp-key))
- (setq template-delim t))
- ;; ..... or is a C++ << operator.
- (and (c-major-mode-is 'c++-mode)
- (progn
- (goto-char (1- final-pos))
- (c-beginning-of-current-token)
- (looking-at "<<"))
- (>= (match-end 0) final-pos)))
-
- ;; It's a >. Either a template/generic terminator ...
- (or (and (c-get-char-property (1- final-pos) 'syntax-table)
- (setq template-delim t))
- ;; or a C++ >> operator.
- (and (c-major-mode-is 'c++-mode)
- (progn
- (goto-char (1- final-pos))
- (c-beginning-of-current-token)
- (looking-at ">>"))
- (>= (match-end 0) final-pos)))))
- (goto-char final-pos)
-
- (when found-delim
- (indent-according-to-mode)))
-
- ;; On the off chance that < and > are configured as pairs in
- ;; electric-pair-mode.
- (when (and (boundp 'electric-pair-mode) electric-pair-mode
- (or template-delim include-delim))
- (let (post-self-insert-hook)
- (electric-pair-post-self-insert-function))))
+ (eq (match-end 0) (1- final-pos))
+ (goto-char (1- final-pos))
+ (skip-chars-backward "^<>" (c-point 'bol))
+ (eq (char-before) ?<))))
+ (goto-char final-pos)
+
+ ;; Indent the line if appropriate.
+ (when (and c-electric-flag c-syntactic-indentation c-recognize-<>-arglists)
+ (setq found-delim
+ (if (eq (c-last-command-char) ?<)
+ ;; If a <, basically see if it's got "template" before it .....
+ (or (and (progn
+ (backward-char)
+ (= (point)
+ (progn (c-beginning-of-current-token) (point))))
+ (progn
+ (c-backward-token-2)
+ (looking-at c-opt-<>-sexp-key))
+ (setq template-delim t))
+ ;; ..... or is a C++ << operator.
+ (and (c-major-mode-is 'c++-mode)
+ (progn
+ (goto-char (1- final-pos))
+ (c-beginning-of-current-token)
+ (looking-at "<<"))
+ (>= (match-end 0) final-pos)))
+
+ ;; It's a >. Either a template/generic terminator ...
+ (or (and (c-get-char-property (1- final-pos) 'syntax-table)
+ (setq template-delim t))
+ ;; or a C++ >> operator.
+ (and (c-major-mode-is 'c++-mode)
+ (progn
+ (goto-char (1- final-pos))
+ (c-beginning-of-current-token)
+ (looking-at ">>"))
+ (>= (match-end 0) final-pos)))))
+ (goto-char final-pos)
+
+ (when found-delim
+ (indent-according-to-mode)))))
+
+ ;; On the off chance that < and > are configured as pairs in
+ ;; electric-pair-mode.
+ (when (and (boundp 'electric-pair-mode) electric-pair-mode
+ (or template-delim include-delim))
+ (let (post-self-insert-hook)
+ (electric-pair-post-self-insert-function)))
(when found-delim
(when (and (eq (char-before) ?>)
@@ -1301,12 +1316,13 @@ removed; see the variable `c-cleanup-list'.
Also, if `c-electric-flag' and `c-auto-newline' are both non-nil, some
newline cleanups are done if appropriate; see the variable `c-cleanup-list'."
(interactive "*P")
- (let ((literal (c-save-buffer-state () (c-in-literal)))
+ (let ((literal (c-save-buffer-state ()
+ (c-with-string-fences (c-in-literal))))
;; shut this up
(c-echo-syntactic-information-p nil)
case-fold-search)
(let (post-self-insert-hook) ; The only way to get defined functionality
- ; from `self-insert-command'.
+ ; from `self-insert-command'.
(self-insert-command (prefix-numeric-value arg)))
(if (and (not arg) (not literal))
@@ -1315,46 +1331,47 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'."
;; afterwards.
(old-blink-paren blink-paren-function)
blink-paren-function)
- (if (and c-syntactic-indentation c-electric-flag)
- (indent-according-to-mode))
-
- ;; If we're at EOL, check for new-line clean-ups.
- (when (and c-electric-flag c-auto-newline
- (looking-at "[ \t]*\\\\?$"))
-
- ;; clean up brace-elseif-brace
- (when
- (and (memq 'brace-elseif-brace c-cleanup-list)
- (eq (c-last-command-char) ?\()
- (re-search-backward
- (concat "}"
- "\\([ \t\n]\\|\\\\\n\\)*"
- "else"
- "\\([ \t\n]\\|\\\\\n\\)+"
- "if"
- "\\([ \t\n]\\|\\\\\n\\)*"
- "("
- "\\=")
- nil t)
- (not (c-save-buffer-state () (c-in-literal))))
- (delete-region (match-beginning 0) (match-end 0))
- (insert-and-inherit "} else if ("))
-
- ;; clean up brace-catch-brace
- (when
- (and (memq 'brace-catch-brace c-cleanup-list)
- (eq (c-last-command-char) ?\()
- (re-search-backward
- (concat "}"
- "\\([ \t\n]\\|\\\\\n\\)*"
- "catch"
- "\\([ \t\n]\\|\\\\\n\\)*"
- "("
- "\\=")
- nil t)
- (not (c-save-buffer-state () (c-in-literal))))
- (delete-region (match-beginning 0) (match-end 0))
- (insert-and-inherit "} catch (")))
+ (c-with-string-fences
+ (if (and c-syntactic-indentation c-electric-flag)
+ (indent-according-to-mode))
+
+ ;; If we're at EOL, check for new-line clean-ups.
+ (when (and c-electric-flag c-auto-newline
+ (looking-at "[ \t]*\\\\?$"))
+
+ ;; clean up brace-elseif-brace
+ (when
+ (and (memq 'brace-elseif-brace c-cleanup-list)
+ (eq (c-last-command-char) ?\()
+ (re-search-backward
+ (concat "}"
+ "\\([ \t\n]\\|\\\\\n\\)*"
+ "else"
+ "\\([ \t\n]\\|\\\\\n\\)+"
+ "if"
+ "\\([ \t\n]\\|\\\\\n\\)*"
+ "("
+ "\\=")
+ nil t)
+ (not (c-save-buffer-state () (c-in-literal))))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert-and-inherit "} else if ("))
+
+ ;; clean up brace-catch-brace
+ (when
+ (and (memq 'brace-catch-brace c-cleanup-list)
+ (eq (c-last-command-char) ?\()
+ (re-search-backward
+ (concat "}"
+ "\\([ \t\n]\\|\\\\\n\\)*"
+ "catch"
+ "\\([ \t\n]\\|\\\\\n\\)*"
+ "("
+ "\\=")
+ nil t)
+ (not (c-save-buffer-state () (c-in-literal))))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert-and-inherit "} catch ("))))
;; Apply `electric-pair-mode' stuff.
(when (and (boundp 'electric-pair-mode)
@@ -1362,41 +1379,42 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'."
(let (post-self-insert-hook)
(electric-pair-post-self-insert-function)))
- ;; Check for clean-ups at function calls. These two DON'T need
- ;; `c-electric-flag' or `c-syntactic-indentation' set.
- ;; Point is currently just after the inserted paren.
- (let (beg (end (1- (point))))
- (cond
-
- ;; space-before-funcall clean-up?
- ((and (memq 'space-before-funcall c-cleanup-list)
- (eq (c-last-command-char) ?\()
- (save-excursion
- (backward-char)
- (skip-chars-backward " \t")
- (setq beg (point))
- (and (c-save-buffer-state () (c-on-identifier))
- ;; Don't add a space into #define FOO()....
- (not (and (c-beginning-of-macro)
- (c-forward-over-cpp-define-id)
- (eq (point) beg))))))
- (save-excursion
- (delete-region beg end)
- (goto-char beg)
- (insert ?\ )))
-
- ;; compact-empty-funcall clean-up?
- ((c-save-buffer-state ()
- (and (memq 'compact-empty-funcall c-cleanup-list)
- (eq (c-last-command-char) ?\))
- (save-excursion
- (c-safe (backward-char 2))
- (when (looking-at "()")
- (setq end (point))
- (skip-chars-backward " \t")
- (setq beg (point))
- (c-on-identifier)))))
- (delete-region beg end))))
+ (c-with-string-fences
+ ;; Check for clean-ups at function calls. These two DON'T need
+ ;; `c-electric-flag' or `c-syntactic-indentation' set.
+ ;; Point is currently just after the inserted paren.
+ (let (beg (end (1- (point))))
+ (cond
+
+ ;; space-before-funcall clean-up?
+ ((and (memq 'space-before-funcall c-cleanup-list)
+ (eq (c-last-command-char) ?\()
+ (save-excursion
+ (backward-char)
+ (skip-chars-backward " \t")
+ (setq beg (point))
+ (and (c-save-buffer-state () (c-on-identifier))
+ ;; Don't add a space into #define FOO()....
+ (not (and (c-beginning-of-macro)
+ (c-forward-over-cpp-define-id)
+ (eq (point) beg))))))
+ (save-excursion
+ (delete-region beg end)
+ (goto-char beg)
+ (insert ?\ )))
+
+ ;; compact-empty-funcall clean-up?
+ ((c-save-buffer-state ()
+ (and (memq 'compact-empty-funcall c-cleanup-list)
+ (eq (c-last-command-char) ?\))
+ (save-excursion
+ (c-safe (backward-char 2))
+ (when (looking-at "()")
+ (setq end (point))
+ (skip-chars-backward " \t")
+ (setq beg (point))
+ (c-on-identifier)))))
+ (delete-region beg end)))))
(and (eq last-input-event ?\))
(not executing-kbd-macro)
old-blink-paren
@@ -1405,8 +1423,8 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'."
;; Apply `electric-pair-mode' stuff inside a string or comment.
(when (and (boundp 'electric-pair-mode) electric-pair-mode)
(let (post-self-insert-hook)
- (electric-pair-post-self-insert-function))))
- (c--call-post-self-insert-hook-more-safely)))
+ (electric-pair-post-self-insert-function)))))
+ (c--call-post-self-insert-hook-more-safely))
(defun c-electric-continued-statement ()
"Reindent the current line if appropriate.
@@ -1868,68 +1886,71 @@ defun."
(c-region-is-active-p)
(push-mark))
- (c-save-buffer-state
- (beginning-of-defun-function
- end-of-defun-function
- (paren-state (c-parse-state))
- (orig-point-min (point-min)) (orig-point-max (point-max))
- lim ; Position of { which has been widened to.
- where pos case-fold-search)
-
- (save-restriction
- (if (eq c-defun-tactic 'go-outward)
- (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace.
- paren-state orig-point-min orig-point-max)))
-
- ;; Move back out of any macro/comment/string we happen to be in.
- (c-beginning-of-macro)
- (setq pos (c-literal-start))
- (if pos (goto-char pos))
-
- (setq where (c-where-wrt-brace-construct))
-
- (if (< arg 0)
- ;; Move forward to the closing brace of a function.
- (progn
- (if (memq where '(at-function-end outwith-function))
- (setq arg (1+ arg)))
- (if (< arg 0)
- (c-while-widening-to-decl-block
- (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where))) 0)))
- ;; Move forward to the next opening brace....
- (when (and (= arg 0)
- (progn
- (c-while-widening-to-decl-block
- (not (c-syntactic-re-search-forward "{" nil 'eob)))
- (eq (char-before) ?{)))
- (backward-char)
- ;; ... and backward to the function header.
- (c-beginning-of-decl-1)
- t))
-
- ;; Move backward to the opening brace of a function, making successively
- ;; larger portions of the buffer visible as necessary.
- (when (> arg 0)
- (c-while-widening-to-decl-block
- (> (setq arg (c-backward-to-nth-BOF-{ arg where)) 0)))
-
- (when (eq arg 0)
- ;; Go backward to this function's header.
- (c-beginning-of-decl-1)
-
- (setq pos (point))
- ;; We're now there, modulo comments and whitespace.
- ;; Try to be line oriented; position point at the closest
- ;; preceding boi that isn't inside a comment, but if we hit
- ;; the previous declaration then we use the current point
- ;; instead.
- (while (and (/= (point) (c-point 'boi))
- (c-backward-single-comment)))
- (if (/= (point) (c-point 'boi))
- (goto-char pos)))
-
- (c-keep-region-active)
- (= arg 0)))))
+ (c-with-string-fences
+ (c-save-buffer-state
+ (beginning-of-defun-function
+ end-of-defun-function
+ (paren-state (c-parse-state))
+ (orig-point-min (point-min)) (orig-point-max (point-max))
+ lim ; Position of { which has been widened to.
+ where pos case-fold-search)
+
+ (save-restriction
+ (if (eq c-defun-tactic 'go-outward)
+ (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace.
+ paren-state orig-point-min orig-point-max)))
+
+ ;; Move back out of any macro/comment/string we happen to be in.
+ (c-beginning-of-macro)
+ (setq pos (c-literal-start))
+ (if pos (goto-char pos))
+
+ (setq where (c-where-wrt-brace-construct))
+
+ (if (< arg 0)
+ ;; Move forward to the closing brace of a function.
+ (progn
+ (if (memq where '(at-function-end outwith-function))
+ (setq arg (1+ arg)))
+ (if (< arg 0)
+ (c-while-widening-to-decl-block
+ (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where))) 0)))
+ (prog1
+ ;; Move forward to the next opening brace....
+ (when (and (= arg 0)
+ (progn
+ (c-while-widening-to-decl-block
+ (not (c-syntactic-re-search-forward "{" nil 'eob)))
+ (eq (char-before) ?{)))
+ (backward-char)
+ ;; ... and backward to the function header.
+ (c-beginning-of-decl-1)
+ t)
+ (c-keep-region-active)))
+
+ ;; Move backward to the opening brace of a function, making successively
+ ;; larger portions of the buffer visible as necessary.
+ (when (> arg 0)
+ (c-while-widening-to-decl-block
+ (> (setq arg (c-backward-to-nth-BOF-{ arg where)) 0)))
+
+ (when (eq arg 0)
+ ;; Go backward to this function's header.
+ (c-beginning-of-decl-1)
+
+ (setq pos (point))
+ ;; We're now there, modulo comments and whitespace.
+ ;; Try to be line oriented; position point at the closest
+ ;; preceding boi that isn't inside a comment, but if we hit
+ ;; the previous declaration then we use the current point
+ ;; instead.
+ (while (and (/= (point) (c-point 'boi))
+ (c-backward-single-comment)))
+ (if (/= (point) (c-point 'boi))
+ (goto-char pos)))
+
+ (c-keep-region-active)
+ (= arg 0))))))
(defun c-forward-to-nth-EOF-\;-or-} (n where)
;; Skip to the closing brace or semicolon of the Nth function after point.
@@ -1996,65 +2017,66 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'."
(c-region-is-active-p)
(push-mark))
- (c-save-buffer-state
- (beginning-of-defun-function
- end-of-defun-function
- (paren-state (c-parse-state))
- (orig-point-min (point-min)) (orig-point-max (point-max))
- lim
- where pos case-fold-search)
-
- (save-restriction
- (if (eq c-defun-tactic 'go-outward)
- (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace
- paren-state orig-point-min orig-point-max)))
-
- ;; Move back out of any macro/comment/string we happen to be in.
- (c-beginning-of-macro)
- (setq pos (c-literal-start))
- (if pos (goto-char pos))
+ (c-with-string-fences
+ (c-save-buffer-state
+ (beginning-of-defun-function
+ end-of-defun-function
+ (paren-state (c-parse-state))
+ (orig-point-min (point-min)) (orig-point-max (point-max))
+ lim
+ where pos case-fold-search)
+
+ (save-restriction
+ (if (eq c-defun-tactic 'go-outward)
+ (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace
+ paren-state orig-point-min orig-point-max)))
+
+ ;; Move back out of any macro/comment/string we happen to be in.
+ (c-beginning-of-macro)
+ (setq pos (c-literal-start))
+ (if pos (goto-char pos))
+
+ (setq where (c-where-wrt-brace-construct))
+
+ (if (< arg 0)
+ ;; Move backwards to the } of a function
+ (progn
+ (if (memq where '(at-header outwith-function))
+ (setq arg (1+ arg)))
+ (if (< arg 0)
+ (c-while-widening-to-decl-block
+ (< (setq arg (- (c-backward-to-nth-BOF-{ (- arg) where))) 0)))
+ (if (= arg 0)
+ (c-while-widening-to-decl-block
+ (progn (c-syntactic-skip-backward "^}")
+ (not (eq (char-before) ?}))))))
+
+ ;; Move forward to the } of a function
+ (if (> arg 0)
+ (c-while-widening-to-decl-block
+ (> (setq arg (c-forward-to-nth-EOF-\;-or-} arg where)) 0))))
+
+ ;; Do we need to move forward from the brace to the semicolon?
+ (when (eq arg 0)
+ (if (c-in-function-trailer-p) ; after "}" of struct/enum, etc.
+ (c-syntactic-re-search-forward ";"))
- (setq where (c-where-wrt-brace-construct))
+ (setq pos (point))
+ ;; We're there now, modulo comments and whitespace.
+ ;; Try to be line oriented; position point after the next
+ ;; newline that isn't inside a comment, but if we hit the
+ ;; next declaration then we use the current point instead.
+ (while (and (not (bolp))
+ (not (looking-at "\\s *$"))
+ (c-forward-single-comment)))
+ (cond ((bolp))
+ ((looking-at "\\s *$")
+ (forward-line 1))
+ (t
+ (goto-char pos))))
- (if (< arg 0)
- ;; Move backwards to the } of a function
- (progn
- (if (memq where '(at-header outwith-function))
- (setq arg (1+ arg)))
- (if (< arg 0)
- (c-while-widening-to-decl-block
- (< (setq arg (- (c-backward-to-nth-BOF-{ (- arg) where))) 0)))
- (if (= arg 0)
- (c-while-widening-to-decl-block
- (progn (c-syntactic-skip-backward "^}")
- (not (eq (char-before) ?}))))))
-
- ;; Move forward to the } of a function
- (if (> arg 0)
- (c-while-widening-to-decl-block
- (> (setq arg (c-forward-to-nth-EOF-\;-or-} arg where)) 0))))
-
- ;; Do we need to move forward from the brace to the semicolon?
- (when (eq arg 0)
- (if (c-in-function-trailer-p) ; after "}" of struct/enum, etc.
- (c-syntactic-re-search-forward ";"))
-
- (setq pos (point))
- ;; We're there now, modulo comments and whitespace.
- ;; Try to be line oriented; position point after the next
- ;; newline that isn't inside a comment, but if we hit the
- ;; next declaration then we use the current point instead.
- (while (and (not (bolp))
- (not (looking-at "\\s *$"))
- (c-forward-single-comment)))
- (cond ((bolp))
- ((looking-at "\\s *$")
- (forward-line 1))
- (t
- (goto-char pos))))
-
- (c-keep-region-active)
- (= arg 0))))
+ (c-keep-region-active)
+ (= arg 0)))))
(defun c-defun-name-1 ()
"Return name of current defun, at current narrowing, or nil if there isn't one.
@@ -2093,13 +2115,12 @@ with a brace block."
(c-forward-syntactic-ws)
(when (eq (char-after) ?\")
(forward-sexp 1)
+ (c-forward-syntactic-ws)
(c-forward-token-2)) ; over the comma and following WS.
- (buffer-substring-no-properties
- (point)
- (progn
- (c-forward-token-2)
- (c-backward-syntactic-ws)
- (point))))
+ (setq pos (point))
+ (and (zerop (c-forward-token-2))
+ (progn (c-backward-syntactic-ws) t)
+ (buffer-substring-no-properties pos (point))))
((and (c-major-mode-is 'objc-mode) (looking-at "[-+]\\s-*(")) ; Objective-C method
;; Move to the beginning of the method name.
@@ -2340,18 +2361,19 @@ with a brace block, at the outermost level of nesting."
"Display the name of the current CC mode defun and the position in it.
With a prefix arg, push the name onto the kill ring too."
(interactive "P")
- (save-restriction
- (widen)
- (c-save-buffer-state ((name-and-limits (c-defun-name-and-limits nil))
- (name (car name-and-limits))
- (limits (cdr name-and-limits))
- (point-bol (c-point 'bol)))
- (when name
- (message "%s. Line %s/%s." name
- (1+ (count-lines (car limits) (max point-bol (car limits))))
- (count-lines (car limits) (cdr limits)))
- (if arg (kill-new name))
- (sit-for 3 t)))))
+ (c-with-string-fences
+ (save-restriction
+ (widen)
+ (c-save-buffer-state ((name-and-limits (c-defun-name-and-limits nil))
+ (name (car name-and-limits))
+ (limits (cdr name-and-limits))
+ (point-bol (c-point 'bol)))
+ (when name
+ (message "%s. Line %s/%s." name
+ (1+ (count-lines (car limits) (max point-bol (car limits))))
+ (count-lines (car limits) (cdr limits)))
+ (if arg (kill-new name))
+ (sit-for 3 t))))))
(put 'c-display-defun-name 'isearch-scroll t)
(defun c-mark-function ()
@@ -2367,34 +2389,35 @@ As opposed to \\[c-beginning-of-defun] and \\[c-end-of-defun], this
function does not require the declaration to contain a brace block."
(interactive)
- (let (decl-limits case-fold-search)
- (c-save-buffer-state nil
- ;; We try to be line oriented, unless there are several
- ;; declarations on the same line.
- (if (looking-at c-syntactic-eol)
- (c-backward-token-2 1 nil (c-point 'bol)))
- (setq decl-limits (c-declaration-limits t)))
-
- (if (not decl-limits)
- (error "Cannot find any declaration")
- (let* ((extend-region-p
- (and (eq this-command 'c-mark-function)
- (eq last-command 'c-mark-function)))
- (push-mark-p (and (eq this-command 'c-mark-function)
- (not extend-region-p)
- (not (c-region-is-active-p)))))
- (if push-mark-p (push-mark))
- (if extend-region-p
- (progn
- (exchange-point-and-mark)
- (setq decl-limits (c-declaration-limits t))
- (when (not decl-limits)
- (exchange-point-and-mark)
- (error "Cannot find any declaration"))
- (goto-char (cdr decl-limits))
- (exchange-point-and-mark))
- (goto-char (car decl-limits))
- (push-mark (cdr decl-limits) nil t))))))
+ (c-with-string-fences
+ (let (decl-limits case-fold-search)
+ (c-save-buffer-state nil
+ ;; We try to be line oriented, unless there are several
+ ;; declarations on the same line.
+ (if (looking-at c-syntactic-eol)
+ (c-backward-token-2 1 nil (c-point 'bol)))
+ (setq decl-limits (c-declaration-limits t)))
+
+ (if (not decl-limits)
+ (error "Cannot find any declaration")
+ (let* ((extend-region-p
+ (and (eq this-command 'c-mark-function)
+ (eq last-command 'c-mark-function)))
+ (push-mark-p (and (eq this-command 'c-mark-function)
+ (not extend-region-p)
+ (not (c-region-is-active-p)))))
+ (if push-mark-p (push-mark))
+ (if extend-region-p
+ (progn
+ (exchange-point-and-mark)
+ (setq decl-limits (c-declaration-limits t))
+ (when (not decl-limits)
+ (exchange-point-and-mark)
+ (error "Cannot find any declaration"))
+ (goto-char (cdr decl-limits))
+ (exchange-point-and-mark))
+ (goto-char (car decl-limits))
+ (push-mark (cdr decl-limits) nil t)))))))
(defun c-cpp-define-name ()
"Return the name of the current CPP macro, or NIL if we're not in one."
@@ -3031,85 +3054,86 @@ be more \"DWIM:ey\"."
nil t))
(if (< count 0)
(c-end-of-statement (- count) lim sentence-flag)
- (c-save-buffer-state
- ((count (or count 1))
- last ; start point for going back ONE chunk. Updated each chunk movement.
- (macro-fence
- (save-excursion (and (not (bobp)) (c-beginning-of-macro) (point))))
- res ; result from sub-function call
- not-bos ; "not beginning-of-statement"
- (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL
-
- ;; Go back one statement at each iteration of the following loop.
- (while (and (/= count 0)
- (or (not lim) (> (point) lim)))
- ;; Go back one "chunk" each time round the following loop, stopping
- ;; when we reach a statement boundary, etc.
- (setq last (point))
- (while
- (cond ; Each arm of this cond returns NIL on reaching a desired
- ; statement boundary, non-NIL otherwise.
- ((bobp)
- (setq count 0)
- nil)
-
- (range ; point is within or approaching a literal.
- (cond
- ;; Single line string or sentence-flag is null => skip the
- ;; entire literal.
- ((or (null sentence-flag)
- (c-one-line-string-p range))
- (goto-char (car range))
- (setq range (c-ascertain-preceding-literal))
- ;; N.B. The following is essentially testing for an AWK regexp
- ;; at BOS:
- ;; Was the previous non-ws thing an end of statement?
- (save-excursion
- (if macro-fence
- (c-backward-comments)
- (c-backward-syntactic-ws))
- (not (or (bobp) (c-after-statement-terminator-p)))))
-
- ;; Comment inside a statement or a multi-line string.
- (t (when (setq res ; returns non-nil when we go out of the literal
- (if (eq (c-literal-type range) 'string)
- (c-beginning-of-sentence-in-string range)
- (c-beginning-of-sentence-in-comment range)))
- (setq range (c-ascertain-preceding-literal)))
- res)))
-
- ;; Non-literal code.
- (t (setq res (c-back-over-illiterals macro-fence))
- (setq not-bos ; "not reached beginning-of-statement".
- (or (= (point) last)
- (memq (char-after) '(?\) ?\}))
- (and
- (car res)
- ;; We're at a tentative BOS. The next form goes
- ;; back over WS looking for an end of previous
- ;; statement.
- (not (save-excursion
- (if macro-fence
- (c-backward-comments)
- (c-backward-syntactic-ws))
- (or (bobp) (c-after-statement-terminator-p)))))))
- ;; Are we about to move backwards into or out of a
- ;; preprocessor command? If so, locate its beginning.
- (when (eq (cdr res) 'macro-boundary)
- (save-excursion
- (beginning-of-line)
- (setq macro-fence
- (and (not (bobp))
- (progn (c-skip-ws-backward) (c-beginning-of-macro))
- (point)))))
- ;; Are we about to move backwards into a literal?
- (when (memq (cdr res) '(macro-boundary literal))
- (setq range (c-ascertain-preceding-literal)))
- not-bos))
- (setq last (point)))
-
- (if (/= count 0) (setq count (1- count))))
- (c-keep-region-active))))
+ (c-with-string-fences
+ (c-save-buffer-state
+ ((count (or count 1))
+ last ; start point for going back ONE chunk. Updated each chunk movement.
+ (macro-fence
+ (save-excursion (and (not (bobp)) (c-beginning-of-macro) (point))))
+ res ; result from sub-function call
+ not-bos ; "not beginning-of-statement"
+ (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL
+
+ ;; Go back one statement at each iteration of the following loop.
+ (while (and (/= count 0)
+ (or (not lim) (> (point) lim)))
+ ;; Go back one "chunk" each time round the following loop, stopping
+ ;; when we reach a statement boundary, etc.
+ (setq last (point))
+ (while
+ (cond ; Each arm of this cond returns NIL on reaching a desired
+ ; statement boundary, non-NIL otherwise.
+ ((bobp)
+ (setq count 0)
+ nil)
+
+ (range ; point is within or approaching a literal.
+ (cond
+ ;; Single line string or sentence-flag is null => skip the
+ ;; entire literal.
+ ((or (null sentence-flag)
+ (c-one-line-string-p range))
+ (goto-char (car range))
+ (setq range (c-ascertain-preceding-literal))
+ ;; N.B. The following is essentially testing for an AWK regexp
+ ;; at BOS:
+ ;; Was the previous non-ws thing an end of statement?
+ (save-excursion
+ (if macro-fence
+ (c-backward-comments)
+ (c-backward-syntactic-ws))
+ (not (or (bobp) (c-after-statement-terminator-p)))))
+
+ ;; Comment inside a statement or a multi-line string.
+ (t (when (setq res ; returns non-nil when we go out of the literal
+ (if (eq (c-literal-type range) 'string)
+ (c-beginning-of-sentence-in-string range)
+ (c-beginning-of-sentence-in-comment range)))
+ (setq range (c-ascertain-preceding-literal)))
+ res)))
+
+ ;; Non-literal code.
+ (t (setq res (c-back-over-illiterals macro-fence))
+ (setq not-bos ; "not reached beginning-of-statement".
+ (or (= (point) last)
+ (memq (char-after) '(?\) ?\}))
+ (and
+ (car res)
+ ;; We're at a tentative BOS. The next form goes
+ ;; back over WS looking for an end of previous
+ ;; statement.
+ (not (save-excursion
+ (if macro-fence
+ (c-backward-comments)
+ (c-backward-syntactic-ws))
+ (or (bobp) (c-after-statement-terminator-p)))))))
+ ;; Are we about to move backwards into or out of a
+ ;; preprocessor command? If so, locate its beginning.
+ (when (eq (cdr res) 'macro-boundary)
+ (save-excursion
+ (beginning-of-line)
+ (setq macro-fence
+ (and (not (bobp))
+ (progn (c-skip-ws-backward) (c-beginning-of-macro))
+ (point)))))
+ ;; Are we about to move backwards into a literal?
+ (when (memq (cdr res) '(macro-boundary literal))
+ (setq range (c-ascertain-preceding-literal)))
+ not-bos))
+ (setq last (point)))
+
+ (if (/= count 0) (setq count (1- count))))
+ (c-keep-region-active)))))
(defun c-end-of-statement (&optional count lim sentence-flag)
"Go to the end of the innermost C statement.
@@ -3127,78 +3151,79 @@ sentence motion in or near comments and multiline strings."
(setq count (or count 1))
(if (< count 0) (c-beginning-of-statement (- count) lim sentence-flag)
- (c-save-buffer-state
- (here ; start point for going forward ONE statement. Updated each statement.
- (macro-fence
- (save-excursion
- (and (not (eobp)) (c-beginning-of-macro)
- (progn (c-end-of-macro) (point)))))
- res
- (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL
-
- ;; Go back/forward one statement at each iteration of the following loop.
- (while (and (/= count 0)
- (or (not lim) (< (point) lim)))
- (setq here (point)) ; ONLY HERE is HERE updated
-
- ;; Go forward one "chunk" each time round the following loop, stopping
- ;; when we reach a statement boundary, etc.
- (while
- (cond ; Each arm of this cond returns NIL on reaching a desired
- ; statement boundary, non-NIL otherwise.
- ((eobp)
- (setq count 0)
- nil)
+ (c-with-string-fences
+ (c-save-buffer-state
+ (here ; start point for going forward ONE statement. Updated each statement.
+ (macro-fence
+ (save-excursion
+ (and (not (eobp)) (c-beginning-of-macro)
+ (progn (c-end-of-macro) (point)))))
+ res
+ (range (c-collect-line-comments (c-literal-limits lim)))) ; (start.end) of current literal or NIL
+
+ ;; Go back/forward one statement at each iteration of the following loop.
+ (while (and (/= count 0)
+ (or (not lim) (< (point) lim)))
+ (setq here (point)) ; ONLY HERE is HERE updated
+
+ ;; Go forward one "chunk" each time round the following loop, stopping
+ ;; when we reach a statement boundary, etc.
+ (while
+ (cond ; Each arm of this cond returns NIL on reaching a desired
+ ; statement boundary, non-NIL otherwise.
+ ((eobp)
+ (setq count 0)
+ nil)
+
+ (range ; point is within a literal.
+ (cond
+ ;; sentence-flag is null => skip the entire literal.
+ ;; or a Single line string.
+ ((or (null sentence-flag)
+ (c-one-line-string-p range))
+ (goto-char (cdr range))
+ (setq range (c-ascertain-following-literal))
+ ;; Is there a virtual semicolon here (e.g. for AWK)?
+ (not (c-at-vsemi-p)))
+
+ ;; Comment or multi-line string.
+ (t (when (setq res ; gets non-nil when we go out of the literal
+ (if (eq (c-literal-type range) 'string)
+ (c-end-of-sentence-in-string range)
+ (c-end-of-sentence-in-comment range)))
+ (setq range (c-ascertain-following-literal)))
+ ;; If we've just come forward out of a literal, check for
+ ;; vsemi. (N.B. AWK can't have a vsemi after a comment, but
+ ;; some other language may do in the future)
+ (and res
+ (not (c-at-vsemi-p))))))
+
+ ;; Non-literal code.
+ (t (setq res (c-forward-over-illiterals macro-fence
+ (> (point) here)))
+ ;; Are we about to move forward into or out of a
+ ;; preprocessor command?
+ (when (eq (cdr res) 'macro-boundary)
+ (setq macro-fence
+ (save-excursion
+ (if macro-fence
+ (progn
+ (end-of-line)
+ (and (not (eobp))
+ (progn (c-skip-ws-forward)
+ (c-beginning-of-macro))
+ (progn (c-end-of-macro)
+ (point))))
+ (and (not (eobp))
+ (c-beginning-of-macro)
+ (progn (c-end-of-macro) (point)))))))
+ ;; Are we about to move forward into a literal?
+ (when (memq (cdr res) '(macro-boundary literal))
+ (setq range (c-ascertain-following-literal)))
+ (car res))))
- (range ; point is within a literal.
- (cond
- ;; sentence-flag is null => skip the entire literal.
- ;; or a Single line string.
- ((or (null sentence-flag)
- (c-one-line-string-p range))
- (goto-char (cdr range))
- (setq range (c-ascertain-following-literal))
- ;; Is there a virtual semicolon here (e.g. for AWK)?
- (not (c-at-vsemi-p)))
-
- ;; Comment or multi-line string.
- (t (when (setq res ; gets non-nil when we go out of the literal
- (if (eq (c-literal-type range) 'string)
- (c-end-of-sentence-in-string range)
- (c-end-of-sentence-in-comment range)))
- (setq range (c-ascertain-following-literal)))
- ;; If we've just come forward out of a literal, check for
- ;; vsemi. (N.B. AWK can't have a vsemi after a comment, but
- ;; some other language may do in the future)
- (and res
- (not (c-at-vsemi-p))))))
-
- ;; Non-literal code.
- (t (setq res (c-forward-over-illiterals macro-fence
- (> (point) here)))
- ;; Are we about to move forward into or out of a
- ;; preprocessor command?
- (when (eq (cdr res) 'macro-boundary)
- (setq macro-fence
- (save-excursion
- (if macro-fence
- (progn
- (end-of-line)
- (and (not (eobp))
- (progn (c-skip-ws-forward)
- (c-beginning-of-macro))
- (progn (c-end-of-macro)
- (point))))
- (and (not (eobp))
- (c-beginning-of-macro)
- (progn (c-end-of-macro) (point)))))))
- ;; Are we about to move forward into a literal?
- (when (memq (cdr res) '(macro-boundary literal))
- (setq range (c-ascertain-following-literal)))
- (car res))))
-
- (if (/= count 0) (setq count (1- count))))
- (c-keep-region-active))))
+ (if (/= count 0) (setq count (1- count))))
+ (c-keep-region-active)))))
;; set up electric character functions to work with pending-del,
@@ -3413,7 +3438,8 @@ to call `c-scan-conditionals' directly instead."
(interactive "p")
(let ((new-point (c-scan-conditionals count target-depth with-else)))
(push-mark)
- (goto-char new-point)))
+ (goto-char new-point))
+ (c-keep-region-active))
(defun c-scan-conditionals (count &optional target-depth with-else)
"Scan forward across COUNT preprocessor conditionals.
@@ -3536,122 +3562,125 @@ prefix argument is equivalent to -1.
depending on the variable `indent-tabs-mode'."
(interactive "P")
- (let ((indent-function
- (if c-syntactic-indentation
- (symbol-function 'indent-according-to-mode)
- (lambda ()
- (let ((c-macro-start c-macro-start)
- (steps (if (equal arg '(4))
- -1
- (prefix-numeric-value arg))))
- (c-shift-line-indentation (* steps c-basic-offset))
- (when (and c-auto-align-backslashes
- (save-excursion
- (end-of-line)
- (eq (char-before) ?\\))
- (c-query-and-set-macro-start))
- ;; Realign the line continuation backslash if inside a macro.
- (c-backslash-region (point) (point) nil t)))
- ))))
- (if (and c-syntactic-indentation arg)
- ;; If c-syntactic-indentation and got arg, always indent this
- ;; line as C and shift remaining lines of expression the same
- ;; amount.
- (let ((shift-amt (save-excursion
- (back-to-indentation)
- (current-column)))
- beg end)
- (c-indent-line)
- (setq shift-amt (- (save-excursion
- (back-to-indentation)
- (current-column))
- shift-amt))
- (save-excursion
- (if (eq c-tab-always-indent t)
- (beginning-of-line)) ; FIXME!!! What is this here for? ACM 2005/10/31
- (setq beg (point))
- (c-forward-sexp 1)
- (setq end (point))
- (goto-char beg)
- (forward-line 1)
- (setq beg (point)))
- (if (> end beg)
- (indent-code-rigidly beg end shift-amt "#")))
- ;; Else use c-tab-always-indent to determine behavior.
- (cond
- ;; CASE 1: indent when at column zero or in line's indentation,
- ;; otherwise insert a tab
- ((not c-tab-always-indent)
- (if (save-excursion
- (skip-chars-backward " \t")
- (not (bolp)))
- (funcall c-insert-tab-function)
- (funcall indent-function)))
- ;; CASE 2: just indent the line
- ((eq c-tab-always-indent t)
- (funcall indent-function))
- ;; CASE 3: if in a literal, insert a tab, but always indent the
- ;; line
- (t
- (if (c-save-buffer-state () (c-in-literal))
- (funcall c-insert-tab-function))
- (funcall indent-function)
- )))))
+ (c-with-string-fences
+ (let ((indent-function
+ (if c-syntactic-indentation
+ (symbol-function 'indent-according-to-mode)
+ (lambda ()
+ (let ((c-macro-start c-macro-start)
+ (steps (if (equal arg '(4))
+ -1
+ (prefix-numeric-value arg))))
+ (c-shift-line-indentation (* steps c-basic-offset))
+ (when (and c-auto-align-backslashes
+ (save-excursion
+ (end-of-line)
+ (eq (char-before) ?\\))
+ (c-query-and-set-macro-start))
+ ;; Realign the line continuation backslash if inside a macro.
+ (c-backslash-region (point) (point) nil t)))
+ ))))
+ (if (and c-syntactic-indentation arg)
+ ;; If c-syntactic-indentation and got arg, always indent this
+ ;; line as C and shift remaining lines of expression the same
+ ;; amount.
+ (let ((shift-amt (save-excursion
+ (back-to-indentation)
+ (current-column)))
+ beg end)
+ (c-indent-line)
+ (setq shift-amt (- (save-excursion
+ (back-to-indentation)
+ (current-column))
+ shift-amt))
+ (save-excursion
+ (if (eq c-tab-always-indent t)
+ (beginning-of-line)) ; FIXME!!! What is this here for? ACM 2005/10/31
+ (setq beg (point))
+ (c-forward-sexp 1)
+ (setq end (point))
+ (goto-char beg)
+ (forward-line 1)
+ (setq beg (point)))
+ (if (> end beg)
+ (indent-code-rigidly beg end shift-amt "#")))
+ ;; Else use c-tab-always-indent to determine behavior.
+ (cond
+ ;; CASE 1: indent when at column zero or in line's indentation,
+ ;; otherwise insert a tab
+ ((not c-tab-always-indent)
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (funcall c-insert-tab-function)
+ (funcall indent-function)))
+ ;; CASE 2: just indent the line
+ ((eq c-tab-always-indent t)
+ (funcall indent-function))
+ ;; CASE 3: if in a literal, insert a tab, but always indent the
+ ;; line
+ (t
+ (if (c-save-buffer-state () (c-in-literal))
+ (funcall c-insert-tab-function))
+ (funcall indent-function)
+ ))))))
(defun c-indent-exp (&optional shutup-p)
"Indent each line in the balanced expression following point syntactically.
If optional SHUTUP-P is non-nil, no errors are signaled if no
balanced expression is found."
(interactive "*P")
- (let ((here (point-marker))
- end)
- (set-marker-insertion-type here t)
- (unwind-protect
- (let ((start (save-restriction
- ;; Find the closest following open paren that
- ;; ends on another line.
- (narrow-to-region (point-min) (c-point 'eol))
- (let (beg (end (point)))
- (while (and (setq beg (c-down-list-forward end))
- (setq end (c-up-list-forward beg))))
- (and beg
- (eq (char-syntax (char-before beg)) ?\()
- (1- beg))))))
- ;; sanity check
- (if (not start)
- (unless shutup-p
- (error "Cannot find start of balanced expression to indent"))
- (goto-char start)
- (setq end (c-safe (scan-sexps (point) 1)))
- (if (not end)
- (unless shutup-p
- (error "Cannot find end of balanced expression to indent"))
- (forward-line)
- (if (< (point) end)
- (c-indent-region (point) end)))))
- (goto-char here)
- (set-marker here nil))))
+ (c-with-string-fences
+ (let ((here (point-marker))
+ end)
+ (set-marker-insertion-type here t)
+ (unwind-protect
+ (let ((start (save-restriction
+ ;; Find the closest following open paren that
+ ;; ends on another line.
+ (narrow-to-region (point-min) (c-point 'eol))
+ (let (beg (end (point)))
+ (while (and (setq beg (c-down-list-forward end))
+ (setq end (c-up-list-forward beg))))
+ (and beg
+ (eq (char-syntax (char-before beg)) ?\()
+ (1- beg))))))
+ ;; sanity check
+ (if (not start)
+ (unless shutup-p
+ (error "Cannot find start of balanced expression to indent"))
+ (goto-char start)
+ (setq end (c-safe (scan-sexps (point) 1)))
+ (if (not end)
+ (unless shutup-p
+ (error "Cannot find end of balanced expression to indent"))
+ (forward-line)
+ (if (< (point) end)
+ (c-indent-region (point) end)))))
+ (goto-char here)
+ (set-marker here nil)))))
(defun c-indent-defun ()
"Indent the current top-level declaration or macro syntactically.
In the macro case this also has the effect of realigning any line
continuation backslashes, unless `c-auto-align-backslashes' is nil."
(interactive "*")
- (let ((here (point-marker)) decl-limits case-fold-search)
- (unwind-protect
- (progn
- (c-save-buffer-state nil
- ;; We try to be line oriented, unless there are several
- ;; declarations on the same line.
- (if (looking-at c-syntactic-eol)
- (c-backward-token-2 1 nil (c-point 'bol))
- (c-forward-token-2 0 nil (c-point 'eol)))
- (setq decl-limits (c-declaration-limits nil)))
- (if decl-limits
- (c-indent-region (car decl-limits)
- (cdr decl-limits))))
- (goto-char here)
- (set-marker here nil))))
+ (c-with-string-fences
+ (let ((here (point-marker)) decl-limits case-fold-search)
+ (unwind-protect
+ (progn
+ (c-save-buffer-state nil
+ ;; We try to be line oriented, unless there are several
+ ;; declarations on the same line.
+ (if (looking-at c-syntactic-eol)
+ (c-backward-token-2 1 nil (c-point 'bol))
+ (c-forward-token-2 0 nil (c-point 'eol)))
+ (setq decl-limits (c-declaration-limits nil)))
+ (if decl-limits
+ (c-indent-region (car decl-limits)
+ (cdr decl-limits))))
+ (goto-char here)
+ (set-marker here nil)))))
(defun c-indent-region (start end &optional quiet)
"Indent syntactically lines whose first char is between START and END inclusive.
@@ -3731,9 +3760,10 @@ starting on the current line.
Otherwise reindent just the current line."
(interactive
(list current-prefix-arg (c-region-is-active-p)))
- (if region
- (c-indent-region (region-beginning) (region-end))
- (c-indent-command arg)))
+ (c-with-string-fences
+ (if region
+ (c-indent-region (region-beginning) (region-end))
+ (c-indent-command arg))))
;; for progress reporting
(defvar c-progress-info nil)
@@ -4820,15 +4850,16 @@ If point is in any other situation, i.e. in normal code, do nothing.
Optional prefix ARG means justify paragraph as well."
(interactive "*P")
- (let ((fill-paragraph-function
- ;; Avoid infinite recursion.
- (if (not (eq fill-paragraph-function 'c-fill-paragraph))
- fill-paragraph-function)))
- (c-mask-paragraph t nil 'fill-paragraph arg))
- ;; Always return t. This has the effect that if filling isn't done
- ;; above, it isn't done at all, and it's therefore effectively
- ;; disabled in normal code.
- t)
+ (c-with-string-fences
+ (let ((fill-paragraph-function
+ ;; Avoid infinite recursion.
+ (if (not (eq fill-paragraph-function 'c-fill-paragraph))
+ fill-paragraph-function)))
+ (c-mask-paragraph t nil 'fill-paragraph arg))
+ ;; Always return t. This has the effect that if filling isn't done
+ ;; above, it isn't done at all, and it's therefore effectively
+ ;; disabled in normal code.
+ t))
(defun c-do-auto-fill ()
;; Do automatic filling if not inside a context where it should be
@@ -4860,181 +4891,170 @@ If a fill prefix is specified, it overrides all the above."
;; used from auto-fill itself, that's normally disabled to avoid
;; unnecessary recursion.
(interactive)
- (let ((fill-prefix fill-prefix)
- (do-line-break
- (lambda ()
- (delete-horizontal-space)
- (if soft
- (insert-and-inherit ?\n)
- (newline (if allow-auto-fill nil 1)))))
- ;; Already know the literal type and limits when called from
- ;; c-context-line-break.
- (c-lit-limits c-lit-limits)
- (c-lit-type c-lit-type)
- (c-macro-start c-macro-start))
-
- (c-save-buffer-state ()
- (when (not (eq c-auto-fill-prefix t))
- ;; Called from do-auto-fill.
- (unless c-lit-limits
- (setq c-lit-limits (c-literal-limits nil nil t)))
- (unless c-lit-type
- (setq c-lit-type (c-literal-type c-lit-limits)))
- (if (memq (cond ((c-query-and-set-macro-start) 'cpp)
- ((null c-lit-type) 'code)
- (t c-lit-type))
- c-ignore-auto-fill)
- (setq fill-prefix t) ; Used as flag in the cond.
- (if (and (null c-auto-fill-prefix)
- (eq c-lit-type 'c)
- (<= (c-point 'bol) (car c-lit-limits)))
- ;; The adaptive fill function has generated a prefix, but
- ;; we're on the first line in a block comment so it'll be
- ;; wrong. Ignore it to guess a better one below.
- (setq fill-prefix nil)
- (when (and (eq c-lit-type 'c++)
- (not (string-match (concat "\\`[ \t]*"
- c-line-comment-starter)
- (or fill-prefix ""))))
- ;; Kludge: If the function that adapted the fill prefix
- ;; doesn't produce the required comment starter for line
- ;; comments, then we ignore it.
- (setq fill-prefix nil)))
- )))
-
- (cond ((eq fill-prefix t)
- ;; A call from do-auto-fill which should be ignored.
- )
- (fill-prefix
- ;; A fill-prefix overrides anything.
- (funcall do-line-break)
- (insert-and-inherit fill-prefix))
- ((c-save-buffer-state ()
- (unless c-lit-limits
- (setq c-lit-limits (c-literal-limits)))
- (unless c-lit-type
- (setq c-lit-type (c-literal-type c-lit-limits)))
- (memq c-lit-type '(c c++)))
- ;; Some sort of comment.
- (if (or comment-multi-line
- (save-excursion
- (goto-char (car c-lit-limits))
- (end-of-line)
- (< (point) (cdr c-lit-limits))))
- ;; Inside a comment that should be continued.
- (let ((fill (c-save-buffer-state nil
- (c-guess-fill-prefix
- (setq c-lit-limits
- (c-collect-line-comments c-lit-limits))
- c-lit-type)))
- (pos (point))
- (comment-text-end
- (or (and (eq c-lit-type 'c)
- (save-excursion
- (goto-char (- (cdr c-lit-limits) 2))
- (if (looking-at "\\*/") (point))))
- (cdr c-lit-limits))))
- ;; Skip forward past the fill prefix in case
- ;; we're standing in it.
- ;;
- ;; FIXME: This doesn't work well in cases like
- ;;
- ;; /* Bla bla bla bla bla
- ;; bla bla
- ;;
- ;; If point is on the 'B' then the line will be
- ;; broken after "Bla b".
- ;;
- ;; If we have an empty comment, /* */, the next
- ;; lot of code pushes point to the */. We fix
- ;; this by never allowing point to end up to the
- ;; right of where it started.
- (while (and (< (current-column) (cdr fill))
- (not (eolp)))
- (forward-char 1))
- (if (and (> (point) comment-text-end)
- (> (c-point 'bol) (car c-lit-limits)))
- (progn
- ;; The skip takes us out of the (block)
- ;; comment; insert the fill prefix at bol
- ;; instead and keep the position.
- (setq pos (copy-marker pos t))
- (beginning-of-line)
- (insert-and-inherit (car fill))
- (if soft (insert-and-inherit ?\n) (newline 1))
- (goto-char pos)
- (set-marker pos nil))
- ;; Don't break in the middle of a comment starter
- ;; or ender.
- (cond ((> (point) comment-text-end)
- (goto-char comment-text-end))
- ((< (point) (+ (car c-lit-limits) 2))
- (goto-char (+ (car c-lit-limits) 2))))
- (funcall do-line-break)
- (insert-and-inherit (car fill))
- (if (and (looking-at c-block-comment-ender-regexp)
- (memq (char-before) '(?\ ?\t)))
- (backward-char)))) ; can this hit the
- ; middle of a TAB?
- ;; Inside a comment that should be broken.
- (let ((comment-start comment-start)
- (comment-end comment-end)
- col)
- (if (eq c-lit-type 'c)
- (unless (string-match "[ \t]*/\\*" comment-start)
- (setq comment-start "/* " comment-end " */"))
- (unless (string-match "[ \t]*//" comment-start)
- (setq comment-start "// " comment-end "")))
- (setq col (save-excursion
- (back-to-indentation)
- (current-column)))
- (funcall do-line-break)
- (when (and comment-end (not (equal comment-end "")))
- (forward-char -1)
- (insert-and-inherit comment-end)
- (forward-char 1))
- ;; c-comment-indent may look at the current
- ;; indentation, so let's start out with the same
- ;; indentation as the previous one.
- (indent-to col)
- (insert-and-inherit comment-start)
- (indent-for-comment))))
- ((c-query-and-set-macro-start)
- ;; In a macro.
- (unless (looking-at "[ \t]*\\\\$")
- ;; Do not clobber the alignment of the line continuation
- ;; slash; c-backslash-region might look at it.
- (delete-horizontal-space))
- ;; Got an asymmetry here: In normal code this command
- ;; doesn't indent the next line syntactically, and otoh a
- ;; normal syntactically indenting newline doesn't continue
- ;; the macro.
- (c-newline-and-indent (if allow-auto-fill nil 1)))
- (t
- ;; Somewhere else in the code.
- (let ((col (save-excursion
+ (c-with-string-fences
+ (let ((fill-prefix fill-prefix)
+ (do-line-break
+ (lambda ()
+ (delete-horizontal-space)
+ (if soft
+ (insert-and-inherit ?\n)
+ (newline (if allow-auto-fill nil 1)))))
+ ;; Already know the literal type and limits when called from
+ ;; c-context-line-break.
+ (c-lit-limits c-lit-limits)
+ (c-lit-type c-lit-type)
+ (c-macro-start c-macro-start))
+
+ (c-save-buffer-state ()
+ (when (not (eq c-auto-fill-prefix t))
+ ;; Called from do-auto-fill.
+ (unless c-lit-limits
+ (setq c-lit-limits (c-literal-limits nil nil t)))
+ (unless c-lit-type
+ (setq c-lit-type (c-literal-type c-lit-limits)))
+ (if (memq (cond ((c-query-and-set-macro-start) 'cpp)
+ ((null c-lit-type) 'code)
+ (t c-lit-type))
+ c-ignore-auto-fill)
+ (setq fill-prefix t) ; Used as flag in the cond.
+ (if (and (null c-auto-fill-prefix)
+ (eq c-lit-type 'c)
+ (<= (c-point 'bol) (car c-lit-limits)))
+ ;; The adaptive fill function has generated a prefix, but
+ ;; we're on the first line in a block comment so it'll be
+ ;; wrong. Ignore it to guess a better one below.
+ (setq fill-prefix nil)
+ (when (and (eq c-lit-type 'c++)
+ (not (string-match (concat "\\`[ \t]*"
+ c-line-comment-starter)
+ (or fill-prefix ""))))
+ ;; Kludge: If the function that adapted the fill prefix
+ ;; doesn't produce the required comment starter for line
+ ;; comments, then we ignore it.
+ (setq fill-prefix nil)))
+ )))
+
+ (cond ((eq fill-prefix t)
+ ;; A call from do-auto-fill which should be ignored.
+ )
+ (fill-prefix
+ ;; A fill-prefix overrides anything.
+ (funcall do-line-break)
+ (insert-and-inherit fill-prefix))
+ ((c-save-buffer-state ()
+ (unless c-lit-limits
+ (setq c-lit-limits (c-literal-limits)))
+ (unless c-lit-type
+ (setq c-lit-type (c-literal-type c-lit-limits)))
+ (memq c-lit-type '(c c++)))
+ ;; Some sort of comment.
+ (if (or comment-multi-line
+ (save-excursion
+ (goto-char (car c-lit-limits))
+ (end-of-line)
+ (< (point) (cdr c-lit-limits))))
+ ;; Inside a comment that should be continued.
+ (let ((fill (c-save-buffer-state nil
+ (c-guess-fill-prefix
+ (setq c-lit-limits
+ (c-collect-line-comments c-lit-limits))
+ c-lit-type)))
+ (pos (point))
+ (comment-text-end
+ (or (and (eq c-lit-type 'c)
+ (save-excursion
+ (goto-char (- (cdr c-lit-limits) 2))
+ (if (looking-at "\\*/") (point))))
+ (cdr c-lit-limits))))
+ ;; Skip forward past the fill prefix in case
+ ;; we're standing in it.
+ ;;
+ ;; FIXME: This doesn't work well in cases like
+ ;;
+ ;; /* Bla bla bla bla bla
+ ;; bla bla
+ ;;
+ ;; If point is on the 'B' then the line will be
+ ;; broken after "Bla b".
+ ;;
+ ;; If we have an empty comment, /* */, the next
+ ;; lot of code pushes point to the */. We fix
+ ;; this by never allowing point to end up to the
+ ;; right of where it started.
+ (while (and (< (current-column) (cdr fill))
+ (not (eolp)))
+ (forward-char 1))
+ (if (and (> (point) comment-text-end)
+ (> (c-point 'bol) (car c-lit-limits)))
+ (progn
+ ;; The skip takes us out of the (block)
+ ;; comment; insert the fill prefix at bol
+ ;; instead and keep the position.
+ (setq pos (copy-marker pos t))
(beginning-of-line)
- (while (and (looking-at "[ \t]*\\\\?$")
- (= (forward-line -1) 0)))
- (current-indentation))))
- (funcall do-line-break)
- (indent-to col))))))
+ (insert-and-inherit (car fill))
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (goto-char pos)
+ (set-marker pos nil))
+ ;; Don't break in the middle of a comment starter
+ ;; or ender.
+ (cond ((> (point) comment-text-end)
+ (goto-char comment-text-end))
+ ((< (point) (+ (car c-lit-limits) 2))
+ (goto-char (+ (car c-lit-limits) 2))))
+ (funcall do-line-break)
+ (insert-and-inherit (car fill))
+ (if (and (looking-at c-block-comment-ender-regexp)
+ (memq (char-before) '(?\ ?\t)))
+ (backward-char)))) ; can this hit the
+ ; middle of a TAB?
+ ;; Inside a comment that should be broken.
+ (let ((comment-start comment-start)
+ (comment-end comment-end)
+ col)
+ (if (eq c-lit-type 'c)
+ (unless (string-match "[ \t]*/\\*" comment-start)
+ (setq comment-start "/* " comment-end " */"))
+ (unless (string-match "[ \t]*//" comment-start)
+ (setq comment-start "// " comment-end "")))
+ (setq col (save-excursion
+ (back-to-indentation)
+ (current-column)))
+ (funcall do-line-break)
+ (when (and comment-end (not (equal comment-end "")))
+ (forward-char -1)
+ (insert-and-inherit comment-end)
+ (forward-char 1))
+ ;; c-comment-indent may look at the current
+ ;; indentation, so let's start out with the same
+ ;; indentation as the previous one.
+ (indent-to col)
+ (insert-and-inherit comment-start)
+ (indent-for-comment))))
+ ((c-query-and-set-macro-start)
+ ;; In a macro.
+ (unless (looking-at "[ \t]*\\\\$")
+ ;; Do not clobber the alignment of the line continuation
+ ;; slash; c-backslash-region might look at it.
+ (delete-horizontal-space))
+ ;; Got an asymmetry here: In normal code this command
+ ;; doesn't indent the next line syntactically, and otoh a
+ ;; normal syntactically indenting newline doesn't continue
+ ;; the macro.
+ (c-newline-and-indent (if allow-auto-fill nil 1)))
+ (t
+ ;; Somewhere else in the code.
+ (let ((col (save-excursion
+ (beginning-of-line)
+ (while (and (looking-at "[ \t]*\\\\?$")
+ (= (forward-line -1) 0)))
+ (current-indentation))))
+ (funcall do-line-break)
+ (indent-to col)))))))
(defalias 'c-comment-line-break-function 'c-indent-new-comment-line)
(make-obsolete 'c-comment-line-break-function 'c-indent-new-comment-line "21.1")
-;; Advice for Emacsen older than 21.1 (!), released 2001/10
-(unless (boundp 'comment-line-break-function)
- (defvar c-inside-line-break-advice nil)
- (defadvice indent-new-comment-line (around c-line-break-advice
- activate preactivate)
- "Call `c-indent-new-comment-line' if in CC Mode."
- (if (or c-inside-line-break-advice
- (not c-buffer-is-cc-mode))
- ad-do-it
- (let ((c-inside-line-break-advice t))
- (c-indent-new-comment-line (ad-get-arg 0))))))
-
(defun c-context-line-break ()
"Do a line break suitable to the context.
@@ -5057,58 +5077,59 @@ When point is inside a string, only insert a backslash when it is also
inside a preprocessor directive."
(interactive "*")
- (let* (c-lit-limits c-lit-type
- (c-macro-start c-macro-start)
- case-fold-search)
-
- (c-save-buffer-state ()
- (setq c-lit-limits (c-literal-limits nil nil t)
- c-lit-type (c-literal-type c-lit-limits))
- (when (eq c-lit-type 'c++)
- (setq c-lit-limits (c-collect-line-comments c-lit-limits)))
- (c-query-and-set-macro-start))
-
- (cond
- ((or (eq c-lit-type 'c)
- (and (eq c-lit-type 'c++) ; C++ comment, but not at the very end of it.
- (< (save-excursion
- (skip-chars-forward " \t")
- (point))
- (1- (cdr c-lit-limits))))
- (and (numberp c-macro-start) ; Macro, but not at the very end of
+ (c-with-string-fences
+ (let* (c-lit-limits c-lit-type
+ (c-macro-start c-macro-start)
+ case-fold-search)
+
+ (c-save-buffer-state ()
+ (setq c-lit-limits (c-literal-limits nil nil t)
+ c-lit-type (c-literal-type c-lit-limits))
+ (when (eq c-lit-type 'c++)
+ (setq c-lit-limits (c-collect-line-comments c-lit-limits)))
+ (c-query-and-set-macro-start))
+
+ (cond
+ ((or (eq c-lit-type 'c)
+ (and (eq c-lit-type 'c++) ; C++ comment, but not at the very end of it.
+ (< (save-excursion
+ (skip-chars-forward " \t")
+ (point))
+ (1- (cdr c-lit-limits))))
+ (and (numberp c-macro-start) ; Macro, but not at the very end of
; it, not in a string, and not in the
; cpp keyword.
- (not (eq c-lit-type 'string))
- (or (not (looking-at "\\s *$"))
- (eq (char-before) ?\\))
- (<= (save-excursion
- (goto-char c-macro-start)
- (if (looking-at c-opt-cpp-start)
- (goto-char (match-end 0)))
- (point))
- (point))))
- (let ((comment-multi-line t)
- (fill-prefix nil))
- (c-indent-new-comment-line nil t)))
-
- ((eq c-lit-type 'string)
- (if (and (numberp c-macro-start)
- (not (eq (char-before) ?\\)))
- (insert ?\\))
- (newline))
-
- (t (delete-horizontal-space)
- (newline)
- ;; c-indent-line may look at the current indentation, so let's
- ;; start out with the same indentation as the previous line.
- (let ((col (save-excursion
- (backward-char)
- (forward-line 0)
- (while (and (looking-at "[ \t]*\\\\?$")
- (= (forward-line -1) 0)))
- (current-indentation))))
- (indent-to col))
- (indent-according-to-mode)))))
+ (not (eq c-lit-type 'string))
+ (or (not (looking-at "\\s *$"))
+ (eq (char-before) ?\\))
+ (<= (save-excursion
+ (goto-char c-macro-start)
+ (if (looking-at c-opt-cpp-start)
+ (goto-char (match-end 0)))
+ (point))
+ (point))))
+ (let ((comment-multi-line t)
+ (fill-prefix nil))
+ (c-indent-new-comment-line nil t)))
+
+ ((eq c-lit-type 'string)
+ (if (and (numberp c-macro-start)
+ (not (eq (char-before) ?\\)))
+ (insert ?\\))
+ (newline))
+
+ (t (delete-horizontal-space)
+ (newline)
+ ;; c-indent-line may look at the current indentation, so let's
+ ;; start out with the same indentation as the previous line.
+ (let ((col (save-excursion
+ (backward-char)
+ (forward-line 0)
+ (while (and (looking-at "[ \t]*\\\\?$")
+ (= (forward-line -1) 0)))
+ (current-indentation))))
+ (indent-to col))
+ (indent-according-to-mode))))))
(defun c-context-open-line ()
"Insert a line break suitable to the context and leave point before it.
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index a1270243550..9edaf465346 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1563,6 +1563,28 @@ with value CHAR in the region [FROM to)."
(forward-char)))))
+;; Miscellaneous macro(s)
+(defvar c-string-fences-set-flag nil)
+;; Non-nil when we have set string fences with `c-restore-string-fences'.
+(defmacro c-with-string-fences (&rest forms)
+ ;; Restore the string fences, evaluate FORMS, then remove them again. It
+ ;; should only be used at the top level of "boundary" functions in CC Mode,
+ ;; i.e. those called from outside CC Mode which directly or indirectly need
+ ;; unbalanced string markers to have their string-fence syntax-table text
+ ;; properties. This includes all calls to `c-parse-state'. This macro will
+ ;; be invoked recursively; however the `c-string-fences-set-flag' mechanism
+ ;; should ensure consistency, when this happens.
+ (declare (debug t))
+ `(unwind-protect
+ (progn
+ (unless c-string-fences-set-flag
+ (c-restore-string-fences))
+ (let ((c-string-fences-set-flag t))
+ ,@forms))
+ (unless c-string-fences-set-flag
+ (c-clear-string-fences))))
+
+
;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
;; For our purposes, these are characterized by being possible to
;; remove again without affecting the other text properties in the
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 3068c41a57e..cfbb668baeb 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -165,12 +165,16 @@
(defvar c-doc-line-join-end-ch)
(defvar c-syntactic-context)
(defvar c-syntactic-element)
+(defvar c-new-id-start)
+(defvar c-new-id-end)
+(defvar c-new-id-is-type)
(cc-bytecomp-defvar c-min-syn-tab-mkr)
(cc-bytecomp-defvar c-max-syn-tab-mkr)
(cc-bytecomp-defun c-clear-syn-tab)
(cc-bytecomp-defun c-clear-string-fences)
(cc-bytecomp-defun c-restore-string-fences)
(cc-bytecomp-defun c-remove-string-fences)
+(cc-bytecomp-defun c-fontify-new-found-type)
;; Make declarations for all the `c-lang-defvar' variables in cc-langs.
@@ -1235,7 +1239,7 @@ comment at the start of cc-engine.el for more info."
(not comma-delimited)
(not (c-looking-at-inexpr-block lim nil t))
(save-excursion
- (c-backward-token-2 1 t nil)
+ (c-backward-token-2 1 t nil) ; Don't test the value
(not (looking-at "=\\([^=]\\|$\\)")))
(or
(not c-opt-block-decls-with-vars-key)
@@ -3418,7 +3422,9 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and
;; Return a good pos (in the sense of `c-state-cache-good-pos') at the
;; lowest[*] position between POS and HERE which is syntactically equivalent
;; to HERE. This position may be HERE itself. POS is before HERE in the
- ;; buffer.
+ ;; buffer. If POS and HERE are both in the same literal, return the start
+ ;; of the literal. STATE is the parsing state at POS.
+ ;;
;; [*] We don't actually always determine this exact position, since this
;; would require a disproportionate amount of work, given that this function
;; deals only with a corner condition, and POS and HERE are typically on
@@ -3434,7 +3440,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and
(setq pos (point)
state s)))
(if (eq (point) here) ; HERE is in the same literal as POS
- pos
+ (nth 8 state) ; A valid good pos cannot be in a literal.
(setq s (parse-partial-sexp pos here (1+ (car state)) nil state nil))
(cond
((> (car s) (car state)) ; Moved into a paren between POS and HERE
@@ -3880,7 +3886,10 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and
(cons (if (and ce (< bra ce) (> ce here)) ; {..} straddling HERE?
bra
(point-min))
- (min here from)))))))))
+ (progn
+ (goto-char (min here from))
+ (c-beginning-of-macro)
+ (point))))))))))
(defsubst c-state-push-any-brace-pair (bra+1 macro-start-or-here)
;; If BRA+1 is nil, do nothing. Otherwise, BRA+1 is the buffer position
@@ -6135,7 +6144,7 @@ comment at the start of cc-engine.el for more info."
(setq s (cons -1 (cdr s))))
((and (equal match ",")
(eq (car s) -1))) ; at "," in "class foo : bar, ..."
- ((member match '(";" "*" "," "("))
+ ((member match '(";" "*" "," ")"))
(when (and s (cdr s) (<= (car s) 0))
(setq s (cdr s))))
((c-keyword-member kwd-sym 'c-flat-decl-block-kwds)
@@ -6808,26 +6817,47 @@ comment at the start of cc-engine.el for more info."
(defvar c-found-types nil)
(make-variable-buffer-local 'c-found-types)
+;; Dynamically bound variable that instructs `c-forward-type' to
+;; record the ranges of types that only are found. Behaves otherwise
+;; like `c-record-type-identifiers'. Also when this variable is non-nil,
+;; `c-fontify-new-found-type' doesn't get called (yet) for the purported
+;; type.
+(defvar c-record-found-types nil)
+
(defsubst c-clear-found-types ()
;; Clears `c-found-types'.
(setq c-found-types
(make-hash-table :test #'equal :weakness nil)))
-(defun c-add-type (from to)
- ;; Add the given region as a type in `c-found-types'. If the region
- ;; doesn't match an existing type but there is a type which is equal
- ;; to the given one except that the last character is missing, then
- ;; the shorter type is removed. That's done to avoid adding all
- ;; prefixes of a type as it's being entered and font locked. This
- ;; doesn't cover cases like when characters are removed from a type
- ;; or added in the middle. We'd need the position of point when the
- ;; font locking is invoked to solve this well.
+(defun c-add-type-1 (from to)
+ ;; Add the given region as a type in `c-found-types'. Prepare occurrences
+ ;; of this new type for fontification throughout the buffer.
;;
;; This function might do hidden buffer changes.
(let ((type (c-syntactic-content from to c-recognize-<>-arglists)))
(unless (gethash type c-found-types)
- (remhash (substring type 0 -1) c-found-types)
- (puthash type t c-found-types))))
+ (puthash type t c-found-types)
+ (when (and (not c-record-found-types) ; Only call `c-fontify-new-found-type'
+ ; when we haven't "bound" c-found-types
+ ; to itself in c-forward-<>-arglist.
+ (eq (string-match c-symbol-key type) 0)
+ (eq (match-end 0) (length type)))
+ (c-fontify-new-found-type type)))))
+
+(defun c-add-type (from to)
+ ;; Add the given region as a type in `c-found-types'. Also perform the
+ ;; actions of `c-add-type-1'. If the region is or overlaps an identifier
+ ;; which might be being typed in, don't record it. This is tested by
+ ;; checking `c-new-id-start' and `c-new-id-end'. That's done to avoid
+ ;; adding all prefixes of a type as it's being entered and font locked.
+ ;; This is a bit rough and ready, but now covers adding characters into the
+ ;; middle of an identifier.
+ ;;
+ ;; This function might do hidden buffer changes.
+ (if (and c-new-id-start c-new-id-end
+ (<= from c-new-id-end) (>= to c-new-id-start))
+ (setq c-new-id-is-type t)
+ (c-add-type-1 from to)))
(defun c-unfind-type (name)
;; Remove the "NAME" from c-found-types, if present.
@@ -8210,11 +8240,6 @@ multi-line strings (but not C++, for example)."
(setq c-record-ref-identifiers
(cons range c-record-ref-identifiers))))))
-;; Dynamically bound variable that instructs `c-forward-type' to
-;; record the ranges of types that only are found. Behaves otherwise
-;; like `c-record-type-identifiers'.
-(defvar c-record-found-types nil)
-
(defmacro c-forward-keyword-prefixed-id (type)
;; Used internally in `c-forward-keyword-clause' to move forward
;; over a type (if TYPE is 'type) or a name (otherwise) which
@@ -8264,9 +8289,10 @@ multi-line strings (but not C++, for example)."
(defun c-forward-noise-clause ()
;; Point is at a c-noise-macro-with-parens-names macro identifier. Go
;; forward over this name, any parenthesis expression which follows it, and
- ;; any syntactic WS, ending up at the next token. If there is an unbalanced
- ;; paren expression, leave point at it. Always Return t.
- (c-forward-token-2)
+ ;; any syntactic WS, ending up at the next token or EOB. If there is an
+ ;; unbalanced paren expression, leave point at it. Always Return t.
+ (or (zerop (c-forward-token-2))
+ (goto-char (point-max)))
(if (and (eq (char-after) ?\()
(c-go-list-forward))
(c-forward-syntactic-ws))
@@ -8444,6 +8470,11 @@ multi-line strings (but not C++, for example)."
(c-forward-<>-arglist-recur all-types)))
(progn
(when (consp c-record-found-types)
+ (let ((cur c-record-found-types))
+ (while (consp (car-safe cur))
+ (c-fontify-new-found-type
+ (buffer-substring-no-properties (caar cur) (cdar cur)))
+ (setq cur (cdr cur))))
(setq c-record-type-identifiers
;; `nconc' doesn't mind that the tail of
;; `c-record-found-types' is t.
@@ -9169,6 +9200,12 @@ multi-line strings (but not C++, for example)."
(when (and (eq res t)
(consp c-record-found-types))
+ ;; Cause the confirmed types to get fontified.
+ (let ((cur c-record-found-types))
+ (while (consp (car-safe cur))
+ (c-fontify-new-found-type
+ (buffer-substring-no-properties (caar cur) (cdar cur)))
+ (setq cur (cdr cur))))
;; Merge in the ranges of any types found by the second
;; `c-forward-type'.
(setq c-record-type-identifiers
@@ -9906,6 +9943,10 @@ This function might do hidden buffer changes."
;; Set when we have encountered a keyword (e.g. "extern") which
;; causes the following declaration to be treated as though top-level.
make-top
+ ;; A list of found types in this declaration. This is an association
+ ;; list, the car being the buffer position, the cdr being the
+ ;; identifier.
+ found-type-list
;; Save `c-record-type-identifiers' and
;; `c-record-ref-identifiers' since ranges are recorded
;; speculatively and should be thrown away if it turns out
@@ -9975,10 +10016,17 @@ This function might do hidden buffer changes."
;; If the previous identifier is a found type we
;; record it as a real one; it might be some sort of
;; alias for a prefix like "unsigned".
- (save-excursion
- (goto-char type-start)
- (let ((c-promote-possible-types t))
- (c-forward-type))))
+ ;; We postpone entering the new found type into c-found-types
+ ;; until we are sure of it, thus preventing rapid alternation
+ ;; of the fontification of the token throughout the buffer.
+ (push (cons type-start
+ (buffer-substring-no-properties
+ type-start
+ (save-excursion
+ (goto-char type-start)
+ (c-end-of-token)
+ (point))))
+ found-type-list))
;; Signal a type declaration for "struct foo {".
(when (and backup-at-type-decl
@@ -10224,13 +10272,10 @@ This function might do hidden buffer changes."
(when (eq at-type 'found)
;; Remove the ostensible type from the found types list.
(when type-start
- (c-unfind-type
- (buffer-substring-no-properties
- type-start
- (save-excursion
- (goto-char type-start)
- (c-end-of-token)
- (point)))))
+ (let ((discard-t (assq type-start found-type-list)))
+ (when discard-t
+ (setq found-type-list
+ (remq discard-t found-type-list)))))
t))
;; The token which we assumed to be a type is actually the
;; identifier, and we have no explicit type.
@@ -10844,6 +10889,14 @@ This function might do hidden buffer changes."
;; interactive refontification.
(c-put-c-type-property (point) 'c-decl-arg-start))
+ ;; Enter all the found types into `c-found-types'.
+ (when found-type-list
+ (save-excursion
+ (let ((c-promote-possible-types t))
+ (dolist (ft found-type-list)
+ (goto-char (car ft))
+ (c-forward-type)))))
+
;; Record the type's coordinates in `c-record-type-identifiers' for
;; later fontification.
(when (and c-record-type-identifiers at-type ;; (not (eq at-type t))
@@ -12092,7 +12145,10 @@ comment at the start of cc-engine.el for more info."
(and (c-major-mode-is 'pike-mode)
c-decl-block-key)))
(while (eq braceassignp 'dontknow)
- (cond ((eq (char-after) ?\;)
+ (cond ((or (eq (char-after) ?\;)
+ (save-excursion
+ (progn (c-backward-syntactic-ws)
+ (c-at-vsemi-p))))
(setq braceassignp nil))
((and class-key
(looking-at class-key))
@@ -14016,7 +14072,8 @@ comment at the start of cc-engine.el for more info."
;; clause - we assume only C++ needs it.
(c-syntactic-skip-backward "^;,=" lim t))
(setq placeholder (point))
- (memq (char-before) '(?, ?= ?<)))
+ (and (memq (char-before) '(?, ?= ?<))
+ (not (c-crosses-statement-barrier-p (point) indent-point))))
(cond
;; CASE 5D.6: Something like C++11's "using foo = <type-exp>"
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 49e8763a28e..625010b04b2 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -97,6 +97,7 @@
(cc-bytecomp-defun c-font-lock-declarators)
(cc-bytecomp-defun c-font-lock-objc-method)
(cc-bytecomp-defun c-font-lock-invalid-string)
+(cc-bytecomp-defun c-font-lock-fontify-region)
;; Note that font-lock in XEmacs doesn't expand face names as
@@ -919,13 +920,6 @@ casts and declarations are fontified. Used on level 2 and higher."
;; This function does hidden buffer changes.
;;(message "c-font-lock-complex-decl-prepare %s %s" (point) limit)
-
- ;; Clear the list of found types if we start from the start of the
- ;; buffer, to make it easier to get rid of misspelled types and
- ;; variables that have gotten recognized as types in malformed code.
- (when (bobp)
- (c-clear-found-types))
-
(c-skip-comments-and-strings limit)
(when (< (point) limit)
@@ -2258,6 +2252,49 @@ higher."
;; defvar will install its default value later on.
(makunbound def-var)))
+;; `c-re-redisplay-timer' is a timer which, when triggered, causes a
+;; redisplay.
+(defvar c-re-redisplay-timer nil)
+
+(defun c-force-redisplay (buffer start end)
+ ;; Force redisplay immediately. This assumes `font-lock-support-mode' is
+ ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil.
+ (with-current-buffer buffer
+ (save-excursion (c-font-lock-fontify-region start end))
+ (jit-lock-force-redisplay (copy-marker start) (copy-marker end))
+ (setq c-re-redisplay-timer nil)))
+
+(defun c-fontify-new-found-type (type)
+ ;; Cause the fontification of TYPE, a string, wherever it occurs in the
+ ;; buffer. If TYPE is currently displayed in a window, cause redisplay to
+ ;; happen "instantaneously". These actions are done only when jit-lock-mode
+ ;; is active.
+ (when (and font-lock-mode
+ (boundp 'font-lock-support-mode)
+ (eq font-lock-support-mode 'jit-lock-mode))
+ (c-save-buffer-state
+ ((window-boundaries
+ (mapcar (lambda (win)
+ (cons (window-start win)
+ (window-end win)))
+ (get-buffer-window-list (current-buffer) 'no-mini t)))
+ (target-re (concat "\\_<" type "\\_>")))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward target-re nil t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'fontified nil)
+ (dolist (win-boundary window-boundaries)
+ (when (and (< (match-beginning 0) (cdr win-boundary))
+ (> (match-end 0) (car win-boundary))
+ (not c-re-redisplay-timer))
+ (setq c-re-redisplay-timer
+ (run-with-timer 0 nil #'c-force-redisplay
+ (current-buffer)
+ (match-beginning 0) (match-end 0)))))))))))
+
;;; C.
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index ea5dd48986c..584db86539e 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -76,6 +76,8 @@
(cc-require 'cc-engine)
(cc-require 'cc-styles)
+(cc-bytecomp-defun c-restore-string-fences)
+(cc-bytecomp-defun c-clear-string-fences)
(defcustom c-guess-offset-threshold 10
@@ -225,11 +227,12 @@ guess is made from scratch.
Note that the larger the region to guess in, the slower the guessing.
So you can limit the region with `c-guess-region-max'."
(interactive "r\nP")
- (let ((accumulator (when accumulate c-guess-accumulator)))
- (setq c-guess-accumulator (c-guess-examine start end accumulator))
- (let ((pair (c-guess-guess c-guess-accumulator)))
- (setq c-guess-guessed-basic-offset (car pair)
- c-guess-guessed-offsets-alist (cdr pair)))))
+ (c-with-string-fences
+ (let ((accumulator (when accumulate c-guess-accumulator)))
+ (setq c-guess-accumulator (c-guess-examine start end accumulator))
+ (let ((pair (c-guess-guess c-guess-accumulator)))
+ (setq c-guess-guessed-basic-offset (car pair)
+ c-guess-guessed-offsets-alist (cdr pair))))))
(defun c-guess-examine (start end accumulator)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 68070cd0581..c5964165c8d 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -458,12 +458,14 @@ so that all identifiers are recognized as words.")
c-before-change-check-<>-operators
c-truncate-bs-cache
c-before-change-check-unbalanced-strings
- c-parse-quotes-before-change)
+ c-parse-quotes-before-change
+ c-before-change-fix-comment-escapes)
(c objc) '(c-extend-region-for-CPP
c-depropertize-CPP
c-truncate-bs-cache
c-before-change-check-unbalanced-strings
- c-parse-quotes-before-change)
+ c-parse-quotes-before-change
+ c-before-change-fix-comment-escapes)
java '(c-parse-quotes-before-change
c-before-change-check-unbalanced-strings
c-before-change-check-<>-operators)
@@ -500,6 +502,7 @@ parameters \(point-min) and \(point-max).")
c-after-change-mark-abnormal-strings
c-change-expand-fl-region)
(c objc) '(c-depropertize-new-text
+ c-after-change-fix-comment-escapes
c-after-change-escape-NL-in-string
c-parse-quotes-after-change
c-after-change-mark-abnormal-strings
@@ -507,6 +510,7 @@ parameters \(point-min) and \(point-max).")
c-neutralize-syntax-in-CPP
c-change-expand-fl-region)
c++ '(c-depropertize-new-text
+ c-after-change-fix-comment-escapes
c-after-change-escape-NL-in-string
c-after-change-unmark-ml-strings
c-parse-quotes-after-change
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 22ab277781a..70fc1cb73a9 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -179,6 +179,15 @@
(when c-buffer-is-cc-mode
(save-restriction
(widen)
+ (let ((lst (buffer-list)))
+ (catch 'found
+ (dolist (b lst)
+ (if (and (not (eq b (current-buffer)))
+ (with-current-buffer b
+ c-buffer-is-cc-mode))
+ (throw 'found nil)))
+ (remove-hook 'post-command-hook 'c-post-command)
+ (remove-hook 'post-gc-hook 'c-post-gc-hook)))
(c-save-buffer-state ()
(c-clear-char-properties (point-min) (point-max) 'category)
(c-clear-char-properties (point-min) (point-max) 'syntax-table)
@@ -745,6 +754,8 @@ that requires a literal mode spec at compile time."
;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
;; c-after-font-lock-init.
(add-hook 'after-change-functions 'c-after-change nil t)
+ (add-hook 'post-command-hook 'c-post-command)
+
(when (boundp 'font-lock-extend-after-change-region-function)
(set (make-local-variable 'font-lock-extend-after-change-region-function)
'c-extend-after-change-region))) ; Currently (2009-05) used by all
@@ -986,7 +997,8 @@ Note that the style variables are always made local to the buffer."
;; `c-before/after-change', frame 3 is the primitive invoking the change
;; hook.
(memq (cadr (backtrace-frame 3))
- '(put-text-property remove-list-of-text-properties)))
+ '(put-text-property remove-text-properties
+ remove-list-of-text-properties)))
(defun c-depropertize-CPP (beg end)
;; Remove the punctuation syntax-table text property from the CPP parts of
@@ -1308,7 +1320,8 @@ Note that the style variables are always made local to the buffer."
;; balanced by another " is left with a '(1) syntax-table property.
(when
(and c-min-syn-tab-mkr c-max-syn-tab-mkr)
- (let (s pos)
+ (c-save-buffer-state (s pos) ; Prevent text property stuff causing change
+ ; function invocation.
(setq pos c-min-syn-tab-mkr)
(while
(and
@@ -1331,7 +1344,8 @@ Note that the style variables are always made local to the buffer."
(c-search-backward-char-property-with-value-on-char
'c-fl-syn-tab '(15) ?\"
(max (- (point) 500) (point-min))))
- (not (equal (c-get-char-property (point) 'syntax-table) '(1))))
+ (not (equal (c-get-char-property (point) 'syntax-table)
+ '(1))))
(setq pos (1+ pos))))
(while (< pos c-max-syn-tab-mkr)
(setq pos
@@ -1361,7 +1375,9 @@ Note that the style variables are always made local to the buffer."
;; Restore any syntax-table text properties which are "mirrored" by
;; c-fl-syn-tab text properties.
(when (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
- (let ((pos c-min-syn-tab-mkr))
+ (c-save-buffer-state ; Prevent text property stuff causing change function
+ ; invocation.
+ ((pos c-min-syn-tab-mkr))
(while
(and
(< pos c-max-syn-tab-mkr)
@@ -1951,6 +1967,123 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
;; confused by already processed single quotes.
(narrow-to-region (point) (point-max))))))
+;; The next two variables record the bounds of an identifier currently being
+;; typed in. These are used to prevent such a partial identifier being
+;; recorded as a found type by c-add-type.
+(defvar c-new-id-start nil)
+(make-variable-buffer-local 'c-new-id-start)
+(defvar c-new-id-end nil)
+(make-variable-buffer-local 'c-new-id-end)
+;; The next variable, when non-nil, records that the previous two variables
+;; define a type.
+(defvar c-new-id-is-type nil)
+(make-variable-buffer-local 'c-new-id-is-type)
+
+(defun c-before-change-fix-comment-escapes (beg end)
+ "Remove punctuation syntax-table text properties from C/C++ comment markers.
+This is to handle the rare case of two or more backslashes at an
+end of line in a // comment or the equally rare case of a
+backslash preceding the terminator of a /* comment, as \\*/.
+
+This function is used solely as a member of
+`c-get-state-before-change-functions', where it should appear
+late in that variable, and it must be used only together with
+`c-after-change-fix-comment-escapes'.
+
+Note that the function currently only handles comments beginning
+with // and /*, not more generic line and block comments."
+ (c-save-buffer-state (end-state)
+ (setq end-state (c-full-pp-to-literal end))
+ (when (memq (cadr end-state) '(c c++))
+ (goto-char (max (- beg 2) (point-min)))
+ (if (eq (cadr end-state) 'c)
+ (when (search-forward "\\*/"
+ (or (cdr (caddr end-state)) (point-max)) t)
+ (c-clear-char-property (match-beginning 0) 'syntax-table)
+ (c-truncate-lit-pos-cache (match-beginning 0)))
+ (while (search-forward "\\\\\n"
+ (or (cdr (caddr end-state)) (point-max)) t)
+ (c-clear-char-property (match-beginning 0) 'syntax-table)
+ (c-truncate-lit-pos-cache (match-beginning 0)))))))
+
+(defun c-after-change-fix-comment-escapes (beg end _old-len)
+ "Apply punctuation syntax-table text properties to C/C++ comment markers.
+This is to handle the rare case of two or more backslashes at an
+end of line in a // comment or the equally rare case of a
+backslash preceding the terminator of a /* comment, as \\*/.
+
+This function is used solely as a member of
+`c-before-font-lock-functions', where it should appear early in
+that variable, and it must be used only together with
+`c-before-change-fix-comment-escapes'.
+
+Note that the function currently only handles comments beginning
+with // and /*, not more generic line and block comments."
+ (c-save-buffer-state (state)
+ ;; We cannot use `c-full-pp-to-literal' in this function, since the
+ ;; `syntax-table' text properties after point are not yet in a consistent
+ ;; state.
+ (setq state (c-semi-pp-to-literal beg))
+ (goto-char (if (memq (cadr state) '(c c++))
+ (caddr state)
+ (max (- beg 2) (point-min))))
+ (while
+ (re-search-forward "\\\\\\(\\(\\\\\n\\)\\|\\(\\*/\\)\\)"
+ (min (+ end 2) (point-max)) t)
+ (setq state (c-semi-pp-to-literal (match-beginning 0)))
+ (when (cond
+ ((eq (cadr state) 'c)
+ (match-beginning 3))
+ ((eq (cadr state) 'c++)
+ (match-beginning 2)))
+ (c-put-char-property (match-beginning 0) 'syntax-table '(1))
+ (c-truncate-lit-pos-cache (match-beginning 0))))
+
+ (goto-char end)
+ (setq state (c-semi-pp-to-literal (point)))
+ (cond
+ ((eq (cadr state) 'c)
+ (when (search-forward "*/" nil t)
+ (when (eq (char-before (match-beginning 0)) ?\\)
+ (c-put-char-property (1- (match-beginning 0)) 'syntax-table '(1))
+ (c-truncate-lit-pos-cache (1- (match-beginning 0))))))
+ ((eq (cadr state) 'c++)
+ (while
+ (progn
+ (end-of-line)
+ (and (eq (char-before) ?\\)
+ (progn
+ (when (eq (char-before (1- (point))) ?\\)
+ (c-put-char-property (- (point) 2) 'syntax-table '(1))
+ (c-truncate-lit-pos-cache (1- (point))))
+ t)
+ (not (eobp))))
+ (forward-char))))))
+
+(defun c-update-new-id (end)
+ ;; Note the bounds of any identifier that END is in or just after, in
+ ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to
+ ;; nil.
+ (save-excursion
+ (goto-char end)
+ (let ((id-beg (c-on-identifier)))
+ (setq c-new-id-start id-beg
+ c-new-id-end (and id-beg
+ (progn (c-end-of-current-token) (point)))))))
+
+(defun c-post-command ()
+ ;; If point was inside of a new identifier and no longer is, record that
+ ;; fact.
+ (when (and c-buffer-is-cc-mode
+ c-new-id-start c-new-id-end
+ (or (> (point) c-new-id-end)
+ (< (point) c-new-id-start)))
+ (when c-new-id-is-type
+ (c-add-type-1 c-new-id-start c-new-id-end))
+ (setq c-new-id-start nil
+ c-new-id-end nil
+ c-new-id-is-type nil)))
+
(defun c-before-change (beg end)
;; Function to be put on `before-change-functions'. Primarily, this calls
;; the language dependent `c-get-state-before-change-functions'. It is
@@ -1968,115 +2101,116 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
;; or a comment - "wrongly" removing a symbol from `c-found-types'
;; isn't critical.
(unless (c-called-from-text-property-change-p)
- (save-restriction
- (widen)
- (if c-just-done-before-change
- ;; We have two consecutive calls to `before-change-functions' without
- ;; an intervening `after-change-functions'. An example of this is bug
- ;; #38691. To protect CC Mode, assume that the entire buffer has
- ;; changed.
- (setq beg (point-min)
- end (point-max)
- c-just-done-before-change 'whole-buffer)
- (setq c-just-done-before-change t))
- ;; (c-new-BEG c-new-END) will be the region to fontify.
- (setq c-new-BEG beg c-new-END end)
- (setq c-maybe-stale-found-type nil)
- ;; A workaround for syntax-ppss's failure to notice syntax-table text
- ;; property changes.
- (when (fboundp 'syntax-ppss)
- (setq c-syntax-table-hwm most-positive-fixnum))
- (save-match-data
- (widen)
- (unwind-protect
- (progn
- (c-restore-string-fences)
- (save-excursion
- ;; Are we inserting/deleting stuff in the middle of an
- ;; identifier?
- (c-unfind-enclosing-token beg)
- (c-unfind-enclosing-token end)
- ;; Are we coalescing two tokens together, e.g. "fo o"
- ;; -> "foo"?
- (when (< beg end)
- (c-unfind-coalesced-tokens beg end))
- (c-invalidate-sws-region-before beg end)
- ;; Are we (potentially) disrupting the syntactic
- ;; context which makes a type a type? E.g. by
- ;; inserting stuff after "foo" in "foo bar;", or
- ;; before "foo" in "typedef foo *bar;"?
- ;;
- ;; We search for appropriate c-type properties "near"
- ;; the change. First, find an appropriate boundary
- ;; for this property search.
- (let (lim lim-2
- type type-pos
- marked-id term-pos
- (end1
- (or (and (eq (get-text-property end 'face)
- 'font-lock-comment-face)
- (previous-single-property-change end 'face))
- end)))
- (when (>= end1 beg) ; Don't hassle about changes entirely in
+ (c-with-string-fences
+ (save-restriction
+ (widen)
+ ;; Clear the list of found types if we make a change at the start of the
+ ;; buffer, to make it easier to get rid of misspelled types and
+ ;; variables that have gotten recognized as types in malformed code.
+ (when (eq beg (point-min))
+ (c-clear-found-types))
+ (if c-just-done-before-change
+ ;; We have two consecutive calls to `before-change-functions'
+ ;; without an intervening `after-change-functions'. An example of
+ ;; this is bug #38691. To protect CC Mode, assume that the entire
+ ;; buffer has changed.
+ (setq beg (point-min)
+ end (point-max)
+ c-just-done-before-change 'whole-buffer)
+ (setq c-just-done-before-change t))
+ ;; (c-new-BEG c-new-END) will be the region to fontify.
+ (setq c-new-BEG beg c-new-END end)
+ (setq c-maybe-stale-found-type nil)
+ ;; A workaround for syntax-ppss's failure to notice syntax-table text
+ ;; property changes.
+ (when (fboundp 'syntax-ppss)
+ (setq c-syntax-table-hwm most-positive-fixnum))
+ (save-match-data
+ (save-excursion
+ ;; Are we inserting/deleting stuff in the middle of an
+ ;; identifier?
+ (c-unfind-enclosing-token beg)
+ (c-unfind-enclosing-token end)
+ ;; Are we coalescing two tokens together, e.g. "fo o"
+ ;; -> "foo"?
+ (when (< beg end)
+ (c-unfind-coalesced-tokens beg end))
+ (c-invalidate-sws-region-before beg end)
+ ;; Are we (potentially) disrupting the syntactic
+ ;; context which makes a type a type? E.g. by
+ ;; inserting stuff after "foo" in "foo bar;", or
+ ;; before "foo" in "typedef foo *bar;"?
+ ;;
+ ;; We search for appropriate c-type properties "near"
+ ;; the change. First, find an appropriate boundary
+ ;; for this property search.
+ (let (lim lim-2
+ type type-pos
+ marked-id term-pos
+ (end1
+ (or (and (eq (get-text-property end 'face)
+ 'font-lock-comment-face)
+ (previous-single-property-change end 'face))
+ end)))
+ (when (>= end1 beg) ; Don't hassle about changes entirely in
; comments.
- ;; Find a limit for the search for a `c-type' property
- ;; Point is currently undefined. A `goto-char' somewhere is needed. (2020-12-06).
- (setq lim-2 (c-determine-limit 1000 (point) ; that is wrong. FIXME!!! (2020-12-06)
- ))
- (while
- (and (/= (skip-chars-backward "^;{}" lim-2) 0)
- (> (point) (point-min))
- (memq (c-get-char-property (1- (point)) 'face)
- '(font-lock-comment-face font-lock-string-face))))
- (setq lim (max (point-min) (1- (point))))
-
- ;; Look for the latest `c-type' property before end1
- (when (and (> end1 (point-min))
- (setq type-pos
- (if (get-text-property (1- end1) 'c-type)
- end1
- (previous-single-property-change end1 'c-type
- nil lim))))
- (setq type (get-text-property (max (1- type-pos) lim) 'c-type))
-
- (when (memq type '(c-decl-id-start c-decl-type-start))
- ;; Get the identifier, if any, that the property is on.
- (goto-char (1- type-pos))
- (setq marked-id
- (when (looking-at "\\(\\sw\\|\\s_\\)")
- (c-beginning-of-current-token)
- (buffer-substring-no-properties (point) type-pos)))
-
- (goto-char end1)
- (setq lim-2 (c-determine-+ve-limit 1000))
- (skip-chars-forward "^;{}" lim-2) ; FIXME!!! loop for
+ ;; Find a limit for the search for a `c-type' property
+ ;; Point is currently undefined. A `goto-char' somewhere is needed. (2020-12-06).
+ (setq lim-2 (c-determine-limit 1000 (point) ; that is wrong. FIXME!!! (2020-12-06)
+ ))
+ (while
+ (and (/= (skip-chars-backward "^;{}" lim-2) 0)
+ (> (point) (point-min))
+ (memq (c-get-char-property (1- (point)) 'face)
+ '(font-lock-comment-face font-lock-string-face))))
+ (setq lim (max (point-min) (1- (point))))
+
+ ;; Look for the latest `c-type' property before end1
+ (when (and (> end1 (point-min))
+ (setq type-pos
+ (if (get-text-property (1- end1) 'c-type)
+ end1
+ (previous-single-property-change end1 'c-type
+ nil lim))))
+ (setq type (get-text-property (max (1- type-pos) lim) 'c-type))
+
+ (when (memq type '(c-decl-id-start c-decl-type-start))
+ ;; Get the identifier, if any, that the property is on.
+ (goto-char (1- type-pos))
+ (setq marked-id
+ (when (looking-at "\\(\\sw\\|\\s_\\)")
+ (c-beginning-of-current-token)
+ (buffer-substring-no-properties (point) type-pos)))
+
+ (goto-char end1)
+ (setq lim-2 (c-determine-+ve-limit 1000))
+ (skip-chars-forward "^;{}" lim-2) ; FIXME!!! loop for
; comment, maybe
- (setq lim (point))
- (setq term-pos
- (or (c-next-single-property-change end 'c-type nil lim) lim))
- (setq c-maybe-stale-found-type
- (list type marked-id
- type-pos term-pos
- (buffer-substring-no-properties type-pos
- term-pos)
- (buffer-substring-no-properties beg end)))))))
-
- (if c-get-state-before-change-functions
- (mapc (lambda (fn)
- (funcall fn beg end))
- c-get-state-before-change-functions))
-
- (c-laomib-invalidate-cache beg end)))
- (c-clear-string-fences))))
- (c-truncate-lit-pos-cache beg)
- ;; The following must be done here rather than in `c-after-change'
- ;; because newly inserted parens would foul up the invalidation
- ;; algorithm.
- (c-invalidate-state-cache beg)
- ;; The following must happen after the previous, which likely alters
- ;; the macro cache.
- (when c-opt-cpp-symbol
- (c-invalidate-macro-cache beg end))))
+ (setq lim (point))
+ (setq term-pos
+ (or (c-next-single-property-change end 'c-type nil lim) lim))
+ (setq c-maybe-stale-found-type
+ (list type marked-id
+ type-pos term-pos
+ (buffer-substring-no-properties type-pos
+ term-pos)
+ (buffer-substring-no-properties beg end)))))))
+
+ (if c-get-state-before-change-functions
+ (mapc (lambda (fn)
+ (funcall fn beg end))
+ c-get-state-before-change-functions))
+
+ (c-laomib-invalidate-cache beg end))))
+ (c-truncate-lit-pos-cache beg)
+ ;; The following must be done here rather than in `c-after-change'
+ ;; because newly inserted parens would foul up the invalidation
+ ;; algorithm.
+ (c-invalidate-state-cache beg)
+ ;; The following must happen after the previous, which likely alters
+ ;; the macro cache.
+ (when c-opt-cpp-symbol
+ (c-invalidate-macro-cache beg end)))))
(defvar c-in-after-change-fontification nil)
(make-variable-buffer-local 'c-in-after-change-fontification)
@@ -2128,50 +2262,48 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(save-restriction
(save-match-data ; c-recognize-<>-arglists changes match-data
(widen)
- (unwind-protect
- (progn
- (c-restore-string-fences)
- (when (> end (point-max))
- ;; Some emacsen might return positions past the end. This
- ;; has been observed in Emacs 20.7 when rereading a buffer
- ;; changed on disk (haven't been able to minimize it, but
- ;; Emacs 21.3 appears to work).
- (setq end (point-max))
- (when (> beg end)
- (setq beg end)))
-
- ;; C-y is capable of spuriously converting category
- ;; properties c-</>-as-paren-syntax and
- ;; c-cpp-delimiter into hard syntax-table properties.
- ;; Remove these when it happens.
- (when (eval-when-compile (memq 'category-properties c-emacs-features))
- (c-save-buffer-state ()
- (c-clear-char-property-with-value beg end 'syntax-table
- c-<-as-paren-syntax)
- (c-clear-char-property-with-value beg end 'syntax-table
- c->-as-paren-syntax)
- (c-clear-char-property-with-value beg end 'syntax-table nil)))
-
- (c-trim-found-types beg end old-len) ; maybe we don't
- ; need all of these.
- (c-invalidate-sws-region-after beg end old-len)
- ;; (c-invalidate-state-cache beg) ; moved to
- ;; `c-before-change'.
- (c-invalidate-find-decl-cache beg)
-
- (when c-recognize-<>-arglists
- (c-after-change-check-<>-operators beg end))
-
- (setq c-in-after-change-fontification t)
- (save-excursion
- (mapc (lambda (fn)
- (funcall fn beg end old-len))
- c-before-font-lock-functions)))
- (c-clear-string-fences))))))
+ (c-with-string-fences
+ (when (> end (point-max))
+ ;; Some emacsen might return positions past the end. This
+ ;; has been observed in Emacs 20.7 when rereading a buffer
+ ;; changed on disk (haven't been able to minimize it, but
+ ;; Emacs 21.3 appears to work).
+ (setq end (point-max))
+ (when (> beg end)
+ (setq beg end)))
+
+ ;; C-y is capable of spuriously converting category
+ ;; properties c-</>-as-paren-syntax and
+ ;; c-cpp-delimiter into hard syntax-table properties.
+ ;; Remove these when it happens.
+ (when (eval-when-compile (memq 'category-properties c-emacs-features))
+ (c-save-buffer-state ()
+ (c-clear-char-property-with-value beg end 'syntax-table
+ c-<-as-paren-syntax)
+ (c-clear-char-property-with-value beg end 'syntax-table
+ c->-as-paren-syntax)
+ (c-clear-char-property-with-value beg end 'syntax-table nil)))
+
+ (c-update-new-id end)
+ (c-trim-found-types beg end old-len) ; maybe we don't
+ ; need all of these.
+ (c-invalidate-sws-region-after beg end old-len)
+ ;; (c-invalidate-state-cache beg) ; moved to
+ ;; `c-before-change'.
+ (c-invalidate-find-decl-cache beg)
+
+ (when c-recognize-<>-arglists
+ (c-after-change-check-<>-operators beg end))
+
+ (setq c-in-after-change-fontification t)
+ (save-excursion
+ (mapc (lambda (fn)
+ (funcall fn beg end old-len))
+ c-before-font-lock-functions)))))
;; A workaround for syntax-ppss's failure to notice syntax-table text
;; property changes.
- (when (fboundp 'syntax-ppss)
- (syntax-ppss-flush-cache c-syntax-table-hwm)))
+ (when (fboundp 'syntax-ppss)
+ (syntax-ppss-flush-cache c-syntax-table-hwm)))))
(defun c-doc-fl-decl-start (pos)
;; If the line containing POS is in a doc comment continued line (as defined
@@ -2403,46 +2535,42 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(widen)
(let (new-beg new-end new-region case-fold-search)
(c-save-buffer-state nil
- ;; Temporarily reapply the string fence syntax-table properties.
- (unwind-protect
- (progn
- (c-restore-string-fences)
- (if (and c-in-after-change-fontification
- (< beg c-new-END) (> end c-new-BEG))
- ;; Region and the latest after-change fontification region overlap.
- ;; Determine the upper and lower bounds of our adjusted region
- ;; separately.
- (progn
- (if (<= beg c-new-BEG)
- (setq c-in-after-change-fontification nil))
- (setq new-beg
- (if (and (>= beg (c-point 'bol c-new-BEG))
- (<= beg c-new-BEG))
- ;; Either jit-lock has accepted `c-new-BEG', or has
- ;; (probably) extended the change region spuriously
- ;; to BOL, which position likely has a
- ;; syntactically different position. To ensure
- ;; correct fontification, we start at `c-new-BEG',
- ;; assuming any characters to the left of
- ;; `c-new-BEG' on the line do not require
- ;; fontification.
- c-new-BEG
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-end (cdr new-region))
- (car new-region)))
- (setq new-end
- (if (and (>= end (c-point 'bol c-new-END))
- (<= end c-new-END))
- c-new-END
- (or new-end
- (cdr (c-before-context-fl-expand-region beg end))))))
- ;; Context (etc.) fontification.
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-beg (car new-region) new-end (cdr new-region)))
- ;; Finally invoke font lock's functionality.
- (funcall (default-value 'font-lock-fontify-region-function)
- new-beg new-end verbose))
- (c-clear-string-fences))))))
+ (c-with-string-fences
+ (if (and c-in-after-change-fontification
+ (< beg c-new-END) (> end c-new-BEG))
+ ;; Region and the latest after-change fontification region overlap.
+ ;; Determine the upper and lower bounds of our adjusted region
+ ;; separately.
+ (progn
+ (if (<= beg c-new-BEG)
+ (setq c-in-after-change-fontification nil))
+ (setq new-beg
+ (if (and (>= beg (c-point 'bol c-new-BEG))
+ (<= beg c-new-BEG))
+ ;; Either jit-lock has accepted `c-new-BEG', or has
+ ;; (probably) extended the change region spuriously
+ ;; to BOL, which position likely has a
+ ;; syntactically different position. To ensure
+ ;; correct fontification, we start at `c-new-BEG',
+ ;; assuming any characters to the left of
+ ;; `c-new-BEG' on the line do not require
+ ;; fontification.
+ c-new-BEG
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-end (cdr new-region))
+ (car new-region)))
+ (setq new-end
+ (if (and (>= end (c-point 'bol c-new-END))
+ (<= end c-new-END))
+ c-new-END
+ (or new-end
+ (cdr (c-before-context-fl-expand-region beg end))))))
+ ;; Context (etc.) fontification.
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-beg (car new-region) new-end (cdr new-region)))
+ ;; Finally invoke font lock's functionality.
+ (funcall (default-value 'font-lock-fontify-region-function)
+ new-beg new-end verbose))))))
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
@@ -2550,17 +2678,24 @@ This function is called from `c-common-init', once per mode initialization."
At the time of call, point is just after the newly inserted CHAR.
-When CHAR is \", t will be returned unless the \" is marked with
-a string fence syntax-table text property. For other characters,
-the default value of `electric-pair-inhibit-predicate' is called
-and its value returned.
+When CHAR is \" and not within a comment, t will be returned if
+the quotes on the current line are already balanced (i.e. if the
+last \" is not marked with a string fence syntax-table text
+property). For other cases, the default value of
+`electric-pair-inhibit-predicate' is called and its value
+returned.
This function is the appropriate value of
`electric-pair-inhibit-predicate' for CC Mode modes, which mark
invalid strings with such a syntax table text property on the
opening \" and the next unescaped end of line."
- (if (eq char ?\")
- (not (equal (get-text-property (1- (point)) 'c-fl-syn-tab) '(15)))
+ (if (and (eq char ?\")
+ (not (memq (cadr (c-semi-pp-to-literal (1- (point)))) '(c c++))))
+ (let ((last-quote (save-match-data
+ (save-excursion
+ (goto-char (c-point 'eoll))
+ (search-backward "\"")))))
+ (not (equal (c-get-char-property last-quote 'c-fl-syn-tab) '(15))))
(funcall (default-value 'electric-pair-inhibit-predicate) char)))
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index a66f91e0eb3..1cf14d52d55 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -180,6 +180,7 @@
(inclass . +)
(inline-open . 0))))
("linux"
+ (indent-tabs-mode . t)
(c-basic-offset . 8)
(c-comment-only-line-offset . 0)
(c-hanging-braces-alist . ((brace-list-open)
@@ -444,17 +445,19 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil."
defstr))
(prompt (concat symname " offset " defstr))
(keymap (make-sparse-keymap))
- (minibuffer-completion-table obarray)
- (minibuffer-completion-predicate 'fboundp)
offset input)
;; In principle completing-read is used here, but SPC is unbound
;; to make it less annoying to enter lists.
(set-keymap-parent keymap minibuffer-local-completion-map)
(define-key keymap " " 'self-insert-command)
(while (not offset)
- (setq input (read-from-minibuffer prompt nil keymap t
- 'c-read-offset-history
- (format "%s" oldoff)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-completion-table obarray)
+ (setq-local minibuffer-completion-predicate 'fboundp))
+ (setq input (read-from-minibuffer prompt nil keymap t
+ 'c-read-offset-history
+ (format "%s" oldoff))))
(if (c-valid-offset input)
(setq offset input)
;; error, but don't signal one, keep trying
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 45521d50218..e0f5a7ee021 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -179,7 +179,7 @@ STYLE stands for the choice where the value is taken from some
style setting. PREAMBLE is optionally prepended to FOO; that is,
if FOO contains :tag or :value, the respective two-element list
component is ignored."
- (declare (debug (symbolp form stringp &rest)))
+ (declare (debug (symbolp form stringp &rest)) (indent defun))
(let* ((expanded-doc (concat doc "
This is a style variable. Apart from the valid values described
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 6fc898d95be..32031d19462 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -793,14 +793,6 @@ bundle agent rcfiles
(cdr (assq 'functions cfengine3-fallback-syntax)))
'symbols))
-(defcustom cfengine-mode-abbrevs nil
- "Abbrevs for CFEngine2 mode."
- :type '(repeat (list (string :tag "Name")
- (string :tag "Expansion")
- (choice :tag "Hook" (const nil) function))))
-
-(make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1")
-
;; Taken from the doc for pre-release 2.1.
(eval-and-compile
(defconst cfengine2-actions
@@ -989,13 +981,7 @@ Intended as the value of `indent-line-function'."
(defun cfengine-fill-paragraph (&optional justify)
"Fill `paragraphs' in Cfengine code."
(interactive "P")
- (or (if (fboundp 'fill-comment-paragraph)
- (fill-comment-paragraph justify)
- ;; else do nothing in a comment
- (nth 4 (parse-partial-sexp (save-excursion
- (beginning-of-defun)
- (point))
- (point))))
+ (or (fill-comment-paragraph justify)
(let ((paragraph-start
;; Include start of parenthesized block.
"\f\\|[ \t]*$\\|.*(")
@@ -1415,7 +1401,6 @@ to the action header."
(setq-local outline-regexp "[ \t]*\\(\\sw\\|\\s_\\)+:+")
(setq-local outline-level #'cfengine2-outline-level)
(setq-local fill-paragraph-function #'cfengine-fill-paragraph)
- (define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs)
(setq font-lock-defaults
'(cfengine2-font-lock-keywords nil nil nil beginning-of-line))
;; Fixme: set the args of functions in evaluated classes to string
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 7d4a8ffc6fc..9f33186d8b1 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -82,6 +82,25 @@ after `call-process' inserts the grep output into the buffer.")
"Position of the start of the text inserted by `compilation-filter'.
This is bound before running `compilation-filter-hook'.")
+(defcustom compilation-hidden-output nil
+ "Regexp to match output from the compilation that should be hidden.
+This can also be a list of regexps.
+
+The text matched by this variable will be made invisible, which
+means that it'll still be present in the buffer, so that
+navigation commands (for instance, `next-error') can still make
+use of the hidden text to determine the current directory and the
+like.
+
+For instance, to hide the verbose output from recursive
+makefiles, you can say something like:
+
+ (setq compilation-hidden-output
+ \\='(\"^make[^\n]+\n\"))"
+ :type '(choice regexp
+ (repeat regexp))
+ :version "29.1")
+
(defvar compilation-first-column 1
"This is how compilers number the first column, usually 1 or 0.
If this is buffer-local in the destination buffer, Emacs obeys
@@ -257,7 +276,16 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
"): ")
3 4 5 (1 . 2))
- (iar
+ (gradle-android
+ ,(rx bol (* " ") "ERROR:"
+ (group-n 1 ; file
+ (+ (not (in ":\n"))))
+ ":"
+ (group-n 2 (+ digit)) ; line
+ ": ")
+ 1 2)
+
+ (iar
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
1 2 nil (3))
@@ -340,69 +368,73 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1)
(gnu
+ ;; The `gnu' message syntax is
+ ;; [PROGRAM:]FILE:LINE[-ENDLINE]:[COL[-ENDCOL]:] MESSAGE
+ ;; or
+ ;; [PROGRAM:]FILE:LINE[.COL][-ENDLINE[.ENDCOL]]: MESSAGE
,(rx
bol
- ;; Match an optional program name in the format
- ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
- ;; which is used for non-interactive programs other than
- ;; compilers (e.g. the "jade:" entry in compilation.txt).
- (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
- ;; FIXME: This pattern was added for handling messages
- ;; from Ruby, but it is unclear whether it is actually
- ;; used since the gcc-include rule above seems to cover
- ;; it.
- (regexp "[ \t]+\\(?:in \\|from\\)")))
+ ;; Match an optional program name which is used for
+ ;; non-interactive programs other than compilers (e.g. the
+ ;; "jade:" entry in compilation.txt).
+ (? (| (: alpha (+ (in ?. ?- alnum)) ":" (? " "))
+ ;; Skip indentation generated by GCC's -fanalyzer.
+ (: (+ " ") "|")))
;; File name group.
(group-n 1
- ;; Avoid matching the file name as a program in the pattern
- ;; above by disallow file names entirely composed of digits.
- (: (regexp "[0-9]*[^0-9\n]")
- ;; This rule says that a file name can be composed
- ;; of any non-newline char, but it also rules out
- ;; some valid but unlikely cases, such as a
- ;; trailing space or a space followed by a -, or a
- ;; colon followed by a space.
- (*? (| (regexp "[^\n :]")
- (regexp " [^-/\n]")
- (regexp ":[^ \n]")))))
- (regexp ": ?")
+ ;; Avoid matching the file name as a program in the pattern
+ ;; above by disallowing file names entirely composed of digits.
+ ;; Do not allow file names beginning with a space.
+ (| (not (in "0-9" "\n\t "))
+ (: (+ (in "0-9"))
+ (not (in "0-9" "\n"))))
+ ;; A file name can be composed of any non-newline char, but
+ ;; rule out some valid but unlikely cases, such as a trailing
+ ;; space or a space followed by a -, or a colon followed by a
+ ;; space.
+ (*? (| (not (in "\n :"))
+ (: " " (not (in ?- "/\n")))
+ (: ":" (not (in " \n"))))))
+ ":" (? " ")
;; Line number group.
- (group-n 2 (regexp "[0-9]+"))
+ (group-n 2 (+ (in "0-9")))
(? (| (: "-"
- (group-n 4 (regexp "[0-9]+")) ; ending line
- (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column
+ (group-n 4 (+ (in "0-9"))) ; ending line
+ (? "." (group-n 5 (+ (in "0-9"))))) ; ending column
(: (in ".:")
- (group-n 3 (regexp "[0-9]+")) ; starting column
+ (group-n 3 (+ (in "0-9"))) ; starting column
(? "-"
- (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line
- (group-n 5 (regexp "[0-9]+")))))) ; ending column
+ (? (group-n 4 (+ (in "0-9"))) ".") ; ending line
+ (group-n 5 (+ (in "0-9"))))))) ; ending column
":"
(| (: (* " ")
(group-n 6 (| "FutureWarning"
"RuntimeWarning"
- "Warning"
- "warning"
+ "Warning" "warning"
"W:")))
(: (* " ")
- (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)")
- "I:"
- (: "[ skipping " (+ nonl) " ]")
- "instantiated from"
- "required from"
- (regexp "[Nn]ote"))))
+ (group-n 7
+ (| (| "Info" "info"
+ "Information" "information"
+ "Informational" "informational"
+ "I:"
+ "instantiated from"
+ "required from"
+ "Note" "note")
+ (: "[ skipping " (+ nonl) " ]"))))
(: (* " ")
- (regexp "[Ee]rror"))
+ (| "Error" "error"))
;; Avoid matching time stamps on the form "HH:MM:SS" where
;; MM is interpreted as a line number by trying to rule out
;; messages where the text after the line number starts with
;; a 2-digit number.
- (: (regexp "[0-9]?")
- (| (regexp "[^0-9\n]")
+ (: (? (in "0-9"))
+ (| (not (in "0-9\n"))
eol))
- (regexp "[0-9][0-9][0-9]")))
+ (: (in "0-9") (in "0-9") (in "0-9"))))
1 (2 . 4) (3 . 5) (6 . 7))
(cucumber
@@ -954,7 +986,10 @@ Faces `compilation-error-face', `compilation-warning-face',
(defcustom compilation-auto-jump-to-first-error nil
"If non-nil, automatically jump to the first error during compilation."
- :type 'boolean
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "If location known" if-location-known)
+ (const :tag "First known location" first-known))
:version "23.1")
(defvar-local compilation-auto-jump-to-next nil
@@ -1185,21 +1220,46 @@ POS and RES.")
l2
(setcdr l1 (cons (list ,key) l2)))))))
+(defun compilation--file-known-p ()
+ "Say whether the file under point can be found."
+ (when-let* ((msg (get-text-property (point) 'compilation-message))
+ (loc (compilation--message->loc msg))
+ (elem (compilation-find-file-1
+ (point-marker)
+ (caar (compilation--loc->file-struct loc))
+ (cadr (car (compilation--loc->file-struct loc)))
+ (compilation--file-struct->formats
+ (compilation--loc->file-struct loc)))))
+ (car elem)))
+
(defun compilation-auto-jump (buffer pos)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(goto-char pos)
(let ((win (get-buffer-window buffer 0)))
(if win (set-window-point win pos)))
- (if compilation-auto-jump-to-first-error
- (compile-goto-error)))))
+ (when compilation-auto-jump-to-first-error
+ (cl-case compilation-auto-jump-to-first-error
+ ('if-location-known
+ (when (compilation--file-known-p)
+ (compile-goto-error)))
+ ('first-known
+ (let (match)
+ (while (and (not (compilation--file-known-p))
+ (setq match (text-property-search-forward
+ 'compilation-message nil nil t)))
+ (goto-char (prop-match-beginning match))))
+ (when (compilation--file-known-p)
+ (compile-goto-error)))
+ (otherwise
+ (compile-goto-error)))))))
;; This function is the central driver, called when font-locking to gather
;; all information needed to later jump to corresponding source code.
;; Return a property list with all meta information on this error location.
(defun compilation-error-properties (file line end-line col end-col type fmt
- rule)
+ rule)
(unless (text-property-not-all (match-beginning 0) (point)
'compilation-message nil)
(if file
@@ -1523,7 +1583,8 @@ to `compilation-error-regexp-alist' if RULES is nil."
;; FIXME-omake: Doing it here seems wrong, at least it should depend on
;; whether or not omake's own error messages are recognized.
(cond
- ((not omake-included) nil)
+ ((or (not omake-included) (not pat))
+ nil)
((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
nil) ;; Not anchored or anchored but already allows empty spaces.
(t (setq pat (concat "^\\(?: \\)?" (substring pat 1)))))
@@ -1542,7 +1603,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
(error "HYPERLINK should be an integer: %s" (nth 5 item)))
(goto-char start)
- (while (re-search-forward pat end t)
+ (while (and pat (re-search-forward pat end t))
(when (setq props (compilation-error-properties
file line end-line col end-col
(or type 2) fmt rule))
@@ -1755,13 +1816,21 @@ If nil, ask to kill it."
:type 'boolean
:version "24.3")
+(defcustom compilation-max-output-line-length 400
+ "Output lines that are longer than this value will be hidden.
+If nil, don't hide anything."
+ :type '(choice (const :tag "Hide nothing" nil)
+ integer)
+ :version "29.1")
+
(defun compilation--update-in-progress-mode-line ()
;; `compilation-in-progress' affects the mode-line of all
;; buffers when it changes from nil to non-nil or vice-versa.
(unless compilation-in-progress (force-mode-line-update t)))
;;;###autoload
-(defun compilation-start (command &optional mode name-function highlight-regexp)
+(defun compilation-start (command &optional mode name-function highlight-regexp
+ continue)
"Run compilation command COMMAND (low level interface).
If COMMAND starts with a cd command, that becomes the `default-directory'.
The rest of the arguments are optional; for them, nil means use the default.
@@ -1778,6 +1847,12 @@ If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
the matching section of the visited source line; the default is to use the
global value of `compilation-highlight-regexp'.
+If CONTINUE is non-nil, the buffer won't be emptied before
+compilation is started. This can be useful if you wish to
+combine the output from several compilation commands in the same
+buffer. The new output will be at the end of the buffer, and
+point is not changed.
+
Returns the compilation buffer created."
(or mode (setq mode 'compilation-mode))
(let* ((name-of-mode
@@ -1841,7 +1916,12 @@ Returns the compilation buffer created."
(if (= (length expanded-dir) 1)
(car expanded-dir)
substituted-dir)))))
- (erase-buffer)
+ (if continue
+ (progn
+ ;; Save the point so we can restore it.
+ (setq continue (point))
+ (goto-char (point-max)))
+ (erase-buffer))
;; Select the desired mode.
(if (not (eq mode t))
(progn
@@ -1867,12 +1947,13 @@ Returns the compilation buffer created."
(if (or compilation-auto-jump-to-first-error
(eq compilation-scroll-output 'first-error))
(setq-local compilation-auto-jump-to-next t))
- ;; Output a mode setter, for saving and later reloading this buffer.
- (insert "-*- mode: " name-of-mode
- "; default-directory: "
- (prin1-to-string (abbreviate-file-name default-directory))
- " -*-\n"
- (format "%s started at %s\n\n"
+ (when (zerop (buffer-size))
+ ;; Output a mode setter, for saving and later reloading this buffer.
+ (insert "-*- mode: " name-of-mode
+ "; default-directory: "
+ (prin1-to-string (abbreviate-file-name default-directory))
+ " -*-\n"))
+ (insert (format "%s started at %s\n\n"
mode-name
(substring (current-time-string) 0 19))
command "\n")
@@ -1891,28 +1972,33 @@ Returns the compilation buffer created."
(and (derived-mode-p 'comint-mode)
(comint-term-environment))
(list (format "INSIDE_EMACS=%s,compile" emacs-version))
+ ;; Some external programs (like "git grep") use a pager;
+ ;; defeat that.
+ (list "PAGER=")
(copy-sequence process-environment))))
(setq-local compilation-arguments
(list command mode name-function highlight-regexp))
(setq-local revert-buffer-function 'compilation-revert-buffer)
- (and outwin
- ;; Forcing the window-start overrides the usual redisplay
- ;; feature of bringing point into view, so setting the
- ;; window-start to top of the buffer risks losing the
- ;; effect of moving point to EOB below, per
- ;; compilation-scroll-output, if the command is long
- ;; enough to push point outside of the window. This
- ;; could happen, e.g., in `rgrep'.
- (not compilation-scroll-output)
- (set-window-start outwin (point-min)))
+ (when (and outwin
+ (not continue)
+ ;; Forcing the window-start overrides the usual redisplay
+ ;; feature of bringing point into view, so setting the
+ ;; window-start to top of the buffer risks losing the
+ ;; effect of moving point to EOB below, per
+ ;; compilation-scroll-output, if the command is long
+ ;; enough to push point outside of the window. This
+ ;; could happen, e.g., in `rgrep'.
+ (not compilation-scroll-output))
+ (set-window-start outwin (point-min)))
;; Position point as the user will see it.
(let ((desired-visible-point
- ;; Put it at the end if `compilation-scroll-output' is set.
- (if compilation-scroll-output
- (point-max)
- ;; Normally put it at the top.
- (point-min))))
+ (cond
+ (continue continue)
+ ;; Put it at the end if `compilation-scroll-output' is set.
+ (compilation-scroll-output (point-max))
+ ;; Normally put it at the top.
+ (t (point-min)))))
(goto-char desired-visible-point)
(when (and outwin (not (eq outwin (selected-window))))
(set-window-point outwin desired-visible-point)))
@@ -2228,6 +2314,7 @@ The parent is always `compilation-mode' and the customizable `compilation-...'
variables are also set from the name of the mode you have chosen,
by replacing the first word, e.g., `compilation-scroll-output' from
`grep-scroll-output' if that variable exists."
+ (declare (indent defun))
(let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
`(define-derived-mode ,mode compilation-mode ,name
,doc
@@ -2407,8 +2494,8 @@ commands of Compilation major mode are available. See
(defun compilation-filter (proc string)
"Process filter for compilation buffers.
-Just inserts the text,
-handles carriage motion (see `comint-inhibit-carriage-motion'),
+Just inserts the text, handles carriage motion (see
+`comint-inhibit-carriage-motion'), `compilation-hidden-output',
and runs `compilation-filter-hook'."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
@@ -2428,13 +2515,18 @@ and runs `compilation-filter-hook'."
;; We used to use `insert-before-markers', so that windows with
;; point at `process-mark' scroll along with the output, but we
;; now use window-point-insertion-type instead.
- (insert string)
+ (if (not compilation-max-output-line-length)
+ (insert string)
+ (dolist (line (string-lines string nil t))
+ (compilation--insert-abbreviated-line
+ line compilation-max-output-line-length)))
+ (when compilation-hidden-output
+ (compilation--hide-output compilation-filter-start))
(unless comint-inhibit-carriage-motion
(comint-carriage-motion (process-mark proc) (point)))
(set-marker (process-mark proc) (point))
;; Update the number of errors in compilation-mode-line-errors
(compilation--ensure-parse (point))
- ;; (setq-local compilation-buffer-modtime (current-time))
(run-hooks 'compilation-filter-hook))
(goto-char pos)
(narrow-to-region min max)
@@ -2442,6 +2534,58 @@ and runs `compilation-filter-hook'."
(set-marker min nil)
(set-marker max nil))))))
+(defun compilation--hide-output (start)
+ (save-excursion
+ (goto-char start)
+ (beginning-of-line)
+ ;; Apply the match to each line, but wait until we have a complete
+ ;; line.
+ (let ((start (point)))
+ (while (search-forward "\n" nil t)
+ (save-restriction
+ (narrow-to-region start (point))
+ (dolist (regexp (ensure-list compilation-hidden-output))
+ (goto-char start)
+ (while (re-search-forward regexp nil t)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '( invisible t
+ rear-nonsticky t))))
+ (goto-char (point-max)))))))
+
+(defun compilation--insert-abbreviated-line (string width)
+ (if (and (> (current-column) 0)
+ (get-text-property (1- (point)) 'button))
+ ;; We already have an abbreviation; just add the string to it.
+ (let ((beg (point)))
+ (insert string)
+ (add-text-properties
+ beg
+ ;; Don't make the final newline invisible.
+ (if (= (aref string (1- (length string))) ?\n)
+ (1- (point))
+ (point))
+ (text-properties-at (1- beg))))
+ (insert string)
+ ;; If we exceeded the limit, hide the last portion of the line.
+ (when (> (current-column) width)
+ (let ((start (save-excursion
+ (move-to-column width)
+ (point))))
+ (buttonize-region
+ start (point)
+ (lambda (start)
+ (let ((inhibit-read-only t))
+ (remove-text-properties start (save-excursion
+ (goto-char start)
+ (line-end-position))
+ (text-properties-at start)))))
+ (put-text-property
+ start (if (= (aref string (1- (length string))) ?\n)
+ ;; Don't hide the final newline.
+ (1- (point))
+ (point))
+ 'display (if (char-displayable-p ?…) "[…]" "[...]"))))))
+
(defsubst compilation-buffer-internal-p ()
"Test if inside a compilation buffer."
(local-variable-p 'compilation-locs))
@@ -2931,19 +3075,7 @@ and overlay is highlighted between MK and END-MK."
(remove-hook 'pre-command-hook
#'compilation-goto-locus-delete-o))
-(defun compilation-find-file (marker filename directory &rest formats)
- "Find a buffer for file FILENAME.
-If FILENAME is not found at all, ask the user where to find it.
-Pop up the buffer containing MARKER and scroll to MARKER if we ask
-the user where to find the file.
-Search the directories in `compilation-search-path'.
-A nil in `compilation-search-path' means to try the
-\"current\" directory, which is passed in DIRECTORY.
-If DIRECTORY is relative, it is combined with `default-directory'.
-If DIRECTORY is nil, that means use `default-directory'.
-FORMATS, if given, is a list of formats to reformat FILENAME when
-looking for it: for each element FMT in FORMATS, this function
-attempts to find a file whose name is produced by (format FMT FILENAME)."
+(defun compilation-find-file-1 (marker filename directory &optional formats)
(or formats (setq formats '("%s")))
(let ((dirs compilation-search-path)
(spec-dir (if directory
@@ -2992,6 +3124,23 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
(find-file-noselect name))
fmts (cdr fmts)))
(setq dirs (cdr dirs))))
+ (list buffer spec-dir)))
+
+(defun compilation-find-file (marker filename directory &rest formats)
+ "Find a buffer for file FILENAME.
+If FILENAME is not found at all, ask the user where to find it.
+Pop up the buffer containing MARKER and scroll to MARKER if we ask
+the user where to find the file.
+Search the directories in `compilation-search-path'.
+A nil in `compilation-search-path' means to try the
+\"current\" directory, which is passed in DIRECTORY.
+If DIRECTORY is relative, it is combined with `default-directory'.
+If DIRECTORY is nil, that means use `default-directory'.
+FORMATS, if given, is a list of formats to reformat FILENAME when
+looking for it: for each element FMT in FORMATS, this function
+attempts to find a file whose name is produced by (format FMT FILENAME)."
+ (pcase-let ((`(,buffer ,spec-dir)
+ (compilation-find-file-1 marker filename directory formats)))
(while (null buffer) ;Repeat until the user selects an existing file.
;; The file doesn't exist. Ask the user where to find it.
(save-excursion ;This save-excursion is probably not right.
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ae36789af82..f51d2fcb115 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -64,7 +64,7 @@
;; This mode supports font-lock, imenu and mode-compile. In the
;; hairy version font-lock is on, but you should activate imenu
;; yourself (note that mode-compile is not standard yet). Well, you
-;; can use imenu from keyboard anyway (M-x imenu), but it is better
+;; can use imenu from keyboard anyway (M-g i), but it is better
;; to bind it like that:
;; (define-key global-map [M-S-down-mouse-3] 'imenu)
@@ -558,6 +558,20 @@ This way enabling/disabling of menu items is more correct."
:type 'boolean
:group 'cperl-speed)
+(defcustom cperl-file-style nil
+ "Indentation style to use in cperl-mode."
+ :type '(choice (const "CPerl")
+ (const "PBP")
+ (const "PerlStyle")
+ (const "GNU")
+ (const "C++")
+ (const "K&R")
+ (const "BSD")
+ (const "Whitesmith")
+ (const :tag "Default" nil))
+ :version "29.1")
+;;;###autoload(put 'cperl-file-style 'safe-local-variable 'stringp)
+
(defcustom cperl-ps-print-face-properties
'((font-lock-keyword-face nil nil bold shadow)
(font-lock-variable-name-face nil nil bold)
@@ -1019,15 +1033,9 @@ Unless KEEP, removes the old indentation."
(define-key map [(control ?c) (control ?h) ?v]
;;(concat (char-to-string help-char) "v") ; does not work
'cperl-get-help))
- (substitute-key-definition
- 'indent-sexp 'cperl-indent-exp
- map global-map)
- (substitute-key-definition
- 'indent-region 'cperl-indent-region
- map global-map)
- (substitute-key-definition
- 'indent-for-comment 'cperl-indent-for-comment
- map global-map)
+ (define-key map [remap indent-sexp] #'cperl-indent-exp)
+ (define-key map [remap indent-region] #'cperl-indent-region)
+ (define-key map [remap indent-for-comment] #'cperl-indent-for-comment)
map)
"Keymap used in CPerl mode.")
@@ -1083,7 +1091,7 @@ Unless KEEP, removes the old indentation."
["Debugger" cperl-db t]
"----"
("Tools"
- ["Imenu" imenu (fboundp 'imenu)]
+ ["Imenu" imenu]
["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)]
"----"
["Ispell PODs" cperl-pod-spell
@@ -1314,7 +1322,7 @@ name, and one for the discovery of a following BLOCK.")
,cperl--ws+-rx
(group-n 2 ,cperl--normal-identifier-rx))
"A regular expression to detect a subroutine start.
-Contains three groups: One one to distinguish lexical from
+Contains three groups: One to distinguish lexical from
\"normal\" subroutines, for the keyword \"sub\", and one for the
subroutine name.")
@@ -1666,9 +1674,11 @@ Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith
`cperl-continued-statement-offset' 5 4 2 4 4
CPerl knows several indentation styles, and may bulk set the
-corresponding variables. Use \\[cperl-set-style] to do this. Use
-\\[cperl-set-style-back] to restore the memorized preexisting values
-\(both available from menu). See examples in `cperl-style-examples'.
+corresponding variables. Use \\[cperl-set-style] to do this or
+set the `cperl-file-style' user option. Use
+\\[cperl-set-style-back] to restore the memorized preexisting
+values \(both available from menu). See examples in
+`cperl-style-examples'.
Part of the indentation style is how different parts of if/elsif/else
statements are broken into lines; in CPerl, this is reflected on how
@@ -1801,8 +1811,15 @@ or as help on variables `cperl-tips', `cperl-problems',
(when (and cperl-pod-here-scan
(not cperl-syntaxify-by-font-lock))
(cperl-find-pods-heres))
+ (when cperl-file-style
+ (cperl-set-style cperl-file-style))
+ (add-hook 'hack-local-variables-hook #'cperl--set-file-style nil t)
;; Setup Flymake
(add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
+
+(defun cperl--set-file-style ()
+ (when cperl-file-style
+ (cperl-set-style cperl-file-style)))
;; Fix for perldb - make default reasonable
(defun cperl-db ()
@@ -3840,7 +3857,7 @@ recursive calls in starting lines of here-documents."
"\\<" cperl-sub-regexp "\\>" ; sub with proto/attr
"\\("
cperl-white-and-comment-rex
- (rx (group (eval cperl--normal-identifier-rx)))
+ (rx (opt (group (eval cperl--normal-identifier-rx))))
"\\)"
"\\("
cperl-maybe-white-and-comment-rex
@@ -5951,7 +5968,7 @@ default function."
(eval cperl--basic-identifier-rx)))
(0+ blank) "(")
;; '("\\<for\\(each\\)?\\([ \t]+\\(state\\|my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
- 4 font-lock-variable-name-face)
+ 1 font-lock-variable-name-face)
;; Avoid $!, and s!!, qq!! etc. when not fontifying syntactically
'("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face)
'("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)))
@@ -6319,7 +6336,7 @@ else
)
("Current"))
"List of variables to set to get a particular indentation style.
-Should be used via `cperl-set-style' or via Perl menu.
+Should be used via `cperl-set-style', `cperl-file-style' or via Perl menu.
See examples in `cperl-style-examples'.")
@@ -6365,7 +6382,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(eval '(mode-compile)))) ; Avoid a warning
(declare-function Info-find-node "info"
- (filename nodename &optional no-going-back strict-case))
+ (filename nodename &optional no-going-back strict-case
+ noerror))
(defun cperl-info-buffer (type)
;; Return buffer with documentation. Creates if missing.
@@ -7062,9 +7080,7 @@ One may build such TAGS files from CPerl mode menu."
(error "No items found"))
(setq update
;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))
- (if (if (fboundp 'display-popup-menus-p)
- (display-popup-menus-p)
- window-system)
+ (if (display-popup-menus-p)
(x-popup-menu t (nth 2 cperl-hierarchy))
(require 'tmm)
(tmm-prompt (nth 2 cperl-hierarchy))))
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index 5cdcd7d32e3..f4584b63113 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -702,11 +702,8 @@ BRANCH should be either nil (false branch), t (true branch) or `both'."
(x-popup-menu cpp-button-event
(list prompt (cons prompt cpp-face-default-list)))
(let ((name (car (rassq default cpp-face-default-list))))
- (cdr (assoc (completing-read (if name
- (concat prompt
- " (default " name "): ")
- (concat prompt ": "))
- cpp-face-default-list nil t)
+ (cdr (assoc (completing-read (format-prompt "%s" name prompt)
+ cpp-face-default-list nil t)
cpp-face-all-list))))
default))
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 971e3f6174d..03469b9f55b 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -180,9 +180,6 @@ C++ modes are included."
(cwarn-font-lock-keywords cwarn-mode)
(font-lock-flush))
-;;;###autoload
-(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
-
;;}}}
;;{{{ Help functions
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index dacb2a5f011..16b2f3ff503 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -996,7 +996,7 @@ if for some reason a circle is in the inheritance graph."
Each line corresponds to a class in a class tree.
Letters do not insert themselves, they are commands.
File operations in the tree buffer work on class tree data structures.
-E.g.\\[save-buffer] writes the tree to the file it was loaded from.
+E.g. \\[save-buffer] writes the tree to the file it was loaded from.
Tree mode key bindings:
\\{ebrowse-tree-mode-map}"
@@ -1330,9 +1330,9 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise."
"Set the indentation width of the tree display."
(interactive)
(let ((width (string-to-number (read-string
- (concat "Indentation (default "
- (int-to-string ebrowse--indentation)
- "): ")
+ (format-prompt
+ "Indentation"
+ (int-to-string ebrowse--indentation))
nil nil ebrowse--indentation))))
(when (cl-plusp width)
(setq-local ebrowse--indentation width)
@@ -4050,23 +4050,27 @@ NUMBER-OF-STATIC-VARIABLES:"
(defvar ebrowse-global-map nil
"Keymap for Ebrowse commands.")
-
(defvar ebrowse-global-prefix-key "\C-c\C-m"
"Prefix key for Ebrowse commands.")
-
-(defvar ebrowse-global-submap-4 nil
- "Keymap used for `ebrowse-global-prefix' followed by `4'.")
-
-
-(defvar ebrowse-global-submap-5 nil
- "Keymap used for `ebrowse-global-prefix' followed by `5'.")
-
+(defvar-keymap ebrowse-global-submap-4
+ :doc "Keymap used for `ebrowse-global-prefix' followed by `4'."
+ "." #'ebrowse-tags-find-definition-other-window
+ "f" #'ebrowse-tags-find-definition-other-window
+ "v" #'ebrowse-tags-find-declaration-other-window
+ "F" #'ebrowse-tags-view-definition-other-window
+ "V" #'ebrowse-tags-view-declaration-other-window)
+
+(defvar-keymap ebrowse-global-submap-5
+ :doc "Keymap used for `ebrowse-global-prefix' followed by `5'."
+ "." #'ebrowse-tags-find-definition-other-frame
+ "f" #'ebrowse-tags-find-definition-other-frame
+ "v" #'ebrowse-tags-find-declaration-other-frame
+ "F" #'ebrowse-tags-view-definition-other-frame
+ "V" #'ebrowse-tags-view-declaration-other-frame)
(unless ebrowse-global-map
(setq ebrowse-global-map (make-sparse-keymap))
- (setq ebrowse-global-submap-4 (make-sparse-keymap))
- (setq ebrowse-global-submap-5 (make-sparse-keymap))
(define-key ebrowse-global-map "a" 'ebrowse-tags-apropos)
(define-key ebrowse-global-map "b" 'ebrowse-pop-to-browser-buffer)
(define-key ebrowse-global-map "-" 'ebrowse-back-in-position-stack)
@@ -4087,17 +4091,7 @@ NUMBER-OF-STATIC-VARIABLES:"
(define-key ebrowse-global-map " " 'ebrowse-electric-buffer-list)
(define-key ebrowse-global-map "\t" 'ebrowse-tags-complete-symbol)
(define-key ebrowse-global-map "4" ebrowse-global-submap-4)
- (define-key ebrowse-global-submap-4 "." 'ebrowse-tags-find-definition-other-window)
- (define-key ebrowse-global-submap-4 "f" 'ebrowse-tags-find-definition-other-window)
- (define-key ebrowse-global-submap-4 "v" 'ebrowse-tags-find-declaration-other-window)
- (define-key ebrowse-global-submap-4 "F" 'ebrowse-tags-view-definition-other-window)
- (define-key ebrowse-global-submap-4 "V" 'ebrowse-tags-view-declaration-other-window)
(define-key ebrowse-global-map "5" ebrowse-global-submap-5)
- (define-key ebrowse-global-submap-5 "." 'ebrowse-tags-find-definition-other-frame)
- (define-key ebrowse-global-submap-5 "f" 'ebrowse-tags-find-definition-other-frame)
- (define-key ebrowse-global-submap-5 "v" 'ebrowse-tags-find-declaration-other-frame)
- (define-key ebrowse-global-submap-5 "F" 'ebrowse-tags-view-definition-other-frame)
- (define-key ebrowse-global-submap-5 "V" 'ebrowse-tags-view-declaration-other-frame)
(define-key global-map ebrowse-global-prefix-key ebrowse-global-map))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index bdd7751fc0c..0c4a9bfdbea 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -31,6 +31,7 @@
(require 'cl-generic)
(require 'lisp-mode)
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
"Abbrev table for Emacs Lisp mode.
@@ -45,15 +46,16 @@ It has `lisp-mode-abbrev-table' as its parent."
table)
"Syntax table used in `emacs-lisp-mode'.")
-(defvar emacs-lisp-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\e\t" 'completion-at-point)
- (define-key map "\e\C-x" 'eval-defun)
- (define-key map "\e\C-q" 'indent-pp-sexp)
- map)
- "Keymap for Emacs Lisp mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
+(defvar-keymap emacs-lisp-mode-map
+ :doc "Keymap for Emacs Lisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map."
+ :parent lisp-mode-shared-map
+ "M-TAB" #'completion-at-point
+ "C-M-x" #'eval-defun
+ "C-c C-e" #'elisp-eval-buffer
+ "C-c C-f" #'elisp-byte-compile-file
+ "C-c C-b" #'elisp-byte-compile-buffer
+ "C-M-q" #'indent-pp-sexp)
(easy-menu-define emacs-lisp-mode-menu emacs-lisp-mode-map
"Menu for Emacs Lisp mode."
@@ -239,6 +241,26 @@ Comments in the form will be lost."
(if (bolp) (delete-char -1))
(indent-region start (point)))))
+(defun elisp-mode-syntax-propertize (start end)
+ (goto-char start)
+ (let ((case-fold-search nil))
+ (funcall
+ (syntax-propertize-rules
+ ;; Empty symbol.
+ ("##" (0 (unless (nth 8 (syntax-ppss))
+ (string-to-syntax "_"))))
+ ;; Unicode character names. (The longest name is 88 characters
+ ;; long.)
+ ("\\?\\\\N{[-A-Za-z0-9 ]\\{,100\\}}"
+ (0 (unless (nth 8 (syntax-ppss))
+ (string-to-syntax "_"))))
+ ((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector.
+ (seq (group-n 1 "s") "(") ; Record.
+ (seq (group-n 1 (+ "^")) "["))) ; Char-table.
+ (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax "'")))))
+ start end)))
+
(defcustom emacs-lisp-mode-hook nil
"Hook run when entering Emacs Lisp mode."
:options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
@@ -270,10 +292,8 @@ Comments in the form will be lost."
(setq-local lexical-binding t)
(add-file-local-variable-prop-line 'lexical-binding t interactive))))
-(defvar elisp--dynlex-modeline-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mode-line mouse-1] 'elisp-enable-lexical-binding)
- map))
+(defvar-keymap elisp--dynlex-modeline-map
+ "<mode-line> <mouse-1>" #'elisp-enable-lexical-binding)
;;;###autoload
(define-derived-mode emacs-lisp-mode lisp-data-mode
@@ -314,6 +334,7 @@ be used instead.
#'elisp-eldoc-var-docstring nil t)
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
+ (setq-local syntax-propertize-function #'elisp-mode-syntax-propertize)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil 'local)
(add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
@@ -610,13 +631,13 @@ functions are annotated with \"<f>\" via the
;; t if in function position.
(funpos (eq (char-before beg) ?\())
(quoted (elisp--form-quoted-p beg))
- (fun-sym (condition-case nil
- (save-excursion
- (up-list -1)
- (forward-char 1)
- (and (memq (char-syntax (char-after)) '(?w ?_))
- (read (current-buffer))))
- (error nil))))
+ (is-ignore-error
+ (condition-case nil
+ (save-excursion
+ (up-list -1)
+ (forward-char 1)
+ (looking-at-p "ignore-error\\>"))
+ (error nil))))
(when (and end (or (not (nth 8 (syntax-ppss)))
(memq (char-before beg) '(?` ?‘))))
(let ((table-etc
@@ -625,7 +646,7 @@ functions are annotated with \"<f>\" via the
;; FIXME: We could look at the first element of
;; the current form and use it to provide a more
;; specific completion table in more cases.
- ((eq fun-sym 'ignore-error)
+ (is-ignore-error
(list t (elisp--completion-local-symbols)
:predicate (lambda (sym)
(get sym 'error-conditions))))
@@ -636,7 +657,8 @@ functions are annotated with \"<f>\" via the
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location))
+ :company-location #'elisp--company-location
+ :company-deprecated #'elisp--company-deprecated))
(quoted
(list nil (elisp--completion-local-symbols)
;; Don't include all symbols (bug#16646).
@@ -652,7 +674,8 @@ functions are annotated with \"<f>\" via the
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location))
+ :company-location #'elisp--company-location
+ :company-deprecated #'elisp--company-deprecated))
(t
(list nil (completion-table-merge
elisp--local-variables-completion-table
@@ -667,7 +690,8 @@ functions are annotated with \"<f>\" via the
'variable))
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location)))
+ :company-location #'elisp--company-location
+ :company-deprecated #'elisp--company-deprecated)))
;; Looks like a funcall position. Let's double check.
(save-excursion
(goto-char (1- beg))
@@ -677,7 +701,10 @@ functions are annotated with \"<f>\" via the
(let ((c (char-after)))
(if (eq c ?\() ?\(
(if (memq (char-syntax c) '(?w ?_))
- (read (current-buffer))))))
+ (let ((pt (point)))
+ (forward-sexp)
+ (intern-soft
+ (buffer-substring pt (point))))))))
(error nil))))
(pcase parent
;; FIXME: Rather than hardcode special cases here,
@@ -714,13 +741,15 @@ functions are annotated with \"<f>\" via the
:company-kind (lambda (_) 'variable)
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location))
+ :company-location #'elisp--company-location
+ :company-deprecated #'elisp--company-deprecated))
(_ (list nil (elisp--completion-local-symbols)
:predicate #'elisp--shorthand-aware-fboundp
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
+ :company-deprecated #'elisp--company-deprecated
))))))))
(nconc (list beg end)
(if (null (car table-etc))
@@ -743,14 +772,19 @@ functions are annotated with \"<f>\" via the
((facep sym) 'color)
(t 'text))))
+(defun elisp--company-deprecated (str)
+ (let ((sym (intern-soft str)))
+ (or (get sym 'byte-obsolete-variable)
+ (get sym 'byte-obsolete-info))))
+
(defun lisp-completion-at-point (&optional _predicate)
(declare (obsolete elisp-completion-at-point "25.1"))
(elisp-completion-at-point))
;;; Xref backend
-(declare-function xref-make "xref" (summary location))
-(declare-function xref-item-location "xref" (this))
+(declare-function xref-make "progmodes/xref" (summary location))
+(declare-function xref-item-location "progmodes/xref" (this))
(defun elisp--xref-backend () 'elisp)
@@ -773,7 +807,7 @@ functions are annotated with \"<f>\" via the
(defun elisp--xref-make-xref (type symbol file &optional summary)
"Return an xref for TYPE SYMBOL in FILE.
TYPE must be a type in `find-function-regexp-alist' (use nil for
-'defun). If SUMMARY is non-nil, use it for the summary;
+`defun'). If SUMMARY is non-nil, use it for the summary;
otherwise build the summary from TYPE and SYMBOL."
(xref-make (or summary
(format elisp--xref-format (or type 'defun) symbol))
@@ -1190,16 +1224,16 @@ namespace but with lower confidence."
;;; Elisp Interaction mode
-(defvar lisp-interaction-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\e\C-x" 'eval-defun)
- (define-key map "\e\C-q" 'indent-pp-sexp)
- (define-key map "\e\t" 'completion-at-point)
- (define-key map "\n" 'eval-print-last-sexp)
- map)
- "Keymap for Lisp Interaction mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
+(defvar-keymap lisp-interaction-mode-map
+ :doc "Keymap for Lisp Interaction mode.
+All commands in `lisp-mode-shared-map' are inherited by this map."
+ :parent lisp-mode-shared-map
+ "C-M-x" #'eval-defun
+ "C-M-q" #'indent-pp-sexp
+ "C-c C-e" #'elisp-eval-buffer
+ "C-c C-b" #'elisp-byte-compile-buffer
+ "M-TAB" #'completion-at-point
+ "C-j" #'eval-print-last-sexp)
(easy-menu-define lisp-interaction-mode-menu lisp-interaction-mode-map
"Menu for Lisp Interaction mode."
@@ -1610,8 +1644,6 @@ Return the result of evaluation."
;; printing, not while evaluating.
(defvar elisp--eval-defun-result)
(let ((debug-on-error eval-expression-debug-on-error)
- (print-length eval-expression-print-length)
- (print-level eval-expression-print-level)
elisp--eval-defun-result)
(save-excursion
;; Arrange for eval-region to "read" the (possibly) altered form.
@@ -1626,10 +1658,17 @@ Return the result of evaluation."
(setq beg (point))
(setq form (funcall load-read-function (current-buffer)))
(setq end (point)))
- ;; Alter the form if necessary.
- (let ((form (eval-sexp-add-defvars
- (elisp--eval-defun-1
- (macroexpand form)))))
+ ;; Alter the form if necessary. We bind `print-level' (etc.)
+ ;; in the form itself, because we want evalling the form to
+ ;; use the original values, while we want the printing to use
+ ;; `eval-expression-print-length' (etc.).
+ (let ((form `(let ((print-level ,print-level)
+ (print-length ,print-length))
+ ,(eval-sexp-add-defvars
+ (elisp--eval-defun-1
+ (macroexpand form)))))
+ (print-length eval-expression-print-length)
+ (print-level eval-expression-print-level))
(eval-region beg end standard-output
(lambda (_ignore)
;; Skipping to the end of the specified region
@@ -1645,7 +1684,10 @@ Return the result of evaluation."
elisp--eval-defun-result))
(defun eval-defun (edebug-it)
- "Evaluate the top-level form containing point, or after point.
+ "Evaluate the top-level form containing point.
+If point isn't in a top-level form, evaluate the first top-level
+form after point. If there is no top-level form after point,
+eval the first preceeding top-level form.
If the current defun is actually a call to `defvar' or `defcustom',
evaluating it this way resets the variable using its initial value
@@ -1733,7 +1775,8 @@ Intended for `eldoc-documentation-functions' (which see)."
(defun elisp-eldoc-var-docstring (callback &rest _ignored)
"Document variable at point.
-Intended for `eldoc-documentation-functions' (which see)."
+Intended for `eldoc-documentation-functions' (which see).
+Also see `elisp-eldoc-var-docstring-with-value'."
(let* ((sym (elisp--current-symbol))
(docstring (and sym (elisp-get-var-docstring sym))))
(when docstring
@@ -1741,6 +1784,33 @@ Intended for `eldoc-documentation-functions' (which see)."
:thing sym
:face 'font-lock-variable-name-face))))
+(defun elisp-eldoc-var-docstring-with-value (callback &rest _)
+ "Document variable at point.
+Intended for `eldoc-documentation-functions' (which see).
+Compared to `elisp-eldoc-var-docstring', this also includes the
+current variable value and a bigger chunk of the docstring."
+ (when-let ((cs (elisp--current-symbol)))
+ (when (and (boundp cs)
+ ;; nil and t are boundp!
+ (not (null cs))
+ (not (eq cs t)))
+ (funcall callback
+ (format "%.100S %s"
+ (symbol-value cs)
+ (let* ((doc (documentation-property
+ cs 'variable-documentation t))
+ (more (- (length doc) 1000)))
+ (concat (propertize
+ (string-limit (if (string= doc "nil")
+ "Undocumented."
+ doc)
+ 1000)
+ 'face 'font-lock-doc-face)
+ (when (> more 0)
+ (format "[%sc more]" more)))))
+ :thing cs
+ :face 'font-lock-variable-name-face))))
+
(defun elisp-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
If SYM is a subr and no arglist is obtainable from the docstring
@@ -2058,7 +2128,9 @@ current buffer state and calls REPORT-FN when done."
(when (process-live-p elisp-flymake--byte-compile-process)
(kill-process elisp-flymake--byte-compile-process)))
(let ((temp-file (make-temp-file "elisp-flymake-byte-compile"))
- (source-buffer (current-buffer)))
+ (source-buffer (current-buffer))
+ (coding-system-for-write 'utf-8-unix)
+ (coding-system-for-read 'utf-8))
(save-restriction
(widen)
(write-region (point-min) (point-max) temp-file nil 'nomessage))
@@ -2079,7 +2151,7 @@ current buffer state and calls REPORT-FN when done."
:connection-type 'pipe
:sentinel
(lambda (proc _event)
- (when (eq (process-status proc) 'exit)
+ (unless (process-live-p proc)
(unwind-protect
(cond
((not (and (buffer-live-p source-buffer)
@@ -2108,6 +2180,8 @@ Runs in a batch-mode Emacs. Interactively use variable
(interactive (list buffer-file-name))
(let* ((file (or file
(car command-line-args-left)))
+ (coding-system-for-read 'utf-8-unix)
+ (coding-system-for-write 'utf-8)
(byte-compile-log-buffer
(generate-new-buffer " *dummy-byte-compile-log-buffer*"))
(byte-compile-dest-file-function #'ignore)
@@ -2125,6 +2199,67 @@ Runs in a batch-mode Emacs. Interactively use variable
(terpri)
(pp collected)))
+(defun elisp-eval-buffer ()
+ "Evaluate the forms in the current buffer."
+ (interactive)
+ (eval-buffer)
+ (message "Evaluated the %s buffer" (buffer-name)))
+
+(defun elisp-byte-compile-file (&optional load)
+ "Byte compile the file the current buffer is visiting.
+If LOAD is non-nil, load the resulting .elc file. When called
+interactively, this is the prefix argument."
+ (interactive "P")
+ (unless buffer-file-name
+ (error "This buffer is not visiting a file"))
+ (byte-compile-file buffer-file-name)
+ (when load
+ (load (funcall byte-compile-dest-file-function buffer-file-name))))
+
+(defun elisp-byte-compile-buffer (&optional load)
+ "Byte compile the current buffer, but don't write a file.
+If LOAD is non-nil, load byte-compiled data. When called
+interactively, this is the prefix argument."
+ (interactive "P")
+ (let ((bfn buffer-file-name)
+ file elc)
+ (require 'bytecomp)
+ (unwind-protect
+ (progn
+ (setq file (make-temp-file "compile" nil ".el")
+ elc (funcall byte-compile-dest-file-function file))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (let ((set-message-function
+ (lambda (message)
+ (when (string-match-p "\\`Wrote " message)
+ 'ignore)))
+ (byte-compile-log-warning-function
+ (lambda (string position &optional fill level)
+ (if bfn
+ ;; Massage the warnings to that they point to
+ ;; this file, not the one in /tmp.
+ (let ((byte-compile-current-file bfn)
+ (byte-compile-root-dir (file-name-directory bfn)))
+ (byte-compile--log-warning-for-byte-compile
+ string position fill level))
+ ;; We don't have a file name, so the warnings
+ ;; will point to a file that doesn't exist. This
+ ;; should be fixed in some way.
+ (byte-compile--log-warning-for-byte-compile
+ string position fill level)))))
+ (byte-compile-file file))
+ (when (and bfn (get-buffer "*Compile-Log*"))
+ (with-current-buffer "*Compile-Log*"
+ (setq default-directory (file-name-directory bfn))))
+ (if load
+ (load elc)
+ (message "Byte-compiled the current buffer")))
+ (when file
+ (when (file-exists-p file)
+ (delete-file file))
+ (when (file-exists-p elc)
+ (delete-file elc))))))
+
(put 'read-symbol-shorthands 'safe-local-variable #'consp)
diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el
new file mode 100644
index 00000000000..13da1d478d6
--- /dev/null
+++ b/lisp/progmodes/erts-mode.el
@@ -0,0 +1,223 @@
+;;; erts-mode.el --- major mode to edit erts files -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; Keywords: tools
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'ert)
+
+(defgroup erts-mode nil
+ "Major mode for editing Emacs test files."
+ :group 'lisp)
+
+(defface erts-mode-specification-name
+ '((((class color)
+ (background dark))
+ :foreground "green")
+ (((class color)
+ (background light))
+ :foreground "cornflower blue")
+ (t
+ :bold t))
+ "Face used for displaying specification names."
+ :group 'erts-mode)
+
+(defface erts-mode-specification-value
+ '((((class color)
+ (background dark))
+ :foreground "DeepSkyBlue1")
+ (((class color)
+ (background light))
+ :foreground "blue")
+ (t
+ :bold t))
+ "Face used for displaying specification values."
+ :group 'erts-mode)
+
+(defface erts-mode-start-test
+ '((t :inherit font-lock-keyword-face))
+ "Face used for displaying specification test start markers."
+ :group 'erts-mode)
+
+(defface erts-mode-end-test
+ '((t :inherit font-lock-comment-face))
+ "Face used for displaying specification test start markers."
+ :group 'erts-mode)
+
+(defvar-keymap erts-mode-map
+ :parent prog-mode-map
+ "C-c C-r" #'erts-tag-region
+ "C-c C-c" #'erts-run-test)
+
+(defvar erts-mode-font-lock-keywords
+ ;; Specifications.
+ `((erts-mode--match-not-in-test
+ ("^\\([^ \t\n:]+:\\)[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?"
+ (progn (goto-char (match-beginning 0)) (match-end 0)) nil
+ (1 'erts-mode-specification-name)
+ (2 'erts-mode-specification-value)))
+ ("^=-=$" 0 'erts-mode-start-test)
+ ("^=-=-=$" 0 'erts-mode-end-test)))
+
+(defun erts-mode--match-not-in-test (_limit)
+ (when (erts-mode--in-test-p (point))
+ (erts-mode--end-of-test))
+ (let ((start (point)))
+ (goto-char
+ (if (re-search-forward "^=-=$" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (if (< (point) start)
+ nil
+ ;; Here we disregard LIMIT so that we may extend the area again.
+ (set-match-data (list start (point)))
+ (point))))
+
+(defun erts-mode--end-of-test ()
+ (search-forward "^=-=-=\n" nil t))
+
+(defun erts-mode--in-test-p (point)
+ "Say whether POINT is in a test."
+ (save-excursion
+ (goto-char point)
+ (beginning-of-line)
+ (if (looking-at "=-=\\(-=\\)?$")
+ t
+ (let ((test-start (save-excursion
+ (re-search-backward "^=-=\n" nil t))))
+ ;; Before the first test.
+ (and test-start
+ (let ((test-end (re-search-backward "^=-=-=\n" nil t)))
+ (or (null test-end)
+ ;; Between tests.
+ (> test-start test-end))))))))
+
+;;;###autoload
+(define-derived-mode erts-mode prog-mode "erts"
+ "Major mode for editing erts (Emacs testing) files.
+This mode mainly provides some font locking.
+
+\\{erts-mode-map}"
+ (setq-local font-lock-defaults '(erts-mode-font-lock-keywords t)))
+
+(defun erts-tag-region (start end name)
+ "Tag the region between START and END as a test.
+Interactively, this is the region.
+
+NAME should be a string appropriate for output by ert if the test fails.
+If NAME is nil or the empty string, a name will be auto-generated."
+ (interactive "r\nsTest name: " erts-mode)
+ ;; Automatically make a name.
+ (when (zerop (length name))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((names nil))
+ (while (re-search-forward "^Name:[ \t]*\\(.*\\)" nil t)
+ (let ((name (match-string 1)))
+ (unless (erts-mode--in-test-p (point))
+ (push name names))))
+ (setq name
+ (cl-loop with base = (file-name-sans-extension (buffer-name))
+ for i from 1
+ for name = (format "%s%d" base i)
+ unless (member name names)
+ return name)))))
+ (save-excursion
+ (goto-char end)
+ (unless (bolp)
+ (insert "\n"))
+ (insert "=-=-=\n")
+ (goto-char start)
+ (insert "Name: " name "\n\n")
+ (insert "=-=\n")))
+
+(defun erts-mode--preceding-spec (name)
+ (save-excursion
+ ;; Find the name, but skip if it's in a test.
+ (while (and (re-search-backward (format "^%s:" name) nil t)
+ (erts-mode--in-test-p (point))))
+ (and (not (erts-mode--in-test-p (point)))
+ (re-search-forward "^=-=$" nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (cdr (assq (intern (downcase name))
+ (ert--erts-specifications (point))))))))
+
+(defun erts-run-test (test-function &optional verbose)
+ "Run the current test.
+If the current erts file doesn't define a test function, the user
+will be prompted for one.
+
+If VERBOSE (interactively, the prefix), display a diff of the
+expected results and the actual results in a separate buffer."
+ (interactive
+ (list (or (erts-mode--preceding-spec "Code")
+ (read-string "Transformation function: "))
+ current-prefix-arg)
+ erts-mode)
+ (save-excursion
+ (erts-mode--goto-start-of-test)
+ (condition-case arg
+ (ert-test--erts-test
+ (list (cons 'dummy t)
+ (cons 'code (car (read-from-string test-function)))
+ (cons 'point-char (erts-mode--preceding-spec "Point-Char")))
+ (buffer-file-name))
+ (:success (message "Test successful"))
+ (ert-test-failed
+ (if (not verbose)
+ (message "Test failure; result: \n%s"
+ (substring-no-properties (cadr (cadr arg))))
+ (message "Test failure")
+ (let (expected got)
+ (unwind-protect
+ (progn
+ (with-current-buffer
+ (setq expected (generate-new-buffer "erts expected"))
+ (insert (nth 1 (cadr arg))))
+ (with-current-buffer
+ (setq got (generate-new-buffer "erts results"))
+ (insert (nth 2 (cadr arg))))
+ (diff-buffers expected got))
+ (kill-buffer expected)
+ (kill-buffer got))))))))
+
+(defun erts-mode--goto-start-of-test ()
+ (if (not (erts-mode--in-test-p (point)))
+ (re-search-forward "^=-=\n" nil t)
+ (re-search-backward "^=-=\n" nil t)
+ (let ((potential-start (match-end 0)))
+ ;; See if we're in a two-clause ("before" and "after") test or not.
+ (if-let ((start (and (save-excursion (re-search-backward "^=-=\n" nil t))
+ (match-end 0))))
+ (let ((end (save-excursion (re-search-backward "^=-=-=\n" nil t))))
+ (if (or (not end)
+ (> start end))
+ ;; We are, so go to the real start.
+ (goto-char start)
+ (goto-char potential-start)))
+ (goto-char potential-start)))))
+
+(provide 'erts-mode)
+
+;;; erts-mode.el ends here
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 124817ffda4..7766694edff 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -145,7 +145,9 @@ Otherwise, `find-tag-default' is used."
:type '(choice (const nil) function))
(define-obsolete-variable-alias 'find-tag-marker-ring-length
- 'xref-marker-ring-length "25.1")
+ 'tags-location-ring-length "25.1")
+
+(defvar tags-location-ring-length 16)
(defcustom tags-tag-face 'default
"Face for tags in the output of `tags-apropos'."
@@ -180,10 +182,11 @@ Example value:
(sexp :tag "Tags to search")))
:version "21.1")
-(defvaralias 'find-tag-marker-ring 'xref--marker-ring)
+;; Obsolete variable kept for compatibility. We don't use it in any way.
+(defvar find-tag-marker-ring (make-ring 16))
(make-obsolete-variable
'find-tag-marker-ring
- "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead."
+ "use `xref-push-marker-stack' or `xref-go-back' instead."
"25.1")
(defvar default-tags-table-function nil
@@ -191,7 +194,7 @@ Example value:
This function receives no arguments and should return the default
tags table file to use for the current buffer.")
-(defvar tags-location-ring (make-ring xref-marker-ring-length)
+(defvar tags-location-ring (make-ring tags-location-ring-length)
"Ring of markers which are locations visited by \\[find-tag].
Pop back to the last location with \\[negative-argument] \\[find-tag].")
@@ -292,7 +295,7 @@ file the tag was in."
(or (locate-dominating-file default-directory "TAGS")
default-directory)))
(list (read-file-name
- "Visit tags table (default TAGS): "
+ (format-prompt "Visit tags table" "TAGS")
;; default to TAGS from default-directory up to root.
default-tag-dir
(expand-file-name "TAGS" default-tag-dir)
@@ -625,7 +628,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(car list))
;; Finally, prompt the user for a file name.
(expand-file-name
- (read-file-name "Visit tags table (default TAGS): "
+ (read-file-name (format-prompt "Visit tags table" "TAGS")
default-directory
"TAGS"
t))))))
@@ -731,13 +734,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(interactive)
;; Clear out the markers we are throwing away.
(let ((i 0))
- (while (< i xref-marker-ring-length)
+ (while (< i tags-location-ring-length)
(if (aref (cddr tags-location-ring) i)
(set-marker (aref (cddr tags-location-ring) i) nil))
(setq i (1+ i))))
(xref-clear-marker-stack)
(setq tags-file-name nil
- tags-location-ring (make-ring xref-marker-ring-length)
+ tags-location-ring (make-ring tags-location-ring-length)
tags-table-list nil
tags-table-computed-list nil
tags-table-computed-list-for nil
@@ -1068,7 +1071,7 @@ See documentation of variable `tags-file-name'."
regexp next-p t))
;;;###autoload
-(defalias 'pop-tag-mark 'xref-pop-marker-stack)
+(defalias 'pop-tag-mark 'xref-go-back)
(defvar tag-lines-already-matched nil
@@ -1995,7 +1998,8 @@ see the doc of that variable if you want to add names to the list."
(setq set-list (delete (car set-list) set-list)))
(goto-char (point-min))
(insert-before-markers
- "Type `t' to select a tags table or set of tags tables:\n\n")
+ (substitute-command-keys
+ "Type \\`t' to select a tags table or set of tags tables:\n\n"))
(if desired-point
(goto-char desired-point))
(set-window-start (selected-window) 1 t))
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index d7c093444ed..670b6e7e898 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -240,12 +240,13 @@ executable."
(not (string= argument
(buffer-substring (point) (match-end 1))))
(if (or (not executable-query) no-query-flag
- (save-window-excursion
- ;; Make buffer visible before question.
- (switch-to-buffer (current-buffer))
- (y-or-n-p (format-message
- "Replace magic number by `#!%s'? "
- argument))))
+ (save-match-data
+ (save-window-excursion
+ ;; Make buffer visible before question.
+ (switch-to-buffer (current-buffer))
+ (y-or-n-p (format-message
+ "Replace magic number by `#!%s'? "
+ argument)))))
(progn
(replace-match argument t t nil 1)
(message "Magic number changed to `#!%s'" argument))))
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 526865e6f61..dcd74f0369c 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -345,6 +345,7 @@ The options are `downcase-word', `upcase-word', `capitalize-word' and nil."
;; there are spaces.
"contiguous" "submodule" "concurrent" "codimension"
"sync all" "sync memory" "critical" "image_index" "error stop"
+ "impure"
))
"\\_>")
"Regexp used by the function `f90-change-keywords'.")
@@ -599,6 +600,7 @@ and variable-name parts, respectively."
(append
f90-font-lock-keywords-1
(list
+ '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face))
;; Variable declarations (avoid the real function call).
;; NB by accident (?), this correctly fontifies the "integer" in:
;; integer () function foo ()
@@ -610,8 +612,8 @@ and variable-name parts, respectively."
'("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\
\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\
-\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)"
- (1 font-lock-type-face t) (4 font-lock-variable-name-face t))
+\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\(?:&\n[^&!\n]*\\)*\\)"
+ (1 font-lock-type-face t) (4 font-lock-variable-name-face append))
;; Derived type/class variables.
;; TODO ? If we just highlighted the "type" part, rather than
;; "type(...)", this could be in the previous expression. And this
@@ -646,18 +648,19 @@ do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\
forall\\|block\\|critical\\)\\)\\_>"
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
;; Implicit declaration.
- '("\\_<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
+ '("\\_<\\(implicit\\)[ \t]+\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
\\|enumerator\\|procedure\\|\
logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t]*"
(1 font-lock-keyword-face) (2 font-lock-type-face))
'("\\_<\\(namelist\\|common\\)[ \t]*/\\(\\(?:\\sw\\|\\s_\\)+\\)?/"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
"\\_<else\\([ \t]*if\\|where\\)?\\_>"
- '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face))
"\\_<\\(then\\|continue\\|format\\|include\\|\\(?:error[ \t]+\\)?stop\\|\
return\\)\\_>"
- '("\\_<\\(exit\\|cycle\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>"
+ '("\\_<\\(exit\\|cycle\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
+ '("\\_<\\(exit\\|cycle\\)\\_>"
+ (1 font-lock-keyword-face))
'("\\_<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
;; F2003 "class default".
'("\\_<\\(class\\)[ \t]*default" . 1)
@@ -822,9 +825,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
:style toggle :help "Expand abbreviations while typing in this buffer"]
["Add Imenu Menu" f90-add-imenu-menu
:active (not (lookup-key (current-local-map) [menu-bar index]))
- :included (fboundp 'imenu-add-to-menubar)
- :help "Add an index menu to the menu-bar"
- ]))
+ :help "Add an index menu to the menu-bar"]))
map)
"Keymap used in F90 mode.")
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index eebfa70e348..4ab16831bc1 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -903,7 +903,7 @@ can also be executed interactively independently of
(defun flymake-proc--delete-temp-directory (dir-name)
"Attempt to delete temp dir DIR-NAME, do not fail on error."
- (let* ((temp-dir temporary-file-directory)
+ (let* ((temp-dir (file-truename temporary-file-directory))
(suffix (substring dir-name (1+ (length (directory-file-name temp-dir))))))
(while (> (length suffix) 0)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 83d7bc8641c..0b7958e52fb 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -303,7 +303,7 @@ generated it."
(defun flymake-error (text &rest args)
"Format TEXT with ARGS and signal an error for Flymake."
(let ((msg (apply #'format-message text args)))
- (flymake-log :error msg)
+ (flymake-log :error "%s" msg)
(error (concat "[Flymake] " msg))))
(cl-defstruct (flymake--diag
@@ -1102,6 +1102,13 @@ The commands `flymake-goto-next-error' and
`flymake-goto-prev-error' can be used to navigate among Flymake
diagnostics annotated in the buffer.
+By default, `flymake-mode' doesn't override the \\[next-error] command, but
+if you're using Flymake a lot (and don't use the regular compilation
+mechanisms that often), it can be useful to put something like
+the following in your init file:
+
+ (setq next-error-function \\='flymake-goto-next-error)
+
The visual appearance of each type of diagnostic can be changed
by setting properties `flymake-overlay-control', `flymake-bitmap'
and `flymake-severity' on the symbols of diagnostic types (like
@@ -1358,6 +1365,11 @@ This is a suitable place for placing the `flymake-error-counter',
Separating each of these with space is not necessary."
:type '(repeat (choice string symbol)))
+(defcustom flymake-mode-line-lighter "Flymake"
+ "The string to use in the Flymake mode line."
+ :type 'string
+ :version "29.1")
+
(defvar flymake-mode-line-title '(:eval (flymake--mode-line-title))
"Mode-line construct to show Flymake's mode name and menu.")
@@ -1386,7 +1398,7 @@ correctly.")
(defun flymake--mode-line-title ()
`(:propertize
- "Flymake"
+ ,flymake-mode-line-lighter
mouse-face mode-line-highlight
help-echo
,(lambda (&rest _)
@@ -1637,6 +1649,8 @@ buffer."
(defun flymake-show-buffer-diagnostics ()
"Show a list of Flymake diagnostics for current buffer."
(interactive)
+ (unless flymake-mode
+ (user-error "Flymake mode is not enabled in the current buffer"))
(let* ((name (flymake--diagnostics-buffer-name))
(source (current-buffer))
(target (or (get-buffer name)
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 86f0be7320e..786c5ae8042 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -2213,7 +2213,6 @@ arg DO-SPACE prevents stripping the whitespace."
:style toggle :help "Expand abbreviations while typing in this buffer"]
["Add Imenu Menu" imenu-add-menubar-index
:active (not (lookup-key (current-local-map) [menu-bar index]))
- :included (fboundp 'imenu-add-to-menubar)
:help "Add an index menu to the menu-bar"]))
(provide 'fortran)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index a1385b0dea8..21bb75ae0cf 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -90,6 +90,7 @@
(require 'gud)
(require 'cl-lib)
(require 'cl-seq)
+(require 'bindat)
(eval-when-compile (require 'pcase))
(declare-function speedbar-change-initial-expansion-list
@@ -104,6 +105,7 @@
;; at toplevel, so the compiler doesn't know under which circumstances
;; they're defined.
(declare-function gud-until "gud" (arg))
+(declare-function gud-go "gud" (arg))
(declare-function gud-print "gud" (arg))
(declare-function gud-down "gud" (arg))
(declare-function gud-up "gud" (arg))
@@ -283,8 +285,8 @@ Possible values are:
:type '(choice
(const :tag "Always restore" t)
(const :tag "Don't restore" nil)
- (const :tag "Depends on `gdb-show-main'" 'if-gdb-show-main)
- (const :tag "Depends on `gdb-many-windows'" 'if-gdb-many-windows))
+ (const :tag "Depends on `gdb-show-main'" if-gdb-show-main)
+ (const :tag "Depends on `gdb-many-windows'" if-gdb-many-windows))
:group 'gdb
:version "28.1")
@@ -682,7 +684,7 @@ Note that this variable only takes effect when variable
Until there are such number of source windows on screen, GDB
tries to open a new window when visiting a new source file; after
that GDB starts to reuse existing source windows."
- :type 'number
+ :type 'natnum
:group 'gdb
:version "28.1")
@@ -954,12 +956,16 @@ detailed description of this mode.
(forward-char 2)
(gud-call "-exec-until *%a" arg)))
"\C-u" "Continue to current line or address.")
- ;; TODO Why arg here?
(gud-def
- gud-go (gud-call (if gdb-active-process
- (gdb-gud-context-command "-exec-continue")
- "-exec-run") arg)
- nil "Start or continue execution.")
+ gud-go (progn
+ (when arg
+ (gud-call (concat "-exec-arguments "
+ (read-string "Arguments to exec-run: "))))
+ (gud-call
+ (if gdb-active-process
+ (gdb-gud-context-command "-exec-continue")
+ "-exec-run")))
+ "C-v" "Start or continue execution. Use a prefix to specify arguments.")
;; For debugging Emacs only.
(gud-def gud-pp
@@ -1138,7 +1144,8 @@ no input, and GDB is waiting for input."
(setq name (nth 1 (split-string define "[( ]")))
(push (cons name define) gdb-define-alist))))
-(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
+(declare-function tooltip-show "tooltip" (text &optional use-echo-area
+ text-face default-face))
(defconst gdb--string-regexp (rx "\""
(* (or (seq "\\" nonl)
@@ -1266,7 +1273,7 @@ Used by Speedbar."
:version "22.1")
(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
-(define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch)
+(keymap-set gud-global-map "C-w" 'gud-watch)
(declare-function tooltip-identifier-from-point "tooltip" (point))
@@ -1580,7 +1587,7 @@ Buffer mode and name are selected according to buffer type.
If buffer has trigger associated with it in `gdb-buffer-rules',
this trigger is subscribed to `gdb-buf-publisher' and called with
-'update argument."
+`update' argument."
(or (gdb-get-buffer buffer-type thread)
(let ((rules (assoc buffer-type gdb-buffer-rules))
(new (generate-new-buffer "limbo")))
@@ -1612,6 +1619,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
;; Used to display windows with thread-bound buffers
(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc
split-horizontal)
+ (declare (indent defun))
`(defun ,name (&optional thread)
,(when doc doc)
(message "%s" thread)
@@ -2104,7 +2112,7 @@ is running."
(not (null gdb-running-threads-count))
(> gdb-running-threads-count 0))))
-;; GUD displays the selected GDB frame. This might might not be the current
+;; GUD displays the selected GDB frame. This might not be the current
;; GDB frame (after up, down etc). If no GDB frame is visible but the last
;; visited breakpoint is, use that window.
(defun gdb-display-source-buffer (buffer)
@@ -3012,6 +3020,7 @@ calling `gdb-current-context-command').
Triggers defined by this command are meant to be used as a
trigger argument when describing buffer types with
`gdb-set-buffer-rules'."
+ (declare (indent defun))
`(defun ,trigger-name (&optional signal)
(when
(or (not ,signal-list)
@@ -3032,6 +3041,7 @@ Erase current buffer and evaluate CUSTOM-DEFUN.
Then call `gdb-update-buffer-name'.
If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
+ (declare (indent defun))
`(defun ,handler-name ()
(let* ((inhibit-read-only t)
,@(unless nopreserve
@@ -3055,6 +3065,7 @@ See `def-gdb-auto-update-trigger'.
HANDLER-NAME handler uses customization of CUSTOM-DEFUN.
See `def-gdb-auto-update-handler'."
+ (declare (indent defun))
`(progn
(def-gdb-auto-update-trigger ,trigger-name
,gdb-command
@@ -3489,6 +3500,7 @@ corresponding to the mode line clicked."
CUSTOM-DEFUN may use locally bound `thread' variable, which will
be the value of `gdb-thread' property of the current line.
If `gdb-thread' is nil, error is signaled."
+ (declare (indent defun))
`(defun ,name (&optional event)
,(when doc doc)
(interactive (list last-input-event))
@@ -3504,6 +3516,7 @@ If `gdb-thread' is nil, error is signaled."
&optional doc)
"Define a NAME which will call BUFFER-COMMAND with id of thread
on the current line."
+ (declare (indent defun))
`(def-gdb-thread-buffer-command ,name
(,buffer-command (gdb-mi--field thread 'id))
,doc))
@@ -3559,6 +3572,7 @@ on the current line."
"Define a NAME which will execute GUD-COMMAND with
`gdb-thread-number' locally bound to id of thread on the current
line."
+ (declare (indent defun))
`(def-gdb-thread-buffer-command ,name
(if gdb-non-stop
(let ((gdb-thread-number (gdb-mi--field thread 'id))
@@ -3727,6 +3741,7 @@ in `gdb-memory-format'."
(defmacro def-gdb-set-positive-number (name variable echo-string &optional doc)
"Define a function NAME which reads new VAR value from minibuffer."
+ (declare (indent defun))
`(defun ,name (event)
,(when doc doc)
(interactive "e")
@@ -3755,6 +3770,7 @@ in `gdb-memory-format'."
"Define a function NAME to switch memory buffer to use FORMAT.
DOC is an optional documentation string."
+ (declare (indent defun))
`(defun ,name () ,(when doc doc)
(interactive)
(customize-set-variable 'gdb-memory-format ,format)
@@ -3824,6 +3840,7 @@ DOC is an optional documentation string."
"Define a function NAME to switch memory unit size to UNIT-SIZE.
DOC is an optional documentation string."
+ (declare (indent defun))
`(defun ,name () ,(when doc doc)
(interactive)
(customize-set-variable 'gdb-memory-unit ,unit-size)
@@ -3848,6 +3865,7 @@ The defined function switches Memory buffer to show address
stored in ADDRESS-VAR variable.
DOC is an optional documentation string."
+ (declare (indent defun))
`(defun ,name
,(when doc doc)
(interactive)
@@ -4293,7 +4311,7 @@ member."
;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
(def-gdb-trigger-and-handler
gdb-invalidate-locals
- (concat (gdb-current-context-command "-stack-list-locals")
+ (concat (gdb-current-context-command "-stack-list-variables")
" --simple-values")
gdb-locals-handler gdb-locals-handler-custom
'(start update))
@@ -4304,6 +4322,48 @@ member."
'gdb-locals-mode
'gdb-invalidate-locals)
+
+;; Retrieve the values of all variables before invalidating locals.
+(def-gdb-trigger-and-handler
+ gdb-locals-values
+ (concat (gdb-current-context-command "-stack-list-variables")
+ " --all-values")
+ gdb-locals-values-handler gdb-locals-values-handler-custom
+ '(start update))
+
+(gdb-set-buffer-rules
+ 'gdb-locals-values-buffer
+ 'gdb-locals-values-buffer-name
+ 'gdb-locals-mode
+ 'gdb-locals-values)
+
+(defun gdb-locals-values-buffer-name ()
+ (gdb-current-context-buffer-name
+ (concat "local values of " (gdb-get-target-string))))
+
+(defcustom gdb-locals-simple-values-only nil
+ "Only display simple values in the Locals buffer."
+ :type 'boolean
+ :group 'gud
+ :version "29.1")
+
+(defcustom gdb-locals-value-limit 100
+ "Maximum length the value of a local variable is allowed to be."
+ :type 'integer
+ :group 'gud
+ :version "29.1")
+
+(defvar gdb-locals-values-table (make-hash-table :test #'equal)
+ "Mapping of local variable names to a string with their value.")
+
+(defun gdb-locals-values-handler-custom ()
+ "Store the values of local variables in `gdb-locals-value-map'."
+ (let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables)))
+ (dolist (local locals-list)
+ (let ((name (bindat-get-field local 'name))
+ (value (bindat-get-field local 'value)))
+ (puthash name value gdb-locals-values-table)))))
+
(defvar gdb-locals-watch-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
@@ -4320,6 +4380,15 @@ member."
map)
"Keymap to edit value of a simple data type local variable.")
+(defun gdb-locals-value-filter (value)
+ "Filter function for the local variable VALUE."
+ (let* ((no-nl (replace-regexp-in-string "\n" " " value))
+ (str (replace-regexp-in-string "[[:space:]]+" " " no-nl))
+ (limit gdb-locals-value-limit))
+ (if (>= (length str) limit)
+ (concat (substring str 0 limit) "...")
+ str)))
+
(defun gdb-edit-locals-value (&optional event)
"Assign a value to a variable displayed in the locals buffer."
(interactive (list last-input-event))
@@ -4332,17 +4401,22 @@ member."
(gud-basic-call
(concat "-gdb-set variable " var " = " value)))))
-;; Don't display values of arrays or structures.
-;; These can be expanded using gud-watch.
+;; Complex data types are looked up in `gdb-locals-values-table'.
(defun gdb-locals-handler-custom ()
- (let ((locals-list (gdb-mi--field (gdb-mi--partial-output) 'locals))
+ "Handler to rebuild the local variables table buffer."
+ (let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables))
(table (make-gdb-table)))
(dolist (local locals-list)
(let ((name (gdb-mi--field local 'name))
(value (gdb-mi--field local 'value))
(type (gdb-mi--field local 'type)))
(when (not value)
- (setq value "<complex data type>"))
+ (setq value
+ (if gdb-locals-simple-values-only
+ "<complex data type>"
+ (gethash name gdb-locals-values-table "<unavailable>"))))
+ (setq value (gdb-locals-value-filter value))
+
(if (or (not value)
(string-match "0x" value))
(add-text-properties 0 (length name)
@@ -4865,6 +4939,8 @@ file\" where the GDB session starts (see `gdb-main-file')."
(expand-file-name gdb-default-window-configuration-file
gdb-window-configuration-directory)))
;; Create default layout as before.
+ ;; Make sure that local values are updated before locals.
+ (gdb-get-buffer-create 'gdb-locals-values-buffer)
(gdb-get-buffer-create 'gdb-locals-buffer)
(gdb-get-buffer-create 'gdb-stack-buffer)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index bbcb644b73f..423de7d5818 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -48,8 +48,8 @@ to avoid computing them again.")
"Set SYMBOL to VALUE, and update `grep-host-defaults-alist'.
SYMBOL should be one of `grep-command', `grep-template',
`grep-use-null-device', `grep-find-command' `grep-find-template',
-`grep-find-use-xargs', `grep-use-null-filename-separator', or
-`grep-highlight-matches'."
+`grep-find-use-xargs', `grep-use-null-filename-separator',
+`grep-highlight-matches', or `grep-quoting-style'."
(when grep-host-defaults-alist
(let* ((host-id
(intern (or (file-remote-p default-directory) "localhost")))
@@ -202,6 +202,9 @@ by `grep-compute-defaults'; to change the default value, use
:set #'grep-apply-setting
:version "22.1")
+(defvar grep-quoting-style nil
+ "Whether to use POSIX-like shell argument quoting.")
+
(defcustom grep-files-aliases
'(("all" . "* .*")
("el" . "*.el")
@@ -212,6 +215,7 @@ by `grep-compute-defaults'; to change the default value, use
("hh" . "*.hxx *.hpp *.[Hh] *.HH *.h++")
("h" . "*.h")
("l" . "[Cc]hange[Ll]og*")
+ ("am" . "Makefile.am GNUmakefile *.mk")
("m" . "[Mm]akefile*")
("tex" . "*.tex")
("texi" . "*.texi")
@@ -269,16 +273,16 @@ See `compilation-error-screen-columns'."
(defvar grep-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map compilation-minor-mode-map)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\^?" 'scroll-down-command)
- (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
-
- (define-key map "\r" 'compile-goto-error) ;; ?
- (define-key map "{" 'compilation-previous-file)
- (define-key map "}" 'compilation-next-file)
- (define-key map "\t" 'compilation-next-error)
- (define-key map [backtab] 'compilation-previous-error)
+ (define-key map " " #'scroll-up-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map "\^?" #'scroll-down-command)
+ (define-key map "\C-c\C-f" #'next-error-follow-minor-mode)
+
+ (define-key map "\r" #'compile-goto-error) ;; ?
+ (define-key map "{" #'compilation-previous-file)
+ (define-key map "}" #'compilation-next-file)
+ (define-key map "\t" #'compilation-next-error)
+ (define-key map [backtab] #'compilation-previous-error)
map)
"Keymap for grep buffers.
`compilation-minor-mode-map' is a cdr of this.")
@@ -322,24 +326,24 @@ See `compilation-error-screen-columns'."
;; FIXME: Nowadays the last button is not "help" but "search"!
(help (last tool-bar-map))) ;; Keep Help last in tool bar
(tool-bar-local-item
- "left-arrow" 'previous-error-no-select 'previous-error-no-select map
+ "left-arrow" #'previous-error-no-select #'previous-error-no-select map
:rtl "right-arrow"
:help "Goto previous match")
(tool-bar-local-item
- "right-arrow" 'next-error-no-select 'next-error-no-select map
+ "right-arrow" #'next-error-no-select #'next-error-no-select map
:rtl "left-arrow"
:help "Goto next match")
(tool-bar-local-item
- "cancel" 'kill-compilation 'kill-compilation map
+ "cancel" #'kill-compilation #'kill-compilation map
:enable '(let ((buffer (compilation-find-buffer)))
(get-buffer-process buffer))
:help "Stop grep")
(tool-bar-local-item
- "refresh" 'recompile 'recompile map
+ "refresh" #'recompile #'recompile map
:help "Restart grep")
(append map help))))
-(defalias 'kill-grep 'kill-compilation)
+(defalias 'kill-grep #'kill-compilation)
;; override compilation-last-buffer
(defvar grep-last-buffer nil
@@ -443,9 +447,9 @@ buffer `default-directory'."
(defvar grep-find-abbreviate-properties
(let ((ellipsis (if (char-displayable-p ?…) "[…]" "[...]"))
(map (make-sparse-keymap)))
- (define-key map [down-mouse-2] 'mouse-set-point)
- (define-key map [mouse-2] 'grep-find-toggle-abbreviation)
- (define-key map "\C-m" 'grep-find-toggle-abbreviation)
+ (define-key map [down-mouse-2] #'mouse-set-point)
+ (define-key map [mouse-2] #'grep-find-toggle-abbreviation)
+ (define-key map "\C-m" #'grep-find-toggle-abbreviation)
`(face nil display ,ellipsis mouse-face highlight
help-echo "RET, mouse-2: show unabbreviated command"
keymap ,map abbreviated-command t))
@@ -453,7 +457,7 @@ buffer `default-directory'."
(defvar grep-mode-font-lock-keywords
'(;; Command output lines.
- (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$"
+ (": \\(.\\{,200\\}\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$"
1 grep-error-face)
;; remove match from grep-regexp-alist before fontifying
("^Grep[/a-zA-Z]* started.*"
@@ -616,8 +620,8 @@ This function is called from `compilation-filter-hook'."
"Compute the defaults for the `grep' command.
The value depends on `grep-command', `grep-template',
`grep-use-null-device', `grep-find-command', `grep-find-template',
-`grep-use-null-filename-separator', `grep-find-use-xargs' and
-`grep-highlight-matches'."
+`grep-use-null-filename-separator', `grep-find-use-xargs',
+`grep-highlight-matches', and `grep-quoting-style'."
;; Keep default values.
(unless grep-host-defaults-alist
(add-to-list
@@ -631,13 +635,14 @@ The value depends on `grep-command', `grep-template',
(grep-use-null-filename-separator
,grep-use-null-filename-separator)
(grep-find-use-xargs ,grep-find-use-xargs)
- (grep-highlight-matches ,grep-highlight-matches)))))
- (let* ((host-id
- (intern (or (file-remote-p default-directory) "localhost")))
+ (grep-highlight-matches ,grep-highlight-matches)
+ (grep-quoting-style ,grep-quoting-style)))))
+ (let* ((remote (file-remote-p default-directory))
+ (host-id (intern (or remote "localhost")))
(host-defaults (assq host-id grep-host-defaults-alist))
(defaults (assq nil grep-host-defaults-alist))
- (quot-braces (shell-quote-argument "{}"))
- (quot-scolon (shell-quote-argument ";")))
+ (quot-braces (shell-quote-argument "{}" remote))
+ (quot-scolon (shell-quote-argument ";" remote)))
;; There are different defaults on different hosts. They must be
;; computed for every host once.
(dolist (setting '(grep-command grep-template
@@ -791,8 +796,11 @@ The value depends on `grep-command', `grep-template',
find-program gcmd null quot-braces))
(t
(format "%s -H <D> <X> -type f <F> -print | \"%s\" %s"
- find-program xargs-program gcmd))))))))
- ;; Save defaults for this host.
+ find-program xargs-program gcmd))))))
+
+ (setq grep-quoting-style (and remote 'posix))))
+
+ ;; Save defaults for this host.
(setq grep-host-defaults-alist
(delete (assq host-id grep-host-defaults-alist)
grep-host-defaults-alist))
@@ -807,7 +815,8 @@ The value depends on `grep-command', `grep-template',
(grep-use-null-filename-separator
,grep-use-null-filename-separator)
(grep-find-use-xargs ,grep-find-use-xargs)
- (grep-highlight-matches ,grep-highlight-matches))))))
+ (grep-highlight-matches ,grep-highlight-matches)
+ (grep-quoting-style ,grep-quoting-style))))))
(defun grep-tag-default ()
(or (and transient-mark-mode mark-active
@@ -820,7 +829,8 @@ The value depends on `grep-command', `grep-template',
(defun grep-default-command ()
"Compute the default grep command for \\[universal-argument] \\[grep] to offer."
- (let ((tag-default (shell-quote-argument (grep-tag-default)))
+ (let ((tag-default
+ (shell-quote-argument (grep-tag-default) grep-quoting-style))
;; This a regexp to match single shell arguments.
;; Could someone please add comments explaining it?
(sh-arg-re
@@ -875,6 +885,14 @@ The value depends on `grep-command', `grep-template',
(setq-local compilation-disable-input t)
(setq-local compilation-error-screen-columns
grep-error-screen-columns)
+ ;; We normally use a nul byte to separate the file name from the
+ ;; contents, but display it as ":". That's fine, but when yanking
+ ;; to other buffers, it's annoying to have the nul byte there.
+ (unless kill-transform-function
+ (setq-local kill-transform-function #'identity))
+ (add-function :filter-return (local 'kill-transform-function)
+ (lambda (string)
+ (string-replace "\0" ":" string)))
(add-hook 'compilation-filter-hook #'grep-filter nil t))
(defun grep--save-buffers ()
@@ -952,8 +970,7 @@ easily repeat a find command."
(grep command-args))))
;;;###autoload
-(defalias 'find-grep 'grep-find)
-
+(defalias 'find-grep #'grep-find)
;; User-friendly interactive API.
@@ -963,7 +980,7 @@ easily repeat a find command."
("<F>" . files)
("<N>" . (null-device))
("<X>" . excl)
- ("<R>" . (shell-quote-argument (or regexp ""))))
+ ("<R>" . (shell-quote-argument (or regexp "") grep-quoting-style)))
"List of substitutions performed by `grep-expand-template'.
If car of an element matches, the cdr is evalled in order to get the
substitution string.
@@ -1010,7 +1027,7 @@ these include `opts', `dir', `files', `null-device', `excl' and
;; Instead of a `grep-read-files-function' variable, we used to lookup
;; mode-specific functions in the major mode's symbol properties, so preserve
;; this behavior for backward compatibility.
- (let ((old-function (get major-mode 'grep-read-files))) ;Obsolete since 28.1
+ (let ((old-function (get major-mode #'grep-read-files))) ;Obsolete since 28.1
(if old-function
(funcall old-function)
(let ((file-name-at-point
@@ -1057,17 +1074,18 @@ REGEXP is used as a string in the prompt."
default-extension
(car grep-files-history)
(car (car grep-files-aliases))))
- (files (completing-read
- (concat "Search for \"" regexp
- "\" in files matching wildcard"
- (if default (concat " (default " default ")"))
- ": ")
- #'read-file-name-internal
- nil nil nil 'grep-files-history
- (delete-dups
- (delq nil
- (append (list default default-alias default-extension)
- (mapcar #'car grep-files-aliases)))))))
+ (defaults
+ (delete-dups
+ (delq nil
+ (append (list default default-alias default-extension)
+ (mapcar #'car grep-files-aliases)))))
+ (files (completing-read
+ (format-prompt "Search for \"%s\" in files matching wildcard"
+ default regexp)
+ (completion-table-merge
+ (lambda (_string _pred _action) defaults)
+ #'read-file-name-internal)
+ nil nil nil 'grep-files-history defaults)))
(and files
(or (cdr (assoc files grep-files-aliases))
files))))
@@ -1114,6 +1132,9 @@ command before it's run."
(when (and (stringp regexp) (> (length regexp) 0))
(unless (and dir (file-accessible-directory-p dir))
(setq dir default-directory))
+ (unless (string-equal (file-remote-p dir) (file-remote-p default-directory))
+ (let ((default-directory dir))
+ (grep-compute-defaults)))
(let ((command regexp))
(if (null files)
(if (string= command grep-command)
@@ -1136,11 +1157,13 @@ command before it's run."
(mapconcat
(lambda (ignore)
(cond ((stringp ignore)
- (shell-quote-argument ignore))
+ (shell-quote-argument
+ ignore grep-quoting-style))
((consp ignore)
(and (funcall (car ignore) dir)
(shell-quote-argument
- (cdr ignore))))))
+ (cdr ignore)
+ grep-quoting-style)))))
grep-find-ignored-files
" --exclude=")))
(and (eq grep-use-directories-skip t)
@@ -1160,7 +1183,7 @@ command before it's run."
(if (and grep-use-null-device null-device (null-device))
(concat command " " (null-device))
command)
- 'grep-mode))
+ #'grep-mode))
;; Set default-directory if we started lgrep in the *grep* buffer.
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir))))))
@@ -1193,7 +1216,11 @@ When called programmatically and FILES is nil, REGEXP is expected
to specify a command to run.
If CONFIRM is non-nil, the user will be given an opportunity to edit the
-command before it's run."
+command before it's run.
+
+Interactively, the user can use the \\`M-c' command while entering
+the regexp to indicate whether the grep should be case sensitive
+or not."
(interactive
(progn
(grep-compute-defaults)
@@ -1212,13 +1239,17 @@ command before it's run."
(when (and (stringp regexp) (> (length regexp) 0))
(unless (and dir (file-accessible-directory-p dir))
(setq dir default-directory))
+ (unless (string-equal (file-remote-p dir) (file-remote-p default-directory))
+ (let ((default-directory dir))
+ (grep-compute-defaults)))
(if (null files)
(if (not (string= regexp (if (consp grep-find-command)
(car grep-find-command)
grep-find-command)))
- (compilation-start regexp 'grep-mode))
+ (compilation-start regexp #'grep-mode))
(setq dir (file-name-as-directory (expand-file-name dir)))
- (let ((command (rgrep-default-command regexp files nil)))
+ (let* ((case-fold-search (read-regexp-case-fold-search regexp))
+ (command (rgrep-default-command regexp files nil)))
(when command
(if confirm
(setq command
@@ -1227,7 +1258,7 @@ command before it's run."
(add-to-history 'grep-find-history command))
(grep--save-buffers)
(let ((default-directory dir))
- (compilation-start command 'grep-mode))
+ (compilation-start command #'grep-mode))
;; Set default-directory if we started rgrep in the *grep* buffer.
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir)))))))
@@ -1247,44 +1278,46 @@ command before it's run."
(grep-expand-template
grep-find-template
regexp
- (concat (shell-quote-argument "(")
+ (concat (shell-quote-argument "(" grep-quoting-style)
" " find-name-arg " "
(mapconcat
- #'shell-quote-argument
+ (lambda (x) (shell-quote-argument x grep-quoting-style))
(split-string files)
(concat " -o " find-name-arg " "))
" "
- (shell-quote-argument ")"))
+ (shell-quote-argument ")" grep-quoting-style))
dir
(concat
(and grep-find-ignored-directories
(concat "-type d "
- (shell-quote-argument "(")
+ (shell-quote-argument "(" grep-quoting-style)
;; we should use shell-quote-argument here
" -path "
- (mapconcat (lambda (d) (shell-quote-argument (concat "*/" d)))
- (rgrep-find-ignored-directories dir)
- " -o -path ")
+ (mapconcat
+ (lambda (d)
+ (shell-quote-argument (concat "*/" d) grep-quoting-style))
+ (rgrep-find-ignored-directories dir)
+ " -o -path ")
" "
- (shell-quote-argument ")")
+ (shell-quote-argument ")" grep-quoting-style)
" -prune -o "))
(and grep-find-ignored-files
- (concat (shell-quote-argument "!") " -type d "
- (shell-quote-argument "(")
+ (concat (shell-quote-argument "!" grep-quoting-style) " -type d "
+ (shell-quote-argument "(" grep-quoting-style)
;; we should use shell-quote-argument here
" -name "
(mapconcat
(lambda (ignore)
(cond ((stringp ignore)
- (shell-quote-argument ignore))
+ (shell-quote-argument ignore grep-quoting-style))
((consp ignore)
(and (funcall (car ignore) dir)
(shell-quote-argument
- (cdr ignore))))))
+ (cdr ignore) grep-quoting-style)))))
grep-find-ignored-files
" -o -name ")
" "
- (shell-quote-argument ")")
+ (shell-quote-argument ")" grep-quoting-style)
" -prune -o ")))))
(defun grep-find-toggle-abbreviation ()
@@ -1354,7 +1387,7 @@ The returned file name is relative."
(caar (compilation--loc->file-struct loc))))
;;;###autoload
-(defalias 'rzgrep 'zrgrep)
+(defalias 'rzgrep #'zrgrep)
(provide 'grep)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 085cd9b7e66..be43effed7d 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -54,8 +54,8 @@
(declare-function gdb-tooltip-print-1 "gdb-mi" (expr))
(declare-function gud-pp "gdb-mi" (arg))
(declare-function gdb-var-delete "gdb-mi" ())
-(declare-function speedbar-toggle-line-expansion "gud" ())
-(declare-function speedbar-edit-line "gud" ())
+(declare-function speedbar-toggle-line-expansion "speedbar" ())
+(declare-function speedbar-edit-line "speedbar" ())
;; FIXME: The declares below are necessary because we don't call `gud-def'
;; at toplevel, so the compiler doesn't know under which circumstances
;; they're defined.
@@ -90,8 +90,10 @@ pdb (Python), and jdb."
"Prefix of all GUD commands valid in C buffers."
:type 'key-sequence)
-(global-set-key (vconcat gud-key-prefix "\C-l") #'gud-refresh)
-;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack
+(defvar-keymap gud-global-map
+ "C-l" #'gud-refresh)
+
+(global-set-key gud-key-prefix gud-global-map)
(defvar gud-marker-filter nil)
(put 'gud-marker-filter 'permanent-local t)
@@ -332,7 +334,7 @@ Used to gray out relevant toolbar icons.")
(">" . gud-down)))
(define-key map key cmd))
map)
- "Keymap to repeat `gud-gdb' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `gud-gdb' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
(defun gud-set-repeat-map-property (keymap-symbol)
@@ -433,7 +435,7 @@ we're in the GUD buffer)."
;; Unused lexical warning if cmd does not use "arg".
cmd))))
,(if key `(local-set-key ,(concat "\C-c" key) #',func))
- ,(if key `(global-set-key (vconcat gud-key-prefix ,key) #',func))))
+ ,(if key `(define-key gud-global-map ,key #',func))))
;; Where gud-display-frame should put the debugging arrow; a cons of
;; (filename . line-number). This is set by the marker-filter, which scans
@@ -742,10 +744,10 @@ The option \"--fullname\" must be included in this value."
output))
-(easy-mmode-defmap gud-minibuffer-local-map
- '(("\C-i" . comint-dynamic-complete-filename))
- "Keymap for minibuffer prompting of gud startup command."
- :inherit minibuffer-local-map)
+(defvar-keymap gud-minibuffer-local-map
+ :doc "Keymap for minibuffer prompting of gud startup command."
+ :parent minibuffer-local-map
+ "C-i" #'comint-dynamic-complete-filename)
(defun gud-query-cmdline (minor-mode &optional init)
(let* ((hist-sym (gud-symbol 'history nil minor-mode))
@@ -757,13 +759,18 @@ The option \"--fullname\" must be included in this value."
(concat (or cmd-name (symbol-name minor-mode))
" "
(or init
- (let ((file nil))
- (dolist (f (directory-files default-directory) file)
- (if (and (file-executable-p f)
- (not (file-directory-p f))
- (or (not file)
- (file-newer-than-file-p f file)))
- (setq file f)))))))
+ (let ((file nil)
+ (files (directory-files default-directory)))
+ ;; On remote systems, this may be slow, so avoid it.
+ (when (or (not (file-remote-p default-directory))
+ (length< files 50))
+ (dolist (f files)
+ (if (and (file-executable-p f)
+ (not (file-directory-p f))
+ (or (not file)
+ (file-newer-than-file-p f file)))
+ (setq file f)))
+ file)))))
gud-minibuffer-local-map nil
hist-sym)))
@@ -867,7 +874,8 @@ the buffer in which this command was invoked."
COMMAND is the prefix for which we seek completion.
CONTEXT is the text before COMMAND on the line."
(let* ((complete-list
- (gud-gdb-run-command-fetch-lines (concat "complete " context command)
+ (gud-gdb-run-command-fetch-lines (concat "server complete "
+ context command)
(current-buffer)
;; From string-match above.
(length context))))
@@ -1046,7 +1054,7 @@ SKIP is the number of chars to skip on each line, it defaults to 0."
("l" . gud-refresh)))
(define-key map key cmd))
map)
- "Keymap to repeat `sdb' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `sdb' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
(defun gud-sdb-marker-filter (string)
@@ -1293,7 +1301,7 @@ whereby $stopformat=1 produces an output format compatible with
gud-irix-p)
(define-key map "f" 'gud-finish))
map)
- "Keymap to repeat `dbx' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `dbx' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
;; The process filter is also somewhat
@@ -1468,7 +1476,7 @@ and source-file directory for your debugger."
(">" . gud-down)))
(define-key map key cmd))
map)
- "Keymap to repeat `xdb' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `xdb' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
(defcustom gud-xdb-directories nil
@@ -1556,7 +1564,7 @@ directories if your program contains sources from more than one directory."
("l" . gud-refresh)))
(define-key map key cmd))
map)
- "Keymap to repeat `perldb' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `perldb' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
(defun gud-perldb-massage-args (_file args)
@@ -1746,7 +1754,7 @@ working directory and source-file directory for your debugger."
(">" . gud-down)))
(define-key map key cmd))
map)
- "Keymap to repeat `pdb' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `pdb' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
;; There's no guarantee that Emacs will hand the filter the entire
@@ -1863,7 +1871,7 @@ directory and source-file directory for your debugger."
(">" . gud-down)))
(define-key map key cmd))
map)
- "Keymap to repeat `guiler' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `guiler' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
(defun gud-guiler-marker-filter (string)
@@ -2390,7 +2398,7 @@ extension EXTN. Normally EXTN is given as the regular expression
("l" . gud-refresh)))
(define-key map key cmd))
map)
- "Keymap to repeat `jdb' stepping instructions `C-x C-a C-n n n'.
+ "Keymap to repeat `jdb' stepping instructions \\`C-x C-a C-n n n'.
Used in `repeat-mode'.")
(defun gud-jdb-find-source-using-classpath (p)
@@ -2452,7 +2460,7 @@ during jdb initialization depending on the value of
;; not supported/followed)
(if (and gud-jdb-use-classpath
(not gud-jdb-classpath-string)
- (or (string-match "classpath:[ \t[]+\\([^]]+\\)" gud-marker-acc)
+ (or (string-match "classpath:[ \t[]+\\([^]]*\\)" gud-marker-acc)
(string-match "-classpath[ \t\"]+\\([^ \"]+\\)" gud-marker-acc)))
(setq gud-jdb-classpath
(gud-jdb-parse-classpath-string
@@ -3539,8 +3547,8 @@ Treats actions as defuns."
#'gdb-script-end-of-defun)
(setq-local font-lock-defaults
'(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
- (font-lock-syntactic-face-function
- . gdb-script-font-lock-syntactic-face)))
+ (font-lock-syntactic-face-function
+ . gdb-script-font-lock-syntactic-face)))
;; Recognize docstrings.
(setq-local syntax-propertize-function
gdb-script-syntax-propertize-function)
@@ -3686,7 +3694,6 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
(message "Dereferencing is now %s."
(if gud-tooltip-dereference "on" "off")))
-(defvar tooltip-use-echo-area)
(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
(declare-function tooltip-strip-prompt "tooltip" (process output))
@@ -3700,8 +3707,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
"Process debugger output and show it in a tooltip window."
(remove-function (process-filter process) #'gud-tooltip-process-output)
(tooltip-show (tooltip-strip-prompt process output)
- (or gud-tooltip-echo-area tooltip-use-echo-area
- (not tooltip-mode))))
+ (or gud-tooltip-echo-area (not tooltip-mode))))
(defun gud-tooltip-print-command (expr)
"Return a suitable command to print the expression EXPR."
@@ -3745,8 +3751,7 @@ This function must return nil if it doesn't handle EVENT."
(unless (null define-elt)
(tooltip-show
(cdr define-elt)
- (or gud-tooltip-echo-area tooltip-use-echo-area
- (not tooltip-mode)))
+ (or gud-tooltip-echo-area (not tooltip-mode)))
expr))))
(when gud-tooltip-dereference
(setq expr (concat "*" expr)))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index f6a4711e244..f2ada676ab7 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -181,30 +181,24 @@ Effective only if `hide-ifdef-expand-reinclusion-guard' is t."
:type 'regexp
:version "25.1")
-(defvar hide-ifdef-mode-submap
+(defvar-keymap hide-ifdef-mode-submap
+ :doc "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'."
;; Set up the submap that goes after the prefix key.
- (let ((map (make-sparse-keymap)))
- (define-key map "d" 'hide-ifdef-define)
- (define-key map "u" 'hide-ifdef-undef)
- (define-key map "D" 'hide-ifdef-set-define-alist)
- (define-key map "U" 'hide-ifdef-use-define-alist)
-
- (define-key map "h" 'hide-ifdefs)
- (define-key map "s" 'show-ifdefs)
- (define-key map "\C-d" 'hide-ifdef-block)
- (define-key map "\C-s" 'show-ifdef-block)
- (define-key map "e" 'hif-evaluate-macro)
- (define-key map "C" 'hif-clear-all-ifdef-defined)
-
- (define-key map "\C-q" 'hide-ifdef-toggle-read-only)
- (define-key map "\C-w" 'hide-ifdef-toggle-shadowing)
- (substitute-key-definition
- 'read-only-mode 'hide-ifdef-toggle-outside-read-only map)
- ;; `toggle-read-only' is obsoleted by `read-only-mode'.
- (substitute-key-definition
- 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map)
- map)
- "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
+ "d" #'hide-ifdef-define
+ "u" #'hide-ifdef-undef
+ "D" #'hide-ifdef-set-define-alist
+ "U" #'hide-ifdef-use-define-alist
+ "h" #'hide-ifdefs
+ "s" #'show-ifdefs
+ "C-d" #'hide-ifdef-block
+ "C-s" #'show-ifdef-block
+ "e" #'hif-evaluate-macro
+ "C" #'hif-clear-all-ifdef-defined
+ "C-q" #'hide-ifdef-toggle-read-only
+ "C-w" #'hide-ifdef-toggle-shadowing
+ "<remap> <read-only-mode>" #'hide-ifdef-toggle-outside-read-only
+ ;; `toggle-read-only' is obsoleted by `read-only-mode'.
+ "<remap> <toggle-read-only>" #'hide-ifdef-toggle-outside-read-only)
(defcustom hide-ifdef-mode-prefix-key "\C-c@"
"Prefix key for all Hide-Ifdef mode commands."
@@ -2456,7 +2450,7 @@ This allows #ifdef VAR to be hidden."
(t
nil))))
(var (read-minibuffer "Define what? " default))
- (val (read-from-minibuffer (format "Set %s to? (default 1): " var)
+ (val (read-from-minibuffer (format-prompt "Set %s to?" "1" var)
nil nil t nil "1")))
(list var val)))
(hif-set-var var (or val 1))
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index e1ee9efc54b..ec281f3a496 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -31,17 +31,16 @@
"Abbrev table in use in Icon-mode buffers.")
(define-abbrev-table 'icon-mode-abbrev-table ())
-(defvar icon-mode-map
- (let ((map (make-sparse-keymap "Icon")))
- (define-key map "{" 'electric-icon-brace)
- (define-key map "}" 'electric-icon-brace)
- (define-key map "\e\C-h" 'mark-icon-function)
- (define-key map "\e\C-a" 'beginning-of-icon-defun)
- (define-key map "\e\C-e" 'end-of-icon-defun)
- (define-key map "\e\C-q" 'indent-icon-exp)
- (define-key map "\177" 'backward-delete-char-untabify)
- map)
- "Keymap used in Icon mode.")
+(defvar-keymap icon-mode-map
+ :doc "Keymap used in Icon mode."
+ :name "Icon"
+ "{" #'electric-icon-brace
+ "}" #'electric-icon-brace
+ "C-M-h" #'mark-icon-function
+ "C-M-a" #'beginning-of-icon-defun
+ "C-M-e" #'end-of-icon-defun
+ "C-M-q" #'indent-icon-exp
+ "DEL" #'backward-delete-char-untabify)
(easy-menu-define icon-mode-menu icon-mode-map
"Menu for Icon mode."
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index af09cab1258..d21a9faec9d 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -231,7 +231,7 @@ because these are used as separators by IDL."
(defcustom idlwave-shell-graphics-window-size '(500 400)
"Size of IDL graphics windows popped up by special IDLWAVE command.
-The command is `C-c C-d C-f' and accepts as a prefix the window nr.
+The command is \\`C-c C-d C-f' and accepts as a prefix the window nr.
A command like `WINDOW,N,xsize=XX,ysize=YY' is sent to IDL."
:group 'idlwave-shell-general-setup
:type '(list
@@ -817,7 +817,7 @@ IDL has currently stepped.")
Command history, searching of previous commands, command line
editing are available via the comint-mode key bindings, by default
- mostly on the key `C-c'. Command history is also available with
+ mostly on the key \\`C-c'. Command history is also available with
the arrow keys UP and DOWN.
2. Completion
@@ -844,7 +844,7 @@ IDL has currently stepped.")
---------
A complete set of commands for compiling and debugging IDL programs
is available from the menu. Also keybindings starting with a
- `C-c C-d' prefix are available for most commands in the *idl* buffer
+ \\`C-c C-d' prefix are available for most commands in the *idl* buffer
and also in source buffers. The best place to learn about the
keybindings is again the menu.
@@ -1327,7 +1327,7 @@ See also the variable `idlwave-shell-input-mode-spells'."
Characters are sent one by one, without newlines. The loop is blocking
and intercepts all input events to Emacs. You can use this command
to interact with the IDL command GET_KBRD.
-The loop can be aborted by typing `C-g'. The loop also exits automatically
+The loop can be aborted by typing \\[keyboard-quit]. The loop also exits automatically
when the IDL prompt gets displayed again after the current IDL command."
(interactive)
@@ -1342,7 +1342,8 @@ when the IDL prompt gets displayed again after the current IDL command."
(funcall errf "No IDL program seems to be waiting for input"))
;; OK, start the loop
- (message "Character mode on: Sending single chars (`C-g' to exit)")
+ (message (substitute-command-keys
+ "Character mode on: Sending single chars (\\[keyboard-quit] to exit)"))
(message
(catch 'exit
(while t
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index e3985db64ab..a2061fde762 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1001,9 +1001,9 @@ Obsolete, if the IDL Assistant is being used for help."
"List of modifiers to be used for the debugging commands.
Will be used to bind debugging commands in the shell buffer and in all
source buffers. These are additional convenience bindings, the debugging
-commands are always available with the `C-c C-d' prefix.
+commands are always available with the \\`C-c C-d' prefix.
If you set this to (control shift), this means setting a breakpoint will
-be on `C-S-b', compiling a source file on `C-S-c' etc. Possible modifiers
+be on \\`C-S-b', compiling a source file on \\`C-S-c' etc. Possible modifiers
are `control', `meta', `super', `hyper', `alt', and `shift'."
:group 'idlwave-shell-general-setup
:type '(set :tag "Specify modifiers"
@@ -1353,7 +1353,7 @@ the leftover unidentified statements containing an equal sign.")
;; Note that this is documented in the v18 manuals as being a string
;; of length one rather than a single character.
;; The code in this file accepts either format for compatibility.
-(defvar idlwave-comment-indent-char ?\
+(defvar idlwave-comment-indent-char ?\s
"Character to be inserted for IDL comment indentation.
Normally a space.")
@@ -3247,7 +3247,7 @@ ignored."
;; In the following while statements, after one iteration
;; point will be at the beginning of a line in which case
;; the while will not be executed for the
- ;; the first paragraph line and thus will not affect the
+ ;; first paragraph line and thus will not affect the
;; indentation.
;;
;; First check to see if indentation is based on hanging indent.
@@ -8421,7 +8421,7 @@ was pressed."
(defun idlwave-list-shell-load-path-shadows (&optional _arg)
"List the load path shadows of all routines compiled under the shell.
This is very useful for checking an IDL application. Just compile the
-application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced
+application, do RESOLVE_ALL, and \\`C-c C-i' to compile all referenced
routines and update IDLWAVE internal info. Then check for shadowing
with this command."
(interactive)
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index c952e449810..b9042e66c6b 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -308,7 +308,7 @@ quoted using shell quote syntax.
"inferior-lisp" (car cmdlist) nil (cdr cmdlist)))
(inferior-lisp-mode)))
(setq inferior-lisp-buffer "*inferior-lisp*")
- (pop-to-buffer-same-window "*inferior-lisp*"))
+ (pop-to-buffer "*inferior-lisp*" display-comint-buffer-action))
;;;###autoload
(defalias 'run-lisp 'inferior-lisp)
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 812b3b98e3c..eb2a1e4fccc 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -33,7 +33,7 @@
;; The main features of this JavaScript mode are syntactic
;; highlighting (enabled with `font-lock-mode' or
;; `global-font-lock-mode'), automatic indentation and filling of
-;; comments, C preprocessor fontification, and MozRepl integration.
+;; comments, and C preprocessor fontification.
;;
;; General Remarks:
;;
@@ -51,7 +51,6 @@
(require 'cc-fonts))
(require 'newcomment)
(require 'imenu)
-(require 'moz nil t)
(require 'json)
(require 'prog-mode)
@@ -59,12 +58,9 @@
(require 'cl-lib)
(require 'ido))
-(defvar inferior-moz-buffer)
-(defvar moz-repl-name)
(defvar ido-cur-list)
(defvar electric-layout-rules)
(declare-function ido-mode "ido" (&optional arg))
-(declare-function inferior-moz-process "ext:mozrepl" ())
;;; Constants
@@ -95,7 +91,7 @@ name.")
(defconst js--plain-method-re
(concat "^\\s-*?\\(" js--dotted-name-re "\\)\\.prototype"
- "\\.\\(" js--name-re "\\)\\s-*?=\\s-*?\\(function\\)\\_>")
+ "\\.\\(" js--name-re "\\)\\s-*?=\\s-*?\\(\\(:?async[ \t\n]+\\)function\\)\\_>")
"Regexp matching an explicit JavaScript prototype \"method\" declaration.
Group 1 is a (possibly-dotted) class name, group 2 is a method name,
and group 3 is the `function' keyword.")
@@ -485,25 +481,22 @@ seldom use, either globally or on a per-buffer basis."
(list 'const x))
js--available-frameworks)))
-(defcustom js-js-switch-tabs
- (and (memq system-type '(darwin)) t)
+(defvar js-js-switch-tabs (and (memq system-type '(darwin)) t)
"Whether `js-mode' should display tabs while selecting them.
This is useful only if the windowing system has a good mechanism
-for preventing Firefox from stealing the keyboard focus."
- :type 'boolean)
+for preventing Firefox from stealing the keyboard focus.")
+(make-obsolete-variable 'js-js-switch-tabs "MozRepl no longer exists" "28.1")
-(defcustom js-js-tmpdir
- (locate-user-emacs-file "js/js")
+(defvar js-js-tmpdir (locate-user-emacs-file "js/js")
"Temporary directory used by `js-mode' to communicate with Mozilla.
-This directory must be readable and writable by both Mozilla and Emacs."
- :type 'directory
- :version "28.1")
+This directory must be readable and writable by both Mozilla and Emacs.")
+(make-obsolete-variable 'js-js-tmpdir "MozRepl no longer exists" "28.1")
-(defcustom js-js-timeout 5
+(defvar js-js-timeout 5
"Reply timeout for executing commands in Mozilla via `js-mode'.
The value is given in seconds. Increase this value if you are
-getting timeout messages."
- :type 'integer)
+getting timeout messages.")
+(make-obsolete-variable 'js-js-timeout "MozRepl no longer exists" "28.1")
(defcustom js-indent-first-init nil
"Non-nil means specially indent the first variable declaration's initializer.
@@ -667,24 +660,11 @@ This variable is like `sgml-attribute-offset'."
:type 'integer
:safe 'integerp)
-;;; KeyMap
-
-(defvar js-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [(control ?c) (meta ?:)] #'js-eval)
- (define-key keymap [(control ?c) (control ?j)] #'js-set-js-context)
- (define-key keymap [(control meta ?x)] #'js-eval-defun)
- (define-key keymap [(meta ?.)] #'js-find-symbol)
- (easy-menu-define nil keymap "JavaScript Menu"
- '("JavaScript"
- ["Select New Mozilla Context..." js-set-js-context
- (fboundp #'inferior-moz-process)]
- ["Evaluate Expression in Mozilla Context..." js-eval
- (fboundp #'inferior-moz-process)]
- ["Send Current Function to Mozilla..." js-eval-defun
- (fboundp #'inferior-moz-process)]))
- keymap)
- "Keymap for `js-mode'.")
+;;; Keymap
+
+(defvar-keymap js-mode-map
+ :doc "Keymap for `js-mode'."
+ "M-." #'js-find-symbol)
;;; Syntax table and parsing
@@ -932,9 +912,10 @@ This puts point at the `function' keyword.
If this is a syntactically-correct non-expression function,
return the name of the function, or t if the name could not be
determined. Otherwise, return nil."
- (cl-assert (looking-at "\\_<function\\_>"))
+ (unless (looking-at "\\(\\_<async\\_>[ \t\n]+\\)?\\_<function\\_>")
+ (error "Invalid position"))
(let ((name t))
- (forward-word-strictly)
+ (goto-char (match-end 0))
(forward-comment most-positive-fixnum)
(when (eq (char-after) ?*)
(forward-char)
@@ -970,14 +951,17 @@ If POS is not in a function prologue, return nil."
(goto-char (match-end 0))))
(skip-syntax-backward "w_")
- (and (or (looking-at "\\_<function\\_>")
- (js--re-search-backward "\\_<function\\_>" nil t))
-
- (save-match-data (goto-char (match-beginning 0))
- (js--forward-function-decl))
-
- (<= pos (point))
- (or prologue-begin (match-beginning 0))))))
+ (let ((start nil))
+ (and (or (looking-at "\\_<function\\_>")
+ (js--re-search-backward "\\_<function\\_>" nil t))
+ (progn
+ (setq start (match-beginning 0))
+ (goto-char start)
+ (when (looking-back "\\_<async\\_>[ \t\n]+" (- (point) 30))
+ (setq start (match-beginning 0)))
+ (js--forward-function-decl))
+ (<= pos (point))
+ (or prologue-begin start))))))
(defun js--beginning-of-defun-raw ()
"Helper function for `js-beginning-of-defun'.
@@ -1247,7 +1231,6 @@ LIMIT defaults to point."
;; Regular function declaration
((and (looking-at "\\_<function\\_>")
(setq name (js--forward-function-decl)))
-
(when (eq name t)
(setq name (js--guess-function-name orig-match-end))
(if name
@@ -1259,6 +1242,11 @@ LIMIT defaults to point."
(cl-assert (eq (char-after) ?{))
(forward-char)
+ (save-excursion
+ (goto-char orig-match-start)
+ (when (looking-back "\\_<async\\_>[ \t\n]+"
+ (- (point) 30))
+ (setq orig-match-start (match-beginning 0))))
(make-js--pitem
:paren-depth orig-depth
:h-begin orig-match-start
@@ -3308,10 +3296,7 @@ marker."
(setf (car bounds) (point))))
(buffer-substring (car bounds) (cdr bounds)))))
-(defvar find-tag-marker-ring) ; etags
-
-;; etags loads ring.
-(declare-function ring-insert "ring" (ring item))
+(declare-function xref-push-marker-stack "xref" (&optional m))
(defun js-find-symbol (&optional arg)
"Read a JavaScript symbol and jump to it.
@@ -3319,7 +3304,7 @@ With a prefix argument, restrict symbols to those from the
current buffer. Pushes a mark onto the tag ring just like
`find-tag'."
(interactive "P")
- (require 'etags)
+ (require 'xref)
(let (symbols marker)
(if (not arg)
(setq symbols (js--get-all-known-symbols))
@@ -3331,1111 +3316,11 @@ current buffer. Pushes a mark onto the tag ring just like
symbols "Jump to: "
(js--guess-symbol-at-point))))
- (ring-insert find-tag-marker-ring (point-marker))
+ (xref-push-marker-stack)
(switch-to-buffer (marker-buffer marker))
(push-mark)
(goto-char marker)))
-;;; MozRepl integration
-
-(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error))
-(define-error 'js-js-error "JavaScript Error") ;; '(js-error error))
-
-(defun js--wait-for-matching-output
- (process regexp timeout &optional start)
- "Wait TIMEOUT seconds for PROCESS to output a match for REGEXP.
-On timeout, return nil. On success, return t with match data
-set. If START is non-nil, look for output starting from START.
-Otherwise, use the current value of `process-mark'."
- (with-current-buffer (process-buffer process)
- (cl-loop with start-pos = (or start
- (marker-position (process-mark process)))
- with end-time = (time-add nil timeout)
- for time-left = (float-time (time-subtract end-time nil))
- do (goto-char (point-max))
- if (looking-back regexp start-pos) return t
- while (> time-left 0)
- do (accept-process-output process time-left nil t)
- do (goto-char (process-mark process))
- finally do (signal
- 'js-moz-bad-rpc
- (list (format "Timed out waiting for output matching %S" regexp))))))
-
-(cl-defstruct js--js-handle
- ;; Integer, mirrors the value we see in JS
- (id nil :read-only t)
-
- ;; Process to which this thing belongs
- (process nil :read-only t))
-
-(defun js--js-handle-expired-p (x)
- (not (eq (js--js-handle-process x)
- (inferior-moz-process))))
-
-(defvar js--js-references nil
- "Maps Elisp JavaScript proxy objects to their JavaScript IDs.")
-
-(defvar js--js-process nil
- "The most recent MozRepl process object.")
-
-(defvar js--js-gc-idle-timer nil
- "Idle timer for cleaning up JS object references.")
-
-(defvar js--js-last-gcs-done nil)
-
-(defconst js--moz-interactor
- (replace-regexp-in-string
- "[ \n]+" " "
- ; */" Make Emacs happy
-"(function(repl) {
- repl.defineInteractor('js', {
- onStart: function onStart(repl) {
- if(!repl._jsObjects) {
- repl._jsObjects = {};
- repl._jsLastID = 0;
- repl._jsGC = this._jsGC;
- }
- this._input = '';
- },
-
- _jsGC: function _jsGC(ids_in_use) {
- var objects = this._jsObjects;
- var keys = [];
- var num_freed = 0;
-
- for(var pn in objects) {
- keys.push(Number(pn));
- }
-
- keys.sort(function(x, y) x - y);
- ids_in_use.sort(function(x, y) x - y);
- var i = 0;
- var j = 0;
-
- while(i < ids_in_use.length && j < keys.length) {
- var id = ids_in_use[i++];
- while(j < keys.length && keys[j] !== id) {
- var k_id = keys[j++];
- delete objects[k_id];
- ++num_freed;
- }
- ++j;
- }
-
- while(j < keys.length) {
- var k_id = keys[j++];
- delete objects[k_id];
- ++num_freed;
- }
-
- return num_freed;
- },
-
- _mkArray: function _mkArray() {
- var result = [];
- for(var i = 0; i < arguments.length; ++i) {
- result.push(arguments[i]);
- }
- return result;
- },
-
- _parsePropDescriptor: function _parsePropDescriptor(parts) {
- if(typeof parts === 'string') {
- parts = [ parts ];
- }
-
- var obj = parts[0];
- var start = 1;
-
- if(typeof obj === 'string') {
- obj = window;
- start = 0;
- } else if(parts.length < 2) {
- throw new Error('expected at least 2 arguments');
- }
-
- for(var i = start; i < parts.length - 1; ++i) {
- obj = obj[parts[i]];
- }
-
- return [obj, parts[parts.length - 1]];
- },
-
- _getProp: function _getProp(/*...*/) {
- if(arguments.length === 0) {
- throw new Error('no arguments supplied to getprop');
- }
-
- if(arguments.length === 1 &&
- (typeof arguments[0]) !== 'string')
- {
- return arguments[0];
- }
-
- var [obj, propname] = this._parsePropDescriptor(arguments);
- return obj[propname];
- },
-
- _putProp: function _putProp(properties, value) {
- var [obj, propname] = this._parsePropDescriptor(properties);
- obj[propname] = value;
- },
-
- _delProp: function _delProp(propname) {
- var [obj, propname] = this._parsePropDescriptor(arguments);
- delete obj[propname];
- },
-
- _typeOf: function _typeOf(thing) {
- return typeof thing;
- },
-
- _callNew: function(constructor) {
- if(typeof constructor === 'string')
- {
- constructor = window[constructor];
- } else if(constructor.length === 1 &&
- typeof constructor[0] !== 'string')
- {
- constructor = constructor[0];
- } else {
- var [obj,propname] = this._parsePropDescriptor(constructor);
- constructor = obj[propname];
- }
-
- /* Hacky, but should be robust */
- var s = 'new constructor(';
- for(var i = 1; i < arguments.length; ++i) {
- if(i != 1) {
- s += ',';
- }
-
- s += 'arguments[' + i + ']';
- }
-
- s += ')';
- return eval(s);
- },
-
- _callEval: function(thisobj, js) {
- return eval.call(thisobj, js);
- },
-
- getPrompt: function getPrompt(repl) {
- return 'EVAL>'
- },
-
- _lookupObject: function _lookupObject(repl, id) {
- if(typeof id === 'string') {
- switch(id) {
- case 'global':
- return window;
- case 'nil':
- return null;
- case 't':
- return true;
- case 'false':
- return false;
- case 'undefined':
- return undefined;
- case 'repl':
- return repl;
- case 'interactor':
- return this;
- case 'NaN':
- return NaN;
- case 'Infinity':
- return Infinity;
- case '-Infinity':
- return -Infinity;
- default:
- throw new Error('No object with special id:' + id);
- }
- }
-
- var ret = repl._jsObjects[id];
- if(ret === undefined) {
- throw new Error('No object with id:' + id + '(' + typeof id + ')');
- }
- return ret;
- },
-
- _findOrAllocateObject: function _findOrAllocateObject(repl, value) {
- if(typeof value !== 'object' && typeof value !== 'function') {
- throw new Error('_findOrAllocateObject called on non-object('
- + typeof(value) + '): '
- + value)
- }
-
- for(var id in repl._jsObjects) {
- id = Number(id);
- var obj = repl._jsObjects[id];
- if(obj === value) {
- return id;
- }
- }
-
- var id = ++repl._jsLastID;
- repl._jsObjects[id] = value;
- return id;
- },
-
- _fixupList: function _fixupList(repl, list) {
- for(var i = 0; i < list.length; ++i) {
- if(list[i] instanceof Array) {
- this._fixupList(repl, list[i]);
- } else if(typeof list[i] === 'object') {
- var obj = list[i];
- if(obj.funcall) {
- var parts = obj.funcall;
- this._fixupList(repl, parts);
- var [thisobj, func] = this._parseFunc(parts[0]);
- list[i] = func.apply(thisobj, parts.slice(1));
- } else if(obj.objid) {
- list[i] = this._lookupObject(repl, obj.objid);
- } else {
- throw new Error('Unknown object type: ' + obj.toSource());
- }
- }
- }
- },
-
- _parseFunc: function(func) {
- var thisobj = null;
-
- if(typeof func === 'string') {
- func = window[func];
- } else if(func instanceof Array) {
- if(func.length === 1 && typeof func[0] !== 'string') {
- func = func[0];
- } else {
- [thisobj, func] = this._parsePropDescriptor(func);
- func = thisobj[func];
- }
- }
-
- return [thisobj,func];
- },
-
- _encodeReturn: function(value, array_as_mv) {
- var ret;
-
- if(value === null) {
- ret = ['special', 'null'];
- } else if(value === true) {
- ret = ['special', 'true'];
- } else if(value === false) {
- ret = ['special', 'false'];
- } else if(value === undefined) {
- ret = ['special', 'undefined'];
- } else if(typeof value === 'number') {
- if(isNaN(value)) {
- ret = ['special', 'NaN'];
- } else if(value === Infinity) {
- ret = ['special', 'Infinity'];
- } else if(value === -Infinity) {
- ret = ['special', '-Infinity'];
- } else {
- ret = ['atom', value];
- }
- } else if(typeof value === 'string') {
- ret = ['atom', value];
- } else if(array_as_mv && value instanceof Array) {
- ret = ['array', value.map(this._encodeReturn, this)];
- } else {
- ret = ['objid', this._findOrAllocateObject(repl, value)];
- }
-
- return ret;
- },
-
- _handleInputLine: function _handleInputLine(repl, line) {
- var ret;
- var array_as_mv = false;
-
- try {
- if(line[0] === '*') {
- array_as_mv = true;
- line = line.substring(1);
- }
- var parts = eval(line);
- this._fixupList(repl, parts);
- var [thisobj, func] = this._parseFunc(parts[0]);
- ret = this._encodeReturn(
- func.apply(thisobj, parts.slice(1)),
- array_as_mv);
- } catch(x) {
- ret = ['error', x.toString() ];
- }
-
- var JSON = Components.classes['@mozilla.org/dom/json;1'].createInstance(Components.interfaces.nsIJSON);
- repl.print(JSON.encode(ret));
- repl._prompt();
- },
-
- handleInput: function handleInput(repl, chunk) {
- this._input += chunk;
- var match, line;
- while(match = this._input.match(/.*\\n/)) {
- line = match[0];
-
- if(line === 'EXIT\\n') {
- repl.popInteractor();
- repl._prompt();
- return;
- }
-
- this._input = this._input.substring(line.length);
- this._handleInputLine(repl, line);
- }
- }
- });
-})
-")
-
- "String to set MozRepl up into a simple-minded evaluation mode.")
-
-(defun js--js-encode-value (x)
- "Marshall the given value for JS.
-Strings and numbers are JSON-encoded. Lists (including nil) are
-made into JavaScript array literals and their contents encoded
-with `js--js-encode-value'."
- (cond ((or (stringp x) (numberp x)) (json-encode x))
- ((symbolp x) (format "{objid:%S}" (symbol-name x)))
- ((js--js-handle-p x)
-
- (when (js--js-handle-expired-p x)
- (error "Stale JS handle"))
-
- (format "{objid:%s}" (js--js-handle-id x)))
-
- ((sequencep x)
- (if (eq (car-safe x) 'js--funcall)
- (format "{funcall:[%s]}"
- (mapconcat #'js--js-encode-value (cdr x) ","))
- (concat
- "[" (mapconcat #'js--js-encode-value x ",") "]")))
- (t
- (error "Unrecognized item: %S" x))))
-
-(defconst js--js-prompt-regexp "\\(repl[0-9]*\\)> $")
-(defconst js--js-repl-prompt-regexp "^EVAL>$")
-(defvar js--js-repl-depth 0)
-
-(defun js--js-wait-for-eval-prompt ()
- (js--wait-for-matching-output
- (inferior-moz-process)
- js--js-repl-prompt-regexp js-js-timeout
-
- ;; start matching against the beginning of the line in
- ;; order to catch a prompt that's only partially arrived
- (save-excursion (forward-line 0) (point))))
-
-;; Presumably "inferior-moz-process" loads comint.
-(declare-function comint-send-string "comint" (process string))
-(declare-function comint-send-input "comint"
- (&optional no-newline artificial))
-
-(defun js--js-enter-repl ()
- (inferior-moz-process) ; called for side-effect
- (with-current-buffer inferior-moz-buffer
- (goto-char (point-max))
-
- ;; Do some initialization the first time we see a process
- (unless (eq (inferior-moz-process) js--js-process)
- (setq js--js-process (inferior-moz-process))
- (setq js--js-references (make-hash-table :test 'eq :weakness t))
- (setq js--js-repl-depth 0)
-
- ;; Send interactor definition
- (comint-send-string js--js-process js--moz-interactor)
- (comint-send-string js--js-process
- (concat "(" moz-repl-name ")\n"))
- (js--wait-for-matching-output
- (inferior-moz-process) js--js-prompt-regexp
- js-js-timeout))
-
- ;; Sanity check
- (when (looking-back js--js-prompt-regexp
- (save-excursion (forward-line 0) (point)))
- (setq js--js-repl-depth 0))
-
- (if (> js--js-repl-depth 0)
- ;; If js--js-repl-depth > 0, we *should* be seeing an
- ;; EVAL> prompt. If we don't, give Mozilla a chance to catch
- ;; up with us.
- (js--js-wait-for-eval-prompt)
-
- ;; Otherwise, tell Mozilla to enter the interactor mode
- (insert (match-string-no-properties 1)
- ".pushInteractor('js')")
- (comint-send-input nil t)
- (js--wait-for-matching-output
- (inferior-moz-process) js--js-repl-prompt-regexp
- js-js-timeout))
-
- (cl-incf js--js-repl-depth)))
-
-(defun js--js-leave-repl ()
- (cl-assert (> js--js-repl-depth 0))
- (when (= 0 (cl-decf js--js-repl-depth))
- (with-current-buffer inferior-moz-buffer
- (goto-char (point-max))
- (js--js-wait-for-eval-prompt)
- (insert "EXIT")
- (comint-send-input nil t)
- (js--wait-for-matching-output
- (inferior-moz-process) js--js-prompt-regexp
- js-js-timeout))))
-
-(defsubst js--js-not (value)
- (memq value '(nil null false undefined)))
-
-(defsubst js--js-true (value)
- (not (js--js-not value)))
-
-(eval-and-compile
- (defun js--optimize-arglist (arglist)
- "Convert immediate js< and js! references to deferred ones."
- (cl-loop for item in arglist
- if (eq (car-safe item) 'js<)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_getProp"))
- (js--optimize-arglist (cdr item)))
- else if (eq (car-safe item) 'js>)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_putProp"))
-
- (if (atom (cadr item))
- (list (cadr item))
- (list
- (append
- (list 'list ''js--funcall
- '(list 'interactor "_mkArray"))
- (js--optimize-arglist (cadr item)))))
- (js--optimize-arglist (cddr item)))
- else if (eq (car-safe item) 'js!)
- collect (pcase-let ((`(,_ ,function . ,body) item))
- (append (list 'list ''js--funcall
- (if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function))
- (js--optimize-arglist body)))
- else
- collect item)))
-
-(defmacro js--js-get-service (class-name interface-name)
- `(js! ("Components" "classes" ,class-name "getService")
- (js< "Components" "interfaces" ,interface-name)))
-
-(defmacro js--js-create-instance (class-name interface-name)
- `(js! ("Components" "classes" ,class-name "createInstance")
- (js< "Components" "interfaces" ,interface-name)))
-
-(defmacro js--js-qi (object interface-name)
- `(js! (,object "QueryInterface")
- (js< "Components" "interfaces" ,interface-name)))
-
-(defmacro with-js (&rest forms)
- "Run FORMS with the Mozilla repl set up for js commands.
-Inside the lexical scope of `with-js', `js?', `js!',
-`js-new', `js-eval', `js-list', `js<', `js>', `js-get-service',
-`js-create-instance', and `js-qi' are defined."
- (declare (indent 0) (debug t))
- `(progn
- (js--js-enter-repl)
- (unwind-protect
- (cl-macrolet ((js? (&rest body) `(js--js-true ,@body))
- (js! (function &rest body)
- `(js--js-funcall
- ,(if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function)
- ,@(js--optimize-arglist body)))
-
- (js-new (function &rest body)
- `(js--js-new
- ,(if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function)
- ,@body))
-
- (js-eval (thisobj js)
- `(js--js-eval
- ,@(js--optimize-arglist
- (list thisobj js))))
-
- (js-list (&rest args)
- `(js--js-list
- ,@(js--optimize-arglist args)))
-
- (js-get-service (&rest args)
- `(js--js-get-service
- ,@(js--optimize-arglist args)))
-
- (js-create-instance (&rest args)
- `(js--js-create-instance
- ,@(js--optimize-arglist args)))
-
- (js-qi (&rest args)
- `(js--js-qi
- ,@(js--optimize-arglist args)))
-
- (js< (&rest body) `(js--js-get
- ,@(js--optimize-arglist body)))
- (js> (props value)
- `(js--js-funcall
- '(interactor "_putProp")
- ,(if (consp props)
- (cons 'list
- (js--optimize-arglist props))
- props)
- ,@(js--optimize-arglist (list value))
- ))
- (js-handle? (arg) `(js--js-handle-p ,arg)))
- ,@forms)
- (js--js-leave-repl))))
-
-(defvar js--js-array-as-list nil
- "Whether to listify any Array returned by a Mozilla function.
-If nil, the whole Array is treated as a JS symbol.")
-
-(defun js--js-decode-retval (result)
- (pcase (intern (cl-first result))
- ('atom (cl-second result))
- ('special (intern (cl-second result)))
- ('array
- (mapcar #'js--js-decode-retval (cl-second result)))
- ('objid
- (or (gethash (cl-second result)
- js--js-references)
- (puthash (cl-second result)
- (make-js--js-handle
- :id (cl-second result)
- :process (inferior-moz-process))
- js--js-references)))
-
- ('error (signal 'js-js-error (list (cl-second result))))
- (x (error "Unmatched case in js--js-decode-retval: %S" x))))
-
-(defvar comint-last-input-end)
-
-(defun js--js-funcall (function &rest arguments)
- "Call the Mozilla function FUNCTION with arguments ARGUMENTS.
-If function is a string, look it up as a property on the global
-object and use the global object for `this'.
-If FUNCTION is a list with one element, use that element as the
-function with the global object for `this', except that if that
-single element is a string, look it up on the global object.
-If FUNCTION is a list with more than one argument, use the list
-up to the last value as a property descriptor and the last
-argument as a function."
-
- (with-js
- (let ((argstr (js--js-encode-value
- (cons function arguments))))
-
- (with-current-buffer inferior-moz-buffer
- ;; Actual funcall
- (when js--js-array-as-list
- (insert "*"))
- (insert argstr)
- (comint-send-input nil t)
- (js--wait-for-matching-output
- (inferior-moz-process) "EVAL>"
- js-js-timeout)
- (goto-char comint-last-input-end)
-
- ;; Read the result
- (let* ((json-array-type 'list)
- (result (prog1 (json-read)
- (goto-char (point-max)))))
- (js--js-decode-retval result))))))
-
-(defun js--js-new (constructor &rest arguments)
- "Call CONSTRUCTOR as a constructor, with arguments ARGUMENTS.
-CONSTRUCTOR is a JS handle, a string, or a list of these things."
- (apply #'js--js-funcall
- '(interactor "_callNew")
- constructor arguments))
-
-(defun js--js-eval (thisobj js)
- (js--js-funcall '(interactor "_callEval") thisobj js))
-
-(defun js--js-list (&rest arguments)
- "Return a Lisp array resulting from evaluating each of ARGUMENTS."
- (let ((js--js-array-as-list t))
- (apply #'js--js-funcall '(interactor "_mkArray")
- arguments)))
-
-(defun js--js-get (&rest props)
- (apply #'js--js-funcall '(interactor "_getProp") props))
-
-(defun js--js-put (props value)
- (js--js-funcall '(interactor "_putProp") props value))
-
-(defun js-gc (&optional force)
- "Tell the repl about any objects we don't reference anymore.
-With argument, run even if no intervening GC has happened."
- (interactive)
-
- (when force
- (setq js--js-last-gcs-done nil))
-
- (let ((this-gcs-done gcs-done) keys num)
- (when (and js--js-references
- (boundp 'inferior-moz-buffer)
- (buffer-live-p inferior-moz-buffer)
-
- ;; Don't bother running unless we've had an intervening
- ;; garbage collection; without a gc, nothing is deleted
- ;; from the weak hash table, so it's pointless telling
- ;; MozRepl about that references we still hold
- (not (eq js--js-last-gcs-done this-gcs-done))
-
- ;; Are we looking at a normal prompt? Make sure not to
- ;; interrupt the user if he's doing something
- (with-current-buffer inferior-moz-buffer
- (save-excursion
- (goto-char (point-max))
- (looking-back js--js-prompt-regexp
- (save-excursion (forward-line 0) (point))))))
-
- (setq keys (cl-loop for x being the hash-keys
- of js--js-references
- collect x))
- (setq num (js--js-funcall '(repl "_jsGC") (or keys [])))
-
- (setq js--js-last-gcs-done this-gcs-done)
- (when (called-interactively-p 'interactive)
- (message "Cleaned %s entries" num))
-
- num)))
-
-(run-with-idle-timer 30 t #'js-gc)
-
-(defun js-eval (js)
- "Evaluate the JavaScript in JS and return JSON-decoded result."
- (interactive "MJavaScript to evaluate: ")
- (with-js
- (let* ((content-window (js--js-content-window
- (js--get-js-context)))
- (result (js-eval content-window js)))
- (when (called-interactively-p 'interactive)
- (message "%s" (js! "String" result)))
- result)))
-
-(defun js--get-tabs ()
- "Enumerate all JavaScript contexts available.
-Each context is a list:
- (TITLE URL BROWSER TAB TABBROWSER) for content documents
- (TITLE URL WINDOW) for windows
-
-All tabs of a given window are grouped together. The most recent
-window is first. Within each window, the tabs are returned
-left-to-right."
- (with-js
- (let (windows)
-
- (cl-loop with window-mediator = (js! ("Components" "classes"
- "@mozilla.org/appshell/window-mediator;1"
- "getService")
- (js< "Components" "interfaces"
- "nsIWindowMediator"))
- with enumerator = (js! (window-mediator "getEnumerator") nil)
-
- while (js? (js! (enumerator "hasMoreElements")))
- for window = (js! (enumerator "getNext"))
- for window-info = (js-list window
- (js< window "document" "title")
- (js! (window "location" "toString"))
- (js< window "closed")
- (js< window "windowState"))
-
- unless (or (js? (cl-fourth window-info))
- (eq (cl-fifth window-info) 2))
- do (push window-info windows))
-
- (cl-loop for (window title location) in windows
- collect (list title location window)
-
- for gbrowser = (js< window "gBrowser")
- if (js-handle? gbrowser)
- nconc (cl-loop
- for x below (js< gbrowser "browsers" "length")
- collect (js-list (js< gbrowser
- "browsers"
- x
- "contentDocument"
- "title")
-
- (js! (gbrowser
- "browsers"
- x
- "contentWindow"
- "location"
- "toString"))
- (js< gbrowser
- "browsers"
- x)
-
- (js! (gbrowser
- "tabContainer"
- "childNodes"
- "item")
- x)
-
- gbrowser))))))
-
-(defvar js-read-tab-history nil)
-
-(declare-function ido-chop "ido" (items elem))
-
-(defun js--read-tab (prompt)
- "Read a Mozilla tab with prompt PROMPT.
-Return a cons of (TYPE . OBJECT). TYPE is either `window' or
-`tab', and OBJECT is a JavaScript handle to a ChromeWindow or a
-browser, respectively."
-
- ;; Prime IDO
- (unless ido-mode
- (ido-mode 1)
- (ido-mode -1))
-
- (with-js
- (let ((tabs (js--get-tabs)) selected-tab-cname
- selected-tab prev-hitab)
-
- ;; Disambiguate names
- (setq tabs
- (cl-loop with tab-names = (make-hash-table :test 'equal)
- for tab in tabs
- for cname = (format "%s (%s)"
- (cl-second tab) (cl-first tab))
- for num = (cl-incf (gethash cname tab-names -1))
- if (> num 0)
- do (setq cname (format "%s <%d>" cname num))
- collect (cons cname tab)))
-
- (cl-labels
- ((find-tab-by-cname
- (cname)
- (cl-loop for tab in tabs
- if (equal (car tab) cname)
- return (cdr tab)))
-
- (mogrify-highlighting
- (hitab unhitab)
-
- ;; Hack to reduce the number of
- ;; round-trips to mozilla
- (let (cmds)
- (cond
- ;; Highlighting tab
- ((cl-fourth hitab)
- (push '(js! ((cl-fourth hitab) "setAttribute")
- "style"
- "color: red; font-weight: bold")
- cmds)
-
- ;; Highlight window proper
- (push '(js! ((cl-third hitab)
- "setAttribute")
- "style"
- "border: 8px solid red")
- cmds)
-
- ;; Select tab, when appropriate
- (when js-js-switch-tabs
- (push
- '(js> ((cl-fifth hitab) "selectedTab") (cl-fourth hitab))
- cmds)))
-
- ;; Highlighting whole window
- ((cl-third hitab)
- (push '(js! ((cl-third hitab) "document"
- "documentElement" "setAttribute")
- "style"
- (concat "-moz-appearance: none;"
- "border: 8px solid red;"))
- cmds)))
-
- (cond
- ;; Unhighlighting tab
- ((cl-fourth unhitab)
- (push '(js! ((cl-fourth unhitab) "setAttribute") "style" "")
- cmds)
- (push '(js! ((cl-third unhitab) "setAttribute") "style" "")
- cmds))
-
- ;; Unhighlighting window
- ((cl-third unhitab)
- (push '(js! ((cl-third unhitab) "document"
- "documentElement" "setAttribute")
- "style" "")
- cmds)))
-
- (eval `(with-js
- (js-list ,@(nreverse cmds)))
- t)))
-
- (command-hook
- ()
- (let* ((tab (find-tab-by-cname (car ido-matches))))
- (mogrify-highlighting tab prev-hitab)
- (setq prev-hitab tab)))
-
- (setup-hook
- ()
- ;; Fiddle with the match list a bit: if our first match
- ;; is a tabbrowser window, rotate the match list until
- ;; the active tab comes up
- (let ((matched-tab (find-tab-by-cname (car ido-matches))))
- (when (and matched-tab
- (null (cl-fourth matched-tab))
- (equal "navigator:browser"
- (js! ((cl-third matched-tab)
- "document"
- "documentElement"
- "getAttribute")
- "windowtype")))
-
- (cl-loop with tab-to-match = (js< (cl-third matched-tab)
- "gBrowser"
- "selectedTab")
-
- for match in ido-matches
- for candidate-tab = (find-tab-by-cname match)
- if (eq (cl-fourth candidate-tab) tab-to-match)
- do (setq ido-cur-list
- (ido-chop ido-cur-list match))
- and return t)))
-
- (add-hook 'post-command-hook #'command-hook t t)))
-
-
- (unwind-protect
- ;; FIXME: Don't impose IDO on the user.
- (setq selected-tab-cname
- (let ((ido-minibuffer-setup-hook
- (cons #'setup-hook ido-minibuffer-setup-hook)))
- (ido-completing-read
- prompt
- (mapcar #'car tabs)
- nil t nil
- 'js-read-tab-history)))
-
- (when prev-hitab
- (mogrify-highlighting nil prev-hitab)
- (setq prev-hitab nil)))
-
- (add-to-history 'js-read-tab-history selected-tab-cname)
-
- (setq selected-tab (cl-loop for tab in tabs
- if (equal (car tab) selected-tab-cname)
- return (cdr tab)))
-
- (cons (if (cl-fourth selected-tab) 'browser 'window)
- (cl-third selected-tab))))))
-
-(defun js--guess-eval-defun-info (pstate)
- "Helper function for `js-eval-defun'.
-Return a list (NAME . CLASSPARTS), where CLASSPARTS is a list of
-strings making up the class name and NAME is the name of the
-function part."
- (cond ((and (= (length pstate) 3)
- (eq (js--pitem-type (cl-first pstate)) 'function)
- (= (length (js--pitem-name (cl-first pstate))) 1)
- (consp (js--pitem-type (cl-second pstate))))
-
- (append (js--pitem-name (cl-second pstate))
- (list (cl-first (js--pitem-name (cl-first pstate))))))
-
- ((and (= (length pstate) 2)
- (eq (js--pitem-type (cl-first pstate)) 'function))
-
- (append
- (butlast (js--pitem-name (cl-first pstate)))
- (list (car (last (js--pitem-name (cl-first pstate)))))))
-
- (t (error "Function not a toplevel defun or class member"))))
-
-(defvar js--js-context nil
- "The current JavaScript context.
-This is a cons like the one returned from `js--read-tab'.
-Change with `js-set-js-context'.")
-
-(defconst js--js-inserter
- "(function(func_info,func) {
- func_info.unshift('window');
- var obj = window;
- for(var i = 1; i < func_info.length - 1; ++i) {
- var next = obj[func_info[i]];
- if(typeof next !== 'object' && typeof next !== 'function') {
- next = obj.prototype && obj.prototype[func_info[i]];
- if(typeof next !== 'object' && typeof next !== 'function') {
- alert('Could not find ' + func_info.slice(0, i+1).join('.') +
- ' or ' + func_info.slice(0, i+1).join('.') + '.prototype');
- return;
- }
-
- func_info.splice(i+1, 0, 'prototype');
- ++i;
- }
- }
-
- obj[func_info[i]] = func;
- alert('Successfully updated '+func_info.join('.'));
- })")
-
-(defun js-set-js-context (context)
- "Set the JavaScript context to CONTEXT.
-When called interactively, prompt for CONTEXT."
- (interactive (list (js--read-tab "JavaScript Context: ")))
- (setq js--js-context context))
-
-(defun js--get-js-context ()
- "Return a valid JavaScript context.
-If one hasn't been set, or if it's stale, prompt for a new one."
- (with-js
- (when (or (null js--js-context)
- (js--js-handle-expired-p (cdr js--js-context))
- (pcase (car js--js-context)
- ('window (js? (js< (cdr js--js-context) "closed")))
- ('browser (not (js? (js< (cdr js--js-context)
- "contentDocument"))))
- (x (error "Unmatched case in js--get-js-context: %S" x))))
- (setq js--js-context (js--read-tab "JavaScript Context: ")))
- js--js-context))
-
-(defun js--js-content-window (context)
- (with-js
- (pcase (car context)
- ('window (cdr context))
- ('browser (js< (cdr context)
- "contentWindow" "wrappedJSObject"))
- (x (error "Unmatched case in js--js-content-window: %S" x)))))
-
-(defun js--make-nsilocalfile (path)
- (with-js
- (let ((file (js-create-instance "@mozilla.org/file/local;1"
- "nsILocalFile")))
- (js! (file "initWithPath") path)
- file)))
-
-(defun js--js-add-resource-alias (alias path)
- (with-js
- (let* ((io-service (js-get-service "@mozilla.org/network/io-service;1"
- "nsIIOService"))
- (res-prot (js! (io-service "getProtocolHandler") "resource"))
- (res-prot (js-qi res-prot "nsIResProtocolHandler"))
- (path-file (js--make-nsilocalfile path))
- (path-uri (js! (io-service "newFileURI") path-file)))
- (js! (res-prot "setSubstitution") alias path-uri))))
-
-(cl-defun js-eval-defun ()
- "Update a Mozilla tab using the JavaScript defun at point."
- (interactive)
-
- ;; This function works by generating a temporary file that contains
- ;; the function we'd like to insert. We then use the elisp-js bridge
- ;; to command mozilla to load this file by inserting a script tag
- ;; into the document we set. This way, debuggers and such will have
- ;; a way to find the source of the just-inserted function.
- ;;
- ;; We delete the temporary file if there's an error, but otherwise
- ;; we add an unload event listener on the Mozilla side to delete the
- ;; file.
-
- (save-excursion
- (let (begin end pstate defun-info temp-name defun-body)
- (js-end-of-defun)
- (setq end (point))
- (js--ensure-cache)
- (js-beginning-of-defun)
- (re-search-forward "\\_<function\\_>")
- (setq begin (match-beginning 0))
- (setq pstate (js--forward-pstate))
-
- (when (or (null pstate)
- (> (point) end))
- (error "Could not locate function definition"))
-
- (setq defun-info (js--guess-eval-defun-info pstate))
-
- (let ((overlay (make-overlay begin end)))
- (overlay-put overlay 'face 'highlight)
- (unwind-protect
- (unless (y-or-n-p (format "Send %s to Mozilla? "
- (mapconcat #'identity defun-info ".")))
- (message "") ; question message lingers until next command
- (cl-return-from js-eval-defun))
- (delete-overlay overlay)))
-
- (setq defun-body (buffer-substring-no-properties begin end))
-
- (make-directory js-js-tmpdir t)
-
- ;; (Re)register a Mozilla resource URL to point to the
- ;; temporary directory
- (js--js-add-resource-alias "js" js-js-tmpdir)
-
- (setq temp-name (make-temp-file (concat js-js-tmpdir
- "/js-")
- nil ".js"))
- (unwind-protect
- (with-js
- (with-temp-buffer
- (insert js--js-inserter)
- (insert "(")
- (let ((standard-output (current-buffer)))
- (json--print-list defun-info))
- (insert ",\n")
- (insert defun-body)
- (insert "\n)")
- (write-region (point-min) (point-max) temp-name
- nil 1))
-
- ;; Give Mozilla responsibility for deleting this file
- (let* ((content-window (js--js-content-window
- (js--get-js-context)))
- (content-document (js< content-window "document"))
- (head (if (js? (js< content-document "body"))
- ;; Regular content
- (js< (js! (content-document "getElementsByTagName")
- "head")
- 0)
- ;; Chrome
- (js< content-document "documentElement")))
- (elem (js! (content-document "createElementNS")
- "http://www.w3.org/1999/xhtml" "script")))
-
- (js! (elem "setAttribute") "type" "text/javascript")
- (js! (elem "setAttribute") "src"
- (format "resource://js/%s"
- (file-name-nondirectory temp-name)))
-
- (js! (head "appendChild") elem)
-
- (js! (content-window "addEventListener") "unload"
- (js! ((js-new
- "Function" "file"
- "return function() { file.remove(false) }"))
- (js--make-nsilocalfile temp-name))
- 'false)
- (setq temp-name nil)
-
-
-
- ))
-
- ;; temp-name is set to nil on success
- (when temp-name
- (delete-file temp-name))))))
-
;;; Syntax extensions
(defvar js-syntactic-mode-name t
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index b9fcd033bbb..a18c8bcce44 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -121,13 +121,11 @@ If m4 is not in your PATH, set this to an absolute file name."
("#" (0 (when (m4--quoted-p (match-beginning 0))
(string-to-syntax "."))))))
-(defvar m4-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-b" 'm4-m4-buffer)
- (define-key map "\C-c\C-r" 'm4-m4-region)
- (define-key map "\C-c\C-c" 'comment-region)
- map)
- "Keymap for M4 Mode.")
+(defvar-keymap m4-mode-map
+ :doc "Keymap for M4 Mode."
+ "C-c C-b" #'m4-m4-buffer
+ "C-c C-r" #'m4-m4-region
+ "C-c C-c" #'comment-region)
(easy-menu-define m4-mode-menu m4-mode-map
"Menu for M4 Mode."
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 9f08f39e1c0..cbbcf1c2b7c 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -220,8 +220,8 @@ to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"."
"List of special targets.
You will be offered to complete on one of those in the minibuffer whenever
you enter a \".\" at the beginning of a line in `makefile-mode'."
- :type '(repeat string))
-(put 'makefile-special-targets-list 'risky-local-variable t)
+ :type '(repeat string)
+ :risky t)
(defcustom makefile-runtime-macros-list
'(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$"))
@@ -542,8 +542,8 @@ not be enclosed in { } or ( )."
This should identify a `make' command that can handle the `-q' option."
:type 'string)
-(defvaralias 'makefile-query-one-target-method
- 'makefile-query-one-target-method-function)
+(define-obsolete-variable-alias 'makefile-query-one-target-method
+ 'makefile-query-one-target-method-function "29.1")
(defcustom makefile-query-one-target-method-function
'makefile-query-by-make-minus-q
@@ -1170,7 +1170,6 @@ and adds all qualifying names to the list of known targets."
(goto-char (match-end 0))
(insert suffix))))))))
-(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1")
;; Backslashification. Stolen from cc-mode.el.
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 5aaa277431a..f0fd23f3bc3 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -108,30 +108,27 @@
(macro-keywords-2
"\\(primarydef\\|secondarydef\\|tertiarydef\\)")
(args-keywords
- (eval-when-compile
- (regexp-opt
- '("expr" "suffix" "text" "primary" "secondary" "tertiary")
- t)))
+ (regexp-opt
+ '("expr" "suffix" "text" "primary" "secondary" "tertiary")
+ t))
(type-keywords
- (eval-when-compile
- (regexp-opt
- '("boolean" "color" "numeric" "pair" "path" "pen" "picture"
- "string" "transform" "newinternal")
- t)))
+ (regexp-opt
+ '("boolean" "color" "numeric" "pair" "path" "pen" "picture"
+ "string" "transform" "newinternal")
+ t))
(syntactic-keywords
- (eval-when-compile
- (regexp-opt
- '("for" "forever" "forsuffixes" "endfor"
- "step" "until" "upto" "downto" "thru" "within"
- "iff" "if" "elseif" "else" "fi" "exitif" "exitunless"
- "let" "def" "vardef" "enddef" "mode_def"
- "true" "false" "known" "unknown" "and" "or" "not"
- "save" "interim" "inner" "outer" "relax"
- "begingroup" "endgroup" "expandafter" "scantokens"
- "generate" "input" "endinput" "end" "bye"
- "message" "errmessage" "errhelp" "special" "numspecial"
- "readstring" "readfrom" "write")
- t)))
+ (regexp-opt
+ '("for" "forever" "forsuffixes" "endfor"
+ "step" "until" "upto" "downto" "thru" "within"
+ "iff" "if" "elseif" "else" "fi" "exitif" "exitunless"
+ "let" "def" "vardef" "enddef" "mode_def"
+ "true" "false" "known" "unknown" "and" "or" "not"
+ "save" "interim" "inner" "outer" "relax"
+ "begingroup" "endgroup" "expandafter" "scantokens"
+ "generate" "input" "endinput" "end" "bye"
+ "message" "errmessage" "errhelp" "special" "numspecial"
+ "readstring" "readfrom" "write")
+ t))
)
(list
;; embedded TeX code in btex ... etex
@@ -441,8 +438,6 @@ If the list was changed, sort the list and remove duplicates first."
(insert close)))))))
(nth 1 entry))))
-(define-obsolete-function-alias 'meta-complete-symbol
- 'completion-at-point "24.1")
;;; Indentation.
@@ -806,7 +801,6 @@ The environment marked is the one that contains point or follows point."
st)
"Syntax table used in Metafont or MetaPost mode.")
-(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1")
(defvar meta-common-mode-map
(let ((map (make-sparse-keymap)))
;; Comment Paragraphs:
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index 97a218fcfa3..9d1ceaa55a8 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -78,16 +78,13 @@
;;; Code:
(defvar compile-command)
-;;; Key map
-(defvar mixal-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'compile)
- (define-key map "\C-c\C-r" 'mixal-run)
- (define-key map "\C-c\C-d" 'mixal-debug)
- (define-key map "\C-h\C-o" 'mixal-describe-operation-code)
- map)
- "Keymap for `mixal-mode'.")
-;; (makunbound 'mixal-mode-map)
+;;; Keymap
+(defvar-keymap mixal-mode-map
+ :doc "Keymap for `mixal-mode'."
+ "C-c C-c" #'compile
+ "C-c C-r" #'mixal-run
+ "C-c C-d" #'mixal-debug
+ "C-h C-o" #'mixal-describe-operation-code)
;;; Syntax table
(defvar mixal-mode-syntax-table
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index a8d644dba0e..e668570ba17 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -101,9 +101,8 @@
(defcustom m2-indent 5
"This variable gives the indentation in Modula-2 mode."
- :type 'integer)
-(put 'm2-indent 'safe-local-variable
- (lambda (v) (or (null v) (integerp v))))
+ :type 'integer
+ :safe (lambda (v) (or (null v) (integerp v))))
(defconst m2-smie-grammar
;; An official definition can be found as "M2R10.pdf". This grammar does
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index a45909537ad..721dfa51ad3 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -197,8 +197,8 @@ newline or semicolon after an else or end keyword."
(defcustom octave-block-offset 2
"Extra indentation applied to statements in Octave block structures."
- :type 'integer)
-(put 'octave-block-offset 'safe-local-variable 'integerp)
+ :type 'integer
+ :safe #'integerp)
(defvar octave-block-comment-start
(concat (make-string 2 octave-comment-char) " ")
@@ -879,7 +879,8 @@ startup file, `~/.emacs-octave'."
(set-process-filter proc 'comint-output-filter)
;; Just in case, to be sure a cd in the startup file won't have
;; detrimental effects.
- (with-demoted-errors (inferior-octave-resync-dirs))
+ (with-demoted-errors "Octave resync error: %S"
+ (inferior-octave-resync-dirs))
;; Generate a proper prompt, which is critical to
;; `comint-history-isearch-backward-regexp'. Bug#14433.
(comint-send-string proc "\n")))
@@ -1814,18 +1815,18 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first."
(user-error "Aborted")))
(_ name)))
-(defvar find-tag-marker-ring)
+(declare-function xref-push-marker-stack "xref" (&optional m))
(defun octave-find-definition (fn)
"Find the definition of FN.
Functions implemented in C++ can be found if
variable `octave-source-directories' is set correctly."
(interactive (list (octave-completing-read)))
- (require 'etags)
+ (require 'xref)
(let ((orig (point)))
(if (and (derived-mode-p 'octave-mode)
(octave-goto-function-definition fn))
- (ring-insert find-tag-marker-ring (copy-marker orig))
+ (xref-push-marker-stack (copy-marker orig))
(inferior-octave-send-list-and-digest
;; help NAME is more verbose
(list (format "\
@@ -1840,7 +1841,7 @@ if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n"
(setq file (match-string 1 line))))
(if (not file)
(user-error "%s" (or line (format-message "`%s' not found" fn)))
- (ring-insert find-tag-marker-ring (point-marker))
+ (xref-push-marker-stack)
(setq file (funcall octave-find-definition-filename-function file))
(when file
(find-file file)
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 4ab9b4a9962..63399adf3ae 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -1641,10 +1641,10 @@ An error is raised if not in a comment."
(defun opascal-new-comment-line ()
"If in a // comment, do a newline, indented such that one is still in the
comment block. If not in a // comment, just does a normal newline."
- (interactive)
(declare
(obsolete "use comment-indent-new-line with comment-multi-line instead"
"27.1"))
+ (interactive)
(let ((comment (opascal-current-token)))
(if (not (eq 'comment-single-line (opascal-token-kind comment)))
;; Not in a // comment. Just do the normal newline.
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 422ee9bb6bd..8d3194e6a47 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -47,8 +47,8 @@
;; "reset" "rewrite" "write" "writeln")
;; pascal-separator-keywords '("downto" "else" "mod" "div" "then"))
-;; KNOWN BUGS / BUGREPORTS
-;; =======================
+;; KNOWN BUGS / BUG REPORTS
+;; ========================
;; As far as I know, there are no bugs in the current version of this
;; package. This may not be true however, since I never use this mode
;; myself and therefore would never notice them anyway. If you do
@@ -239,14 +239,6 @@ will do all lineups."
(const :tag "Declarations" declaration)
(const :tag "Case statements" case)))
-(defvar pascal-toggle-completions nil
- "If non-nil, `pascal-complete-word' tries all possible completions.
-Repeated use of \\[pascal-complete-word] then shows all
-completions in turn, instead of displaying a list of all possible
-completions.")
-(make-obsolete-variable 'pascal-toggle-completions
- 'completion-cycle-threshold "24.1")
-
(defcustom pascal-type-keywords
'("array" "file" "packed" "char" "integer" "real" "string" "record")
"Keywords for types used when completing a word in a declaration or parmlist.
@@ -1297,13 +1289,6 @@ indent of the current line in parameterlist."
(when (> e b)
(list b e #'pascal-completion))))
-(define-obsolete-function-alias 'pascal-complete-word
- 'completion-at-point "24.1")
-
-(define-obsolete-function-alias 'pascal-show-completions
- 'completion-help-at-point "24.1")
-
-
(defun pascal-get-default-symbol ()
"Return symbol around current point as a string."
(save-excursion
@@ -1357,9 +1342,7 @@ The default is a name found in the buffer around point."
default ""))
(label
;; Do completion with default.
- (completing-read (if (not (string= default ""))
- (concat "Label (default " default "): ")
- "Label: ")
+ (completing-read (format-prompt "Label" default)
;; Complete with the defuns found in the
;; current-buffer.
(let ((buf (current-buffer)))
@@ -1384,8 +1367,6 @@ The default is a name found in the buffer around point."
;;;
(defvar pascal-outline-map
(let ((map (make-sparse-keymap)))
- (if (fboundp 'set-keymap-name)
- (set-keymap-name map 'pascal-outline-map))
(define-key map "\M-\C-a" 'pascal-outline-prev-defun)
(define-key map "\M-\C-e" 'pascal-outline-next-defun)
(define-key map "\C-c\C-d" 'pascal-outline-goto-defun)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 6f468192a90..92b47ce88f6 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -191,7 +191,9 @@
,(concat "\\<"
(regexp-opt '("if" "until" "while" "elsif" "else" "unless"
"do" "dump" "for" "foreach" "exit" "die"
- "BEGIN" "END" "return" "exec" "eval") t)
+ "BEGIN" "END" "return" "exec" "eval"
+ "when" "given" "default")
+ t)
"\\>")
;;
;; Fontify declarators and prefixes as types.
@@ -212,7 +214,7 @@
(eval-and-compile
(defconst perl--syntax-exp-intro-keywords
- '("split" "if" "unless" "until" "while" "print"
+ '("split" "if" "unless" "until" "while" "print" "printf"
"grep" "map" "not" "or" "and" "for" "foreach" "return"))
(defconst perl--syntax-exp-intro-regexp
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 20685354890..7738de6a745 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -49,9 +49,15 @@
(define-key-after menu [prog-separator] menu-bar-separator
'middle-separator)
+ (unless (xref-forward-history-empty-p)
+ (define-key-after menu [xref-forward]
+ '(menu-item "Go Forward" xref-go-forward
+ :help "Forward to the position gone Back from")
+ 'prog-separator))
+
(unless (xref-marker-stack-empty-p)
(define-key-after menu [xref-pop]
- '(menu-item "Go Back" xref-pop-marker-stack
+ '(menu-item "Go Back" xref-go-back
:help "Back to the position of the last search")
'prog-separator))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 07093d61474..30f51704dca 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
;; Version: 0.8.1
-;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
+;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
;; not compatible with the version of Emacs recorded above.
@@ -322,7 +322,15 @@ to find the list of ignores for each directory."
(process-file-shell-command command nil t))
(pt (point-min)))
(unless (zerop status)
- (error "File listing failed: %s" (buffer-string)))
+ (goto-char (point-min))
+ (if (and
+ (not (eql status 127))
+ (search-forward "Permission denied\n" nil t))
+ (let ((end (1- (point))))
+ (re-search-backward "\\`\\|\0")
+ (error "File listing failed: %s"
+ (buffer-substring (1+ (point)) end)))
+ (error "File listing failed: %s" (buffer-string))))
(goto-char pt)
(while (search-forward "\0" nil t)
(push (buffer-substring-no-properties (1+ pt) (1- (point)))
@@ -374,6 +382,12 @@ you might have to restart Emacs to see the effect."
:package-version '(project . "0.2.0")
:safe #'booleanp)
+(defcustom project-vc-include-untracked t
+ "When non-nil, the VC project backend includes untracked files."
+ :type 'boolean
+ :version "29.1"
+ :safe #'booleanp)
+
;; FIXME: Using the current approach, major modes are supposed to set
;; this variable to a buffer-local value. So we don't have access to
;; the "external roots" of language A from buffers of language B, which
@@ -410,30 +424,33 @@ The directory names should be absolute. Used in the VC project
backend implementation of `project-external-roots'.")
(defun project-try-vc (dir)
- (let* ((backend
- ;; FIXME: This is slow. Cache it.
- (ignore-errors (vc-responsible-backend dir)))
- (root
- (pcase backend
- ('Git
- ;; Don't stop at submodule boundary.
- ;; FIXME: Cache for a shorter time.
- (or (vc-file-getprop dir 'project-git-root)
- (let ((root (vc-call-backend backend 'root dir)))
- (vc-file-setprop
- dir 'project-git-root
- (if (and
- ;; FIXME: Invalidate the cache when the value
- ;; of this variable changes.
- (project--vc-merge-submodules-p root)
- (project--submodule-p root))
- (let* ((parent (file-name-directory
- (directory-file-name root))))
- (vc-call-backend backend 'root parent))
- root)))))
- ('nil nil)
- (_ (ignore-errors (vc-call-backend backend 'root dir))))))
- (and root (cons 'vc root))))
+ (or (vc-file-getprop dir 'project-vc)
+ (let* ((backend (ignore-errors (vc-responsible-backend dir)))
+ (root
+ (pcase backend
+ ('Git
+ ;; Don't stop at submodule boundary.
+ (or (vc-file-getprop dir 'project-git-root)
+ (let ((root (vc-call-backend backend 'root dir)))
+ (vc-file-setprop
+ dir 'project-git-root
+ (if (and
+ ;; FIXME: Invalidate the cache when the value
+ ;; of this variable changes.
+ (project--vc-merge-submodules-p root)
+ (project--submodule-p root))
+ (let* ((parent (file-name-directory
+ (directory-file-name root))))
+ (vc-call-backend backend 'root parent))
+ root)))))
+ ('nil nil)
+ (_ (ignore-errors (vc-call-backend backend 'root dir)))))
+ project)
+ (when root
+ (setq project (list 'vc backend root))
+ ;; FIXME: Cache for a shorter time.
+ (vc-file-setprop dir 'project-vc project)
+ project))))
(defun project--submodule-p (root)
;; XXX: We only support Git submodules for now.
@@ -459,7 +476,7 @@ backend implementation of `project-external-roots'.")
(t nil))))
(cl-defmethod project-root ((project (head vc)))
- (cdr project))
+ (nth 2 project))
(cl-defmethod project-external-roots ((project (head vc)))
(project-subtract-directories
@@ -474,8 +491,8 @@ backend implementation of `project-external-roots'.")
(lambda (dir)
(let ((ignores (project--value-in-dir 'project-vc-ignores dir))
backend)
- (if (and (file-equal-p dir (cdr project))
- (setq backend (vc-responsible-backend dir))
+ (if (and (file-equal-p dir (nth 2 project))
+ (setq backend (cadr project))
(cond
((eq backend 'Hg))
((and (eq backend 'Git)
@@ -501,8 +518,9 @@ backend implementation of `project-external-roots'.")
(args '("-z"))
(vc-git-use-literal-pathspecs nil)
files)
- ;; Include unregistered.
- (setq args (append args '("-c" "-o" "--exclude-standard")))
+ (setq args (append args
+ '("-c" "--exclude-standard")
+ (and project-vc-include-untracked '("-o"))))
(when extra-ignores
(setq args (append args
(cons "--"
@@ -554,9 +572,9 @@ backend implementation of `project-external-roots'.")
(delete-consecutive-dups files)))
(`Hg
(let ((default-directory (expand-file-name (file-name-as-directory dir)))
- args)
- ;; Include unregistered.
- (setq args (nconc args '("-mcardu" "--no-status" "-0")))
+ (args (list (concat "-mcard" (and project-vc-include-untracked "u"))
+ "--no-status"
+ "-0")))
(when extra-ignores
(setq args (nconc args
(mapcan
@@ -581,17 +599,17 @@ backend implementation of `project-external-roots'.")
(insert-file-contents ".gitmodules")
(let (res)
(goto-char (point-min))
- (while (re-search-forward "path *= *\\(.+\\)" nil t)
+ (while (re-search-forward "^[ \t]*path *= *\\(.+\\)" nil t)
(push (match-string 1) res))
(nreverse res)))
(file-missing nil)))
(cl-defmethod project-ignores ((project (head vc)) dir)
- (let* ((root (cdr project))
+ (let* ((root (nth 2 project))
backend)
(append
(when (file-equal-p dir root)
- (setq backend (vc-responsible-backend root))
+ (setq backend (cadr project))
(delq
nil
(mapcar
@@ -768,7 +786,6 @@ The following commands are available:
(define-key tab-prefix-map "p" #'project-other-tab-command))
(declare-function grep-read-files "grep")
-(declare-function xref--show-xrefs "xref")
(declare-function xref--find-ignores-arguments "xref")
;;;###autoload
@@ -794,7 +811,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(project--files-in-directory dir
nil
(grep-read-files regexp))))))
- (xref--show-xrefs
+ (xref-show-xrefs
(apply-partially #'project--find-regexp-in-files regexp files)
nil)))
@@ -822,7 +839,7 @@ pattern to search for."
(project-files pr (cons
(project-root pr)
(project-external-roots pr)))))
- (xref--show-xrefs
+ (xref-show-xrefs
(apply-partially #'project--find-regexp-in-files regexp files)
nil)))
@@ -842,28 +859,40 @@ pattern to search for."
project-regexp-history-variable)))
;;;###autoload
-(defun project-find-file ()
+(defun project-find-file (&optional include-all)
"Visit a file (with completion) in the current project.
The filename at point (determined by `thing-at-point'), if any,
-is available as part of \"future history\"."
- (interactive)
+is available as part of \"future history\".
+
+If INCLUDE-ALL is non-nil, or with prefix argument when called
+interactively, include all files under the project root, except
+for VCS directories listed in `vc-directory-exclusion-list'."
+ (interactive "P")
(let* ((pr (project-current t))
- (dirs (list (project-root pr))))
- (project-find-file-in (thing-at-point 'filename) dirs pr)))
+ (root (project-root pr))
+ (dirs (list root)))
+ (project-find-file-in
+ (or (thing-at-point 'filename)
+ (and buffer-file-name (file-relative-name buffer-file-name root)))
+ dirs pr include-all)))
;;;###autoload
-(defun project-or-external-find-file ()
+(defun project-or-external-find-file (&optional include-all)
"Visit a file (with completion) in the current project or external roots.
The filename at point (determined by `thing-at-point'), if any,
-is available as part of \"future history\"."
- (interactive)
+is available as part of \"future history\".
+
+If INCLUDE-ALL is non-nil, or with prefix argument when called
+interactively, include all files under the project root, except
+for VCS directories listed in `vc-directory-exclusion-list'."
+ (interactive "P")
(let* ((pr (project-current t))
(dirs (cons
(project-root pr)
(project-external-roots pr))))
- (project-find-file-in (thing-at-point 'filename) dirs pr)))
+ (project-find-file-in (thing-at-point 'filename) dirs pr include-all)))
(defcustom project-read-file-name-function #'project--read-file-cpd-relative
"Function to call to read a file name from a list.
@@ -916,15 +945,28 @@ by the user at will."
predicate
hist mb-default))
-(defun project-find-file-in (suggested-filename dirs project)
+(defun project-find-file-in (suggested-filename dirs project &optional include-all)
"Complete a file name in DIRS in PROJECT and visit the result.
SUGGESTED-FILENAME is a relative file name, or part of it, which
-is used as part of \"future history\"."
- (let* ((all-files (project-files project dirs))
+is used as part of \"future history\".
+
+If INCLUDE-ALL is non-nil, or with prefix argument when called
+interactively, include all files from DIRS, except for VCS
+directories listed in `vc-directory-exclusion-list'."
+ (let* ((vc-dirs-ignores (mapcar
+ (lambda (dir)
+ (concat dir "/"))
+ vc-directory-exclusion-list))
+ (all-files
+ (if include-all
+ (mapcan
+ (lambda (dir) (project--files-in-directory dir vc-dirs-ignores))
+ dirs)
+ (project-files project dirs)))
(completion-ignore-case read-file-name-completion-ignore-case)
(file (funcall project-read-file-name-function
- "Find file" all-files nil nil
+ "Find file" all-files nil 'file-name-history
suggested-filename)))
(if (string= file "")
(user-error "You didn't specify the file")
@@ -961,7 +1003,7 @@ is used as part of \"future history\"."
"Dired"
;; Some completion UIs show duplicates.
(delete-dups all-dirs)
- nil nil)))
+ nil 'file-name-history)))
(dired dir)))
;;;###autoload
@@ -976,6 +1018,8 @@ is used as part of \"future history\"."
(interactive)
(vc-dir (project-root (project-current t))))
+(declare-function comint-check-proc "comint")
+
;;;###autoload
(defun project-shell ()
"Start an inferior shell in the current project's root directory.
@@ -984,11 +1028,14 @@ switch to it. Otherwise, create a new shell buffer.
With \\[universal-argument] prefix arg, create a new inferior shell buffer even
if one already exists."
(interactive)
+ (require 'comint)
(let* ((default-directory (project-root (project-current t)))
(default-project-shell-name (project-prefixed-buffer-name "shell"))
(shell-buffer (get-buffer default-project-shell-name)))
(if (and shell-buffer (not current-prefix-arg))
- (pop-to-buffer-same-window shell-buffer)
+ (if (comint-check-proc shell-buffer)
+ (pop-to-buffer shell-buffer (bound-and-true-p display-comint-buffer-action))
+ (shell shell-buffer))
(shell (generate-new-buffer-name default-project-shell-name)))))
;;;###autoload
@@ -1004,7 +1051,7 @@ if one already exists."
(eshell-buffer-name (project-prefixed-buffer-name "eshell"))
(eshell-buffer (get-buffer eshell-buffer-name)))
(if (and eshell-buffer (not current-prefix-arg))
- (pop-to-buffer-same-window eshell-buffer)
+ (pop-to-buffer eshell-buffer (bound-and-true-p display-comint-buffer-action))
(eshell t))))
;;;###autoload
@@ -1047,11 +1094,17 @@ type \\[help-command] at that time.
If you exit the `query-replace', you can later continue the
`query-replace' loop using the command \\[fileloop-continue]."
(interactive
- (pcase-let ((`(,from ,to)
- (query-replace-read-args "Query replace (regexp)" t t)))
- (list from to)))
+ (let ((query-replace-read-from-regexp-default 'find-tag-default-as-regexp))
+ (pcase-let ((`(,from ,to)
+ (query-replace-read-args "Query replace (regexp)" t t)))
+ (list from to))))
(fileloop-initialize-replace
- from to (project-files (project-current t)) 'default)
+ from to
+ ;; XXX: Filter out Git submodules, which are not regular files.
+ ;; `project-files' can return those, which is arguably suboptimal,
+ ;; but removing them eagerly has performance cost.
+ (cl-delete-if-not #'file-regular-p (project-files (project-current t)))
+ 'default)
(fileloop-continue))
(defvar compilation-read-command)
@@ -1087,6 +1140,29 @@ If non-nil, it overrides `compilation-buffer-name-function' for
compilation-buffer-name-function)))
(call-interactively #'compile)))
+(defcustom project-ignore-buffer-conditions nil
+ "List of conditions to filter the buffers to be switched to.
+If any of these conditions are satisfied for a buffer in the
+current project, `project-switch-to-buffer',
+`project-display-buffer' and `project-display-buffer-other-frame'
+ignore it.
+See the doc string of `project-kill-buffer-conditions' for the
+general form of conditions."
+ :type '(repeat (choice regexp function symbol
+ (cons :tag "Major mode"
+ (const major-mode) symbol)
+ (cons :tag "Derived mode"
+ (const derived-mode) symbol)
+ (cons :tag "Negation"
+ (const not) sexp)
+ (cons :tag "Conjunction"
+ (const and) sexp)
+ (cons :tag "Disjunction"
+ (const or) sexp)))
+ :version "29.1"
+ :group 'project
+ :package-version '(project . "0.8.2"))
+
(defun project--read-project-buffer ()
(let* ((pr (project-current t))
(current-buffer (current-buffer))
@@ -1096,7 +1172,10 @@ If non-nil, it overrides `compilation-buffer-name-function' for
(predicate
(lambda (buffer)
;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist.
- (memq (cdr buffer) buffers))))
+ (and (memq (cdr buffer) buffers)
+ (not
+ (project--buffer-check
+ (cdr buffer) project-ignore-buffer-conditions))))))
(read-buffer
"Switch to buffer: "
(when (funcall predicate (cons other-name other-buffer))
@@ -1150,7 +1229,10 @@ displayed."
(not (major-mode . help-mode)))
(derived-mode . compilation-mode)
(derived-mode . dired-mode)
- (derived-mode . diff-mode))
+ (derived-mode . diff-mode)
+ (derived-mode . comint-mode)
+ (derived-mode . eshell-mode)
+ (derived-mode . change-log-mode))
"List of conditions to kill buffers related to a project.
This list is used by `project-kill-buffers'.
Each condition is either:
@@ -1160,10 +1242,9 @@ Each condition is either:
- a cons-cell, where the car describes how to interpret the cdr.
The car can be one of the following:
* `major-mode': the buffer is killed if the buffer's major
- mode is eq to the cons-cell's cdr
+ mode is eq to the cons-cell's cdr.
* `derived-mode': the buffer is killed if the buffer's major
- mode is derived from the major mode denoted by the cons-cell's
- cdr
+ mode is derived from the major mode in the cons-cell's cdr.
* `not': the cdr is interpreted as a negation of a condition.
* `and': the cdr is a list of recursive conditions, that all have
to be met.
@@ -1183,9 +1264,18 @@ current project, it will be killed."
(const and) sexp)
(cons :tag "Disjunction"
(const or) sexp)))
- :version "28.1"
+ :version "29.1"
+ :group 'project
+ :package-version '(project . "0.8.2"))
+
+(defcustom project-kill-buffers-display-buffer-list nil
+ "Non-nil to display list of buffers to kill before killing project buffers.
+Used by `project-kill-buffers'."
+ :type 'boolean
+ :version "29.1"
:group 'project
- :package-version '(project . "0.6.0"))
+ :package-version '(project . "0.8.2")
+ :safe #'booleanp)
(defun project--buffer-list (pr)
"Return the list of all buffers in project PR."
@@ -1202,16 +1292,17 @@ current project, it will be killed."
(push buf bufs)))
(nreverse bufs)))
-(defun project--kill-buffer-check (buf conditions)
+(defun project--buffer-check (buf conditions)
"Check if buffer BUF matches any element of the list CONDITIONS.
-See `project-kill-buffer-conditions' for more details on the form
-of CONDITIONS."
- (catch 'kill
+See `project-kill-buffer-conditions' or
+`project-ignore-buffer-conditions' for more details on the
+form of CONDITIONS."
+ (catch 'match
(dolist (c conditions)
(when (cond
((stringp c)
(string-match-p c (buffer-name buf)))
- ((symbolp c)
+ ((functionp c)
(funcall c buf))
((eq (car-safe c) 'major-mode)
(eq (buffer-local-value 'major-mode buf)
@@ -1221,15 +1312,15 @@ of CONDITIONS."
(buffer-local-value 'major-mode buf)
(cdr c)))
((eq (car-safe c) 'not)
- (not (project--kill-buffer-check buf (cdr c))))
+ (not (project--buffer-check buf (cdr c))))
((eq (car-safe c) 'or)
- (project--kill-buffer-check buf (cdr c)))
+ (project--buffer-check buf (cdr c)))
((eq (car-safe c) 'and)
(seq-every-p
- (apply-partially #'project--kill-buffer-check
+ (apply-partially #'project--buffer-check
buf)
(mapcar #'list (cdr c)))))
- (throw 'kill t)))))
+ (throw 'match t)))))
(defun project--buffers-to-kill (pr)
"Return list of buffers in project PR to kill.
@@ -1237,7 +1328,7 @@ What buffers should or should not be killed is described
in `project-kill-buffer-conditions'."
(let (bufs)
(dolist (buf (project-buffers pr))
- (when (project--kill-buffer-check buf project-kill-buffer-conditions)
+ (when (project--buffer-check buf project-kill-buffer-conditions)
(push buf bufs)))
bufs))
@@ -1250,17 +1341,40 @@ identical. Only the buffers that match a condition in
`project-kill-buffer-conditions' will be killed. If NO-CONFIRM
is non-nil, the command will not ask the user for confirmation.
NO-CONFIRM is always nil when the command is invoked
-interactively."
+interactively.
+
+Also see the `project-kill-buffers-display-buffer-list' variable."
(interactive)
(let* ((pr (project-current t))
- (bufs (project--buffers-to-kill pr)))
+ (bufs (project--buffers-to-kill pr))
+ (query-user (lambda ()
+ (yes-or-no-p
+ (format "Kill %d buffers in %s? "
+ (length bufs)
+ (project-root pr))))))
(cond (no-confirm
(mapc #'kill-buffer bufs))
((null bufs)
(message "No buffers to kill"))
- ((yes-or-no-p (format "Kill %d buffers in %s? "
- (length bufs)
- (project-root pr)))
+ (project-kill-buffers-display-buffer-list
+ (when
+ (with-current-buffer-window
+ (get-buffer-create "*Buffer List*")
+ `(display-buffer--maybe-at-bottom
+ (dedicated . t)
+ (window-height . (fit-window-to-buffer))
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ (list-buffers-noselect nil bufs))))
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (funcall query-user)
+ (when (window-live-p window)
+ (quit-restore-window window 'kill))))))
+ (mapc #'kill-buffer bufs)))
+ ((funcall query-user)
(mapc #'kill-buffer bufs)))))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 6bc7ee408d5..5aba95d4c79 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -742,14 +742,6 @@ Relevant only when `prolog-imenu-flag' is non-nil."
:group 'prolog-other
:type 'boolean)
-(defcustom prolog-char-quote-workaround nil
- "If non-nil, declare 0 as a quote character to handle 0'<char>.
-This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
- :version "24.1"
- :group 'prolog-other
- :type 'boolean)
-(make-obsolete-variable 'prolog-char-quote-workaround nil "24.1")
-
;;-------------------------------------------------------------------
;; Internal variables
@@ -1303,7 +1295,7 @@ To find out what version of Prolog mode you are running, enter
(t t)))
;; This statement was missing in Emacs 24.1, 24.2, 24.3.
-(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1")
+(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1") ; "24.4" ; for grep
;;;###autoload
(defun run-prolog (arg)
"Run an inferior Prolog process, input and output via buffer *prolog*.
@@ -1355,8 +1347,6 @@ the variable `prolog-prompt-regexp'."
(error "This Prolog system has defined no interpreter"))
(unless (comint-check-proc "*prolog*")
(with-current-buffer (get-buffer-create "*prolog*")
- (prolog-inferior-mode)
-
;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier,
;; which assumes it is running under Emacs if either INFERIOR=yes or
;; if EMACS is set to a nonempty value. The EMACS setting is
@@ -1369,6 +1359,7 @@ the variable `prolog-prompt-regexp'."
(cons "INFERIOR=yes" process-environment))))
(apply 'make-comint-in-buffer "prolog" (current-buffer)
pname nil pswitches))
+ (prolog-inferior-mode)
(unless prolog-system
;; Setup auto-detection.
@@ -2484,11 +2475,8 @@ Interaction supports completion."
(if (eq (try-completion default prolog-info-alist) nil)
(setq default nil))
;; Read the PredSpec from the user
- (completing-read
- (if (zerop (length default))
- "Help on predicate: "
- (concat "Help on predicate (default " default "): "))
- prolog-info-alist nil t nil nil default)))
+ (completing-read (format-prompt "Help on predicate" default)
+ prolog-info-alist nil t nil nil default)))
(defun prolog-build-info-alist (&optional verbose)
"Build an alist of all builtins and library predicates.
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index f7f1784b172..1c99937c4b9 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -5,7 +5,7 @@
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; URL: https://github.com/fgallina/python.el
;; Version: 0.28
-;; Package-Requires: ((emacs "24.2") (cl-lib "1.0"))
+;; Package-Requires: ((emacs "24.4") (cl-lib "1.0"))
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
@@ -92,7 +92,7 @@
;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7.
;; See URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To
;; avoid this, the `python-shell-unbuffered' defaults to non-nil and
-;; controls whether `python-shell-calculate-process-environment'
+;; controls whether `python-shell--calculate-process-environment'
;; should set the "PYTHONUNBUFFERED" environment variable on startup:
;; See URL `https://docs.python.org/3/using/cmdline.html#cmdoption-u'.
@@ -149,7 +149,7 @@
;; (setq python-shell-process-environment
;; (list
;; (format "PATH=%s" (mapconcat
-;; 'identity
+;; #'identity
;; (reverse
;; (cons (getenv "PATH")
;; '("/path/to/env/bin/")))
@@ -245,10 +245,9 @@
(require 'ansi-color)
(require 'cl-lib)
(require 'comint)
-(require 'tramp-sh)
+(eval-when-compile (require 'subr-x)) ;For `string-empty-p'.
;; Avoid compiler warnings
-(defvar view-return-to-alist)
(defvar compilation-error-regexp-alist)
(defvar outline-heading-end-regexp)
@@ -273,39 +272,39 @@
(defvar python-mode-map
(let ((map (make-sparse-keymap)))
;; Movement
- (define-key map [remap backward-sentence] 'python-nav-backward-block)
- (define-key map [remap forward-sentence] 'python-nav-forward-block)
- (define-key map [remap backward-up-list] 'python-nav-backward-up-list)
- (define-key map [remap mark-defun] 'python-mark-defun)
- (define-key map "\C-c\C-j" 'imenu)
+ (define-key map [remap backward-sentence] #'python-nav-backward-block)
+ (define-key map [remap forward-sentence] #'python-nav-forward-block)
+ (define-key map [remap backward-up-list] #'python-nav-backward-up-list)
+ (define-key map [remap mark-defun] #'python-mark-defun)
+ (define-key map "\C-c\C-j" #'imenu)
;; Indent specific
- (define-key map "\177" 'python-indent-dedent-line-backspace)
- (define-key map (kbd "<backtab>") 'python-indent-dedent-line)
- (define-key map "\C-c<" 'python-indent-shift-left)
- (define-key map "\C-c>" 'python-indent-shift-right)
+ (define-key map "\177" #'python-indent-dedent-line-backspace)
+ (define-key map (kbd "<backtab>") #'python-indent-dedent-line)
+ (define-key map "\C-c<" #'python-indent-shift-left)
+ (define-key map "\C-c>" #'python-indent-shift-right)
;; Skeletons
- (define-key map "\C-c\C-tc" 'python-skeleton-class)
- (define-key map "\C-c\C-td" 'python-skeleton-def)
- (define-key map "\C-c\C-tf" 'python-skeleton-for)
- (define-key map "\C-c\C-ti" 'python-skeleton-if)
- (define-key map "\C-c\C-tm" 'python-skeleton-import)
- (define-key map "\C-c\C-tt" 'python-skeleton-try)
- (define-key map "\C-c\C-tw" 'python-skeleton-while)
+ (define-key map "\C-c\C-tc" #'python-skeleton-class)
+ (define-key map "\C-c\C-td" #'python-skeleton-def)
+ (define-key map "\C-c\C-tf" #'python-skeleton-for)
+ (define-key map "\C-c\C-ti" #'python-skeleton-if)
+ (define-key map "\C-c\C-tm" #'python-skeleton-import)
+ (define-key map "\C-c\C-tt" #'python-skeleton-try)
+ (define-key map "\C-c\C-tw" #'python-skeleton-while)
;; Shell interaction
- (define-key map "\C-c\C-p" 'run-python)
- (define-key map "\C-c\C-s" 'python-shell-send-string)
- (define-key map "\C-c\C-e" 'python-shell-send-statement)
- (define-key map "\C-c\C-r" 'python-shell-send-region)
- (define-key map "\C-\M-x" 'python-shell-send-defun)
- (define-key map "\C-c\C-c" 'python-shell-send-buffer)
- (define-key map "\C-c\C-l" 'python-shell-send-file)
- (define-key map "\C-c\C-z" 'python-shell-switch-to-shell)
+ (define-key map "\C-c\C-p" #'run-python)
+ (define-key map "\C-c\C-s" #'python-shell-send-string)
+ (define-key map "\C-c\C-e" #'python-shell-send-statement)
+ (define-key map "\C-c\C-r" #'python-shell-send-region)
+ (define-key map "\C-\M-x" #'python-shell-send-defun)
+ (define-key map "\C-c\C-c" #'python-shell-send-buffer)
+ (define-key map "\C-c\C-l" #'python-shell-send-file)
+ (define-key map "\C-c\C-z" #'python-shell-switch-to-shell)
;; Some util commands
- (define-key map "\C-c\C-v" 'python-check)
- (define-key map "\C-c\C-f" 'python-eldoc-at-point)
- (define-key map "\C-c\C-d" 'python-describe-at-point)
+ (define-key map "\C-c\C-v" #'python-check)
+ (define-key map "\C-c\C-f" #'python-eldoc-at-point)
+ (define-key map "\C-c\C-d" #'python-describe-at-point)
;; Utilities
- (substitute-key-definition 'complete-symbol 'completion-at-point
+ (substitute-key-definition #'complete-symbol #'completion-at-point
map global-map)
(easy-menu-define python-menu map "Python Mode menu"
'("Python"
@@ -359,9 +358,12 @@
(defmacro python-rx (&rest regexps)
"Python mode specialized rx macro.
This variant of `rx' supports common Python named REGEXPS."
- `(rx-let ((block-start (seq symbol-start
+ `(rx-let ((sp-bsnl (or space (and ?\\ ?\n)))
+ (block-start (seq symbol-start
(or "def" "class" "if" "elif" "else" "try"
"except" "finally" "for" "while" "with"
+ ;; Python 3.10+ PEP634
+ "match" "case"
;; Python 3.5+ PEP492
(and "async" (+ space)
(or "def" "for" "with")))
@@ -394,7 +396,7 @@ This variant of `rx' supports common Python named REGEXPS."
(open-paren (or "{" "[" "("))
(close-paren (or "}" "]" ")"))
(simple-operator (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%))
- (not-simple-operator (not simple-operator))
+ (not-simple-operator (not (or simple-operator ?\n)))
(operator (or "==" ">=" "is" "not"
"**" "//" "<<" ">>" "<=" "!="
"+" "-" "/" "&" "^" "~" "|" "*" "<" ">"
@@ -538,9 +540,9 @@ the {...} holes that appear within f-strings."
(setq ppss (syntax-ppss))))))
(defvar python-font-lock-keywords-level-1
- `((,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_))))
+ `((,(python-rx symbol-start "def" (1+ space) (group symbol-name))
(1 font-lock-function-name-face))
- (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_))))
+ (,(python-rx symbol-start "class" (1+ space) (group symbol-name))
(1 font-lock-type-face)))
"Font lock keywords to use in `python-mode' for level 1 decoration.
@@ -563,6 +565,8 @@ class declarations.")
;; Python 3.5+ PEP492
(and "async" (+ space) (or "def" "for" "with"))
"await"
+ ;; Python 3.10+
+ "match" "case"
;; Extra:
"self")
symbol-end)
@@ -601,15 +605,18 @@ builtins.")
(defun python-font-lock-assignment-matcher (regexp)
"Font lock matcher for assignments based on REGEXP.
-Return nil if REGEXP matched within a `paren' context (to avoid,
-e.g., default values for arguments or passing arguments by name
-being treated as assignments) or is followed by an '=' sign (to
-avoid '==' being treated as an assignment."
+Search for next occurrence if REGEXP matched within a `paren'
+context (to avoid, e.g., default values for arguments or passing
+arguments by name being treated as assignments) or is followed by
+an '=' sign (to avoid '==' being treated as an assignment. Set
+point to the position one character before the end of the
+occurrence found so that subsequent searches can detect the '='
+sign in chained assignment."
(lambda (limit)
- (let ((res (re-search-forward regexp limit t)))
- (unless (or (python-syntax-context 'paren)
- (equal (char-after (point)) ?=))
- res))))
+ (cl-loop while (re-search-forward regexp limit t)
+ unless (or (python-syntax-context 'paren)
+ (equal (char-after) ?=))
+ return (progn (backward-char) t))))
(defvar python-font-lock-keywords-maximum-decoration
`((python--font-lock-f-strings)
@@ -671,7 +678,7 @@ avoid '==' being treated as an assignment."
;; and variants thereof
;; the cases
;; (a) = 5
- ;; [a] = 5
+ ;; [a] = 5,
;; [*a] = 5, 6
;; are handled separately below
(,(python-font-lock-assignment-matcher
@@ -701,10 +708,11 @@ avoid '==' being treated as an assignment."
(1 font-lock-variable-name-face))
;; special cases
;; (a) = 5
- ;; [a] = 5
+ ;; [a] = 5,
;; [*a] = 5, 6
(,(python-font-lock-assignment-matcher
- (python-rx (or "[" "(") (* space)
+ (python-rx (or line-start ?\; ?=) (* space)
+ (or "[" "(") (* space)
grouped-assignment-target (* space)
(or ")" "]") (* space)
assignment-operator))
@@ -825,7 +833,6 @@ It makes underscores and dots word constituent chars.")
(defcustom python-indent-offset 4
"Default indentation offset for Python."
- :group 'python
:type 'integer
:safe 'integerp)
@@ -835,21 +842,18 @@ It makes underscores and dots word constituent chars.")
(defcustom python-indent-guess-indent-offset t
"Non-nil tells Python mode to guess `python-indent-offset' value."
:type 'boolean
- :group 'python
:safe 'booleanp)
(defcustom python-indent-guess-indent-offset-verbose t
"Non-nil means to emit a warning when indentation guessing fails."
:version "25.1"
:type 'boolean
- :group 'python
:safe' booleanp)
(defcustom python-indent-trigger-commands
'(indent-for-tab-command yas-expand yas/expand)
"Commands that might trigger a `python-indent-line' call."
- :type '(repeat symbol)
- :group 'python)
+ :type '(repeat symbol))
(defcustom python-indent-def-block-scale 2
"Multiplier applied to indentation inside multi-line def blocks."
@@ -1298,7 +1302,7 @@ Called from a program, START and END specify the region to indent."
;; Don't mess with strings, unless it's the
;; enclosing set of quotes or a docstring.
(or (not (python-syntax-context 'string))
- (eq
+ (equal
(syntax-after
(+ (1- (point))
(current-indentation)
@@ -1427,8 +1431,15 @@ marks the next defun after the ones already marked."
;;; Navigation
+(defcustom python-forward-sexp-function #'python-nav-forward-sexp
+ "Function to use when navigating between expressions."
+ :version "28.1"
+ :type '(choice (const :tag "Python blocks" python-nav-forward-sexp)
+ (const :tag "CC-mode like" nil)
+ function))
+
(defvar python-nav-beginning-of-defun-regexp
- (python-rx line-start (* space) defun (+ space) (group symbol-name))
+ (python-rx line-start (* space) defun (+ sp-bsnl) (group symbol-name))
"Regexp matching class or function definition.
The name of the defun should be grouped so it can be retrieved
via `match-string'.")
@@ -1443,26 +1454,34 @@ With positive ARG search backwards, else search forwards."
(line-beg-pos (line-beginning-position))
(line-content-start (+ line-beg-pos (current-indentation)))
(pos (point-marker))
+ (min-indentation (+ (current-indentation)
+ (if (python-info-looking-at-beginning-of-defun)
+ python-indent-offset 0)))
(body-indentation
(and (> arg 0)
(save-excursion
(while (and
- (not (python-info-looking-at-beginning-of-defun))
+ (or (not (python-info-looking-at-beginning-of-defun))
+ (>= (current-indentation) min-indentation))
+ (setq min-indentation
+ (min min-indentation (current-indentation)))
(python-nav-backward-block)))
(or (and (python-info-looking-at-beginning-of-defun)
(+ (current-indentation) python-indent-offset))
0))))
(found
(progn
- (when (and (python-info-looking-at-beginning-of-defun)
+ (when (and (python-info-looking-at-beginning-of-defun nil t)
(or (< arg 0)
;; If looking at beginning of defun, and if
;; pos is > line-content-start, ensure a
;; backward re search match this defun by
;; going to end of line before calling
;; re-search-fn bug#40563
- (and (> arg 0) (> pos line-content-start))))
- (end-of-line 1))
+ (and (> arg 0)
+ (or (python-info-continuation-line-p)
+ (> pos line-content-start)))))
+ (python-nav-end-of-statement))
(while (and (funcall re-search-fn
python-nav-beginning-of-defun-regexp nil t)
@@ -1472,14 +1491,18 @@ With positive ARG search backwards, else search forwards."
(and (> arg 0)
(not (= (current-indentation) 0))
(>= (current-indentation) body-indentation)))))
- (and (python-info-looking-at-beginning-of-defun)
+ (and (python-info-looking-at-beginning-of-defun nil t)
(or (not (= (line-number-at-pos pos)
(line-number-at-pos)))
(and (>= (point) line-beg-pos)
(<= (point) line-content-start)
(> pos line-content-start)))))))
(if found
- (or (beginning-of-line 1) t)
+ (progn
+ (when (< arg 0)
+ (python-nav-beginning-of-statement))
+ (beginning-of-line 1)
+ t)
(and (goto-char pos) nil))))
(defun python-nav-beginning-of-defun (&optional arg)
@@ -1518,7 +1541,10 @@ Returns nil if point is not in a def or class."
(python-util-forward-comment -1)
(forward-line 1)
;; Ensure point moves forward.
- (and (> beg-pos (point)) (goto-char beg-pos)))))
+ (and (> beg-pos (point)) (goto-char beg-pos))
+ ;; Return non-nil if we did something (because then we were in a
+ ;; def/class).
+ (/= beg-pos (point)))))
(defun python-nav--syntactically (fn poscompfn &optional contextfn)
"Move point using FN avoiding places with specific context.
@@ -1615,11 +1641,15 @@ of the statement."
(while (and (or noend (goto-char (line-end-position)))
(not (eobp))
(cond ((setq string-start (python-syntax-context 'string))
- ;; The assertion can only fail if syntax table
+ ;; The condition can be nil if syntax table
;; text properties and the `syntax-ppss' cache
;; are somehow out of whack. This has been
;; observed when using `syntax-ppss' during
;; narrowing.
+ ;; It can also fail in cases where the buffer is in
+ ;; the process of being modified, e.g. when creating
+ ;; a string with `electric-pair-mode' disabled such
+ ;; that there can be an unmatched single quote
(when (>= string-start last-string-end)
(goto-char string-start)
(if (python-syntax-context 'paren)
@@ -1702,7 +1732,10 @@ backward to previous statement."
(while (and (forward-line 1)
(not (eobp))
(or (and (> (current-indentation) block-indentation)
- (or (python-nav-end-of-statement) t))
+ (let ((start (point)))
+ (python-nav-end-of-statement)
+ ;; must move forward otherwise infinite loop
+ (> (point) start)))
(python-info-current-line-comment-p)
(python-info-current-line-empty-p))))
(python-util-forward-comment -1)
@@ -2018,7 +2051,6 @@ position, else returns nil."
(defcustom python-shell-buffer-name "Python"
"Default buffer name for Python interpreter."
:type 'string
- :group 'python
:safe 'stringp)
(defcustom python-shell-interpreter
@@ -2032,19 +2064,16 @@ Some Python interpreters also require changes to
`python-shell-interpreter' to \"ipython3\" requires setting
`python-shell-interpreter-args' to \"--simple-prompt\"."
:version "28.1"
- :type 'string
- :group 'python)
+ :type 'string)
(defcustom python-shell-internal-buffer-name "Python Internal"
"Default buffer name for the Internal Python interpreter."
:type 'string
- :group 'python
:safe 'stringp)
(defcustom python-shell-interpreter-args "-i"
"Default arguments for the Python interpreter."
- :type 'string
- :group 'python)
+ :type 'string)
(defcustom python-shell-interpreter-interactive-arg "-i"
"Interpreter argument to force it to run interactively."
@@ -2109,7 +2138,6 @@ It should not contain a caret (^) at the beginning."
"Should syntax highlighting be enabled in the Python shell buffer?
Restart the Python shell after changing this variable for it to take effect."
:type 'boolean
- :group 'python
:safe 'booleanp)
(defcustom python-shell-unbuffered t
@@ -2117,7 +2145,6 @@ Restart the Python shell after changing this variable for it to take effect."
When non-nil, this may prevent delayed and missing output in the
Python shell. See commentary for details."
:type 'boolean
- :group 'python
:safe 'booleanp)
(defcustom python-shell-process-environment nil
@@ -2127,8 +2154,7 @@ When this variable is non-nil, values are exported into the
process environment before starting it. Any variables already
present in the current environment are superseded by variables
set here."
- :type '(repeat string)
- :group 'python)
+ :type '(repeat string))
(defcustom python-shell-extra-pythonpaths nil
"List of extra pythonpaths for Python shell.
@@ -2137,8 +2163,7 @@ the PYTHONPATH before starting processes. Any values present
here that already exists in PYTHONPATH are moved to the beginning
of the list so that they are prioritized when looking for
modules."
- :type '(repeat string)
- :group 'python)
+ :type '(repeat string))
(defcustom python-shell-exec-path nil
"List of paths for searching executables.
@@ -2146,8 +2171,7 @@ When this variable is non-nil, values added at the beginning of
the PATH before starting processes. Any values present here that
already exists in PATH are moved to the beginning of the list so
that they are prioritized when looking for executables."
- :type '(repeat string)
- :group 'python)
+ :type '(repeat string))
(defcustom python-shell-remote-exec-path nil
"List of paths to be ensured remotely for searching executables.
@@ -2158,8 +2182,7 @@ here. Normally you won't use this variable directly unless you
plan to ensure a particular set of paths to all Python shell
executed through tramp connections."
:version "25.1"
- :type '(repeat string)
- :group 'python)
+ :type '(repeat string))
(define-obsolete-variable-alias
'python-shell-virtualenv-path 'python-shell-virtualenv-root "25.1")
@@ -2169,13 +2192,11 @@ executed through tramp connections."
This variable, when set to a string, makes the environment to be
modified such that shells are started within the specified
virtualenv."
- :type '(choice (const nil) directory)
- :group 'python)
+ :type '(choice (const nil) directory))
(defcustom python-shell-setup-codes nil
"List of code run by `python-shell-send-setup-code'."
- :type '(repeat symbol)
- :group 'python)
+ :type '(repeat symbol))
(defcustom python-shell-compilation-regexp-alist
`((,(rx line-start (1+ (any " \t")) "File \""
@@ -2189,8 +2210,7 @@ virtualenv."
"(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
1 2))
"`compilation-error-regexp-alist' for inferior Python."
- :type '(alist regexp)
- :group 'python)
+ :type '(alist regexp))
(defvar python-shell-output-filter-in-progress nil)
(defvar python-shell-output-filter-buffer nil)
@@ -2208,33 +2228,34 @@ virtualenv."
(or (getenv "PYTHONPATH") "") path-separator 'omit)))
(python-shell--add-to-path-with-priority
pythonpath python-shell-extra-pythonpaths)
- (mapconcat 'identity pythonpath path-separator)))
+ (mapconcat #'identity pythonpath path-separator)))
(defun python-shell-calculate-process-environment ()
- "Calculate `process-environment' or `tramp-remote-process-environment'.
+ (declare (obsolete python-shell--calculate-process-environment "29.1"))
+ (defvar tramp-remote-process-environment)
+ (let* ((remote-p (file-remote-p default-directory)))
+ (append (python-shell--calculate-process-environment)
+ (if remote-p
+ tramp-remote-process-environment
+ process-environment))))
+
+(defun python-shell--calculate-process-environment ()
+ "Return a list of entries to add to the `process-environment'.
Prepends `python-shell-process-environment', sets extra
pythonpaths from `python-shell-extra-pythonpaths' and sets a few
-virtualenv related vars. If `default-directory' points to a
-remote host, the returned value is intended for
-`tramp-remote-process-environment'."
- (let* ((remote-p (file-remote-p default-directory))
- (process-environment (if remote-p
- tramp-remote-process-environment
- process-environment))
- (virtualenv (when python-shell-virtualenv-root
- (directory-file-name python-shell-virtualenv-root))))
- (dolist (env python-shell-process-environment)
- (pcase-let ((`(,key ,value) (split-string env "=")))
- (setenv key value)))
+virtualenv related vars."
+ (let* ((virtualenv (when python-shell-virtualenv-root
+ (directory-file-name python-shell-virtualenv-root)))
+ (res python-shell-process-environment))
(when python-shell-unbuffered
- (setenv "PYTHONUNBUFFERED" "1"))
+ (push "PYTHONUNBUFFERED=1" res))
(when python-shell-extra-pythonpaths
- (setenv "PYTHONPATH" (python-shell-calculate-pythonpath)))
+ (push (concat "PYTHONPATH=" (python-shell-calculate-pythonpath)) res))
(if (not virtualenv)
- process-environment
- (setenv "PYTHONHOME" nil)
- (setenv "VIRTUAL_ENV" virtualenv))
- process-environment))
+ nil
+ (push "PYTHONHOME" res)
+ (push (concat "VIRTUAL_ENV=" virtualenv) res))
+ res))
(defun python-shell-calculate-exec-path ()
"Calculate `exec-path'.
@@ -2262,14 +2283,26 @@ of `exec-path'."
(defun python-shell-tramp-refresh-remote-path (vec paths)
"Update VEC's remote-path giving PATHS priority."
+ (cl-assert (featurep 'tramp))
+ (declare-function tramp-set-remote-path "tramp-sh")
+ (declare-function tramp-set-connection-property "tramp-cache")
+ (declare-function tramp-get-connection-property "tramp-cache")
(let ((remote-path (tramp-get-connection-property vec "remote-path" nil)))
(when remote-path
+ ;; FIXME: This part of the Tramp code still knows about Python!
(python-shell--add-to-path-with-priority remote-path paths)
(tramp-set-connection-property vec "remote-path" remote-path)
(tramp-set-remote-path vec))))
+
(defun python-shell-tramp-refresh-process-environment (vec env)
"Update VEC's process environment with ENV."
+ (cl-assert (featurep 'tramp))
+ (defvar tramp-end-of-heredoc)
+ (defvar tramp-end-of-output)
+ ;; Do we even know that `tramp-sh' is loaded at this point?
+ ;; What about files accessed via FTP, sudo, ...?
+ (declare-function tramp-send-command "tramp-sh")
;; Stolen from `tramp-open-connection-setup-interactive-shell'.
(let ((env (append (when (fboundp 'tramp-get-remote-locale)
;; Emacs<24.4 compat.
@@ -2282,7 +2315,7 @@ of `exec-path'."
unset vars item)
(while env
(setq item (split-string (car env) "=" 'omit))
- (setcdr item (mapconcat 'identity (cdr item) "="))
+ (setcdr item (mapconcat #'identity (cdr item) "="))
(if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
(push (format "%s %s" (car item) (cdr item)) vars)
(push (car item) unset))
@@ -2292,12 +2325,12 @@ of `exec-path'."
vec
(format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s"
tramp-end-of-heredoc
- (mapconcat 'identity vars "\n")
+ (mapconcat #'identity vars "\n")
tramp-end-of-heredoc)
t))
(when unset
(tramp-send-command
- vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
+ vec (format "unset %s" (mapconcat #'identity unset " ")) t))))
(defmacro python-shell-with-environment (&rest body)
"Modify shell environment during execution of BODY.
@@ -2306,41 +2339,49 @@ execution of body. If `default-directory' points to a remote
machine then modifies `tramp-remote-process-environment' and
`python-shell-remote-exec-path' instead."
(declare (indent 0) (debug (body)))
- (let ((vec (make-symbol "vec")))
- `(progn
- (let* ((,vec
- (when (file-remote-p default-directory)
- (ignore-errors
- (tramp-dissect-file-name default-directory 'noexpand))))
- (process-environment
- (if ,vec
- process-environment
- (python-shell-calculate-process-environment)))
- (exec-path
- (if ,vec
- exec-path
- (python-shell-calculate-exec-path)))
- (tramp-remote-process-environment
- (if ,vec
- (python-shell-calculate-process-environment)
- tramp-remote-process-environment)))
- (when (tramp-get-connection-process ,vec)
- ;; For already existing connections, the new exec path must
- ;; be re-set, otherwise it won't take effect. One example
- ;; of such case is when remote dir-locals are read and
- ;; *then* subprocesses are triggered within the same
- ;; connection.
- (python-shell-tramp-refresh-remote-path
- ,vec (python-shell-calculate-exec-path))
- ;; The `tramp-remote-process-environment' variable is only
- ;; effective when the started process is an interactive
- ;; shell, otherwise (like in the case of processes started
- ;; with `process-file') the environment is not changed.
- ;; This makes environment modifications effective
- ;; unconditionally.
- (python-shell-tramp-refresh-process-environment
- ,vec tramp-remote-process-environment))
- ,(macroexp-progn body)))))
+ `(python-shell--with-environment
+ (python-shell--calculate-process-environment)
+ (lambda () ,@body)))
+
+(defun python-shell--with-environment (extraenv bodyfun)
+ ;; FIXME: This is where the generic code delegates to Tramp.
+ (let* ((vec
+ (and (file-remote-p default-directory)
+ (fboundp 'tramp-dissect-file-name)
+ (ignore-errors
+ (tramp-dissect-file-name default-directory 'noexpand)))))
+ (if vec
+ (python-shell--tramp-with-environment vec extraenv bodyfun)
+ (let ((process-environment
+ (append extraenv process-environment))
+ (exec-path
+ ;; FIXME: This is still Python-specific.
+ (python-shell-calculate-exec-path)))
+ (funcall bodyfun)))))
+
+(defun python-shell--tramp-with-environment (vec extraenv bodyfun)
+ (defvar tramp-remote-process-environment)
+ (declare-function tramp-get-connection-process "tramp" (vec))
+ (let* ((tramp-remote-process-environment
+ (append extraenv tramp-remote-process-environment)))
+ (when (tramp-get-connection-process vec)
+ ;; For already existing connections, the new exec path must
+ ;; be re-set, otherwise it won't take effect. One example
+ ;; of such case is when remote dir-locals are read and
+ ;; *then* subprocesses are triggered within the same
+ ;; connection.
+ (python-shell-tramp-refresh-remote-path
+ ;; FIXME: This is still Python-specific.
+ vec (python-shell-calculate-exec-path))
+ ;; The `tramp-remote-process-environment' variable is only
+ ;; effective when the started process is an interactive
+ ;; shell, otherwise (like in the case of processes started
+ ;; with `process-file') the environment is not changed.
+ ;; This makes environment modifications effective
+ ;; unconditionally.
+ (python-shell-tramp-refresh-process-environment
+ vec tramp-remote-process-environment))
+ (funcall bodyfun)))
(defvar python-shell--prompt-calculated-input-regexp nil
"Calculated input prompt regexp for inferior python shell.
@@ -2623,12 +2664,13 @@ banner and the initial prompt are received separately."
(define-obsolete-function-alias
'python-comint-output-filter-function
- 'ansi-color-filter-apply
+ #'ansi-color-filter-apply
"25.1")
(defun python-comint-postoutput-scroll-to-bottom (output)
"Faster version of `comint-postoutput-scroll-to-bottom'.
Avoids `recenter' calls until OUTPUT is completely sent."
+ (declare (obsolete nil "29.1")) ; Not used.
(when (and (not (string= "" output))
(python-shell-comint-end-of-output-p
(ansi-color-filter-apply output)))
@@ -2721,20 +2763,12 @@ goes wrong and syntax highlighting in the shell gets messed up."
(deactivate-mark nil)
(start-pos prompt-end)
(buffer-undo-list t)
- (font-lock-buffer-pos nil)
(replacement
(python-shell-font-lock-with-font-lock-buffer
- (delete-region (line-beginning-position)
- (point-max))
- (setq font-lock-buffer-pos (point))
+ (delete-region (point-min) (point-max))
(insert input)
- ;; Ensure buffer is fontified, keeping it
- ;; compatible with Emacs < 24.4.
- (if (fboundp 'font-lock-ensure)
- (funcall 'font-lock-ensure)
- (font-lock-default-fontify-buffer))
- (buffer-substring font-lock-buffer-pos
- (point-max))))
+ (font-lock-ensure)
+ (buffer-string)))
(replacement-length (length replacement))
(i 0))
;; Inject text properties to get input fontified.
@@ -2816,8 +2850,7 @@ current process to not hang while waiting. This is useful to
safely attach setup code for long-running processes that
eventually provide a shell."
:version "25.1"
- :type 'hook
- :group 'python)
+ :type 'hook)
(defconst python-shell-eval-setup-code
"\
@@ -2943,15 +2976,15 @@ variable.
(setq-local comint-output-filter-functions
'(ansi-color-process-output
python-shell-comint-watch-for-first-prompt-output-filter
- python-comint-postoutput-scroll-to-bottom
comint-watch-for-password-prompt))
(setq-local comint-highlight-input nil)
(setq-local compilation-error-regexp-alist
python-shell-compilation-regexp-alist)
+ (setq-local scroll-conservatively 1)
(add-hook 'completion-at-point-functions
#'python-shell-completion-at-point nil 'local)
(define-key inferior-python-mode-map "\t"
- 'python-shell-completion-complete-or-indent)
+ #'python-shell-completion-complete-or-indent)
(make-local-variable 'python-shell-internal-last-output)
(when python-shell-font-lock-enable
(python-shell-font-lock-turn-on))
@@ -2977,7 +3010,8 @@ killed."
(let* ((cmdlist (split-string-and-unquote cmd))
(interpreter (car cmdlist))
(args (cdr cmdlist))
- (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name
+ (buffer (apply #'make-comint-in-buffer proc-name
+ proc-buffer-name
interpreter nil args))
(python-shell--parent-buffer (current-buffer))
(process (get-buffer-process buffer))
@@ -3075,7 +3109,8 @@ of `error' with a user-friendly message."
(or (python-shell-get-process)
(if interactivep
(user-error
- "Start a Python process first with `M-x run-python' or `%s'"
+ (substitute-command-keys
+ "Start a Python process first with \\`M-x run-python' or `%s'")
;; Get the binding.
(key-description
(where-is-internal
@@ -3126,7 +3161,7 @@ there for compatibility with CEDET.")
(run-python-internal))))
(define-obsolete-function-alias
- 'python-proc 'python-shell-internal-get-or-create-process "24.3")
+ 'python-proc #'python-shell-internal-get-or-create-process "24.3")
(defun python-shell--save-temp-file (string)
(let* ((temporary-file-directory
@@ -3211,11 +3246,13 @@ detecting a prompt at the end of the buffer."
(defun python-shell-send-string-no-output (string &optional process)
"Send STRING to PROCESS and inhibit output.
Return the output."
- (let ((process (or process (python-shell-get-process-or-error)))
- (comint-preoutput-filter-functions
- '(python-shell-output-filter))
- (python-shell-output-filter-in-progress t)
- (inhibit-quit t))
+ (or process (setq process (python-shell-get-process-or-error)))
+ (cl-letf (((process-filter process)
+ (lambda (_proc str)
+ (with-current-buffer (process-buffer process)
+ (python-shell-output-filter str))))
+ (python-shell-output-filter-in-progress t)
+ (inhibit-quit t))
(or
(with-local-quit
(python-shell-send-string string process)
@@ -3243,10 +3280,10 @@ Returns the output. See `python-shell-send-string-no-output'."
(python-shell-internal-get-or-create-process))))
(define-obsolete-function-alias
- 'python-send-receive 'python-shell-internal-send-string "24.3")
+ 'python-send-receive #'python-shell-internal-send-string "24.3")
(define-obsolete-function-alias
- 'python-send-string 'python-shell-internal-send-string "24.3")
+ 'python-send-string #'python-shell-internal-send-string "24.3")
(defun python-shell-buffer-substring (start end &optional nomain no-cookie)
"Send buffer substring from START to END formatted for shell.
@@ -3281,22 +3318,25 @@ the python shell:
(goto-char start)
(python-util-forward-comment 1)
(current-indentation))))
- (fillstr (and (not no-cookie)
- (not starts-at-point-min-p)
- (concat
- (format "# -*- coding: %s -*-\n" encoding)
- (make-string
- ;; Subtract 2 because of the coding cookie.
- (- (line-number-at-pos start) 2) ?\n)))))
+ (fillstr (cond (starts-at-point-min-p
+ nil)
+ ((not no-cookie)
+ (concat
+ (format "# -*- coding: %s -*-\n" encoding)
+ (make-string
+ ;; Subtract 2 because of the coding cookie.
+ (- (line-number-at-pos start) 2) ?\n)))
+ (t
+ (make-string (- (line-number-at-pos start) 1) ?\n)))))
(with-temp-buffer
(python-mode)
(when fillstr
(insert fillstr))
- (insert substring)
- (goto-char (point-min))
(when (not toplevel-p)
- (insert "if True:")
+ (forward-line -1)
+ (insert "if True:\n")
(delete-region (point) (line-end-position)))
+ (insert substring)
(when nomain
(let* ((if-name-main-start-end
(and nomain
@@ -3542,8 +3582,7 @@ def __PYTHON_EL_get_completions(text):
completer.print_mode = True
return completions"
"Code used to setup completion in inferior Python processes."
- :type 'string
- :group 'python)
+ :type 'string)
(define-obsolete-variable-alias
'python-shell-completion-module-string-code
@@ -3760,7 +3799,8 @@ With argument MSG show activation/deactivation message."
(format "was t and %S is not part of the "
(file-name-nondirectory python-shell-interpreter))
"`python-shell-completion-native-disabled-interpreters' "
- "list. Native completions have been disabled locally. "))
+ "list. Native completions have been disabled locally. "
+ "Consider installing the python package \"readline\". "))
(python-shell-completion-native-turn-off msg))))))
(defun python-shell-completion-native-turn-on-maybe-with-msg ()
@@ -3807,7 +3847,7 @@ With argument MSG show activation/deactivation message."
(comint-redirect-perform-sanity-check nil)
(comint-redirect-insert-matching-regexp t)
(comint-redirect-finished-regexp
- "1__dummy_completion__[[:space:]]*\n")
+ "1__dummy_completion__.*\n")
(comint-redirect-output-buffer redirect-buffer))
;; Compatibility with Emacs 24.x. Comint changed and
;; now `comint-redirect-filter' gets 3 args. This
@@ -3815,7 +3855,8 @@ With argument MSG show activation/deactivation message."
;; in use based on its args and uses `apply-partially'
;; to make it up for the 3 args case.
(if (= (length
- (help-function-arglist 'comint-redirect-filter)) 3)
+ (help-function-arglist 'comint-redirect-filter))
+ 3)
(set-process-filter
process (apply-partially
#'comint-redirect-filter original-filter-fn))
@@ -3924,7 +3965,7 @@ using that one instead of current buffer's process."
(define-obsolete-function-alias
'python-shell-completion-complete-at-point
- 'python-shell-completion-at-point
+ #'python-shell-completion-at-point
"25.1")
(defun python-shell-completion-complete-or-indent ()
@@ -3953,7 +3994,6 @@ considered over. The overlay arrow will be removed from the currently tracked
buffer. Additionally, if `python-pdbtrack-kill-buffers' is non-nil, all
files opened by pdbtracking will be killed."
:type 'boolean
- :group 'python
:safe 'booleanp)
(defcustom python-pdbtrack-stacktrace-info-regexp
@@ -4162,7 +4202,7 @@ inferior Python process is updated properly."
(define-obsolete-function-alias
'python-completion-complete-at-point
- 'python-completion-at-point
+ #'python-completion-at-point
"25.1")
@@ -4172,29 +4212,25 @@ inferior Python process is updated properly."
"Function to fill comments.
This is the function used by `python-fill-paragraph' to
fill comments."
- :type 'symbol
- :group 'python)
+ :type 'symbol)
(defcustom python-fill-string-function 'python-fill-string
"Function to fill strings.
This is the function used by `python-fill-paragraph' to
fill strings."
- :type 'symbol
- :group 'python)
+ :type 'symbol)
(defcustom python-fill-decorator-function 'python-fill-decorator
"Function to fill decorators.
This is the function used by `python-fill-paragraph' to
fill decorators."
- :type 'symbol
- :group 'python)
+ :type 'symbol)
(defcustom python-fill-paren-function 'python-fill-paren
"Function to fill parens.
This is the function used by `python-fill-paragraph' to
fill parens."
- :type 'symbol
- :group 'python)
+ :type 'symbol)
(defcustom python-fill-docstring-style 'pep-257
"Style used to fill docstrings.
@@ -4264,7 +4300,6 @@ value may result in one of the following docstring styles:
(const :tag "PEP-257 with 2 newlines at end of string." pep-257)
(const :tag "PEP-257 with 1 newline at end of string." pep-257-nn)
(const :tag "Symmetric style." symmetric))
- :group 'python
:safe (lambda (val)
(memq val '(django onetwo pep-257 pep-257-nn symmetric nil))))
@@ -4423,7 +4458,6 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
This happens when pressing \"if<SPACE>\", for example, to prompt for
the if condition."
:type 'boolean
- :group 'python
:safe 'booleanp)
(defvar python-skeleton-available '()
@@ -4548,7 +4582,7 @@ The skeleton will be bound to python-skeleton-NAME."
(defun python-skeleton-add-menu-items ()
"Add menu items to Python->Skeletons menu."
- (let ((skeletons (sort python-skeleton-available 'string<)))
+ (let ((skeletons (sort python-skeleton-available #'string<)))
(dolist (skeleton skeletons)
(easy-menu-add-item
nil '("Python" "Skeletons")
@@ -4578,8 +4612,7 @@ def __FFAP_get_module_path(objstr):
except:
return ''"
"Python code to get a module path."
- :type 'string
- :group 'python)
+ :type 'string)
(defun python-ffap-module-path (module)
"Function for `ffap-alist' to return path for MODULE."
@@ -4607,14 +4640,12 @@ def __FFAP_get_module_path(objstr):
(executable-find "epylint")
"install pyflakes, pylint or something else")
"Command used to check a Python file."
- :type 'string
- :group 'python)
+ :type 'string)
(defcustom python-check-buffer-name
"*Python check: %s*"
"Buffer name used for check commands."
- :type 'string
- :group 'python)
+ :type 'string)
(defvar python-check-custom-command nil
"Internal use.")
@@ -4667,7 +4698,10 @@ See `python-check-command' for the default."
target = obj
objtype = 'def'
if target:
- args = inspect.formatargspec(*argspec_function(target))
+ if hasattr(inspect, 'signature'):
+ args = str(inspect.signature(target))
+ else:
+ args = inspect.formatargspec(*argspec_function(target))
name = obj.__name__
doc = '{objtype} {name}{args}'.format(
objtype=objtype, name=name, args=args
@@ -4678,8 +4712,7 @@ See `python-check-command' for the default."
doc = ''
return doc"
"Python code to setup documentation retrieval."
- :type 'string
- :group 'python)
+ :type 'string)
(defun python-eldoc--get-symbol-at-point ()
"Get the current symbol for eldoc.
@@ -4726,14 +4759,13 @@ Set to nil by `python-eldoc-function' if
(defcustom python-eldoc-function-timeout 1
"Timeout for `python-eldoc-function' in seconds."
- :group 'python
:type 'integer
:version "25.1")
(defcustom python-eldoc-function-timeout-permanent t
- "Non-nil means that when `python-eldoc-function' times out
-`python-eldoc-get-doc' will be set to nil."
- :group 'python
+ "If non-nil, a timeout in Python-Eldoc will disable it permanently.
+Python-Eldoc can be re-enabled manually by setting `python-eldoc-get-doc'
+back to t in the affected buffer."
:type 'boolean
:version "25.1")
@@ -4766,10 +4798,14 @@ Interactively, prompt for symbol."
(interactive
(let ((symbol (python-eldoc--get-symbol-at-point))
(enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Describe symbol (default %s): " symbol)
- "Describe symbol: ")
- nil nil symbol))))
+ (list (read-string
+ ;; `format-prompt' is new in Emacs 28.1.
+ (if (fboundp 'format-prompt)
+ (format-prompt "Describe symbol" symbol)
+ (if symbol
+ (format "Describe symbol (default %s): " symbol)
+ "Describe symbol: "))
+ nil nil symbol))))
(message (python-eldoc--get-doc-at-point symbol)))
(defun python-describe-at-point (symbol process)
@@ -4921,7 +4957,7 @@ To this:
(\"decorator.wrapped_f\" . 393))"
;; Inspired by imenu--flatten-index-alist removed in revno 21853.
(apply
- 'nconc
+ #'nconc
(mapcar
(lambda (item)
(let ((name (if prefix
@@ -5004,7 +5040,7 @@ since it returns nil if point is not inside a defun."
(and (= (current-indentation) 0) (throw 'exit t))))
(and names
(concat (and type (format "%s " type))
- (mapconcat 'identity names ".")))))))
+ (mapconcat #'identity names ".")))))))
(defun python-info-current-symbol (&optional replace-self)
"Return current symbol using dotty syntax.
@@ -5025,9 +5061,10 @@ parent defun name."
(replace-regexp-in-string
(python-rx line-start word-start "self" word-end ?.)
(concat
- (mapconcat 'identity
+ (mapconcat #'identity
(butlast (split-string current-defun "\\."))
- ".") ".")
+ ".")
+ ".")
name)))))))
(defun python-info-statement-starts-block-p ()
@@ -5069,7 +5106,7 @@ parent defun name."
(define-obsolete-function-alias
'python-info-closing-block
- 'python-info-dedenter-opening-block-position "24.4")
+ #'python-info-dedenter-opening-block-position "24.4")
(defun python-info-dedenter-opening-block-position ()
"Return the point of the closest block the current line closes.
@@ -5114,7 +5151,8 @@ likely an invalid python file."
(let ((indentation (current-indentation)))
(when (and (not (memq indentation collected-indentations))
(or (not collected-indentations)
- (< indentation (apply #'min collected-indentations)))
+ (< indentation
+ (apply #'min collected-indentations)))
;; There must be no line with indentation
;; smaller than `indentation' (except for
;; blank lines) between the found opening
@@ -5142,7 +5180,7 @@ likely an invalid python file."
(define-obsolete-function-alias
'python-info-closing-block-message
- 'python-info-dedenter-opening-block-message "24.4")
+ #'python-info-dedenter-opening-block-message "24.4")
(defun python-info-dedenter-opening-block-message ()
"Message the first line of the block the current statement closes."
@@ -5267,10 +5305,15 @@ operator."
(forward-line -1)
(python-info-assignment-statement-p t))))
-(defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss)
- "Check if point is at `beginning-of-defun' using SYNTAX-PPSS."
+(defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss
+ check-statement)
+ "Check if point is at `beginning-of-defun' using SYNTAX-PPSS.
+When CHECK-STATEMENT is non-nil, the current statement is checked
+instead of the current physical line."
(and (not (python-syntax-context-type (or syntax-ppss (syntax-ppss))))
(save-excursion
+ (when check-statement
+ (python-nav-beginning-of-statement))
(beginning-of-line 1)
(looking-at python-nav-beginning-of-defun-regexp))))
@@ -5444,10 +5487,12 @@ allowed files."
(let ((dir-name (file-name-as-directory dir)))
(apply #'nconc
(mapcar (lambda (file-name)
- (let ((full-file-name (expand-file-name file-name dir-name)))
+ (let ((full-file-name
+ (expand-file-name file-name dir-name)))
(when (and
(not (member file-name '("." "..")))
- (funcall (or predicate #'identity) full-file-name))
+ (funcall (or predicate #'identity)
+ full-file-name))
(list full-file-name))))
(directory-files dir-name)))))
@@ -5515,7 +5560,6 @@ required arguments. Once launched it will receive the Python source to be
checked as its standard input.
To use `flake8' you would set this to (\"flake8\" \"-\")."
:version "26.1"
- :group 'python-flymake
:type '(repeat string))
;; The default regexp accommodates for older pyflakes, which did not
@@ -5537,7 +5581,6 @@ If COLUMN or TYPE are nil or that index didn't match, that
information is not present on the matched line and a default will
be used."
:version "26.1"
- :group 'python-flymake
:type '(list regexp
(integer :tag "Line's index")
(choice
@@ -5562,19 +5605,9 @@ configuration could be:
By default messages are considered errors."
:version "26.1"
- :group 'python-flymake
:type '(alist :key-type (regexp)
:value-type (symbol)))
-(defcustom python-forward-sexp-function #'python-nav-forward-sexp
- "Function to use when navigating between expressions."
- :version "28.1"
- :group 'python
- :group 'python-flymake
- :type '(choice (const :tag "Python blocks" python-nav-forward-sexp)
- (const :tag "CC-mode like" nil)
- function))
-
(defvar-local python--flymake-proc nil)
(defun python--flymake-parse-output (source proc report-fn)
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 72631a6557f..87bb92908d1 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -70,7 +70,7 @@
"Regexp to match modifiers.")
(defconst ruby-block-mid-keywords
- '("then" "else" "elsif" "when" "rescue" "ensure")
+ '("then" "else" "elsif" "when" "in" "rescue" "ensure")
"Keywords where the indentation gets shallower in middle of block statements.")
(defconst ruby-block-mid-re
@@ -325,6 +325,13 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
"Use `ruby-encoding-map' to set encoding magic comment if this is non-nil."
:type 'boolean :group 'ruby)
+(defcustom ruby-toggle-block-space-before-parameters t
+ "When non-nil, ensure space between the \"toggled\" curly and parameters.
+This only affects the output of the command `ruby-toggle-block'."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
;;; SMIE support
(require 'smie)
@@ -362,7 +369,9 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(for-body (for-head ";" insts))
(for-head (id "in" exp))
(cases (exp "then" insts)
- (cases "when" cases) (insts "else" insts))
+ (cases "when" cases)
+ (cases "in" cases)
+ (insts "else" insts))
(expseq (exp) );;(expseq "," expseq)
(hashvals (exp1 "=>" exp1) (hashvals "," hashvals))
(insts-rescue-insts (insts)
@@ -373,7 +382,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(if-body (ielsei) (if-body "elsif" if-body)))
'((nonassoc "in") (assoc ";") (right " @ ")
(assoc ",") (right "="))
- '((assoc "when"))
+ '((assoc "when" "in"))
'((assoc "elsif"))
'((assoc "rescue" "ensure"))
'((assoc ",")))
@@ -499,7 +508,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
((member tok '("unless" "if" "while" "until"))
(if (save-excursion (forward-word-strictly -1) (ruby-smie--bosp))
tok "iuwu-mod"))
- ((string-match-p "\\`|[*&]?\\'" tok)
+ ((string-match-p "\\`|[*&]*\\'" tok)
(forward-char (- 1 (length tok)))
(setq tok "|")
(cond
@@ -552,7 +561,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
((ruby-smie--closing-pipe-p) "closing-|")
(t tok)))
((string-match-p "\\`[^|]+|\\'" tok) "closing-|")
- ((string-match-p "\\`|[*&]\\'" tok)
+ ((string-match-p "\\`|[*&]*\\'" tok)
(forward-char 1)
(substring tok 1))
((and (equal tok "") (eq ?\\ (char-before)) (looking-at "\n"))
@@ -588,7 +597,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(cond
((smie-rule-parent-p "def" "begin" "do" "class" "module" "for"
"while" "until" "unless"
- "if" "then" "elsif" "else" "when"
+ "if" "then" "elsif" "else" "when" "in"
"rescue" "ensure" "{")
(smie-rule-parent ruby-indent-level))
;; For (invalid) code between switch and case.
@@ -652,7 +661,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
ruby-indent-level))))
(`(:before . ,(or "else" "then" "elsif" "rescue" "ensure"))
(smie-rule-parent))
- ('(:before . "when")
+ (`(:before . ,(or "when" "in"))
;; Align to the previous `when', but look up the virtual
;; indentation of `case'.
(if (smie-rule-sibling-p) 0 (smie-rule-parent)))
@@ -1722,13 +1731,14 @@ See `add-log-current-defun-function'."
(insert "}")
(goto-char orig)
(delete-char 2)
- ;; Maybe this should be customizable, let's see if anyone asks.
- (insert "{ ")
- (setq beg-marker (point-marker))
- (when (looking-at "\\s +|")
- (delete-char (- (match-end 0) (match-beginning 0) 1))
- (forward-char)
- (re-search-forward "|" (line-end-position) t))
+ (insert "{")
+ (if (looking-at "\\s +|")
+ (progn
+ (just-one-space (if ruby-toggle-block-space-before-parameters 1 0))
+ (setq beg-marker (point-marker))
+ (forward-char)
+ (re-search-forward "|" (line-end-position) t))
+ (setq beg-marker (point-marker)))
(save-excursion
(skip-chars-forward " \t\n\r")
(setq beg-pos (point))
@@ -2447,6 +2457,13 @@ If there is no Rubocop config file, Rubocop will be passed a flag
(setq-local beginning-of-defun-function #'ruby-beginning-of-defun)
(setq-local end-of-defun-function #'ruby-end-of-defun)
+ ;; `outline-regexp' contains the first part of `ruby-indent-beg-re'
+ (setq-local outline-regexp (concat "^\\s *"
+ (regexp-opt '("class" "module" "def"))
+ "\\_>"))
+ (setq-local outline-level (lambda () (1+ (/ (current-indentation)
+ ruby-indent-level))))
+
(add-hook 'after-save-hook #'ruby-mode-set-encoding nil 'local)
(add-hook 'electric-indent-functions #'ruby--electric-indent-p nil 'local)
(add-hook 'flymake-diagnostic-functions #'ruby-flymake-auto nil 'local)
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index a2689f17705..e0453c3b2f4 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -1,7 +1,6 @@
;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*-
-;; Copyright (C) 1986-1988, 1997-1998, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1986-2022 Free Software Foundation, Inc.
;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
;; Adapted-by: Dave Love <d.love@dl.ac.uk>
@@ -115,12 +114,53 @@
(define-abbrev-table 'scheme-mode-abbrev-table ())
(defvar scheme-imenu-generic-expression
- '((nil
- "^(define\\(?:-\\(?:generic\\(?:-procedure\\)?\\|method\\)\\)?\\s-+(?\\(\\sw+\\)" 1)
- ("Types"
- "^(define-class\\s-+(?\\(\\sw+\\)" 1)
- ("Macros"
- "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\sw+\\)" 2))
+ `((nil
+ ,(rx bol "(define"
+ (zero-or-one "*")
+ (zero-or-one "-public")
+ (one-or-more space)
+ (zero-or-one "(")
+ (group (one-or-more (or word (syntax symbol)))))
+ 1)
+ ("Methods"
+ ,(rx bol "(define-"
+ (or "generic" "method" "accessor")
+ (one-or-more space)
+ (zero-or-one "(")
+ (group (one-or-more (or word (syntax symbol)))))
+ 1)
+ ("Classes"
+ ,(rx bol "(define-class"
+ (one-or-more space)
+ (zero-or-one "(")
+ (group (one-or-more (or word (syntax symbol)))))
+ 1)
+ ("Records"
+ ,(rx bol "(define-record-type"
+ (zero-or-one "*")
+ (one-or-more space)
+ (group (one-or-more (or word (syntax symbol)))))
+ 1)
+ ("Conditions"
+ ,(rx bol "(define-condition-type"
+ (one-or-more space)
+ (group (one-or-more (or word (syntax symbol)))))
+ 1)
+ ("Modules"
+ ,(rx bol "(define-module"
+ (one-or-more space)
+ (group "(" (one-or-more any) ")"))
+ 1)
+ ("Macros"
+ ,(rx bol "("
+ (or (and "defmacro"
+ (zero-or-one "*")
+ (zero-or-one "-public"))
+ "define-macro" "define-syntax" "define-syntax-rule")
+ (one-or-more space)
+ (zero-or-one "(")
+ (group (one-or-more (or word (syntax symbol)))))
+ 1))
"Imenu generic expression for Scheme mode. See `imenu-generic-expression'.")
(defun scheme-mode-variables ()
@@ -143,7 +183,6 @@
(setq-local comment-start-skip ";+[ \t]*")
(setq-local comment-use-syntax t)
(setq-local comment-column 40)
- (setq-local parse-sexp-ignore-comments t)
(setq-local lisp-indent-function 'scheme-indent-function)
(setq mode-line-process '("" scheme-mode-line-process))
(setq-local imenu-case-fold-search t)
@@ -161,12 +200,10 @@
(defvar scheme-mode-line-process "")
-(defvar scheme-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map lisp-mode-shared-map)
- map)
- "Keymap for Scheme mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
+(defvar-keymap scheme-mode-map
+ :doc "Keymap for Scheme mode.
+All commands in `lisp-mode-shared-map' are inherited by this map."
+ :parent lisp-mode-shared-map)
(easy-menu-define scheme-mode-menu scheme-mode-map
"Menu for Scheme mode."
@@ -351,12 +388,18 @@ See `run-hooks'."
st))
(put 'lambda 'scheme-doc-string-elt 2)
+(put 'lambda* 'scheme-doc-string-elt 2)
;; Docstring's pos in a `define' depends on whether it's a var or fun def.
(put 'define 'scheme-doc-string-elt
(lambda ()
;; The function is called with point right after "define".
(forward-comment (point-max))
(if (eq (char-after) ?\() 2 0)))
+(put 'define* 'scheme-doc-string-elt 2)
+(put 'case-lambda 'scheme-doc-string-elt 1)
+(put 'case-lambda* 'scheme-doc-string-elt 1)
+(put 'define-syntax-rule 'scheme-doc-string-elt 2)
+(put 'syntax-rules 'scheme-doc-string-elt 2)
(defun scheme-syntax-propertize (beg end)
(goto-char beg)
@@ -522,10 +565,20 @@ indentation."
(lisp-indent-specform 2 state indent-point normal-indent)
(lisp-indent-specform 1 state indent-point normal-indent)))
-;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
-;; like defun if the first form is placed on the next line, otherwise
-;; it is indented like any other form (i.e. forms line up under first).
-
+;; See `scheme-indent-function' (the function) for what these do.
+;; In a nutshell:
+;; . for forms with no `scheme-indent-function' property the 2nd
+;; and subsequent lines will be indented with one space;
+;; . if the value of the property is zero, then when the first form
+;; is on a separate line, the next lines will be indented with 2
+;; spaces instead of the default one space;
+;; . if the value is a positive integer N, the first N lines after
+;; the first one will be indented with 4 spaces, and the rest
+;; will be indented with 2 spaces;
+;; . if the value is `defun', the indentation is like for `defun';
+;; . if the value is a function, it will be called to produce the
+;; required indentation.
+;; See also http://community.schemewiki.org/?emacs-indentation.
(put 'begin 'scheme-indent-function 0)
(put 'case 'scheme-indent-function 1)
(put 'delay 'scheme-indent-function 0)
@@ -536,12 +589,16 @@ indentation."
(put 'letrec 'scheme-indent-function 1)
(put 'let-values 'scheme-indent-function 1) ; SRFI 11
(put 'let*-values 'scheme-indent-function 1) ; SRFI 11
+(put 'and-let* 'scheme-indent-function 1) ; SRFI 2
(put 'sequence 'scheme-indent-function 0) ; SICP, not r4rs
(put 'let-syntax 'scheme-indent-function 1)
(put 'letrec-syntax 'scheme-indent-function 1)
-(put 'syntax-rules 'scheme-indent-function 1)
+(put 'syntax-rules 'scheme-indent-function 'defun)
(put 'syntax-case 'scheme-indent-function 2) ; not r5rs
+(put 'with-syntax 'scheme-indent-function 1)
(put 'library 'scheme-indent-function 1) ; R6RS
+;; Part of at least Guile, Chez Scheme, Chicken
+(put 'eval-when 'scheme-indent-function 1)
(put 'call-with-input-file 'scheme-indent-function 1)
(put 'call-with-port 'scheme-indent-function 1)
@@ -565,6 +622,14 @@ indentation."
;; SRFI-8
(put 'receive 'scheme-indent-function 2)
+;; SRFI-204 (withdrawn, but provided in many implementations, see the SRFI text)
+(put 'match 'scheme-indent-function 1)
+(put 'match-lambda 'scheme-indent-function 0)
+(put 'match-lambda* 'scheme-indent-function 0)
+(put 'match-let 'scheme-indent-function 'scheme-let-indent)
+(put 'match-let* 'scheme-indent-function 1)
+(put 'match-letrec 'scheme-indent-function 1)
+
;;;; MIT Scheme specific indentation.
(if scheme-mit-dialect
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 966357c0970..be9f325d93d 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -286,7 +286,7 @@ naming the shell."
:group 'sh-script)
(defcustom sh-imenu-generic-expression
- '((sh
+ `((sh
. ((nil
;; function FOO
;; function FOO()
@@ -295,8 +295,21 @@ naming the shell."
;; FOO()
(nil
"^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()"
- 1)
- )))
+ 1)))
+ (mksh
+ . ((nil
+ ;; function FOO
+ ;; function FOO()
+ ,(rx bol (* (syntax whitespace)) "function" (+ (syntax whitespace))
+ (group (1+ (not (any "\0\t\n \"$&'();<=>\\`|#*?[]/"))))
+ (* (syntax whitespace)) (? "()"))
+ 1)
+ (nil
+ ;; FOO()
+ ,(rx bol (* (syntax whitespace))
+ (group (1+ (not (any "\0\t\n \"$&'();<=>\\`|#*?[]/"))))
+ (* (syntax whitespace)) "()")
+ 1))))
"Alist of regular expressions for recognizing shell function definitions.
See `sh-feature' and `imenu-generic-expression'."
:type '(alist :key-type (symbol :tag "Shell")
@@ -306,7 +319,7 @@ See `sh-feature' and `imenu-generic-expression'."
:value-type
(repeat :tag "Regexp, index..." sexp)))
:group 'sh-script
- :version "20.4")
+ :version "29.1")
(defun sh-current-defun-name ()
"Find the name of function or variable at point.
@@ -402,45 +415,42 @@ This is buffer-local in every such buffer.")
(rpm . (,sh-mode-syntax-table ?\' ".")))
"Syntax-table used in Shell-Script mode. See `sh-feature'.")
-(defvar sh-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c(" 'sh-function)
- (define-key map "\C-c\C-w" 'sh-while)
- (define-key map "\C-c\C-u" 'sh-until)
- (define-key map "\C-c\C-t" 'sh-tmp-file)
- (define-key map "\C-c\C-s" 'sh-select)
- (define-key map "\C-c\C-r" 'sh-repeat)
- (define-key map "\C-c\C-o" 'sh-while-getopts)
- (define-key map "\C-c\C-l" 'sh-indexed-loop)
- (define-key map "\C-c\C-i" 'sh-if)
- (define-key map "\C-c\C-f" 'sh-for)
- (define-key map "\C-c\C-c" 'sh-case)
- (define-key map "\C-c?" #'smie-config-show-indent)
- (define-key map "\C-c=" #'smie-config-set-indent)
- (define-key map "\C-c<" #'smie-config-set-indent)
- (define-key map "\C-c>" #'smie-config-guess)
- (define-key map "\C-c\C-\\" 'sh-backslash-region)
-
- (define-key map "\C-c+" 'sh-add)
- (define-key map "\C-\M-x" 'sh-execute-region)
- (define-key map "\C-c\C-x" 'executable-interpret)
- (define-key map "\C-c\C-n" 'sh-send-line-or-region-and-step)
- (define-key map "\C-c\C-d" 'sh-cd-here)
- (define-key map "\C-c\C-z" 'sh-show-shell)
-
- (define-key map [remap delete-backward-char]
- 'backward-delete-char-untabify)
- (define-key map "\C-c:" 'sh-set-shell)
- (define-key map [remap backward-sentence] 'sh-beginning-of-command)
- (define-key map [remap forward-sentence] 'sh-end-of-command)
- map)
- "Keymap used in Shell-Script mode.")
+(defvar-keymap sh-mode-map
+ :doc "Keymap used in Shell-Script mode."
+ "C-c (" #'sh-function
+ "C-c C-w" #'sh-while
+ "C-c C-u" #'sh-until
+ "C-c C-t" #'sh-tmp-file
+ "C-c C-s" #'sh-select
+ "C-c C-r" #'sh-repeat
+ "C-c C-o" #'sh-while-getopts
+ "C-c C-l" #'sh-indexed-loop
+ "C-c C-i" #'sh-if
+ "C-c C-f" #'sh-for
+ "C-c C-c" #'sh-case
+ "C-c ?" #'smie-config-show-indent
+ "C-c =" #'smie-config-set-indent
+ "C-c <" #'smie-config-set-indent
+ "C-c >" #'smie-config-guess
+ "C-c C-\\" #'sh-backslash-region
+
+ "C-c +" #'sh-add
+ "C-M-x" #'sh-execute-region
+ "C-c C-x" #'executable-interpret
+ "C-c C-n" #'sh-send-line-or-region-and-step
+ "C-c C-d" #'sh-cd-here
+ "C-c C-z" #'sh-show-shell
+ "C-c :" #'sh-set-shell
+
+ "<remap> <delete-backward-char>" #'backward-delete-char-untabify
+ "<remap> <backward-sentence>" #'sh-beginning-of-command
+ "<remap> <forward-sentence>" #'sh-end-of-command)
(easy-menu-define sh-mode-menu sh-mode-map
"Menu for Shell-Script mode."
'("Sh-Script"
["Backslash region" sh-backslash-region
- :help "Insert, align, or delete end-of-line backslashes on the lines in the region."]
+ :help "Insert, align, or delete end-of-line backslashes on the lines in the region"]
["Set shell type..." sh-set-shell
:help "Set this buffer's shell to SHELL (a string)"]
["Execute script..." executable-interpret
@@ -458,7 +468,7 @@ This is buffer-local in every such buffer.")
["Select Statement" sh-select
:help "Insert a select statement "]
["Indexed Loop" sh-indexed-loop
- :help "Insert an indexed loop from 1 to n."]
+ :help "Insert an indexed loop from 1 to n"]
["Options Loop" sh-while-getopts
:help "Insert a while getopts loop."]
["While Loop" sh-while
@@ -482,7 +492,7 @@ This is buffer-local in every such buffer.")
["Show indentation" smie-config-show-indent
:help "Show the how the current line would be indented"]
["Learn buffer indentation" smie-config-guess
- :help "Learn how to indent the buffer the way it currently is."]))
+ :help "Learn how to indent the buffer the way it currently is"]))
(defvar sh-skeleton-pair-default-alist '((?\( _ ?\)) (?\))
(?\[ ?\s _ ?\s ?\]) (?\])
@@ -628,7 +638,8 @@ removed when closing the here document."
(wksh sh-append ksh88)
(zsh sh-append ksh88
- "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs"
+ "autoload" "always"
+ "bindkey" "builtin" "chdir" "compctl" "declare" "dirs"
"disable" "disown" "echotc" "enable" "functions" "getln" "hash"
"history" "integer" "limit" "local" "log" "popd" "pushd" "r"
"readonly" "rehash" "sched" "setopt" "source" "suspend" "true"
@@ -643,7 +654,12 @@ implemented as aliases. See `sh-feature'."
:version "24.4" ; bash4 additions
:group 'sh-script)
-
+(defcustom sh-indent-statement-after-and t
+ "How to indent statements following && in Shell-Script mode.
+If t, indent to align with &&.
+If nil, indent to align with the previous line's indentation."
+ :type 'boolean
+ :version "29.1")
(defcustom sh-leading-keywords
'((bash sh-append sh
@@ -866,7 +882,7 @@ See `sh-feature'.")
"\\(?:\\(?:.*[^\\\n]\\)?\\(?:\\\\\\\\\\)*\\\\\n\\)*.*")
(defconst sh-here-doc-open-re
- (concat "[^<]<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._]\\)+\\)"
+ (concat "[^<]<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._@]\\)+\\)"
sh-escaped-line-re "\\(\n\\)")))
(defun sh--inside-noncommand-expression (pos)
@@ -1140,8 +1156,8 @@ Can be set to a number, or to nil which means leave it as is."
"The default indentation increment.
This value is used for the `+' and `-' symbols in an indentation variable."
:type 'integer
+ :safe #'integerp
:group 'sh-indentation)
-(put 'sh-basic-offset 'safe-local-variable 'integerp)
(defcustom sh-indent-comment t
"How a comment line is to be indented.
@@ -1409,7 +1425,7 @@ If FORCE is non-nil and no process found, create one."
(defun sh-show-shell ()
"Pop the shell interaction buffer."
(interactive)
- (pop-to-buffer (process-buffer (sh-shell-process t))))
+ (pop-to-buffer (process-buffer (sh-shell-process t)) display-comint-buffer-action))
(defun sh-send-text (text)
"Send TEXT to `sh-shell-process'."
@@ -1540,6 +1556,11 @@ with your script for an edit-interpret-debug cycle."
(add-hook 'completion-at-point-functions
#'sh-completion-at-point-function nil t)
(setq-local outline-regexp "###")
+ (setq-local escaped-string-quote
+ (lambda (terminator)
+ (if (eq terminator ?')
+ "'\\'"
+ "\\")))
;; Parse or insert magic number for exec, and set all variables depending
;; on the shell thus determined.
(sh-set-shell
@@ -1551,7 +1572,7 @@ with your script for an edit-interpret-debug cycle."
;; Checks that use `buffer-file-name' follow.
((string-match "\\.m?spec\\'" buffer-file-name) "rpm")
((string-match "[.]sh\\>" buffer-file-name) "sh")
- ((string-match "[.]bash\\>" buffer-file-name) "bash")
+ ((string-match "[.]bash\\(rc\\)?\\>" buffer-file-name) "bash")
((string-match "[.]ksh\\>" buffer-file-name) "ksh")
((string-match "[.]mkshrc\\>" buffer-file-name) "mksh")
((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh")
@@ -1604,7 +1625,7 @@ This adds rules for comments and assignments."
;;; Completion
-(defvar sh--completion-keywords '("if" "while" "until" "for"))
+(defvar sh--completion-keywords '("if" "while" "until" "for" "then"))
(defun sh--vars-before-point ()
(save-excursion
@@ -1776,21 +1797,27 @@ Does not preserve point."
(n (skip-syntax-backward ".")))
(if (or (zerop n)
(and (eq n -1)
+ ;; Skip past quoted white space.
(let ((p (point)))
(if (eq -1 (% (skip-syntax-backward "\\") 2))
t
(goto-char p)
nil))))
(while
- (progn (skip-syntax-backward ".w_'")
- (or (not (zerop (skip-syntax-backward "\\")))
- (when (eq ?\\ (char-before (1- (point))))
- (let ((p (point)))
- (forward-char -1)
- (if (eq -1 (% (skip-syntax-backward "\\") 2))
- t
- (goto-char p)
- nil))))))
+ (progn
+ ;; Skip past words, but stop at semicolons.
+ (while (and (not (zerop (skip-syntax-backward "w_'")))
+ (not (eq (char-before (point)) ?\;))
+ (skip-syntax-backward ".")))
+ (or (not (zerop (skip-syntax-backward "\\")))
+ ;; Skip past quoted white space.
+ (when (eq ?\\ (char-before (1- (point))))
+ (let ((p (point)))
+ (forward-char -1)
+ (if (eq -1 (% (skip-syntax-backward "\\") 2))
+ t
+ (goto-char p)
+ nil))))))
(goto-char (- (point) (% (skip-syntax-backward "\\") 2))))
(buffer-substring-no-properties (point) pos)))
@@ -1899,9 +1926,9 @@ With t, you get the latter as long as that would indent the continuation line
deeper than the initial line."
:version "25.1"
:type '(choice
- (const nil :tag "Never")
- (const t :tag "Only if needed to make it deeper")
- (const always :tag "Always"))
+ (const :value nil :tag "Never")
+ (const :value t :tag "Only if needed to make it deeper")
+ (const :value always :tag "Always"))
:group 'sh-indentation)
(defun sh-smie--continuation-start-indent ()
@@ -1975,7 +2002,7 @@ May return nil if the line should not be treated as continued."
(cons 'column (smie-indent-keyword ";"))
(smie-rule-separator kind)))
(`(:after . ,(or ";;" ";&" ";;&"))
- (with-demoted-errors
+ (with-demoted-errors "SMIE rule error: %S"
(smie-backward-sexp token)
(cons 'column
(if (or (smie-rule-bolp)
@@ -1986,7 +2013,9 @@ May return nil if the line should not be treated as continued."
(current-column)
(smie-indent-calculate)))))
(`(:before . ,(or "|" "&&" "||"))
- (unless (smie-rule-parent-p token)
+ (when (and (not (smie-rule-parent-p token))
+ (or (not (equal token "&&"))
+ sh-indent-statement-after-and))
(smie-backward-sexp token)
`(column . ,(+ (funcall smie-rules-function :elem 'basic)
(smie-indent-virtual)))))
@@ -2381,6 +2410,8 @@ Lines containing only comments are considered empty."
The working directory is that of the buffer, and only environment variables
are already set which is why you can mark a header within the script.
+The executed subshell is `sh-shell-file'.
+
With a positive prefix ARG, instead of sending region, define header from
beginning of buffer to point. With a negative prefix ARG, instead of sending
region, clear header."
@@ -2388,17 +2419,18 @@ region, clear header."
(if flag
(setq sh-header-marker (if (> (prefix-numeric-value flag) 0)
(point-marker)))
- (if sh-header-marker
- (save-excursion
- (let (buffer-undo-list)
- (goto-char sh-header-marker)
- (append-to-buffer (current-buffer) start end)
- (shell-command-on-region (point-min)
- (setq end (+ sh-header-marker
- (- end start)))
- sh-shell-file)
- (delete-region sh-header-marker end)))
- (shell-command-on-region start end (concat sh-shell-file " -")))))
+ (let ((shell-file-name sh-shell-file))
+ (if sh-header-marker
+ (save-excursion
+ (let (buffer-undo-list)
+ (goto-char sh-header-marker)
+ (append-to-buffer (current-buffer) start end)
+ (shell-command-on-region (point-min)
+ (setq end (+ sh-header-marker
+ (- end start)))
+ sh-shell-file)
+ (delete-region sh-header-marker end)))
+ (shell-command-on-region start end (concat sh-shell-file " -"))))))
(defun sh-remember-variable (var)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 6183aee20e3..b950f93f2a0 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -274,8 +274,8 @@ file. Since that is a plaintext file, this could be dangerous."
(defcustom sql-port 0
"Default port for connecting to a MySQL or Postgres server."
:version "24.1"
- :type 'number
- :safe 'numberp)
+ :type 'natnum
+ :safe 'natnump)
(defcustom sql-default-directory nil
"Default directory for SQL processes."
@@ -481,9 +481,9 @@ file. Since that is a plaintext file, this could be dangerous."
:list-all ("\\d+" . "\\dS+")
:list-table ("\\d+ %s" . "\\dS+ %s")
:completion-object sql-postgres-completion-object
- :prompt-regexp "^[[:alnum:]_]*=[#>] "
+ :prompt-regexp "^[-[:alnum:]_]*[-=][#>] "
:prompt-length 5
- :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] "
+ :prompt-cont-regexp "^[-[:alnum:]_]*[-'(][#>] "
:statement sql-postgres-statement-starters
:input-filter sql-remove-tabs-filter
:terminator ("\\(^\\s-*\\\\g\\|;\\)" . "\\g"))
@@ -700,8 +700,17 @@ making new SQLi sessions."
(sexp :tag "Value Expression")))))
:version "24.1")
-(defvaralias 'sql-dialect 'sql-product)
+(defun sql-add-connection (connection params)
+ "Add a new connection to `sql-connection-alist'.
+If CONNECTION already exists, it is replaced with PARAMS."
+ (setq sql-connection-alist
+ (assoc-delete-all connection sql-connection-alist))
+ (push
+ (cons connection params)
+ sql-connection-alist))
+
+(defvaralias 'sql-dialect 'sql-product)
(defcustom sql-product 'ansi
"Select the SQL database product used.
This allows highlighting buffers properly when you open them."
@@ -963,12 +972,7 @@ If set to \"\\n\", each line in the history file will be interpreted as
one command. Multi-line commands are split into several commands when
the input ring is initialized from a history file.
-This variable used to initialize `comint-input-ring-separator'.
-`comint-input-ring-separator' is part of Emacs 21; if your Emacs
-does not have it, setting `sql-input-ring-separator' will have no
-effect. In that case multiline commands will be split into several
-commands when the input history is read, as if you had set
-`sql-input-ring-separator' to \"\\n\"."
+This variable used to initialize `comint-input-ring-separator'."
:type 'string)
;; The usual hooks
@@ -1357,8 +1361,6 @@ specified, it's `sql-product' or `sql-connection' must match."
(defvar sql-interactive-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map comint-mode-map)
- (if (fboundp 'set-keymap-name)
- (set-keymap-name map 'sql-interactive-mode-map)); XEmacs
(define-key map (kbd "C-j") 'sql-accumulate-and-indent)
(define-key map (kbd "C-c C-w") 'sql-copy-column)
(define-key map (kbd "O") 'sql-magic-go)
@@ -2832,16 +2834,6 @@ configured."
(font-lock-mode-internal nil)
(font-lock-mode-internal t))
- (add-hook 'font-lock-mode-hook
- (lambda ()
- ;; Provide defaults for new font-lock faces.
- (defvar font-lock-builtin-face
- (if (boundp 'font-lock-preprocessor-face)
- font-lock-preprocessor-face
- font-lock-keyword-face))
- (defvar font-lock-doc-face font-lock-string-face))
- nil t)
-
;; Setup imenu; it needs the same syntax-alist.
(when imenu
(setq imenu-syntax-alist syntax-alist))))
@@ -3219,19 +3211,12 @@ For both `:file' and `:completion', there can also be a
symbol
(let* ((default (plist-get plist :default))
(last-value (sql-default-value symbol))
- (prompt-def
- (if default
- (if (string-match "\\(\\):[ \t]*\\'" prompt)
- (replace-match (format " (default \"%s\")" default) t t prompt 1)
- (replace-regexp-in-string "[ \t]*\\'"
- (format " (default \"%s\") " default)
- prompt t t))
- prompt))
+ (prompt-def (format-prompt prompt default))
(use-dialog-box nil))
(cond
((plist-member plist :file)
(let ((file-name
- (read-file-name prompt
+ (read-file-name prompt-def
(file-name-directory last-value)
default
(if (plist-member plist :must-match)
@@ -3261,7 +3246,7 @@ For both `:file' and `:completion', there can also be a
default))
((plist-get plist :number)
- (read-number prompt (or default last-value 0)))
+ (read-number (concat prompt ": ") (or default last-value 0)))
(t
(read-string prompt-def last-value history-var default))))))
@@ -3311,7 +3296,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)."
(let ((plist (cdr-safe w)))
(pcase (or (car-safe w) w)
('user
- (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist))
+ (sql-get-login-ext 'sql-user "User" 'sql-user-history plist))
('password
(setq-default sql-password
@@ -3330,14 +3315,14 @@ function like this: (sql-get-login \\='user \\='password \\='database)."
(read-passwd "Password: " nil (sql-default-value 'sql-password)))))
('server
- (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
+ (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist))
('database
- (sql-get-login-ext 'sql-database "Database: "
+ (sql-get-login-ext 'sql-database "Database"
'sql-database-history plist))
('port
- (sql-get-login-ext 'sql-port "Port: "
+ (sql-get-login-ext 'sql-port "Port"
nil (append '(:number t) plist)))))))
(defun sql-find-sqli-buffer (&optional product connection)
@@ -3663,94 +3648,69 @@ Allows the suppression of continuation prompts.")
(defvar sql-preoutput-hold nil)
-(defun sql-starts-with-prompt-re ()
- "Anchor the prompt expression at the beginning of the output line.
-Remove the start of line regexp."
- (concat "\\`" comint-prompt-regexp))
-
-(defun sql-ends-with-prompt-re ()
- "Anchor the prompt expression at the end of the output line.
-Match a SQL prompt or a password prompt."
- (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|"
- "\\(?:" comint-password-prompt-regexp "\\)\\)\\'"))
-
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
Added to the `comint-preoutput-filter-functions' hook in a SQL
-interactive buffer. If `sql-output-newline-count' is greater than
-zero, then an output line matching the continuation prompt is filtered
-out. If the count is zero, then a newline is inserted into the output
-to force the output from the query to appear on a new line.
-
-The complication to this filter is that the continuation prompts
-may arrive in multiple chunks. If they do, then the function
-saves any unfiltered output in a buffer and prepends that buffer
-to the next chunk to properly match the broken-up prompt.
-
-If the filter gets confused, it should reset and stop filtering
-to avoid deleting non-prompt output."
-
- ;; continue gathering lines of text iff
- ;; + we know what a prompt looks like, and
- ;; + there is held text, or
- ;; + there are continuation prompt yet to come, or
- ;; + not just a prompt string
+interactive buffer. The complication to this filter is that the
+continuation prompts may arrive in multiple chunks. If they do,
+then the function saves any unfiltered output in a buffer and
+prepends that buffer to the next chunk to properly match the
+broken-up prompt.
+
+The filter goes into play only if something is already
+accumulated, or we're waiting for continuation
+prompts (`sql-output-newline-count' is positive). In this case:
+- Accumulate process output into `sql-preoutput-hold'.
+- Remove any complete prompts / continuation prompts that we're waiting
+ for.
+- In case we're expecting more prompts - return all currently
+ accumulated _complete_ lines, leaving the rest for the next
+ invocation. They will appear in the output immediately. This way we
+ don't accumulate large chunks of data for no reason.
+- If we found all expected prompts - just return all current accumulated
+ data."
(when (and comint-prompt-regexp
- (or (> (length (or sql-preoutput-hold "")) 0)
- (> (or sql-output-newline-count 0) 0)
- (not (or (string-match sql-prompt-regexp oline)
- (and sql-prompt-cont-regexp
- (string-match sql-prompt-cont-regexp oline))))))
-
+ ;; We either already have something held, or expect
+ ;; prompts
+ (or sql-preoutput-hold
+ (and sql-output-newline-count
+ (> sql-output-newline-count 0))))
(save-match-data
- (let (prompt-found last-nl)
-
- ;; Add this text to what's left from the last pass
- (setq oline (concat sql-preoutput-hold oline)
- sql-preoutput-hold "")
-
- ;; If we are looking for multiple prompts
- (when (and (integerp sql-output-newline-count)
- (>= sql-output-newline-count 1))
- ;; Loop thru each starting prompt and remove it
- (let ((start-re (sql-starts-with-prompt-re)))
- (while (and (not (string= oline ""))
- (> sql-output-newline-count 0)
- (string-match start-re oline))
- (setq oline (replace-match "" nil nil oline)
- sql-output-newline-count (1- sql-output-newline-count)
- prompt-found t)))
-
- ;; If we've found all the expected prompts, stop looking
- (if (= sql-output-newline-count 0)
- (setq sql-output-newline-count nil)
-
- ;; Still more possible prompts, leave them for the next pass
- (setq sql-preoutput-hold oline
- oline "")))
-
- ;; If no prompts were found, stop looking
- (unless prompt-found
- (setq sql-output-newline-count nil
- oline (concat oline sql-preoutput-hold)
- sql-preoutput-hold ""))
-
- ;; Break up output by physical lines if we haven't hit the final prompt
- (let ((end-re (sql-ends-with-prompt-re)))
- (unless (and (not (string= oline ""))
- (string-match end-re oline)
- (>= (match-end 0) (length oline)))
- ;; Find everything upto the last nl
- (setq last-nl 0)
- (while (string-match "\n" oline last-nl)
- (setq last-nl (match-end 0)))
- ;; Hold after the last nl, return upto last nl
- (setq sql-preoutput-hold (concat (substring oline last-nl)
- sql-preoutput-hold)
- oline (substring oline 0 last-nl)))))))
+ ;; Add this text to what's left from the last pass
+ (setq oline (concat sql-preoutput-hold oline)
+ sql-preoutput-hold nil)
+
+ ;; If we are looking for prompts
+ (when (and sql-output-newline-count
+ (> sql-output-newline-count 0))
+ ;; Loop thru each starting prompt and remove it
+ (while (and (not (string-empty-p oline))
+ (> sql-output-newline-count 0)
+ (string-match comint-prompt-regexp oline))
+ (setq oline (replace-match "" nil nil oline)
+ sql-output-newline-count (1- sql-output-newline-count)))
+
+ ;; If we've found all the expected prompts, stop looking
+ (if (= sql-output-newline-count 0)
+ (setq sql-output-newline-count nil)
+ ;; Still more possible prompts, leave them for the next pass
+ (setq sql-preoutput-hold oline
+ oline "")))
+
+ ;; Lines that are now complete may be passed further
+ (when sql-preoutput-hold
+ (let ((last-nl 0))
+ (while (string-match "\n" sql-preoutput-hold last-nl)
+ (setq last-nl (match-end 0)))
+ ;; Return up to last nl, hold after the last nl
+ (setq oline (substring sql-preoutput-hold 0 last-nl)
+ sql-preoutput-hold (substring sql-preoutput-hold last-nl))
+ (when (string-empty-p sql-preoutput-hold)
+ (setq sql-preoutput-hold nil))))))
oline)
+
;;; Sending the region to the SQLi buffer.
(defvar sql-debug-send nil
"Display text sent to SQL process pragmatically.")
@@ -4182,10 +4142,6 @@ must tell Emacs. Here's how to do that in your init file:
(modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))"
:abbrev-table sql-mode-abbrev-table
- (when (and (featurep 'xemacs)
- sql-mode-menu)
- (easy-menu-add sql-mode-menu))
-
;; (smie-setup sql-smie-grammar #'sql-smie-rules)
(setq-local comment-start "--")
;; Make each buffer in sql-mode remember the "current" SQLi buffer.
@@ -4203,18 +4159,35 @@ must tell Emacs. Here's how to do that in your init file:
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(setq-local sql-contains-names t)
+ (setq-local escaped-string-quote "'")
(setq-local syntax-propertize-function
- (syntax-propertize-rules
- ;; Handle escaped apostrophes within strings.
- ("''"
- (0
- (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0))))
- (string-to-syntax ".")
- (forward-char -1)
- nil)))
- ;; Propertize rules to not have /- and -* start comments.
- ("\\(/-\\)" (1 "."))
- ("\\(-\\*\\)" (1 "."))))
+ (eval
+ '(syntax-propertize-rules
+ ;; Handle escaped apostrophes within strings.
+ ((if (eq sql-product 'mysql)
+ "\\\\'"
+ "''")
+ (0
+ (if (save-excursion
+ (nth 3 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax ".")
+ (forward-char -1)
+ nil)))
+ ;; Propertize rules to not have /- and -* start comments.
+ ("\\(/-\\)" (1 "."))
+ ("\\(-\\*\\)"
+ (1
+ (if (save-excursion
+ (not (ppss-comment-depth
+ (syntax-ppss (match-beginning 1)))))
+ ;; If we're outside a comment, we don't let -*
+ ;; start a comment.
+ (string-to-syntax ".")
+ ;; Inside a comment, ignore it to avoid -*/ not
+ ;; being interpreted as a comment end.
+ (forward-char -1)
+ nil))))
+ t))
;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
(sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
@@ -4308,9 +4281,6 @@ you entered, right above the output it created.
(setq mode-name
(concat "SQLi[" (or (sql-get-product-feature sql-product :name)
(symbol-name sql-product)) "]"))
- (when (and (featurep 'xemacs)
- sql-interactive-mode-menu)
- (easy-menu-add sql-interactive-mode-menu))
;; Note that making KEYWORDS-ONLY nil will cause havoc if you try
;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column
@@ -4655,6 +4625,9 @@ the call to \\[sql-product-interactive] with
(setq sql-buffer (buffer-name new-sqli-buffer))
(run-hooks 'sql-set-sqli-hook)))
+ ;; Also set the global value.
+ (setq-default sql-buffer (buffer-name new-sqli-buffer))
+
;; Make sure the connection is complete
;; (Sometimes start up can be slow)
;; and call the login hook
@@ -4681,6 +4654,14 @@ the call to \\[sql-product-interactive] with
(get-buffer new-sqli-buffer)))))
(user-error "No default SQL product defined: set `sql-product'")))
+(defun sql-comint-automatic-password (_)
+ "Intercept password prompts when we know the password.
+This must also do the job of detecting password prompts."
+ (when (and
+ sql-password
+ (not (string= "" sql-password)))
+ sql-password))
+
(defun sql-comint (product params &optional buf-name)
"Set up a comint buffer to run the SQL processor.
@@ -4705,6 +4686,13 @@ buffer. If nil, a name is chosen for it."
(setq buf-name (sql-generate-unique-sqli-buffer-name product nil)))
(set-text-properties 0 (length buf-name) nil buf-name)
+ ;; Create the buffer first, because we want to set it up before
+ ;; comint starts to run.
+ (set-buffer (get-buffer-create buf-name))
+ ;; Set up the automatic population of passwords, if supported.
+ (when (sql-get-product-feature product :password-in-comint)
+ (setq comint-password-function #'sql-comint-automatic-password))
+
;; Start the command interpreter in the buffer
;; PROC-NAME is BUF-NAME without enclosing asterisks
(let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1" buf-name)))
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index ed6dce02c03..7dae14f9e02 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -120,13 +120,13 @@
(defcustom tcl-indent-level 4
"Indentation of Tcl statements with respect to containing block."
- :type 'integer)
-(put 'tcl-indent-level 'safe-local-variable #'integerp)
+ :type 'integer
+ :safe #'integerp)
(defcustom tcl-continued-indent-level 4
"Indentation of continuation line relative to first line of command."
- :type 'integer)
-(put 'tcl-continued-indent-level 'safe-local-variable #'integerp)
+ :type 'integer
+ :safe #'integerp)
(defcustom tcl-auto-newline nil
"Non-nil means automatically newline before and after braces you insert."
@@ -344,7 +344,7 @@ information):
Add functions to the hook with `add-hook':
- (add-hook 'tcl-mode-hook #'tcl-guess-application)")
+ (add-hook \\='tcl-mode-hook #\\='tcl-guess-application)")
(defvar tcl-proc-list
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index b2ce9140573..31d50a1882e 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
-;; Version: 2021.09.23.089128420
+;; Version: 2021.10.14.127365406
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2021-09-23-54ffde4-vpo-GNU"
+(defconst verilog-mode-version "2021-10-14-797711e-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -1264,7 +1264,9 @@ See `verilog-auto-inst-param-value'."
Also affects AUTOINSTPARAM. Declaration order is the default for
backward compatibility, and as some teams prefer signals that are
declared together to remain together. Sorted order reduces
-changes when declarations are moved around in a file.
+changes when declarations are moved around in a file. Sorting is
+within input/output/inout groupings, there is intentionally no
+option to intermix between input/output/inouts.
See also `verilog-auto-arg-sort'."
:version "24.1" ; rev688
@@ -3620,10 +3622,10 @@ is 0.
Meaning of *single* declaration:
E.g. In a module's port-list -
module test(input clk, rst, x, output [1:0] y);
- Here 'input clk, rst, x' is 1 *single* declaration statement,
-and 'output [1:0] y' is the other single declaration. In the 1st single
-declaration, POINT is moved to start of 'clk'. And in the 2nd declaration,
-POINT is moved to 'y'."
+ Here `input clk, rst, x' is 1 *single* declaration statement,
+and `output [1:0] y' is the other single declaration. In the 1st single
+declaration, POINT is moved to start of `clk'. And in the 2nd declaration,
+POINT is moved to `y'."
(let (maxpoint old-point)
@@ -5478,8 +5480,11 @@ becomes:
(let* ((pop-up-windows t))
(let ((name (expand-file-name
(read-file-name
- (format "Find this error in: (default %s) "
- file)
+ ;; `format-prompt' is new in Emacs 28.1.
+ (if (fboundp 'format-prompt)
+ (format-prompt "Find this error in" file)
+ (format "Find this error in (default %s): "
+ file))
nil ;; dir
file t))))
(setq buffer
@@ -6598,7 +6603,8 @@ Also move point to constraint."
(equal (char-before) ?\;)
(equal (char-before) ?\}))
;; skip what looks like bus repetition operator {#{
- (not (string-match "^{\\s-*[\\(\\)0-9a-zA-Z_]*\\s-*{" (buffer-substring p (point)))))))))
+ (not (string-match "^{\\s-*[()0-9a-zA-Z_\\]*\\s-*{"
+ (buffer-substring p (point)))))))))
(progn
(let ( (pt (point)) (pass 0))
(verilog-backward-ws&directives)
@@ -7863,14 +7869,14 @@ If search fails, other files are checked based on
(let* ((default (verilog-get-default-symbol))
;; The following variable is used in verilog-comp-function
(verilog-buffer-to-use (current-buffer))
- (label (if (not (string= default ""))
- ;; Do completion with default
- (completing-read (concat "Goto-Label: (default "
- default ") ")
- #'verilog-comp-defun nil nil "")
- ;; There is no default value. Complete without it
- (completing-read "Goto-Label: "
- #'verilog-comp-defun nil nil "")))
+ (label
+ (completing-read (cond ((fboundp 'format-prompt)
+ ;; `format-prompt' is new in Emacs 28.1.
+ (format-prompt "Goto-Label" default))
+ ((not (string= default ""))
+ (concat "Goto-Label (default " default "): "))
+ (t "Goto-Label: "))
+ #'verilog-comp-defun nil nil ""))
pt)
;; Make sure library paths are correct, in case need to resolve module
(verilog-auto-reeval-locals)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 4e5f5df8142..39c5eb453b1 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -8789,7 +8789,10 @@ project is defined."
(defun vhdl-electric-period (count) "`..' --> ` => '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) vhdl-last-input-event)
+ ;; We use this-command-keys below to account for translation of
+ ;; kp-decimal into '.'; vhdl-last-input-event doesn't catch
+ ;; that.
+ (cond ((eq (preceding-char) (aref (this-command-keys) 0))
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert "=> ")))
@@ -10687,8 +10690,9 @@ Include a library specification, if not already there."
(replace-match "" t t)
(vhdl-template-insert-date))
(goto-char beg)
- (while (search-forward "<year>" end t)
- (replace-match (format-time-string "%Y" nil) t t))
+ (let ((year (format-time-string "%Y")))
+ (while (search-forward "<year>" end t)
+ (replace-match year t t)))
(goto-char beg)
(when file-title
(while (search-forward "<title string>" end t)
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index abe25f2c633..2e8e8d23192 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -64,7 +64,7 @@
;; Variables for customization
;; ---------------------------
;;
-(defvar which-func-unknown "???"
+(defvar which-func-unknown "n/a"
"String to display in the mode line when current function is unknown.")
(defgroup which-func nil
@@ -234,9 +234,6 @@ It creates the Imenu index for the buffer, if necessary."
(setq which-func-mode nil)
(error "Error in which-func-update: %S" info))))))
-;;;###autoload
-(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1")
-
(defvar which-func-update-timer nil)
(unless (or (assq 'which-func-mode mode-line-misc-info)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index c4b439f587c..0213ab3cc58 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
-;; Version: 1.3.0
+;; Version: 1.4.1
;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -75,7 +75,7 @@
(require 'project)
(eval-and-compile
- (when (version< emacs-version "28")
+ (when (version< emacs-version "28.0.60")
;; etags.el in Emacs 26 and 27 uses EIEIO, and its location type
;; inherits from `xref-location'.
(require 'eieio)
@@ -195,9 +195,16 @@ is not known."
;;; Cross-reference
-(cl-defstruct (xref-item
- (:constructor xref-make (summary location))
- (:noinline t))
+(defmacro xref--defstruct (name &rest fields)
+ (declare (indent 1))
+ `(cl-defstruct ,(if (>= emacs-major-version 27)
+ name
+ (remq (assq :noinline name) name))
+ ,@fields))
+
+(xref--defstruct (xref-item
+ (:constructor xref-make (summary location))
+ (:noinline t))
"An xref item describes a reference to a location somewhere."
(summary nil :documentation "String which describes the location.
@@ -213,14 +220,14 @@ locations point to the same line.
This behavior is new in Emacs 28.")
location)
-(cl-defstruct (xref-match-item
- (:include xref-item)
- (:constructor xref-make-match (summary location length))
- (:noinline t))
+(xref--defstruct (xref-match-item
+ (:include xref-item)
+ (:constructor xref-make-match (summary location length))
+ (:noinline t))
"A match xref item describes a search result."
length)
-(cl-defgeneric xref-match-length ((item xref-match-item))
+(cl-defmethod xref-match-length ((item xref-match-item))
"Return the length of the match."
(xref-match-item-length item))
@@ -346,15 +353,9 @@ backward."
(t (goto-char start) nil))))
-;;; Marker stack (M-. pushes, M-, pops)
-
-(defcustom xref-marker-ring-length 16
- "Length of the xref marker ring.
-If this variable is not set through Customize, you must call
-`xref-set-marker-ring-length' for changes to take effect."
- :type 'integer
- :initialize #'custom-initialize-default
- :set #'xref-set-marker-ring-length)
+;; Dummy variable retained for compatibility.
+(defvar xref-marker-ring-length 16)
+(make-obsolete-variable 'xref-marker-ring-length nil "29.1")
(defcustom xref-prompt-for-identifier '(not xref-find-definitions
xref-find-definitions-other-window
@@ -380,7 +381,8 @@ elements is negated: these commands will NOT prompt."
(defcustom xref-after-jump-hook '(recenter
xref-pulse-momentarily)
- "Functions called after jumping to an xref."
+ "Functions called after jumping to an xref.
+Also see `xref-current-item'."
:type 'hook)
(defcustom xref-after-return-hook '(xref-pulse-momentarily)
@@ -425,42 +427,79 @@ or earlier: it can break `dired-do-find-regexp-and-replace'."
:version "28.1"
:package-version '(xref . "1.2.0"))
-(defvar xref--marker-ring (make-ring xref-marker-ring-length)
- "Ring of markers to implement the marker stack.")
+(make-obsolete-variable 'xref--marker-ring 'xref--history "29.1")
+
+(defun xref-set-marker-ring-length (_var _val)
+ (declare (obsolete nil "29.1"))
+ nil)
-(defun xref-set-marker-ring-length (var val)
- "Set `xref-marker-ring-length'.
-VAR is the symbol `xref-marker-ring-length' and VAL is the new
-value."
- (set-default var val)
- (if (ring-p xref--marker-ring)
- (ring-resize xref--marker-ring val)))
+(defvar xref--history (cons nil nil)
+ "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.")
+
+(defun xref--push-backward (m)
+ "Push marker M onto the backward history stack."
+ (unless (equal m (caar xref--history))
+ (push m (car xref--history))))
+
+(defun xref--push-forward (m)
+ "Push marker M onto the forward history stack."
+ (unless (equal m (cadr xref--history))
+ (push m (cdr xref--history))))
(defun xref-push-marker-stack (&optional m)
- "Add point M (defaults to `point-marker') to the marker stack."
- (ring-insert xref--marker-ring (or m (point-marker))))
+ "Add point M (defaults to `point-marker') to the marker stack.
+The future stack is erased."
+ (xref--push-backward (or m (point-marker)))
+ (dolist (mk (cdr xref--history))
+ (set-marker mk nil nil))
+ (setcdr xref--history nil))
+
+;;;###autoload
+(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1")
+
+;;;###autoload
+(defun xref-go-back ()
+ "Go back to the previous position in xref history.
+To undo, use \\[xref-go-forward]."
+ (interactive)
+ (if (null (car xref--history))
+ (user-error "At start of xref history")
+ (let ((marker (pop (car xref--history))))
+ (xref--push-forward (point-marker))
+ (switch-to-buffer (or (marker-buffer marker)
+ (user-error "The marked buffer has been deleted")))
+ (goto-char (marker-position marker))
+ (set-marker marker nil nil)
+ (run-hooks 'xref-after-return-hook))))
;;;###autoload
-(defun xref-pop-marker-stack ()
- "Pop back to where \\[xref-find-definitions] was last invoked."
+(defun xref-go-forward ()
+ "Got to the point where a previous \\[xref-go-back] was invoked."
(interactive)
- (let ((ring xref--marker-ring))
- (when (ring-empty-p ring)
- (user-error "Marker stack is empty"))
- (let ((marker (ring-remove ring 0)))
+ (if (null (cdr xref--history))
+ (user-error "At end of xref history")
+ (let ((marker (pop (cdr xref--history))))
+ (xref--push-backward (point-marker))
(switch-to-buffer (or (marker-buffer marker)
(user-error "The marked buffer has been deleted")))
(goto-char (marker-position marker))
(set-marker marker nil nil)
(run-hooks 'xref-after-return-hook))))
-(defvar xref--current-item nil)
+(define-obsolete-variable-alias
+ 'xref--current-item
+ 'xref-current-item
+ "29.1")
+
+(defvar xref-current-item nil
+ "Dynamically bound to the current item being processed.
+This can be used from `xref-after-jump-hook', for instance.")
(defun xref-pulse-momentarily ()
(pcase-let ((`(,beg . ,end)
(save-excursion
(or
- (let ((length (xref-match-length xref--current-item)))
+ (let ((length (xref-match-length xref-current-item)))
(and length (cons (point) (+ (point) length))))
(back-to-indentation)
(if (eolp)
@@ -470,17 +509,23 @@ value."
;; etags.el needs this
(defun xref-clear-marker-stack ()
- "Discard all markers from the marker stack."
- (let ((ring xref--marker-ring))
- (while (not (ring-empty-p ring))
- (let ((marker (ring-remove ring)))
- (set-marker marker nil nil)))))
+ "Discard all markers from the xref history."
+ (dolist (l (list (car xref--history) (cdr xref--history)))
+ (dolist (m l)
+ (set-marker m nil nil)))
+ (setq xref--history (cons nil nil))
+ nil)
;;;###autoload
(defun xref-marker-stack-empty-p ()
- "Return t if the marker stack is empty; nil otherwise."
- (ring-empty-p xref--marker-ring))
+ "Whether the xref back-history is empty."
+ (null (car xref--history)))
+;; FIXME: rename this to `xref-back-history-empty-p'.
+;;;###autoload
+(defun xref-forward-history-empty-p ()
+ "Whether the xref forward-history is empty."
+ (null (cdr xref--history)))
(defun xref--goto-char (pos)
@@ -511,7 +556,7 @@ If SELECT is non-nil, select the target window."
(window (pop-to-buffer buf t))
(frame (let ((pop-up-frames t)) (pop-to-buffer buf t))))
(xref--goto-char marker))
- (let ((xref--current-item item))
+ (let ((xref-current-item item))
(run-hooks 'xref-after-jump-hook)))
@@ -600,9 +645,15 @@ SELECT is `quit', also quit the *xref* window."
(xref-buffer (current-buffer)))
(cond (select
(if (eq select 'quit) (quit-window nil nil))
- (select-window
- (with-current-buffer xref-buffer
- (xref--show-pos-in-buf marker buf))))
+ (let* ((old-frame (selected-frame))
+ (window (with-current-buffer xref-buffer
+ (xref--show-pos-in-buf marker buf)))
+ (frame (window-frame window)))
+ ;; If we chose another frame, make sure it gets input
+ ;; focus.
+ (unless (eq frame old-frame)
+ (select-frame-set-input-focus frame))
+ (select-window window)))
(t
(save-selected-window
(xref--with-dedicated-window
@@ -619,7 +670,7 @@ SELECT is `quit', also quit the *xref* window."
"Display the source of xref at point in the appropriate window, if any."
(interactive)
(let* ((xref (xref--item-at-point))
- (xref--current-item xref))
+ (xref-current-item xref))
(when xref
(xref--set-arrow)
(xref--show-location (xref-item-location xref)))))
@@ -678,7 +729,7 @@ quit the *xref* buffer."
(let* ((buffer (current-buffer))
(xref (or (xref--item-at-point)
(user-error "Choose a reference to visit")))
- (xref--current-item xref))
+ (xref-current-item xref))
(xref--set-arrow)
(xref--show-location (xref-item-location xref) (if quit 'quit t))
(if (fboundp 'next-error-found)
@@ -695,7 +746,7 @@ quit the *xref* buffer."
"Quit *xref* buffer, then pop the xref marker stack."
(interactive)
(quit-window)
- (xref-pop-marker-stack))
+ (xref-go-back))
(defun xref-query-replace-in-results (from to)
"Perform interactive replacement of FROM with TO in all displayed xrefs.
@@ -703,15 +754,23 @@ quit the *xref* buffer."
This command interactively replaces FROM with TO in the names of the
references displayed in the current *xref* buffer.
+When called interactively, it uses '.*' as FROM, which means
+replace the whole name. Unless called with prefix argument, in
+which case the user is prompted for both FROM and TO.
+
As each match is found, the user must type a character saying
what to do with it. Type SPC or `y' to replace the match,
DEL or `n' to skip and go to the next match. For more directions,
-type \\[help-command] at that time.
-"
+type \\[help-command] at that time."
(interactive
- (let ((fr (read-regexp "Xref query-replace (regexp)" ".*")))
- (list fr
- (read-regexp (format "Xref query-replace (regexp) %s with: " fr)))))
+ (let* ((fr
+ (if current-prefix-arg
+ (read-regexp "Query-replace (regexp)" ".*")
+ ".*"))
+ (prompt (if current-prefix-arg
+ (format "Query-replace (regexp) %s with: " fr)
+ "Query-replace all matches with: ")))
+ (list fr (read-regexp prompt))))
(let* (item xrefs iter)
(save-excursion
(while (setq item (xref--search-property 'xref-item))
@@ -905,15 +964,15 @@ beginning of the line."
(let ((win (get-buffer-window (current-buffer))))
(and win (set-window-point win (point))))
(xref--set-arrow)
- (let ((xref--current-item xref))
+ (let ((xref-current-item xref))
(xref--show-location (xref-item-location xref) t)))
(t
(error "No %s xref" (if backward "previous" "next"))))))
(defvar xref--button-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] #'xref-goto-xref)
- (define-key map [mouse-2] #'xref-select-and-show-xref)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] #'xref-goto-xref)
map))
(defun xref-select-and-show-xref (event)
@@ -1062,6 +1121,13 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)."
(cdr pair)))
alist)))
+(defun xref--ensure-default-directory (dd buffer)
+ ;; We might be in a let-binding which will restore the current value
+ ;; to a previous one (bug#53626). So do this later.
+ (run-with-timer
+ 0 nil
+ (lambda () (with-current-buffer buffer (setq default-directory dd)))))
+
(defun xref--show-xref-buffer (fetcher alist)
(cl-assert (functionp fetcher))
(let* ((xrefs
@@ -1072,7 +1138,7 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)."
(dd default-directory)
buf)
(with-current-buffer (get-buffer-create xref-buffer-name)
- (setq default-directory dd)
+ (xref--ensure-default-directory dd (current-buffer))
(xref--xref-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer))
@@ -1171,7 +1237,7 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'."
(assoc-default 'display-action alist)))
(t
(with-current-buffer (get-buffer-create xref-buffer-name)
- (setq default-directory dd)
+ (xref--ensure-default-directory dd (current-buffer))
(xref--transient-buffer-mode)
(xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
(pop-to-buffer (current-buffer)
@@ -1295,6 +1361,13 @@ definitions."
(defvar xref--read-pattern-history nil)
+;;;###autoload
+(defun xref-show-xrefs (fetcher display-action)
+ "Display some Xref values produced by FETCHER using DISPLAY-ACTION.
+The meanings of both arguments are the same as documented in
+`xref-show-xrefs-function'."
+ (xref--show-xrefs fetcher display-action))
+
(defun xref--show-xrefs (fetcher display-action &optional _always-show-list)
(xref--push-markers)
(unless (functionp fetcher)
@@ -1340,12 +1413,17 @@ definitions."
(xref--prompt-p this-command))
(let ((id
(completing-read
- (if def
- (format "%s (default %s): "
- (substring prompt 0 (string-match
- "[ :]+\\'" prompt))
- def)
- prompt)
+ ;; `format-prompt' is new in Emacs 28.1
+ (if (fboundp 'format-prompt)
+ (format-prompt (substring prompt 0 (string-match
+ "[ :]+\\'" prompt))
+ def)
+ (if def
+ (format "%s (default %s): "
+ (substring prompt 0 (string-match
+ "[ :]+\\'" prompt))
+ def)
+ prompt))
(xref-backend-identifier-completion-table backend)
nil nil nil
'xref--read-identifier-history def)))
@@ -1406,7 +1484,7 @@ definition for IDENTIFIER, display it in the selected window.
Otherwise, display the list of the possible definitions in a
buffer where the user can select from the list.
-Use \\[xref-pop-marker-stack] to return back to where you invoked this command."
+Use \\[xref-go-back] to return back to where you invoked this command."
(interactive (list (xref--read-identifier "Find definitions of: ")))
(xref--find-definitions identifier nil))
@@ -1433,6 +1511,23 @@ is nil, prompt only if there's no usable symbol at point."
(interactive (list (xref--read-identifier "Find references of: ")))
(xref--find-xrefs identifier 'references identifier nil))
+(defun xref-find-references-and-replace (from to)
+ "Replace all references to identifier FROM with TO."
+ (interactive
+ (let* ((query-replace-read-from-default 'find-tag-default)
+ (common
+ (query-replace-read-args "Query replace identifier" nil)))
+ (list (nth 0 common) (nth 1 common))))
+ (require 'xref)
+ (with-current-buffer
+ (let ((xref-show-xrefs-function
+ ;; Some future-proofing (bug#44905).
+ (custom--standard-value 'xref-show-xrefs-function))
+ ;; Disable auto-jumping, it will mess up replacement logic.
+ xref-auto-jump-to-first-xref)
+ (xref-find-references from))
+ (xref-query-replace-in-results ".*" to)))
+
;;;###autoload
(defun xref-find-definitions-at-mouse (event)
"Find the definition of identifier at or around mouse click.
@@ -1460,7 +1555,7 @@ This command is intended to be bound to a mouse event."
(xref-find-references identifier))
(user-error "No identifier here"))))
-(declare-function apropos-parse-pattern "apropos" (pattern))
+(declare-function apropos-parse-pattern "apropos" (pattern &optional do-all))
;;;###autoload
(defun xref-find-apropos (pattern)
@@ -1497,7 +1592,8 @@ output of this command when the backend is etags."
;;; Key bindings
;;;###autoload (define-key esc-map "." #'xref-find-definitions)
-;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
+;;;###autoload (define-key esc-map "," #'xref-go-back)
+;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward)
;;;###autoload (define-key esc-map "?" #'xref-find-references)
;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
@@ -1633,7 +1729,8 @@ IGNORES is a list of glob patterns for files to ignore."
.
;; '!*/' is there to filter out dirs (e.g. submodules).
"xargs -0 rg <C> --null -nH --no-heading --no-messages -g '!*/' -e <R>"
- ))
+ )
+ (ugrep . "xargs -0 ugrep <C> --null -ns -e <R>"))
"Associative list mapping program identifiers to command templates.
Program identifier should be a symbol, named after the search program.
@@ -1662,6 +1759,7 @@ utility function used by commands like `dired-do-find-regexp' and
:type '(choice
(const :tag "Use Grep" grep)
(const :tag "Use ripgrep" ripgrep)
+ (const :tag "Use ugrep" ugrep)
(symbol :tag "User defined"))
:version "28.1"
:package-version '(xref . "1.0.4"))
@@ -1781,7 +1879,7 @@ to control which program to use when looking for matches."
(xref--find-ignores-arguments ignores dir)))
(defun xref--find-ignores-arguments (ignores dir)
- "Convert IGNORES and DIR to a list of arguments for 'find'.
+ "Convert IGNORES and DIR to a list of arguments for `find'.
IGNORES is a list of glob patterns. DIR is an absolute
directory, used as the root of the ignore globs."
(cl-assert (not (string-match-p "\\`~" dir)))
@@ -1841,21 +1939,22 @@ Such as the current syntax table and the applied syntax properties."
(defvar xref--last-file-buffer nil)
(defvar xref--temp-buffer-file-name nil)
+(defvar xref--hits-remote-id nil)
(defun xref--convert-hits (hits regexp)
(let (xref--last-file-buffer
(tmp-buffer (generate-new-buffer " *xref-temp*"))
- (remote-id (file-remote-p default-directory))
+ (xref--hits-remote-id (file-remote-p default-directory))
(syntax-needed (xref--regexp-syntax-dependent-p regexp)))
(unwind-protect
(mapcan (lambda (hit)
- (xref--collect-matches hit regexp tmp-buffer remote-id syntax-needed))
+ (xref--collect-matches hit regexp tmp-buffer syntax-needed))
hits)
(kill-buffer tmp-buffer))))
-(defun xref--collect-matches (hit regexp tmp-buffer remote-id syntax-needed)
+(defun xref--collect-matches (hit regexp tmp-buffer syntax-needed)
(pcase-let* ((`(,line ,file ,text) hit)
- (file (and file (concat remote-id file)))
+ (file (and file (concat xref--hits-remote-id file)))
(buf (xref--find-file-buffer file))
(inhibit-modification-hooks t))
(if buf
@@ -1928,10 +2027,17 @@ Such as the current syntax table and the applied syntax properties."
(defun xref--find-file-buffer (file)
(unless (equal (car xref--last-file-buffer) file)
- (setq xref--last-file-buffer
- ;; `find-buffer-visiting' is considerably slower,
- ;; especially on remote files.
- (cons file (get-file-buffer file))))
+ ;; `find-buffer-visiting' is considerably slower,
+ ;; especially on remote files.
+ (let ((buf (get-file-buffer file)))
+ (when (and buf
+ (or
+ (buffer-modified-p buf)
+ (unless xref--hits-remote-id
+ (not (verify-visited-file-modtime (current-buffer))))))
+ ;; We can't use buffers whose contents diverge from disk (bug#54025).
+ (setq buf nil))
+ (setq xref--last-file-buffer (cons file buf))))
(cdr xref--last-file-buffer))
(provide 'xref)
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index e6db65aced2..6e21131e4aa 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -574,9 +574,8 @@ See also the commands \\[xscheme-yank-pop] and \\[xscheme-yank-push]."
(if (consp arg)
(exchange-point-and-mark)))
-;; Old name, to avoid errors in users' init files.
-(fset 'xscheme-yank-previous-send
- 'xscheme-yank)
+(define-obsolete-function-alias 'xscheme-yank-previous-send
+ #'xscheme-yank "29.1")
(defun xscheme-yank-pop (arg)
"Insert or replace a just-yanked expression with an older expression.
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index bd750ff2a77..eb1abfd92db 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1209,8 +1209,8 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
(ps-output-prologue (format "ETOP%d %d %d put\n" i (car font) index))
(setq index (1+ index))))
(ps-output-prologue (format "/VTOP%d [%s] def\n" i
- (mapconcat #'(lambda (x)
- (format "F%02X" (cdr x)))
+ (mapconcat (lambda (x)
+ (format "F%02X" (cdr x)))
font-list " ")))))
;; Redefine fonts f0, f1, f2, f3, h0, h1, H0.
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index af366066f71..069d116907e 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -3855,7 +3855,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
(defun ps-color-scale (color)
;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
- (mapcar #'(lambda (value) (/ value ps-print-color-scale))
+ (mapcar (lambda (value) (/ value ps-print-color-scale))
(color-values color)))
@@ -4747,11 +4747,11 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(defun ps-background-pages (page-list func)
(if page-list
(mapcar
- #'(lambda (pages)
- (let ((start (if (consp pages) (car pages) pages))
- (end (if (consp pages) (cdr pages) pages)))
- (and (integerp start) (integerp end) (<= start end)
- (add-to-list 'ps-background-pages (vector start end func)))))
+ (lambda (pages)
+ (let ((start (if (consp pages) (car pages) pages))
+ (end (if (consp pages) (cdr pages) pages)))
+ (and (integerp start) (integerp end) (<= start end)
+ (add-to-list 'ps-background-pages (vector start end func)))))
page-list)
(setq ps-background-all-pages (cons func ps-background-all-pages))))
@@ -4789,76 +4789,76 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(defun ps-background-text ()
(mapcar
- #'(lambda (text)
- (setq ps-background-text-count (1+ ps-background-text-count))
- (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
- (ps-output-string (nth 0 text)) ; text
- (ps-output
- "\n"
- (ps-float-format (nth 4 text) 200.0) ; font size
- (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
- (ps-float-format (nth 6 text)
- "PrintHeight PrintPageWidth atan") ; rotation
- (ps-float-format (nth 5 text) 0.85) ; gray
- (ps-float-format (nth 1 text) "0") ; x position
- (ps-float-format (nth 2 text) "0") ; y position
- "\nShowBackText}def\n")
- (ps-background-pages (nthcdr 7 text) ; page list
- (format "ShowBackText-%d\n"
- ps-background-text-count)))
+ (lambda (text)
+ (setq ps-background-text-count (1+ ps-background-text-count))
+ (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
+ (ps-output-string (nth 0 text)) ; text
+ (ps-output
+ "\n"
+ (ps-float-format (nth 4 text) 200.0) ; font size
+ (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
+ (ps-float-format (nth 6 text)
+ "PrintHeight PrintPageWidth atan") ; rotation
+ (ps-float-format (nth 5 text) 0.85) ; gray
+ (ps-float-format (nth 1 text) "0") ; x position
+ (ps-float-format (nth 2 text) "0") ; y position
+ "\nShowBackText}def\n")
+ (ps-background-pages (nthcdr 7 text) ; page list
+ (format "ShowBackText-%d\n"
+ ps-background-text-count)))
ps-print-background-text))
(defun ps-background-image ()
(mapcar
- #'(lambda (image)
- (let ((image-file (expand-file-name (nth 0 image))))
- (when (file-readable-p image-file)
- (setq ps-background-image-count (1+ ps-background-image-count))
- (ps-output
- (format "/ShowBackImage-%d{\n--back-- "
- ps-background-image-count)
- (ps-float-format (nth 5 image) 0.0) ; rotation
- (ps-float-format (nth 3 image) 1.0) ; x scale
- (ps-float-format (nth 4 image) 1.0) ; y scale
- (ps-float-format (nth 1 image) ; x position
- "PrintPageWidth 2 div")
- (ps-float-format (nth 2 image) ; y position
- "PrintHeight 2 div BottomMargin add")
- "\nBeginBackImage\n")
- (ps-insert-file image-file)
- ;; coordinate adjustment to center image
- ;; around x and y position
- (let ((box (ps-get-boundingbox)))
- (with-current-buffer ps-spool-buffer
- (save-excursion
- (if (re-search-backward "^--back--" nil t)
- (replace-match
- (format "%s %s"
- (ps-float-format
- (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
- (aref box 0))))
- (ps-float-format
- (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
- (aref box 1)))))
- t)))))
- (ps-output "\nEndBackImage}def\n")
- (ps-background-pages (nthcdr 6 image) ; page list
- (format "ShowBackImage-%d\n"
- ps-background-image-count)))))
+ (lambda (image)
+ (let ((image-file (expand-file-name (nth 0 image))))
+ (when (file-readable-p image-file)
+ (setq ps-background-image-count (1+ ps-background-image-count))
+ (ps-output
+ (format "/ShowBackImage-%d{\n--back-- "
+ ps-background-image-count)
+ (ps-float-format (nth 5 image) 0.0) ; rotation
+ (ps-float-format (nth 3 image) 1.0) ; x scale
+ (ps-float-format (nth 4 image) 1.0) ; y scale
+ (ps-float-format (nth 1 image) ; x position
+ "PrintPageWidth 2 div")
+ (ps-float-format (nth 2 image) ; y position
+ "PrintHeight 2 div BottomMargin add")
+ "\nBeginBackImage\n")
+ (ps-insert-file image-file)
+ ;; coordinate adjustment to center image
+ ;; around x and y position
+ (let ((box (ps-get-boundingbox)))
+ (with-current-buffer ps-spool-buffer
+ (save-excursion
+ (if (re-search-backward "^--back--" nil t)
+ (replace-match
+ (format "%s %s"
+ (ps-float-format
+ (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
+ (aref box 0))))
+ (ps-float-format
+ (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
+ (aref box 1)))))
+ t)))))
+ (ps-output "\nEndBackImage}def\n")
+ (ps-background-pages (nthcdr 6 image) ; page list
+ (format "ShowBackImage-%d\n"
+ ps-background-image-count)))))
ps-print-background-image))
(defun ps-background (page-number)
(let (has-local-background)
- (mapc #'(lambda (range)
- (and (<= (aref range 0) page-number)
- (<= page-number (aref range 1))
- (if has-local-background
- (ps-output (aref range 2))
- (setq has-local-background t)
- (ps-output "/printLocalBackground{\n"
- (aref range 2)))))
+ (mapc (lambda (range)
+ (and (<= (aref range 0) page-number)
+ (<= page-number (aref range 1))
+ (if has-local-background
+ (ps-output (aref range 2))
+ (setq has-local-background t)
+ (ps-output "/printLocalBackground{\n"
+ (aref range 2)))))
ps-background-pages)
(and has-local-background (ps-output "}def\n"))))
@@ -5697,8 +5697,8 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(> (car page) 0)
(<= (car page) (cdr page))
(setq new (cons page new))))))
- (setq ps-selected-pages (sort new #'(lambda (one other)
- (< (car one) (car other))))
+ (setq ps-selected-pages (sort new (lambda (one other)
+ (< (car one) (car other))))
ps-last-selected-pages ps-selected-pages
ps-first-page nil
ps-last-page nil))
@@ -5782,8 +5782,8 @@ XSTART YSTART are the relative position for the first page in a sheet.")
"unspecified-fg"
0.0)
ps-foreground-list (mapcar
- #'(lambda (arg)
- (ps-rgb-color arg "unspecified-fg" 0.0))
+ (lambda (arg)
+ (ps-rgb-color arg "unspecified-fg" 0.0))
(append (and (not (member ps-print-color-p
'(nil black-white)))
ps-fg-list)
@@ -6012,9 +6012,9 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(if (and (boundp 'ucs-mule-8859-to-mule-unicode)
(char-table-p ucs-mule-8859-to-mule-unicode))
(map-char-table
- #'(lambda (k v)
- (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
- (aset tbl k v)))
+ (lambda (k v)
+ (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
+ (aset tbl k v)))
ucs-mule-8859-to-mule-unicode))
tbl)
"Translation table for PostScript printing.
@@ -6415,7 +6415,7 @@ If FACE is not a valid face name, use default face."
(ps-end-job needs-begin-file)
;; Setting this variable tells the unwind form that the
- ;; the PostScript was generated without error.
+ ;; PostScript was generated without error.
(setq completed-safely t))
;; Unwind form: If some bad mojo occurred while generating
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 7a4b589e457..b80ee3dd7d8 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1,4 +1,4 @@
-;;; recentf.el --- setup a menu of recently opened files -*- lexical-binding: t -*-
+;;; recentf.el --- keep track of recently opened files -*- lexical-binding: t -*-
;; Copyright (C) 1999-2022 Free Software Foundation, Inc.
@@ -23,10 +23,19 @@
;;; Commentary:
-;; This package maintains a menu for visiting files that were operated
-;; on recently. When enabled a new "Open Recent" submenu is
-;; displayed in the "File" menu. The recent files list is
-;; automatically saved across Emacs sessions.
+;; This package maintains a list of recently opened files and makes it
+;; easy to visit them. The recent files list is automatically saved
+;; across Emacs sessions.
+
+;; There are three ways to access recent files:
+;;
+;; (1) `M-x recentf-open' prompts for a recently opened file.
+;;
+;; (2) When this mode is enabled, a new "Open Recent" submenu is
+;; displayed in the "File" menu.
+;;
+;; (3) `M-x recentf-open-files' lists recently visited files in a
+;; buffer.
;; You can customize the number of recent files displayed, the
;; location of the menu and other options. Type:
@@ -45,16 +54,17 @@
;;; Internal data
;;
(defvar recentf-list nil
- "List of recently opened files.")
+ "List of recently opened files for `recentf-mode'.")
-(defsubst recentf-enabled-p ()
- "Return non-nil if recentf mode is currently enabled."
+(defun recentf-enabled-p ()
+ "Return non-nil if `recentf-mode' is currently enabled."
(memq 'recentf-save-list kill-emacs-hook))
+
;;; Customization
;;
(defgroup recentf nil
- "Maintain a menu of recently opened files."
+ "Maintain a list of recently opened files."
:version "21.1"
:group 'files)
@@ -159,7 +169,7 @@ If nil add it at end of menu (see also `easy-menu-add-item')."
(const :tag "Last" nil))
:set 'recentf-menu-customization-changed)
-(defcustom recentf-menu-action 'find-file
+(defcustom recentf-menu-action #'find-file
"Function to invoke with a filename item of the recentf menu.
The default is to call `find-file' to edit the selected file."
:group 'recentf
@@ -168,7 +178,7 @@ The default is to call `find-file' to edit the selected file."
(defcustom recentf-max-menu-items 10
"Maximum number of items in the recentf menu."
:group 'recentf
- :type 'integer)
+ :type 'natnum)
(defcustom recentf-menu-filter nil
"Function used to filter files displayed in the recentf menu.
@@ -237,6 +247,8 @@ This item will replace the \"More...\" item."
(defcustom recentf-auto-cleanup 'mode
"Define when to automatically cleanup the recent list.
+That is, remove duplicates, non-kept, and excluded files.
+
The following values can be set:
- `mode'
@@ -284,7 +296,7 @@ If `file-name-history' is not empty, do nothing."
(make-obsolete-variable 'recentf-load-hook
"use `with-eval-after-load' instead." "28.1")
-(defcustom recentf-filename-handlers nil
+(defcustom recentf-filename-handlers '(abbreviate-file-name)
"Functions to post process recent file names.
They are successively passed a file name to transform it."
:group 'recentf
@@ -294,7 +306,8 @@ They are successively passed a file name to transform it."
(choice
(const file-truename)
(const abbreviate-file-name)
- (function :tag "Other function")))))
+ (function :tag "Other function"))))
+ :version "29.1")
(defcustom recentf-show-file-shortcuts-flag t
"Non-nil means to show \"[N]\" for the Nth item up to 10.
@@ -309,14 +322,14 @@ used as shortcuts to open the Nth file."
(memq system-type '(windows-nt cygwin))
"Non-nil if recentf searches and matches should ignore case.")
-(defsubst recentf-string-equal (s1 s2)
+(defun recentf-string-equal (s1 s2)
"Return non-nil if strings S1 and S2 have identical contents.
Ignore case if `recentf-case-fold-search' is non-nil."
(if recentf-case-fold-search
(string-equal (downcase s1) (downcase s2))
(string-equal s1 s2)))
-(defsubst recentf-string-lessp (s1 s2)
+(defun recentf-string-lessp (s1 s2)
"Return non-nil if string S1 is less than S2 in lexicographic order.
Ignore case if `recentf-case-fold-search' is non-nil."
(if recentf-case-fold-search
@@ -371,7 +384,7 @@ See also the option `recentf-auto-cleanup'.")
;;; File functions
;;
-(defsubst recentf-push (filename)
+(defun recentf-push (filename)
"Push FILENAME into the recent list, if it isn't there yet.
If it is there yet, move it at the beginning of the list.
If `recentf-case-fold-search' is non-nil, ignore case when comparing
@@ -394,7 +407,7 @@ returned nil."
(error nil))
name))
-(defsubst recentf-expand-file-name (name)
+(defun recentf-expand-file-name (name)
"Convert file NAME to absolute, and canonicalize it.
NAME is first passed to the function `expand-file-name', then to
`recentf-filename-handlers' to post process it."
@@ -435,7 +448,7 @@ That is, if it matches any of the `recentf-keep' checks."
checks (cdr checks)))
keepit))
-(defsubst recentf-add-file (filename)
+(defun recentf-add-file (filename)
"Add or move FILENAME at the beginning of the recent list.
Does nothing if the name satisfies any of the `recentf-exclude'
regexps or predicates."
@@ -443,7 +456,7 @@ regexps or predicates."
(when (recentf-include-p filename)
(recentf-push filename)))
-(defsubst recentf-remove-if-non-kept (filename)
+(defun recentf-remove-if-non-kept (filename)
"Remove FILENAME from the recent list, if file is not kept.
Return non-nil if FILENAME has been removed."
(unless (recentf-keep-p filename)
@@ -461,10 +474,30 @@ Return non-nil if F1 is less than F2."
(recentf-string-lessp (file-name-nondirectory f1)
(file-name-nondirectory f2))
(recentf-string-lessp d1 d2))))
+
+
+;;; Open files
+;;
+
+;;;###autoload
+(defun recentf-open (file)
+ "Prompt for FILE in `recentf-list' and visit it.
+Enable `recentf-mode' if it isn't already."
+ (interactive
+ (list
+ (progn (unless recentf-mode (recentf-mode 1))
+ (completing-read (format-prompt "Open recent file" nil)
+ recentf-list nil t))))
+ (when file
+ (funcall recentf-menu-action file)))
+
+;;;###autoload
+(defalias 'recentf 'recentf-open)
+
;;; Menu building
;;
-(defsubst recentf-digit-shortcut-command-name (n)
+(defun recentf-digit-shortcut-command-name (n)
"Return a command name to open the Nth most recent file.
See also the command `recentf-open-most-recent-file'."
(intern (format "recentf-open-most-recent-file-%d" n)))
@@ -476,10 +509,10 @@ See also the command `recentf-open-most-recent-file'."
;; Define a shortcut command.
(defalias cmd
`(lambda ()
- (interactive)
+ (interactive nil recentf-dialog-mode)
(recentf-open-most-recent-file ,k)))
;; Bind it to a digit key.
- (define-key km (vector (+ k ?0)) cmd)))
+ (keymap-set km (format "%d" k) cmd)))
km)
"Digit shortcuts keymap.")
@@ -510,10 +543,6 @@ If non-nil it must contain a list of valid menu-items to be appended
to the recent file list part of the menu. Before calling a menu
filter function this variable is reset to nil.")
-(defsubst recentf-elements (n)
- "Return a list of the first N elements of the recent list."
- (seq-take recentf-list n))
-
(defsubst recentf-make-menu-element (menu-item menu-value)
"Create a new menu-element.
A menu element is a pair (MENU-ITEM . MENU-VALUE), where MENU-ITEM is
@@ -553,7 +582,7 @@ This a menu element (FILE . FILE)."
"Return a list of the first N default menu elements from the recent list.
See also `recentf-make-default-menu-element'."
(mapcar #'recentf-make-default-menu-element
- (recentf-elements n)))
+ (seq-take recentf-list n)))
(defun recentf-apply-menu-filter (filter l)
"Apply function FILTER to the list of menu-elements L.
@@ -650,7 +679,7 @@ Return nil if file NAME is not one of the ten more recent."
:help (concat "Open " value)
:active t)))))
-(defsubst recentf-menu-bar ()
+(defun recentf-menu-bar ()
"Return the keymap of the global menu bar."
(lookup-key global-map [menu-bar]))
@@ -670,59 +699,59 @@ Return nil if file NAME is not one of the ten more recent."
;;; Predefined menu filters
;;
-(defsubst recentf-sort-ascending (l)
+(defun recentf-sort-ascending (l)
"Sort the list of menu elements L in ascending order.
The MENU-ITEM part of each menu element is compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (recentf-menu-element-item e1)
- (recentf-menu-element-item e2)))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (recentf-menu-element-item e1)
+ (recentf-menu-element-item e2)))))
-(defsubst recentf-sort-descending (l)
+(defun recentf-sort-descending (l)
"Sort the list of menu elements L in descending order.
The MENU-ITEM part of each menu element is compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (recentf-menu-element-item e2)
- (recentf-menu-element-item e1)))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (recentf-menu-element-item e2)
+ (recentf-menu-element-item e1)))))
-(defsubst recentf-sort-basenames-ascending (l)
+(defun recentf-sort-basenames-ascending (l)
"Sort the list of menu elements L in ascending order.
Only filenames sans directory are compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (file-name-nondirectory (recentf-menu-element-value e1))
- (file-name-nondirectory (recentf-menu-element-value e2))))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (file-name-nondirectory (recentf-menu-element-value e1))
+ (file-name-nondirectory (recentf-menu-element-value e2))))))
-(defsubst recentf-sort-basenames-descending (l)
+(defun recentf-sort-basenames-descending (l)
"Sort the list of menu elements L in descending order.
Only filenames sans directory are compared."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-string-lessp
- (file-name-nondirectory (recentf-menu-element-value e2))
- (file-name-nondirectory (recentf-menu-element-value e1))))))
+ (lambda (e1 e2)
+ (recentf-string-lessp
+ (file-name-nondirectory (recentf-menu-element-value e2))
+ (file-name-nondirectory (recentf-menu-element-value e1))))))
-(defsubst recentf-sort-directories-ascending (l)
+(defun recentf-sort-directories-ascending (l)
"Sort the list of menu elements L in ascending order.
Compares directories then filenames to order the list."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-directory-compare
- (recentf-menu-element-value e1)
- (recentf-menu-element-value e2)))))
+ (lambda (e1 e2)
+ (recentf-directory-compare
+ (recentf-menu-element-value e1)
+ (recentf-menu-element-value e2)))))
-(defsubst recentf-sort-directories-descending (l)
+(defun recentf-sort-directories-descending (l)
"Sort the list of menu elements L in descending order.
Compares directories then filenames to order the list."
(sort (copy-sequence l)
- #'(lambda (e1 e2)
- (recentf-directory-compare
- (recentf-menu-element-value e2)
- (recentf-menu-element-value e1)))))
+ (lambda (e1 e2)
+ (recentf-directory-compare
+ (recentf-menu-element-value e2)
+ (recentf-menu-element-value e1)))))
(defun recentf-show-basenames (l &optional no-dir)
"Filter the list of menu elements L to show filenames sans directory.
@@ -743,14 +772,14 @@ optional argument NO-DIR is non-nil, or its directory otherwise."
(setq name (format "%s(%s)" name sufx)))
(push (recentf-make-menu-element name full) filtered-list))))
-(defsubst recentf-show-basenames-ascending (l)
+(defun recentf-show-basenames-ascending (l)
"Filter the list of menu elements L to show filenames sans directory.
Filenames are sorted in ascending order.
This filter combines the `recentf-sort-basenames-ascending' and
`recentf-show-basenames' filters."
(recentf-show-basenames (recentf-sort-basenames-ascending l)))
-(defsubst recentf-show-basenames-descending (l)
+(defun recentf-show-basenames-descending (l)
"Filter the list of menu elements L to show filenames sans directory.
Filenames are sorted in descending order.
This filter combines the `recentf-sort-basenames-descending' and
@@ -808,7 +837,7 @@ corresponding sub-menu items are displayed in the main recent files
menu or in the `recentf-arrange-by-rule-others' sub-menu if
defined."
:group 'recentf-filters
- :type 'number)
+ :type 'natnum)
(defcustom recentf-arrange-by-rule-subfilter nil
"Function called by a rule based filter to filter sub-menu elements.
@@ -1037,7 +1066,7 @@ That is, remove a non kept file from the recent list."
(defun recentf-cancel-dialog (&rest _ignore)
"Cancel the current dialog.
IGNORE arguments."
- (interactive)
+ (interactive nil recentf-dialog-mode)
(kill-buffer (current-buffer))
(message "Dialog canceled"))
@@ -1055,19 +1084,20 @@ Go to the beginning of buffer if not found."
(error
(goto-char (point-min)))))
-(defvar recentf-dialog-mode-map
- (let ((km (copy-keymap recentf--shortcuts-keymap)))
- (set-keymap-parent km widget-keymap)
- (define-key km "q" #'recentf-cancel-dialog)
- (define-key km "n" #'next-line)
- (define-key km "p" #'previous-line)
- km)
- "Keymap used in recentf dialogs.")
+(defvar-keymap recentf-dialog-mode-map
+ :doc "Keymap used in recentf dialogs."
+ :parent (make-composed-keymap recentf--shortcuts-keymap widget-keymap)
+ "q" #'recentf-cancel-dialog
+ "n" #'next-line
+ "p" #'previous-line
+ "C-c C-c" #'recentf-edit-list-validate
+ "C-c C-k" #'recentf-cancel-dialog)
(define-derived-mode recentf-dialog-mode nil "recentf-dialog"
"Major mode of recentf dialogs.
\\{recentf-dialog-mode-map}"
+ :interactive nil
:syntax-table nil
:abbrev-table nil
(setq truncate-lines t))
@@ -1104,6 +1134,7 @@ IGNORE other arguments."
(defun recentf-edit-list-validate (&rest _ignore)
"Process the recent list when the edit list dialog is committed.
IGNORE arguments."
+ (interactive nil recentf-dialog-mode)
(if recentf-edit-list
(let ((i 0))
(dolist (e recentf-edit-list)
@@ -1123,8 +1154,8 @@ IGNORE arguments."
(widget-insert
(format-message
(substitute-command-keys
- "Click on OK to delete selected files from the recent list.
-Click on Cancel or type \\[recentf-cancel-dialog] to cancel.\n")))
+ "Click on \"OK\" or type \\[recentf-edit-list-validate] to delete selected files from the recent list.
+Click on \"Cancel\" or type \\[recentf-cancel-dialog] to cancel.\n")))
;; Insert the list of files as checkboxes
(dolist (item recentf-list)
(widget-create 'checkbox
@@ -1337,12 +1368,18 @@ That is, remove duplicates, non-kept, and excluded files."
;;; The minor mode
;;
-(defvar recentf-mode-map (make-sparse-keymap)
- "Keymap to use in recentf mode.")
+(defvar-keymap recentf-mode-map
+ :doc "Keymap to use in `recentf-mode'.")
;;;###autoload
(define-minor-mode recentf-mode
- "Toggle \"Open Recent\" menu (Recentf mode).
+ "Toggle keeping track of opened files (Recentf mode).
+This mode maintains a list of recently opened files and makes it
+easy to visit them. The recent files list is automatically saved
+across Emacs sessions.
+
+You can use `recentf-open' or `recentf-open-files' to visit
+files.
When Recentf mode is enabled, a \"Open Recent\" submenu is
displayed in the \"File\" menu, containing a list of files that
@@ -1353,7 +1390,7 @@ to a file, and killing a buffer is counted as \"operating\" on
the file. If instead you want to prioritize files that appear in
buffers you switch to a lot, you can say something like the following:
- (add-hook 'buffer-list-update-hook 'recentf-track-opened-file)"
+ (add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file)"
:global t
:group 'recentf
:keymap recentf-mode-map
@@ -1379,8 +1416,13 @@ buffers you switch to a lot, you can say something like the following:
(define-obsolete-function-alias 'recentf-trunc-list #'seq-take "28.1")
+(defun recentf-elements (n)
+ "Return a list of the first N elements of the recent list."
+ (declare (obsolete "use `(seq-take recentf-list n)'." "29.1"))
+ (seq-take recentf-list n))
+
(provide 'recentf)
(run-hooks 'recentf-load-hook)
-
+
;;; recentf.el ends here
diff --git a/lisp/rect.el b/lisp/rect.el
index 15d636f074e..e717d2ac7e1 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -656,6 +656,8 @@ on. Only lasts until the region is next deactivated."
:lighter nil
(rectangle--reset-crutches)
(when rectangle-mark-mode
+ (advice-add 'region-beginning :around #'rectangle--region-beginning)
+ (advice-add 'region-end :around #'rectangle--region-end)
(add-hook 'deactivate-mark-hook
(lambda () (rectangle-mark-mode -1)))
(unless (region-active-p)
@@ -754,17 +756,38 @@ Ignores `line-move-visual'."
(rectangle--col-pos col 'point)))
+(defun rectangle--region-beginning (orig)
+ "Like `region-beginning' but supports rectangular regions."
+ (cond
+ ((not rectangle-mark-mode)
+ (funcall orig))
+ (t
+ (apply #'min (mapcar #'car (region-bounds))))))
+
+(defun rectangle--region-end (orig)
+ "Like `region-end' but supports rectangular regions."
+ (cond
+ ((not rectangle-mark-mode)
+ (funcall orig))
+ (t
+ (apply #'max (mapcar #'cdr (region-bounds))))))
+
(defun rectangle--extract-region (orig &optional delete)
(cond
((not rectangle-mark-mode)
(funcall orig delete))
((eq delete 'bounds)
- (extract-rectangle-bounds (region-beginning) (region-end)))
+ (extract-rectangle-bounds
+ ;; Avoid recursive calls from advice
+ (let (rectangle-mark-mode) (region-beginning))
+ (let (rectangle-mark-mode) (region-end))))
(t
(let* ((strs (funcall (if delete
#'delete-extract-rectangle
#'extract-rectangle)
- (region-beginning) (region-end)))
+ ;; Avoid recursive calls from advice
+ (let (rectangle-mark-mode) (region-beginning))
+ (let (rectangle-mark-mode) (region-end))))
(str (mapconcat #'identity strs "\n")))
(when (eq last-command 'kill-region)
;; Try to prevent kill-region from appending this to some
diff --git a/lisp/register.el b/lisp/register.el
index 9af99106e76..78aa130a948 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -279,6 +279,8 @@ ARG is the value of the prefix argument or nil."
(goto-char (cadr val)))
((eq (car val) 'file)
(find-file (cdr val)))
+ ((eq (car val) 'buffer)
+ (switch-to-buffer (cdr val)))
((eq (car val) 'file-query)
(or (find-buffer-visiting (nth 1 val))
(y-or-n-p (format "Visit file %s again? " (nth 1 val)))
@@ -417,6 +419,11 @@ Interactively, reads the register using `register-read-with-preview'."
(prin1 (cdr val))
(princ "."))
+ ((eq (car val) 'buffer)
+ (princ "the buffer ")
+ (prin1 (cdr val))
+ (princ "."))
+
((eq (car val) 'file-query)
(princ "a file-query reference:\n file ")
(prin1 (car (cdr val)))
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 4d04f5ae951..a32f3a4c507 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -176,7 +176,7 @@ that variable on the theory they're doing more good than harm; `repeat' does
that, and usually does do more good than harm. However, like all do-gooders,
sometimes `repeat' gets surprising results from its altruism. The value of
this function is always whether the value of `this-command' would've been
-'repeat if `repeat' hadn't modified it."
+`repeat' if `repeat' hadn't modified it."
(= repeat-num-input-keys-at-repeat num-input-keys))
;; An example of the use of (repeat-is-really-this-command) may still be
@@ -368,8 +368,8 @@ When non-nil and the last typed key (with or without modifiers)
doesn't exist in the keymap attached by the `repeat-map' property,
then don't activate that keymap for the next command. So only the
same keys among repeatable keys are allowed in the repeating sequence.
-For example, with a non-nil value, only `C-x u u' repeats undo,
-whereas `C-/ u' doesn't.
+For example, with a non-nil value, only \\`C-x u u' repeats undo,
+whereas \\`C-/ u' doesn't.
You can also set the property `repeat-check-key' on the command symbol.
This property can override the value of this variable.
@@ -500,14 +500,17 @@ See `describe-repeat-maps' for a list of all repeatable commands."
(defun repeat-echo-message-string (keymap)
"Return a string with a list of repeating keys."
(let (keys)
- (map-keymap (lambda (key _) (push key keys)) keymap)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) keymap)
(format-message "Repeat with %s%s"
(mapconcat (lambda (key)
- (key-description (vector key)))
+ (substitute-command-keys
+ (format "\\`%s'"
+ (key-description (vector key)))))
keys ", ")
(if repeat-exit-key
- (format ", or exit with %s"
- (key-description repeat-exit-key))
+ (substitute-command-keys
+ (format ", or exit with \\`%s'"
+ (key-description repeat-exit-key)))
""))))
(defun repeat-echo-message (keymap)
@@ -546,31 +549,39 @@ See `describe-repeat-maps' for a list of all repeatable commands."
Used in `repeat-mode'."
(interactive)
(require 'help-fns)
- (help-setup-xref (list #'describe-repeat-maps)
- (called-interactively-p 'interactive))
- (let ((keymaps nil))
- (all-completions
- "" obarray (lambda (s)
- (and (commandp s)
- (get s 'repeat-map)
- (push s (alist-get (get s 'repeat-map) keymaps)))))
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
-
- (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b)))))
- (princ (format-message "`%s' keymap is repeatable by these commands:\n"
- (car keymap)))
- (dolist (command (sort (cdr keymap) 'string-lessp))
- (let* ((info (help-fns--analyze-function command))
- (map (list (symbol-value (car keymap))))
- (desc (mapconcat (lambda (key)
- (format-message "`%s'" (key-description key)))
- (or (where-is-internal command map)
- (where-is-internal (nth 3 info) map))
- ", ")))
- (princ (format-message " `%s' (bound to %s)\n" command desc))))
- (princ "\n"))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-repeat-maps)
+ (called-interactively-p 'interactive))
+ (let ((keymaps nil))
+ (all-completions
+ "" obarray (lambda (s)
+ (and (commandp s)
+ (get s 'repeat-map)
+ (push s (alist-get (get s 'repeat-map) keymaps)))))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
+
+ (dolist (keymap (sort keymaps (lambda (a b)
+ (when (and (symbolp (car a))
+ (symbolp (car b)))
+ (string-lessp (car a) (car b))))))
+ (insert (format-message
+ "`%s' keymap is repeatable by these commands:\n"
+ (car keymap)))
+ (dolist (command (sort (cdr keymap) #'string-lessp))
+ (let* ((info (help-fns--analyze-function command))
+ (map (list (if (symbolp (car keymap))
+ (symbol-value (car keymap))
+ (car keymap))))
+ (desc (mapconcat (lambda (key)
+ (propertize (key-description key)
+ 'face 'help-key-binding))
+ (or (where-is-internal command map)
+ (where-is-internal (nth 3 info) map))
+ ", ")))
+ (insert (format-message " `%s' (bound to %s)\n" command desc))))
+ (insert "\n")))))))
(provide 'repeat)
diff --git a/lisp/replace.el b/lisp/replace.el
index dd1bdae4c54..54ee64f64a5 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -30,6 +30,7 @@
(require 'text-mode)
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
(defcustom case-replace t
"Non-nil means `query-replace' should preserve case in replacements."
@@ -186,6 +187,12 @@ See `replace-regexp' and `query-replace-regexp-eval'.")
length)
length)))))
+(defvar query-replace-read-from-default nil
+ "Function to get default non-regexp value for `query-replace-read-from'.")
+
+(defvar query-replace-read-from-regexp-default nil
+ "Function to get default regexp value for `query-replace-read-from'.")
+
(defun query-replace-read-from-suggestions ()
"Return a list of standard suggestions for `query-replace-read-from'.
By default, the list includes the active region, the identifier
@@ -233,8 +240,12 @@ wants to replace FROM with TO."
query-replace-defaults))
(symbol-value query-replace-from-history-variable)))
(minibuffer-allow-text-properties t) ; separator uses text-properties
+ (default (when (and query-replace-read-from-default (not regexp-flag))
+ (funcall query-replace-read-from-default)))
(prompt
- (cond ((and query-replace-defaults separator)
+ (cond ((and query-replace-read-from-regexp-default regexp-flag) prompt)
+ (default (format-prompt prompt default))
+ ((and query-replace-defaults separator)
(format-prompt prompt (car minibuffer-history)))
(query-replace-defaults
(format-prompt
@@ -255,16 +266,26 @@ wants to replace FROM with TO."
(append '((separator . t) (face . t))
text-property-default-nonsticky)))
(if regexp-flag
- (read-regexp prompt nil 'minibuffer-history)
+ (read-regexp
+ (if query-replace-read-from-regexp-default
+ (string-remove-suffix ": " prompt)
+ prompt)
+ query-replace-read-from-regexp-default
+ 'minibuffer-history)
(read-from-minibuffer
prompt nil nil nil nil
- (query-replace-read-from-suggestions) t)))))
+ (if default
+ (delete-dups
+ (cons default (query-replace-read-from-suggestions)))
+ (query-replace-read-from-suggestions))
+ t)))))
(to))
- (if (and (zerop (length from)) query-replace-defaults)
+ (if (and (zerop (length from)) query-replace-defaults (not default))
(cons (caar query-replace-defaults)
(query-replace-compile-replacement
(cdar query-replace-defaults) regexp-flag))
- (setq from (query-replace--split-string from))
+ (setq from (or (and (zerop (length from)) default)
+ (query-replace--split-string from)))
(when (consp from) (setq to (cdr from) from (car from)))
(add-to-history query-replace-from-history-variable from nil t)
;; Warn if user types \n or \t, but don't reject the input.
@@ -345,11 +366,33 @@ should a regexp."
(unless noerror
(barf-if-buffer-read-only))
(save-mark-and-excursion
- (let* ((from (query-replace-read-from prompt regexp-flag))
+ (let* ((delimited-flag (and current-prefix-arg
+ (not (eq current-prefix-arg '-))))
+ (from (minibuffer-with-setup-hook
+ (minibuffer-lazy-highlight-setup
+ :case-fold case-fold-search
+ :filter (when (use-region-p)
+ (replace--region-filter
+ (funcall region-extract-function 'bounds)))
+ :highlight query-replace-lazy-highlight
+ :regexp regexp-flag
+ :regexp-function (or replace-regexp-function
+ delimited-flag
+ (and replace-char-fold
+ (not regexp-flag)
+ #'char-fold-to-regexp))
+ :transform (lambda (string)
+ (let* ((split (query-replace--split-string string))
+ (from-string (if (consp split) (car split) split)))
+ (when (and case-fold-search search-upper-case)
+ (setq isearch-case-fold-search
+ (isearch-no-upper-case-p from-string regexp-flag)))
+ from-string)))
+ (query-replace-read-from prompt regexp-flag)))
(to (if (consp from) (prog1 (cdr from) (setq from (car from)))
(query-replace-read-to from prompt regexp-flag))))
(list from to
- (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
+ (or delimited-flag
(and (plist-member (text-properties-at 0 from) 'isearch-regexp-function)
(get-text-property 0 'isearch-regexp-function from)))
(and current-prefix-arg (eq current-prefix-arg '-))))))
@@ -372,7 +415,7 @@ word boundaries. A negative prefix arg means replace backward.
Use \\<minibuffer-local-map>\\[next-history-element] \
to pull the last incremental search string to the minibuffer
that reads FROM-STRING, or invoke replacements from
-incremental search with a key sequence like `C-s C-s M-%'
+incremental search with a key sequence like \\`C-s C-s M-%'
to use its current search string as the string to replace.
Matching is independent of case if both `case-fold-search'
@@ -429,8 +472,8 @@ To customize possible responses, change the bindings in `query-replace-map'."
(defun query-replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p)
"Replace some things after point matching REGEXP with TO-STRING.
As each match is found, the user must type a character saying
-what to do with it. Type SPC or `y' to replace the match,
-DEL or `n' to skip and go to the next match. For more directions,
+what to do with it. Type \\`SPC' or \\`y' to replace the match,
+\\`DEL' or \\`n' to skip and go to the next match. For more directions,
type \\[help-command] at that time.
In Transient Mark mode, if the mark is active, operate on the contents
@@ -438,12 +481,12 @@ of the region. Otherwise, operate from point to the end of the buffer's
accessible portion.
When invoked interactively, matching a newline with `\\n' will not work;
-use `C-q C-j' instead. To match a tab character (`\\t'), just press `TAB'.
+use \\`C-q C-j' instead. To match a tab character (`\\t'), just press \\`TAB'.
Use \\<minibuffer-local-map>\\[next-history-element] \
to pull the last incremental search regexp to the minibuffer
that reads REGEXP, or invoke replacements from
-incremental search with a key sequence like `C-M-s C-M-s C-M-%'
+incremental search with a key sequence like \\`C-M-s C-M-s C-M-%'
to use its current search regexp as the regexp to replace.
Matching is independent of case if both `case-fold-search'
@@ -852,6 +895,23 @@ by this function to the end of values available via
(regexp-quote (or (car search-ring) ""))
(car (symbol-value query-replace-from-history-variable))))
+(defvar-keymap read-regexp-map
+ :parent minibuffer-local-map
+ "M-c" #'read-regexp-toggle-case-folding)
+
+(defvar read-regexp--case-fold nil)
+
+(defun read-regexp-toggle-case-folding ()
+ (interactive)
+ (setq read-regexp--case-fold
+ (if (or (eq read-regexp--case-fold 'fold)
+ (and read-regexp--case-fold
+ (not (eq read-regexp--case-fold 'inhibit-fold))))
+ 'inhibit-fold
+ 'fold))
+ (minibuffer-message "Case folding is now %s"
+ (if (eq read-regexp--case-fold 'fold) "on" "off")))
+
(defun read-regexp (prompt &optional defaults history)
"Read and return a regular expression as a string.
Prompt with the string PROMPT. If PROMPT ends in \":\" (followed by
@@ -886,7 +946,16 @@ If the first element of DEFAULTS is non-nil (and if PROMPT does not end
in \":\", followed by optional whitespace), DEFAULT is added to the prompt.
The optional argument HISTORY is a symbol to use for the history list.
-If nil, use `regexp-history'."
+If nil, use `regexp-history'.
+
+If the user has used the \\<read-regexp-map>\\[read-regexp-toggle-case-folding] command to specify case
+sensitivity, the returned string will have a text property named
+`case-fold' that has a value of either `fold' or
+`inhibit-fold'. (It's up to the caller of `read-regexp' to
+respect this or not; see `read-regexp-case-fold-search'.)
+
+This command uses the `read-regexp-map' keymap while reading the
+regexp from the user."
(let* ((defaults
(if (and defaults (symbolp defaults))
(cond
@@ -902,21 +971,37 @@ If nil, use `regexp-history'."
(suggestions (delete-dups (delq nil (delete "" suggestions))))
;; Do not automatically add default to the history for empty input.
(history-add-new-input nil)
+ ;; `read-regexp--case-fold' dynamically bound and may be
+ ;; altered by `M-c'.
+ (read-regexp--case-fold case-fold-search)
(input (read-from-minibuffer
(if (string-match-p ":[ \t]*\\'" prompt)
prompt
(format-prompt prompt (and (length> default 0)
(query-replace-descr default))))
- nil nil nil (or history 'regexp-history) suggestions t)))
- (if (equal input "")
- ;; Return the default value when the user enters empty input.
- (prog1 (or default input)
- (when default
- (add-to-history (or history 'regexp-history) default)))
- ;; Otherwise, add non-empty input to the history and return input.
- (prog1 input
- (add-to-history (or history 'regexp-history) input)))))
-
+ nil read-regexp-map
+ nil (or history 'regexp-history) suggestions t))
+ (result (if (equal input "")
+ ;; Return the default value when the user enters
+ ;; empty input.
+ default
+ input)))
+ (when result
+ (add-to-history (or history 'regexp-history) result))
+ (if (and result
+ (or (eq read-regexp--case-fold 'fold)
+ (eq read-regexp--case-fold 'inhibit-fold)))
+ (propertize result 'case-fold read-regexp--case-fold)
+ (or result input))))
+
+(defun read-regexp-case-fold-search (regexp)
+ "Return a value for `case-fold-search' based on REGEXP and current settings.
+REGEXP is a string as returned by `read-regexp'."
+ (let ((fold (get-text-property 0 'case-fold regexp)))
+ (cond
+ ((eq fold 'fold) t)
+ ((eq fold 'inhibit-fold) nil)
+ (t case-fold-search))))
(defalias 'delete-non-matching-lines 'keep-lines)
(defalias 'delete-matching-lines 'flush-lines)
@@ -2102,6 +2187,7 @@ See also `multi-occur'."
;; (for Occur Edit mode).
front-sticky t
rear-nonsticky t
+ read-only t
occur-target ,markers
follow-link t
help-echo "mouse-2: go to this occurrence"))))
@@ -2279,11 +2365,11 @@ See also `multi-occur'."
(defun occur-engine-add-prefix (lines &optional prefix-face)
(mapcar
- #'(lambda (line)
- (concat (if prefix-face
- (propertize " :" 'font-lock-face prefix-face)
- " :")
- line "\n"))
+ (lambda (line)
+ (concat (if prefix-face
+ (propertize " :" 'font-lock-face prefix-face)
+ " :")
+ line "\n"))
lines))
(defun occur-accumulate-lines (count &optional keep-props pt)
@@ -2418,20 +2504,21 @@ To be added to `context-menu-functions'."
;; It would be nice to use \\[...], but there is no reasonable way
;; to make that display both SPC and Y.
(defconst query-replace-help
- "Type Space or `y' to replace one match, Delete or `n' to skip to next,
-RET or `q' to exit, Period to replace one match and exit,
-Comma to replace but not move point immediately,
-C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
-C-w to delete match and recursive edit,
-C-l to clear the screen, redisplay, and offer same replacement again,
-! to replace all remaining matches in this buffer with no more questions,
-^ to move point back to previous match,
-u to undo previous replacement,
-U to undo all replacements,
-E to edit the replacement string.
-In multi-buffer replacements type `Y' to replace all remaining
+ "Type \\`SPC' or \\`y' to replace one match, Delete or \\`n' to skip to next,
+\\`RET' or \\`q' to exit, Period to replace one match and exit,
+\\`,' to replace but not move point immediately,
+\\`C-r' to enter recursive edit (\\[exit-recursive-edit] to get out again),
+\\`C-w' to delete match and recursive edit,
+\\`C-l' to clear the screen, redisplay, and offer same replacement again,
+\\`!' to replace all remaining matches in this buffer with no more questions,
+\\`^' to move point back to previous match,
+\\`u' to undo previous replacement,
+\\`U' to undo all replacements,
+\\`e' to edit the replacement string.
+\\`E' to edit the replacement string with exact case.
+In multi-buffer replacements type \\`Y' to replace all remaining
matches in all remaining buffers with no more questions,
-`N' to skip to the next buffer without replacing remaining matches
+\\`N' to skip to the next buffer without replacing remaining matches
in the current buffer."
"Help message while in `query-replace'.")
@@ -2446,7 +2533,7 @@ in the current buffer."
(define-key map "Y" 'act)
(define-key map "N" 'skip)
(define-key map "e" 'edit-replacement)
- (define-key map "E" 'edit-replacement)
+ (define-key map "E" 'edit-replacement-exact-case)
(define-key map "," 'act-and-show)
(define-key map "q" 'exit)
(define-key map "\r" 'exit)
@@ -2483,8 +2570,9 @@ The \"bindings\" in this map are not commands; they are answers.
The valid answers include `act', `skip', `act-and-show',
`act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
`scroll-down', `scroll-other-window', `scroll-other-window-down',
-`edit', `edit-replacement', `delete-and-edit', `automatic',
-`backup', `undo', `undo-all', `quit', and `help'.
+`edit', `edit-replacement', `edit-replacement-exact-case',
+`delete-and-edit', `automatic', `backup', `undo', `undo-all',
+`quit', and `help'.
This keymap is used by `y-or-n-p' as well as `query-replace'.")
@@ -2637,6 +2725,15 @@ It is used by `query-replace-regexp', `replace-regexp',
It is called with three arguments, as if it were
`re-search-forward'.")
+(defvar replace-regexp-function nil
+ "Function to convert the FROM string of query-replace commands to a regexp.
+This is used by `query-replace', `query-replace-regexp', etc. as
+the value of `isearch-regexp-function' when they search for the
+occurrences of the string/regexp to be replaced. This is intended
+to be used when the string to be replaced, as typed by the user,
+is not to be interpreted literally, but instead should be converted
+to a regexp that is actually used for the search.")
+
(defun replace-search (search-string limit regexp-flag delimited-flag
case-fold &optional backward)
"Search for the next occurrence of SEARCH-STRING to replace."
@@ -2649,7 +2746,8 @@ It is called with three arguments, as if it were
;; outside of this function because then another I-search
;; used after `recursive-edit' might override them.
(let* ((isearch-regexp regexp-flag)
- (isearch-regexp-function (or delimited-flag
+ (isearch-regexp-function (or replace-regexp-function
+ delimited-flag
(and replace-char-fold
(not regexp-flag)
#'char-fold-to-regexp)))
@@ -2665,6 +2763,11 @@ It is called with three arguments, as if it were
(or (if regexp-flag
replace-re-search-function
replace-search-function)
+ ;; `isearch-search-fun' can't be used here because
+ ;; when buffer-local `isearch-search-fun-function'
+ ;; searches e.g. the minibuffer history, then
+ ;; `query-replace' should not operate on the whole
+ ;; history, but only on the minibuffer contents.
(isearch-search-fun-default))))
(funcall search-function search-string limit t)))
@@ -2706,7 +2809,8 @@ It is called with three arguments, as if it were
(if query-replace-lazy-highlight
(let ((isearch-string search-string)
(isearch-regexp regexp-flag)
- (isearch-regexp-function (or delimited-flag
+ (isearch-regexp-function (or replace-regexp-function
+ delimited-flag
(and replace-char-fold
(not regexp-flag)
#'char-fold-to-regexp)))
@@ -2752,6 +2856,26 @@ It is called with three arguments, as if it were
,search-str ,next-replace)
,stack))
+(defun replace--region-filter (bounds)
+ "Return a function that decides if a region is inside BOUNDS.
+BOUNDS is a list of cons cells of the form (START . END). The
+returned function takes as argument two buffer positions, START
+and END."
+ (let ((region-bounds
+ (mapcar (lambda (position)
+ (cons (copy-marker (car position))
+ (copy-marker (cdr position))))
+ bounds)))
+ (lambda (start end)
+ (delq nil (mapcar
+ (lambda (bounds)
+ (and
+ (>= start (car bounds))
+ (<= start (cdr bounds))
+ (>= end (car bounds))
+ (<= end (cdr bounds))))
+ region-bounds)))))
+
(defun perform-replace (from-string replacements
query-flag regexp-flag delimited-flag
&optional repeat-count map start end backward region-noncontiguous-p)
@@ -2836,22 +2960,9 @@ characters."
;; Unless a single contiguous chunk is selected, operate on multiple chunks.
(when region-noncontiguous-p
- (let ((region-bounds
- (mapcar (lambda (position)
- (cons (copy-marker (car position))
- (copy-marker (cdr position))))
- (funcall region-extract-function 'bounds))))
- (setq region-filter
- (lambda (start end)
- (delq nil (mapcar
- (lambda (bounds)
- (and
- (>= start (car bounds))
- (<= start (cdr bounds))
- (>= end (car bounds))
- (<= end (cdr bounds))))
- region-bounds))))
- (add-function :after-while isearch-filter-predicate region-filter)))
+ (setq region-filter (replace--region-filter
+ (funcall region-extract-function 'bounds)))
+ (add-function :after-while isearch-filter-predicate region-filter))
;; If region is active, in Transient Mark mode, operate on region.
(if backward
@@ -3212,7 +3323,13 @@ characters."
(last-command 'recenter-top-bottom))
(recenter-top-bottom)))
((eq def 'edit)
- (let ((opos (point-marker)))
+ (let ((opos (point-marker))
+ ;; Restore original isearch filter to allow
+ ;; using isearch in a recursive edit even
+ ;; when perform-replace was started from
+ ;; `xref--query-replace-1' that let-binds
+ ;; `isearch-filter-predicate' (bug#53758).
+ (isearch-filter-predicate #'isearch-filter-visible))
(setq real-match-data (replace-match-data
nil real-match-data
real-match-data))
@@ -3229,19 +3346,29 @@ characters."
(setq match-again (and (looking-at search-string)
(match-data)))))
;; Edit replacement.
- ((eq def 'edit-replacement)
+ ((or (eq def 'edit-replacement)
+ (eq def 'edit-replacement-exact-case))
(setq real-match-data (replace-match-data
nil real-match-data
real-match-data)
next-replacement
- (read-string "Edit replacement string: "
- next-replacement)
+ (read-string
+ (format "Edit replacement string%s: "
+ (if (eq def
+ 'edit-replacement-exact-case)
+ " (exact case)"
+ ""))
+ next-replacement)
noedit nil)
(if replaced
(set-match-data real-match-data)
(setq noedit
(replace-match-maybe-edit
- next-replacement nocasify literal noedit
+ next-replacement
+ (if (eq def 'edit-replacement-exact-case)
+ t
+ nocasify)
+ literal noedit
real-match-data backward)
replaced t)
(setq next-replacement-replaced next-replacement))
diff --git a/lisp/rot13.el b/lisp/rot13.el
index 2dd53dfb2fd..c063725de85 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -46,29 +46,23 @@
;;; Code:
-(defvar rot13-display-table
- (let ((table (make-display-table))
- (i 0))
- (while (< i 26)
+(defconst rot13-display-table
+ (let ((table (make-display-table)))
+ (dotimes (i 26)
(aset table (+ i ?a) (vector (+ (% (+ i 13) 26) ?a)))
- (aset table (+ i ?A) (vector (+ (% (+ i 13) 26) ?A)))
- (setq i (1+ i)))
+ (aset table (+ i ?A) (vector (+ (% (+ i 13) 26) ?A))))
table)
"Char table for ROT13 display.")
-(defvar rot13-translate-table
- (let ((str (make-string 127 0))
- (i 0))
- (while (< i 127)
- (aset str i i)
- (setq i (1+ i)))
- (setq i 0)
- (while (< i 26)
- (aset str (+ i ?a) (+ (% (+ i 13) 26) ?a))
- (aset str (+ i ?A) (+ (% (+ i 13) 26) ?A))
- (setq i (1+ i)))
- str)
- "String table for ROT13 translation.")
+(put 'plain-char-table 'char-table-extra-slots 0)
+
+(defconst rot13-translate-table
+ (let ((table (make-char-table 'translation-table)))
+ (dotimes (i 26)
+ (aset table (+ i ?a) (+ (% (+ i 13) 26) ?a))
+ (aset table (+ i ?A) (+ (% (+ i 13) 26) ?A)))
+ table)
+ "Char table for ROT13 translation.")
;;;###autoload
(defun rot13 (object &optional start end)
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index afe1cd4bfda..0b18697cea7 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -279,21 +279,24 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(let ((edges (window-edges)))
(- (nth 2 edges) (nth 0 edges))))
-(defsubst ruler-mode-window-col (n)
+(defsubst ruler-mode-window-col (event)
"Return a column number relative to the selected window.
-N is a column number relative to selected frame.
+EVENT is the mouse event that gives the current column.
If required, account for screen estate taken by `display-line-numbers'."
- (if display-line-numbers
+ (let ((n (car (posn-col-row event))))
+ (when display-line-numbers
;; FIXME: ruler-mode relies on N being an integer, so if the
;; 'line-number' face is customized to use a font that is larger
;; or smaller than that of the default face, the alignment might
;; be off by up to half a column, unless the font width is an
;; integral multiple or divisor of the default face's font.
(setq n (- n (round (line-number-display-width 'columns)))))
- (- n
- (or (car (window-margins)) 0)
- (fringe-columns 'left)
- (scroll-bar-columns 'left)))
+ (- n
+ (if (eq (posn-area event) 'header-line)
+ (+ (or (car (window-margins)) 0)
+ (fringe-columns 'left)
+ (scroll-bar-columns 'left))
+ 0))))
(defun ruler-mode-mouse-set-left-margin (start-event)
"Set left margin end to the graduation where the mouse pointer is on.
@@ -370,7 +373,7 @@ dragging. See also the variable `ruler-mode-dragged-symbol'."
col newc oldc)
(save-selected-window
(select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row start)))
+ (setq col (ruler-mode-window-col start)
newc (+ col (ruler-mode-text-scaled-window-hscroll)))
(and
(>= col 0) (< col (ruler-mode-text-scaled-window-width))
@@ -455,7 +458,7 @@ Called on each mouse motion event START-EVENT."
col newc)
(save-selected-window
(select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row end)))
+ (setq col (ruler-mode-window-col end)
newc (+ col (ruler-mode-text-scaled-window-hscroll)))
(when (and (>= col 0) (< col (ruler-mode-text-scaled-window-width)))
(set ruler-mode-dragged-symbol newc)))))
@@ -471,7 +474,7 @@ START-EVENT is the mouse click event."
(when (eq start end) ;; mouse click
(save-selected-window
(select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row start)))
+ (setq col (ruler-mode-window-col start)
ts (+ col (ruler-mode-text-scaled-window-hscroll)))
(and (>= col 0) (< col (ruler-mode-text-scaled-window-width))
(not (member ts tab-stop-list))
@@ -492,7 +495,7 @@ START-EVENT is the mouse click event."
(when (eq start end) ;; mouse click
(save-selected-window
(select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row start)))
+ (setq col (ruler-mode-window-col start)
ts (+ col (ruler-mode-text-scaled-window-hscroll)))
(and (>= col 0) (< col (ruler-mode-text-scaled-window-width))
(member ts tab-stop-list)
@@ -506,36 +509,21 @@ START-EVENT is the mouse click event."
(setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
(force-mode-line-update))
-(defvar ruler-mode-map
- (let ((km (make-sparse-keymap)))
- (define-key km [header-line down-mouse-1]
- #'ignore)
- (define-key km [header-line down-mouse-3]
- #'ignore)
- (define-key km [header-line down-mouse-2]
- #'ruler-mode-mouse-grab-any-column)
- (define-key km [header-line (shift down-mouse-1)]
- #'ruler-mode-mouse-set-left-margin)
- (define-key km [header-line (shift down-mouse-3)]
- #'ruler-mode-mouse-set-right-margin)
- (define-key km [header-line (control down-mouse-1)]
- #'ruler-mode-mouse-add-tab-stop)
- (define-key km [header-line (control down-mouse-3)]
- #'ruler-mode-mouse-del-tab-stop)
- (define-key km [header-line (control down-mouse-2)]
- #'ruler-mode-toggle-show-tab-stops)
- (define-key km [header-line (shift mouse-1)]
- #'ignore)
- (define-key km [header-line (shift mouse-3)]
- #'ignore)
- (define-key km [header-line (control mouse-1)]
- #'ignore)
- (define-key km [header-line (control mouse-3)]
- #'ignore)
- (define-key km [header-line (control mouse-2)]
- #'ignore)
- km)
- "Keymap for ruler minor mode.")
+(defvar-keymap ruler-mode-map
+ :doc "Keymap for `ruler-mode'."
+ "<header-line> <down-mouse-1>" #'ignore
+ "<header-line> <down-mouse-3>" #'ignore
+ "<header-line> <down-mouse-2>" #'ruler-mode-mouse-grab-any-column
+ "<header-line> S-<down-mouse-1>" #'ruler-mode-mouse-set-left-margin
+ "<header-line> S-<down-mouse-3>" #'ruler-mode-mouse-set-right-margin
+ "<header-line> C-<down-mouse-1>" #'ruler-mode-mouse-add-tab-stop
+ "<header-line> C-<down-mouse-3>" #'ruler-mode-mouse-del-tab-stop
+ "<header-line> C-<down-mouse-2>" #'ruler-mode-toggle-show-tab-stops
+ "<header-line> S-<mouse-1>" #'ignore
+ "<header-line> S-<mouse-3>" #'ignore
+ "<header-line> C-<mouse-1>" #'ignore
+ "<header-line> C-<mouse-3>" #'ignore
+ "<header-line> C-<mouse-2>" #'ignore)
(defvar ruler-mode-header-line-format-old nil
"Hold previous value of `header-line-format'.")
diff --git a/lisp/savehist.el b/lisp/savehist.el
index aab304007b2..8924c8dde23 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -60,14 +60,19 @@ If you want to save only specific histories, use `savehist-save-hook'
to modify the value of `savehist-minibuffer-history-variables'."
:type 'boolean)
-(defcustom savehist-additional-variables ()
+(defcustom savehist-additional-variables nil
"List of additional variables to save.
-Each element is a symbol whose value will be persisted across Emacs
-sessions that use Savehist. The contents of variables should be
-printable with the Lisp printer. You don't need to add minibuffer
-history variables to this list, all minibuffer histories will be
-saved automatically as long as `savehist-save-minibuffer-history' is
-non-nil.
+Each element is a variable that will be persisted across Emacs
+sessions that use Savehist.
+
+An element may be variable name (a symbol) or a cons cell of the form
+\(VAR . MAX-SIZE), which means to truncate VAR's value to at most
+MAX-SIZE elements (if the value is a list) before saving the value.
+
+The contents of variables should be printable with the Lisp
+printer. You don't need to add minibuffer history variables to
+this list, all minibuffer histories will be saved automatically
+as long as `savehist-save-minibuffer-history' is non-nil.
User options should be saved with the Customize interface. This
list is useful for saving automatically updated variables that are not
@@ -92,7 +97,8 @@ This is decimal, not octal. The default is 384 (0600 in octal).
Set to nil to use the default permissions that Emacs uses, typically
mandated by umask. The default is a bit more restrictive to protect
the user's privacy."
- :type 'integer)
+ :type '(choice (natnum :tag "Specify")
+ (const :tag "Use default" :value nil)))
(defcustom savehist-autosave-interval (* 5 60)
"The interval between autosaves of minibuffer history.
@@ -278,12 +284,21 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
(delete-region (point) (1+ (point)))))
(insert "))\n"))))))
;; Save the additional variables.
- (dolist (symbol savehist-additional-variables)
- (when (boundp symbol)
- (let ((value (symbol-value symbol)))
- (when (savehist-printable value)
- (prin1 `(setq ,symbol ',value) (current-buffer))
- (insert ?\n))))))
+ (dolist (elem savehist-additional-variables)
+ (let ((symbol (if (consp elem)
+ (car elem)
+ elem)))
+ (when (boundp symbol)
+ (let ((value (symbol-value symbol)))
+ (when (savehist-printable value)
+ ;; When we have a max-size, chop off the last elements.
+ (when (and (consp elem)
+ (listp value)
+ (length> value (cdr elem)))
+ (setq value (copy-sequence value))
+ (setcdr (nthcdr (cdr elem) value) nil))
+ (prin1 `(setq ,symbol ',value) (current-buffer))
+ (insert ?\n)))))))
;; If autosaving, avoid writing if nothing has changed since the
;; last write.
(let ((checksum (md5 (current-buffer) nil nil savehist-coding-system)))
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index c088facb3c3..3830e4b16cf 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -290,7 +290,11 @@ may have changed) back to `save-place-alist'."
;; adding hooks to it.
(with-current-buffer (get-buffer-create " *Saved Places*")
(delete-region (point-min) (point-max))
- (insert-file-contents file)
+ ;; Make sure our 'coding:' cookie in the save-place
+ ;; file will take effect, in case the caller binds
+ ;; coding-system-for-read.
+ (let (coding-system-for-read)
+ (insert-file-contents file))
(goto-char (point-min))
(setq save-place-alist
(with-demoted-errors "Error reading save-place-file: %S"
@@ -328,14 +332,26 @@ may have changed) back to `save-place-alist'."
(with-current-buffer (car buf-list)
;; save-place checks buffer-file-name too, but we can avoid
;; overhead of function call by checking here too.
- (and (or buffer-file-name (and (derived-mode-p 'dired-mode)
- (boundp 'dired-subdir-alist)
- dired-subdir-alist
- (dired-current-directory)))
- (save-place-to-alist))
+ (when (and (or buffer-file-name
+ (and (derived-mode-p 'dired-mode)
+ (boundp 'dired-subdir-alist)
+ dired-subdir-alist
+ (dired-current-directory)))
+ ;; Don't save place in literally-visited file
+ ;; because this will commonly differ from the place
+ ;; when visiting literally (and
+ ;; `find-file-literally' always places point at the
+ ;; start of the buffer).
+ (not find-file-literally))
+ (save-place-to-alist))
(setq buf-list (cdr buf-list))))))
+(defvar save-place-after-find-file-hook nil
+ "Hook run at the end of `save-place-find-file-hook'.")
+
(defun save-place-find-file-hook ()
+ "Function added to `find-file-hook' by `save-place-mode'.
+It runs the hook `save-place-after-find-file-hook'."
(or save-place-loaded (load-save-place-alist-from-file))
(let ((cell (assoc buffer-file-name save-place-alist)))
(if cell
@@ -344,7 +360,8 @@ may have changed) back to `save-place-alist'."
(and (integerp (cdr cell))
(goto-char (cdr cell))))
;; and make sure it will be saved again for later
- (setq save-place-mode t)))))
+ (setq save-place-mode t))))
+ (run-hooks 'save-place-after-find-file-hook))
(declare-function dired-goto-file "dired" (file))
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 3d12723c025..5786a21e88e 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -132,8 +132,11 @@ Setting the variable with a customization buffer also takes effect."
(define-minor-mode scroll-bar-mode
"Toggle vertical scroll bars on all frames (Scroll Bar mode).
-This command applies to all frames that exist and frames to be
-created in the future."
+This command applies to all frames that exist, as well as new
+frames to be created in the future. This is done by altering the
+frame parameters, so if you (re-)set `default-frame-alist' after
+toggling the scroll bars on or off with this command, the scroll
+bars may reappear on new frames."
:variable ((get-scroll-bar-mode)
. (lambda (v) (set-scroll-bar-mode
(if v (or previous-scroll-bar-mode
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index d41e3352332..fa1f3a633b5 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -30,15 +30,13 @@
;;; Code:
-(defvar scroll-lock-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap next-line] 'scroll-lock-next-line)
- (define-key map [remap previous-line] 'scroll-lock-previous-line)
- (define-key map [remap forward-paragraph] 'scroll-lock-forward-paragraph)
- (define-key map [remap backward-paragraph] 'scroll-lock-backward-paragraph)
- (define-key map [S-down] 'scroll-lock-next-line-always-scroll)
- map)
- "Keymap for Scroll Lock mode.")
+(defvar-keymap scroll-lock-mode-map
+ :doc "Keymap for Scroll Lock mode."
+ "<remap> <next-line>" #'scroll-lock-next-line
+ "<remap> <previous-line>" #'scroll-lock-previous-line
+ "<remap> <forward-paragraph>" #'scroll-lock-forward-paragraph
+ "<remap> <backward-paragraph>" #'scroll-lock-backward-paragraph
+ "S-<down>" #'scroll-lock-next-line-always-scroll)
(defvar-local scroll-lock-preserve-screen-pos-save scroll-preserve-screen-position
"Used for saving the state of `scroll-preserve-screen-position'.")
@@ -55,7 +53,7 @@ will scroll the buffer by the respective amount of lines instead
and point will be kept vertically fixed relative to window
boundaries during scrolling.
-Note that the default key binding to Scroll_Lock will not work on
+Note that the default key binding to `scroll' will not work on
MS-Windows systems if `w32-scroll-lock-modifier' is non-nil."
:lighter " ScrLck"
:keymap scroll-lock-mode-map
diff --git a/lisp/select.el b/lisp/select.el
index d9efe811a07..2d501f207f1 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -25,9 +25,10 @@
;; Based partially on earlier release by Lucid.
;; The functionality here is divided in two parts:
-;; - Low-level: gui-get-selection, gui-set-selection, gui-selection-owner-p,
-;; gui-selection-exists-p are the backend-dependent functions meant to access
-;; various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY).
+;; - Low-level: gui-backend-get-selection, gui-backend-set-selection,
+;; gui-backend-selection-owner-p, gui-backend-selection-exists-p are
+;; the backend-dependent functions meant to access various kinds of
+;; selections (CLIPBOARD, PRIMARY, SECONDARY).
;; - Higher-level: gui-select-text and gui-selection-value go together to
;; access the general notion of "GUI selection" for interoperation with other
;; applications. This can use either the clipboard or the primary selection,
@@ -108,56 +109,117 @@ E.g. it doesn't exist under MS-Windows."
:group 'killing
:version "25.1")
-;; We keep track of the last text selected here, so we can check the
-;; current selection against it, and avoid passing back our own text
-;; from gui-selection-value. We track both
-;; separately in case another X application only sets one of them
-;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same.
+;; We keep track of the last selection here, so we can check the
+;; current selection against it, and avoid passing back with
+;; gui-selection-value the same text we previously killed or
+;; yanked. We track both separately in case another X application only
+;; sets one of them we aren't fooled by the PRIMARY or CLIPBOARD
+;; selection staying the same.
(defvar gui--last-selected-text-clipboard nil
"The value of the CLIPBOARD selection last seen.")
+
(defvar gui--last-selected-text-primary nil
"The value of the PRIMARY selection last seen.")
+(defvar gui--last-selection-timestamp-clipboard nil
+ "The timestamp of the CLIPBOARD selection last seen.")
+
+(defvar gui--last-selection-timestamp-primary nil
+ "The timestamp of the PRIMARY selection last seen.")
+
+(defvar gui-last-cut-in-clipboard nil
+ "Whether or not the last call to `interprogram-cut-function' owned CLIPBOARD.")
+
+(defvar gui-last-cut-in-primary nil
+ "Whether or not the last call to `interprogram-cut-function' owned PRIMARY.")
+
+(defun gui--set-last-clipboard-selection (text)
+ "Save last clipboard selection.
+Save the selected text, passed as argument, and for window
+systems that support it, save the selection timestamp too."
+ (setq gui--last-selected-text-clipboard text)
+ (when (eq window-system 'x)
+ (setq gui--last-selection-timestamp-clipboard
+ (gui-backend-get-selection 'CLIPBOARD 'TIMESTAMP))))
+
+(defun gui--set-last-primary-selection (text)
+ "Save last primary selection.
+Save the selected text, passed as argument, and for window
+systems that support it, save the selection timestamp too."
+ (setq gui--last-selected-text-primary text)
+ (when (eq window-system 'x)
+ (setq gui--last-selection-timestamp-primary
+ (gui-backend-get-selection 'PRIMARY 'TIMESTAMP))))
+
+(defun gui--clipboard-selection-unchanged-p (text)
+ "Check whether the clipboard selection has changed.
+Compare the selection text, passed as argument, with the text
+from the last saved selection. For window systems that support
+it, compare the selection timestamp too."
+ (and
+ (equal text gui--last-selected-text-clipboard)
+ (or (not (eq window-system 'x))
+ (eq gui--last-selection-timestamp-clipboard
+ (gui-backend-get-selection 'CLIPBOARD 'TIMESTAMP)))))
+
+(defun gui--primary-selection-unchanged-p (text)
+ "Check whether the primary selection has changed.
+Compare the selection text, passed as argument, with the text
+from the last saved selection. For window systems that support
+it, compare the selection timestamp too."
+ (and
+ (equal text gui--last-selected-text-primary)
+ (or (not (eq window-system 'x))
+ (eq gui--last-selection-timestamp-primary
+ (gui-backend-get-selection 'PRIMARY 'TIMESTAMP)))))
+
+
(defun gui-select-text (text)
"Select TEXT, a string, according to the window system.
-if `select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard.
+If `select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard.
If `select-enable-primary' is non-nil, put TEXT in the primary selection.
MS-Windows does not have a \"primary\" selection."
(when select-enable-primary
(gui-set-selection 'PRIMARY text)
- (setq gui--last-selected-text-primary text))
+ (gui--set-last-primary-selection text))
(when select-enable-clipboard
;; When cutting, the selection is cleared and PRIMARY
;; set to the empty string. Prevent that, PRIMARY
;; should not be reset by cut (Bug#16382).
(setq saved-region-selection text)
(gui-set-selection 'CLIPBOARD text)
- (setq gui--last-selected-text-clipboard text)))
+ (gui--set-last-clipboard-selection text))
+ ;; Record which selections we now have ownership over.
+ (setq gui-last-cut-in-clipboard select-enable-clipboard
+ gui-last-cut-in-primary select-enable-primary))
(define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1")
(defcustom x-select-request-type nil
"Data type request for X selection.
The value is one of the following data types, a list of them, or nil:
- `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
+ `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT', `text/plain\\;charset=utf-8'
If the value is one of the above symbols, try only the specified type.
If the value is a list of them, try each of them in the specified
order until succeed.
-The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
+The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING
+text/plain\\;charset=utf-8)."
:type '(choice (const :tag "Default" nil)
(const COMPOUND_TEXT)
(const UTF8_STRING)
(const STRING)
(const TEXT)
+ (const text/plain\;charset=utf-8)
(set :tag "List of values"
(const COMPOUND_TEXT)
(const UTF8_STRING)
(const STRING)
- (const TEXT)))
+ (const TEXT)
+ (const text/plain\;charset=utf-8)))
:group 'killing)
(defun gui--selection-value-internal (type)
@@ -165,20 +227,29 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
Call `gui-get-selection' with an appropriate DATA-TYPE argument
decided by `x-select-request-type'. The return value is already
decoded. If `gui-get-selection' signals an error, return nil."
- (let ((request-type (if (eq window-system 'x)
- (or x-select-request-type
- '(UTF8_STRING COMPOUND_TEXT STRING))
- 'STRING))
- text)
- (with-demoted-errors "gui-get-selection: %S"
- (if (consp request-type)
- (while (and request-type (not text))
- (setq text (gui-get-selection type (car request-type)))
- (setq request-type (cdr request-type)))
- (setq text (gui-get-selection type request-type))))
- (if text
- (remove-text-properties 0 (length text) '(foreign-selection nil) text))
- text))
+ ;; The doc string of `interprogram-paste-function' says to return
+ ;; nil if no other program has provided text to paste.
+ (unless (and gui-last-cut-in-clipboard
+ ;; `gui-backend-selection-owner-p' might be unreliable on
+ ;; some other window systems.
+ (memq window-system '(x haiku))
+ (eq type 'CLIPBOARD)
+ ;; Should we unify this with gui--clipboard-selection-unchanged-p?
+ (gui-backend-selection-owner-p type))
+ (let ((request-type (if (memq window-system '(x pgtk haiku))
+ (or x-select-request-type
+ '(UTF8_STRING COMPOUND_TEXT STRING text/plain\;charset=utf-8))
+ 'STRING))
+ text)
+ (with-demoted-errors "gui-get-selection: %S"
+ (if (consp request-type)
+ (while (and request-type (not text))
+ (setq text (gui-get-selection type (car request-type)))
+ (setq request-type (cdr request-type)))
+ (setq text (gui-get-selection type request-type))))
+ (if text
+ (remove-text-properties 0 (length text) '(foreign-selection nil) text))
+ text)))
(defun gui-selection-value ()
(let ((clip-text
@@ -186,19 +257,25 @@ decoded. If `gui-get-selection' signals an error, return nil."
(let ((text (gui--selection-value-internal 'CLIPBOARD)))
(when (string= text "")
(setq text nil))
- ;; When `select-enable-clipboard' is non-nil,
- ;; killing/copying text (with, say, `C-w') will push the
- ;; text to the clipboard (and store it in
- ;; `gui--last-selected-text-clipboard'). We check
- ;; whether the text on the clipboard is identical to this
- ;; text, and if so, we report that the clipboard is
- ;; empty. See (bug#27442) for further discussion about
- ;; this DWIM action, and possible ways to make this check
- ;; less fragile, if so desired.
- (prog1
- (unless (equal text gui--last-selected-text-clipboard)
- text)
- (setq gui--last-selected-text-clipboard text)))))
+ ;; Check the CLIPBOARD selection for 'newness', i.e.,
+ ;; whether it is different from the last time we did a
+ ;; yank operation or whether it was set by Emacs itself
+ ;; with a kill operation, since in both cases the text
+ ;; will already be in the kill ring. See (bug#27442) and
+ ;; (bug#53894) for further discussion about this DWIM
+ ;; action, and possible ways to make this check less
+ ;; fragile, if so desired.
+
+ ;; Don't check the "newness" of CLIPBOARD if the last
+ ;; call to `gui-select-text' didn't cause us to become
+ ;; its owner. This lets the user yank text killed by
+ ;; `clipboard-kill-region' with `clipboard-yank' without
+ ;; interference from text killed by other means when
+ ;; `select-enable-clipboard' is nil.
+ (unless (and gui-last-cut-in-clipboard
+ (gui--clipboard-selection-unchanged-p text))
+ (gui--set-last-clipboard-selection text)
+ text))))
(primary-text
(when select-enable-primary
(let ((text (gui--selection-value-internal 'PRIMARY)))
@@ -206,10 +283,10 @@ decoded. If `gui-get-selection' signals an error, return nil."
;; Check the PRIMARY selection for 'newness', is it different
;; from what we remembered them to be last time we did a
;; cut/paste operation.
- (prog1
- (unless (equal text gui--last-selected-text-primary)
- text)
- (setq gui--last-selected-text-primary text))))))
+ (unless (and gui-last-cut-in-primary
+ (gui--primary-selection-unchanged-p text))
+ (gui--set-last-primary-selection text)
+ text)))))
;; As we have done one selection, clear this now.
(setq next-selection-coding-system nil)
@@ -224,11 +301,11 @@ decoded. If `gui-get-selection' signals an error, return nil."
;; something like the following has happened since the last time
;; we looked at the selections: Application X set all the
;; selections, then Application Y set only one of them.
- ;; In this case since we don't have
- ;; timestamps there is no way to know what the 'correct' value to
- ;; return is. The nice thing to do would be to tell the user we
- ;; saw multiple possible selections and ask the user which was the
- ;; one they wanted.
+ ;; In this case, for systems that support selection timestamps, we
+ ;; could return the newer. For systems that don't, there is no
+ ;; way to know what the 'correct' value to return is. The nice
+ ;; thing to do would be to tell the user we saw multiple possible
+ ;; selections and ask the user which was the one they wanted.
(or clip-text primary-text)
))
@@ -304,22 +381,33 @@ the formats available in the clipboard if TYPE is `CLIPBOARD'."
(let ((data (gui-backend-get-selection (or type 'PRIMARY)
(or data-type 'STRING))))
(when (and (stringp data)
- (setq data-type (get-text-property 0 'foreign-selection data)))
+ ;; If this text property is set, then the data needs to
+ ;; be decoded -- otherwise it has already been decoded
+ ;; by the lower level functions.
+ (get-text-property 0 'foreign-selection data))
(let ((coding (or next-selection-coding-system
selection-coding-system
(pcase data-type
('UTF8_STRING 'utf-8)
+ ('text/plain\;charset=utf-8 'utf-8)
('COMPOUND_TEXT 'compound-text-with-extensions)
('C_STRING nil)
- ('STRING 'iso-8859-1)
- (_ (error "Unknown selection data type: %S"
- type))))))
- (setq data (if coding (decode-coding-string data coding)
- ;; This is for C_STRING case.
+ ('STRING 'iso-8859-1)))))
+ (setq data
+ (cond (coding (decode-coding-string data coding))
;; We want to convert each non-ASCII byte to the
;; corresponding eight-bit character, which has
;; a codepoint >= #x3FFF00.
- (string-to-multibyte data))))
+ ((eq data-type 'C_STRING)
+ (string-to-multibyte data))
+ ;; Guess at the charset for types like text/html
+ ;; -- it can be anything, and different
+ ;; applications use different encodings.
+ ((string-match-p "\\`text/" (symbol-name data-type))
+ (decode-coding-string
+ data (car (detect-coding-string data))))
+ ;; Do nothing.
+ (t data))))
(setq next-selection-coding-system nil)
(put-text-property 0 (length data) 'foreign-selection data-type data))
data))
@@ -328,16 +416,21 @@ the formats available in the clipboard if TYPE is `CLIPBOARD'."
(defun gui-set-selection (type data)
"Make an X selection of type TYPE and value DATA.
The argument TYPE (nil means `PRIMARY') says which selection, and
-DATA specifies the contents. TYPE must be a symbol. \(It can also
-be a string, which stands for the symbol with that name, but this
-is considered obsolete.) DATA may be a string, a symbol, an
-integer (or a cons of two integers or list of two integers).
-
-The selection may also be a cons of two markers pointing to the same buffer,
-or an overlay. In these cases, the selection is considered to be the text
-between the markers *at whatever time the selection is examined*.
-Thus, editing done in the buffer after you specify the selection
-can alter the effective value of the selection.
+DATA specifies the contents. TYPE must be a symbol. \(It can
+also be a string, which stands for the symbol with that name, but
+this is considered obsolete.) DATA may be a string, a symbol, or
+an integer.
+
+The selection may also be a cons of two markers pointing to the
+same buffer, or an overlay. In these cases, the selection is
+considered to be the text between the markers *at whatever time
+the selection is examined*. Thus, editing done in the buffer
+after you specify the selection can alter the effective value of
+the selection. If DATA is a string, then its text properties can
+specify alternative values for different data types. For
+example, the value of any property named `text/uri-list' will be
+used instead of DATA itself when another program converts TYPE to
+the target `text/uri-list'.
The data may also be a vector of valid non-vector selection values.
@@ -382,6 +475,73 @@ are not available to other programs."
(symbolp data)
(integerp data)))
+
+;; Minor mode to make losing ownership of PRIMARY behave more like
+;; other X programs.
+
+(defvar lost-selection-last-region-buffer nil
+ "The last buffer from which the region was selected.")
+
+(defun lost-selection-post-select-region-function (_text)
+ "Handle the region being selected into PRIMARY.
+If the current buffer is different from the last buffer,
+deactivate the mark in every other buffer.
+TEXT is ignored."
+ (when (not (eq lost-selection-last-region-buffer
+ (current-buffer)))
+ (dolist (buffer (buffer-list))
+ (unless (or (string-match-p "^ "
+ (buffer-name buffer))
+ (eq buffer (current-buffer)))
+ (with-current-buffer buffer
+ (deactivate-mark t))))
+ (setq lost-selection-last-region-buffer (current-buffer))))
+
+(defun lost-selection-function (selection)
+ "Handle losing of ownership of SELECTION.
+If SELECTION is `PRIMARY', deactivate the mark in every
+non-temporary buffer."
+ (let ((select-active-regions nil))
+ (when (eq selection 'PRIMARY)
+ (dolist (buffer (buffer-list))
+ (unless (string-match-p "^ "
+ (buffer-name buffer))
+ (with-current-buffer buffer
+ (deactivate-mark t)))))))
+
+(define-minor-mode lost-selection-mode
+ "Toggle `lost-selection-mode'.
+
+When this is enabled, selecting some text in another program will
+cause the mark to be deactivated in all buffers, mimicking the
+behavior of most X Windows programs.
+
+Selecting text in a buffer that ends up changing the primary
+selection will also cause the mark to be deactivated in all other
+buffers."
+ :global t
+ :group 'x
+ (if lost-selection-mode
+ (progn
+ (cond ((featurep 'x) (add-hook 'x-lost-selection-functions
+ #'lost-selection-function))
+ ((featurep 'pgtk) (add-hook 'pgtk-lost-selection-functions
+ #'lost-selection-function))
+ ((featurep 'haiku) (add-hook 'haiku-lost-selection-functions
+ #'lost-selection-function)))
+ (add-hook 'post-select-region-hook
+ #'lost-selection-post-select-region-function))
+ (cond ((featurep 'x) (remove-hook 'x-lost-selection-functions
+ #'lost-selection-function))
+ ((featurep 'pgtk) (remove-hook 'pgtk-lost-selection-functions
+ #'lost-selection-function))
+ ((featurep 'haiku) (remove-hook 'haiku-lost-selection-functions
+ #'lost-selection-function)))
+ (remove-hook 'post-select-region-hook
+ #'lost-selection-post-select-region-function)
+ (setq lost-selection-last-region-buffer nil)))
+
+
;; Functions to convert the selection into various other selection types.
;; Every selection type that Emacs handles is implemented this way, except
;; for TIMESTAMP, which is a special case.
@@ -413,7 +573,8 @@ two markers or an overlay. Otherwise, it is nil."
(defun xselect--int-to-cons (n)
(cons (ash n -16) (logand n 65535)))
-(defun xselect--encode-string (type str &optional can-modify)
+(defun xselect--encode-string (type str &optional can-modify
+ prefer-string-to-c-string)
(when str
;; If TYPE is nil, this is a local request; return STR as-is.
(if (null type)
@@ -440,13 +601,13 @@ two markers or an overlay. Otherwise, it is nil."
(setq type 'C_STRING))
(t
(let (non-latin-1 non-unicode eight-bit)
- (mapc #'(lambda (x)
- (if (>= x #x100)
- (if (< x #x110000)
- (setq non-latin-1 t)
- (if (< x #x3FFF80)
- (setq non-unicode t)
- (setq eight-bit t)))))
+ (mapc (lambda (x)
+ (if (>= x #x100)
+ (if (< x #x110000)
+ (setq non-latin-1 t)
+ (if (< x #x3FFF80)
+ (setq non-unicode t)
+ (setq eight-bit t)))))
str)
(setq type (if (or non-unicode
(and
@@ -463,7 +624,8 @@ two markers or an overlay. Otherwise, it is nil."
(if eight-bit 'C_STRING
'STRING))))))))
(cond
- ((eq type 'UTF8_STRING)
+ ((or (eq type 'UTF8_STRING)
+ (eq type 'text/plain\;charset=utf-8))
(if (or (not coding)
(not (eq (coding-system-type coding) 'utf-8)))
(setq coding 'utf-8))
@@ -475,6 +637,12 @@ two markers or an overlay. Otherwise, it is nil."
(setq coding 'iso-8859-1))
(setq str (encode-coding-string str coding)))
+ ((eq type 'text/plain)
+ (if (or (not coding)
+ (not (eq (coding-system-type coding) 'charset)))
+ (setq coding 'ascii))
+ (setq str (encode-coding-string str coding)))
+
((eq type 'COMPOUND_TEXT)
(if (or (not coding)
(not (eq (coding-system-type coding) 'iso-2022)))
@@ -499,7 +667,10 @@ two markers or an overlay. Otherwise, it is nil."
(setq str (string-replace "\0" "\\0" str))
(setq next-selection-coding-system nil)
- (cons type str))))
+ (cons (if (and prefer-string-to-c-string
+ (eq type 'C_STRING))
+ 'STRING type)
+ str))))
(defun xselect-convert-to-string (_selection type value)
(let ((str (cond ((stringp value) value)
@@ -517,31 +688,61 @@ two markers or an overlay. Otherwise, it is nil."
(if len
(xselect--int-to-cons len))))
-(defun xselect-convert-to-targets (_selection _type _value)
- ;; return a vector of atoms, but remove duplicates first.
- (let* ((all (cons 'TIMESTAMP
- (cons 'MULTIPLE
- (mapcar 'car selection-converter-alist))))
- (rest all))
- (while rest
- (cond ((memq (car rest) (cdr rest))
- (setcdr rest (delq (car rest) (cdr rest))))
- ((eq (car (cdr rest)) '_EMACS_INTERNAL) ; shh, it's a secret
- (setcdr rest (cdr (cdr rest))))
- (t
- (setq rest (cdr rest)))))
- (apply 'vector all)))
+(defvar x-dnd-targets-list)
+
+(defun xselect-convert-to-targets (selection _type value)
+ ;; Return a vector of atoms, but remove duplicates first.
+ (if (eq selection 'XdndSelection)
+ ;; This isn't required by the XDND protocol, and sure enough no
+ ;; clients seem to dependent on it, but Emacs implements the
+ ;; receiver side of the Motif drop protocol by looking at the
+ ;; initiator selection's TARGETS target (which Motif provides)
+ ;; instead of the target table on the drag window, so it seems
+ ;; plausible for other clients to rely on that as well.
+ (apply #'vector (mapcar #'intern x-dnd-targets-list))
+ (apply #'vector
+ (delete-dups
+ `( TIMESTAMP MULTIPLE
+ . ,(delq '_EMACS_INTERNAL
+ (mapcar (lambda (conv)
+ (if (or (not (consp (cdr conv)))
+ (funcall (cadr conv) selection
+ (car conv) value))
+ (car conv)
+ '_EMACS_INTERNAL))
+ selection-converter-alist)))))))
(defun xselect-convert-to-delete (selection _type _value)
- (gui-backend-set-selection selection nil)
+ ;; This should be handled by the caller of `x-begin-drag'.
+ (unless (eq selection 'XdndSelection)
+ (gui-backend-set-selection selection nil))
;; A return value of nil means that we do not know how to do this conversion,
;; and replies with an "error". A return value of NULL means that we have
;; done the conversion (and any side-effects) but have no value to return.
'NULL)
-(defun xselect-convert-to-filename (_selection _type value)
- (when (setq value (xselect--selection-bounds value))
- (xselect--encode-string 'TEXT (buffer-file-name (nth 2 value)))))
+(defun xselect-convert-to-filename (selection _type value)
+ (if (not (eq selection 'XdndSelection))
+ (when (setq value (xselect--selection-bounds value))
+ (xselect--encode-string 'TEXT (buffer-file-name (nth 2 value))))
+ (if (and (stringp value)
+ (file-exists-p value))
+ ;; Motif expects this to be STRING, but it treats the data as
+ ;; a sequence of bytes instead of a Latin-1 string.
+ (cons 'STRING (encode-coding-string (expand-file-name value)
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ (when (vectorp value)
+ (with-temp-buffer
+ (cl-loop for file across value
+ do (insert (expand-file-name file) "\0"))
+ ;; Get rid of the last NULL byte.
+ (when (> (point) 1)
+ (delete-char -1))
+ ;; Motif wants STRING.
+ (cons 'STRING (encode-coding-string (buffer-string)
+ (or file-name-coding-system
+ default-file-name-coding-system))))))))
(defun xselect-convert-to-charpos (_selection _type value)
(when (setq value (xselect--selection-bounds value))
@@ -603,11 +804,95 @@ This function returns the string \"emacs\"."
(when (eq selection 'CLIPBOARD)
'NULL))
+(defun xselect-convert-to-username (_selection _type _value)
+ (user-real-login-name))
+
+(defun xselect-convert-to-text-uri-list (_selection _type value)
+ (let ((string
+ (if (stringp value)
+ (xselect--encode-string 'TEXT
+ (concat (url-encode-url value) "\n"))
+ (when (vectorp value)
+ (with-temp-buffer
+ (cl-loop for tem across value
+ do (progn
+ (insert (url-encode-url tem))
+ (insert "\n")))
+ (xselect--encode-string 'TEXT (buffer-string)))))))
+ (cons 'text/uri-list (cdr string))))
+
+(defun xselect-convert-to-xm-file (selection _type value)
+ (when (and (stringp value)
+ (file-exists-p value)
+ (eq selection 'XdndSelection))
+ (xselect--encode-string 'C_STRING
+ (concat value [0]))))
+
+(defun xselect-uri-list-available-p (selection _type value)
+ "Return whether or not `text/uri-list' is a valid target for SELECTION.
+VALUE is the local selection value of SELECTION."
+ (and (eq selection 'XdndSelection)
+ (or (stringp value)
+ (vectorp value))))
+
+(defun xselect-convert-xm-special (_selection _type _value)
+ "")
+
+(defun xselect-dt-netfile-available-p (selection _type value)
+ "Return whether or not `_DT_NETFILE' is a valid target for SELECTION.
+VALUE is SELECTION's local selection value."
+ (and (eq selection 'XdndSelection)
+ (stringp value)
+ (file-exists-p value)
+ (not (file-remote-p value))))
+
+(defun xselect-tt-net-file (file)
+ "Get the canonical ToolTalk filename for FILE.
+FILE must be a local file, or otherwise the conversion will fail.
+The string returned has three components: the hostname of the
+machine where the file is, the real path, and the local path.
+They are encoded into a string of the form
+\"HOST=0-X,RPATH=X-Y,LPATH=Y-Z:DATA\", where X, Y, and Z are the
+positions of the hostname, rpath and lpath inside DATA."
+ (let ((hostname (system-name))
+ (rpath file)
+ (lpath file))
+ (format "HOST=0-%d,RPATH=%d-%d,LPATH=%d-%d:%s%s%s"
+ (1- (length hostname)) (length hostname)
+ (1- (+ (length hostname) (length rpath)))
+ (+ (length hostname) (length rpath))
+ (1- (+ (length hostname) (length rpath)
+ (length lpath)))
+ hostname rpath lpath)))
+
+(defun xselect-convert-to-dt-netfile (selection _type value)
+ "Convert SELECTION to a ToolTalk filename.
+VALUE should be SELECTION's local value."
+ (when (and (eq selection 'XdndSelection)
+ (stringp value)
+ (file-exists-p value)
+ (not (file-remote-p value)))
+ (let ((name (encode-coding-string value
+ (or file-name-coding-system
+ default-file-name-coding-system))))
+ (cons 'STRING
+ (encode-coding-string (xselect-tt-net-file name)
+ (or file-name-coding-system
+ default-file-name-coding-system)
+ t)))))
+
(setq selection-converter-alist
'((TEXT . xselect-convert-to-string)
(COMPOUND_TEXT . xselect-convert-to-string)
(STRING . xselect-convert-to-string)
(UTF8_STRING . xselect-convert-to-string)
+ (text/plain . xselect-convert-to-string)
+ (text/plain\;charset=utf-8 . xselect-convert-to-string)
+ (text/uri-list . (xselect-uri-list-available-p
+ . xselect-convert-to-text-uri-list))
+ (text/x-xdnd-username . xselect-convert-to-username)
+ (FILE . (xselect-uri-list-available-p
+ . xselect-convert-to-xm-file))
(TARGETS . xselect-convert-to-targets)
(LENGTH . xselect-convert-to-length)
(DELETE . xselect-convert-to-delete)
@@ -623,7 +908,11 @@ This function returns the string \"emacs\"."
(ATOM . xselect-convert-to-atom)
(INTEGER . xselect-convert-to-integer)
(SAVE_TARGETS . xselect-convert-to-save-targets)
- (_EMACS_INTERNAL . xselect-convert-to-identity)))
+ (_EMACS_INTERNAL . xselect-convert-to-identity)
+ (XmTRANSFER_SUCCESS . xselect-convert-xm-special)
+ (XmTRANSFER_FAILURE . xselect-convert-xm-special)
+ (_DT_NETFILE . (xselect-dt-netfile-available-p
+ . xselect-convert-to-dt-netfile))))
(provide 'select)
diff --git a/lisp/server.el b/lisp/server.el
index 65602cd1a11..a06f2f952fd 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -90,12 +90,12 @@
(defcustom server-use-tcp nil
"If non-nil, use TCP sockets instead of local sockets."
- :set #'(lambda (sym val)
- (unless (featurep 'make-network-process '(:family local))
- (setq val t)
- (unless load-in-progress
- (message "Local sockets unsupported, using TCP sockets")))
- (set-default sym val))
+ :set (lambda (sym val)
+ (unless (featurep 'make-network-process '(:family local))
+ (setq val t)
+ (unless load-in-progress
+ (message "Local sockets unsupported, using TCP sockets")))
+ (set-default sym val))
:type 'boolean
:version "22.1")
@@ -485,11 +485,11 @@ If CLIENT is non-nil, add a description of it to the logged message."
(when (and (frame-live-p frame)
proc
;; See if this is the last frame for this client.
- (>= 1 (let ((frame-num 0))
- (dolist (f (frame-list))
- (when (eq proc (frame-parameter f 'client))
- (setq frame-num (1+ frame-num))))
- frame-num)))
+ (not (seq-some
+ (lambda (f)
+ (and (not (eq frame f))
+ (eq proc (frame-parameter f 'client))))
+ (frame-list))))
(server-log (format "server-handle-delete-frame, frame %s" frame) proc)
(server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later.
@@ -779,7 +779,8 @@ by the current Emacs process, use the `server-process' variable."
(condition-case nil
(if server-use-tcp
(with-temp-buffer
- (insert-file-contents-literally (expand-file-name name server-auth-dir))
+ (setq default-directory server-auth-dir)
+ (insert-file-contents-literally (expand-file-name name))
(or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)")
(assq 'comm
(process-attributes
@@ -900,12 +901,17 @@ This handles splitting the command if it would be bigger than
)
(cond (w
- (server--create-frame
- nowait proc
- `((display . ,display)
- ,@(if parent-id
- `((parent-id . ,(string-to-number parent-id))))
- ,@parameters)))
+ (condition-case nil
+ (server--create-frame
+ nowait proc
+ `((display . ,display)
+ ,@(if parent-id
+ `((parent-id . ,(string-to-number parent-id))))
+ ,@parameters))
+ (error
+ (server-log "Window system unsupported" proc)
+ (server-send-string proc "-window-system-unsupported \n")
+ nil)))
(t
(server-log "Window system unsupported" proc)
@@ -1308,7 +1314,8 @@ The following commands are accepted by the client:
frame-parameters))
;; When resuming on a tty, tty-name is nil.
(tty-name
- (server-create-tty-frame tty-name tty-type proc))
+ (server-create-tty-frame tty-name tty-type proc
+ frame-parameters))
;; If there won't be a current frame to use, fall
;; back to trying to create a new one.
@@ -1361,7 +1368,7 @@ The following commands are accepted by the client:
((functionp initial-buffer-choice)
(funcall initial-buffer-choice)))))
(switch-to-buffer
- (if (buffer-live-p buf) buf (get-buffer-create "*scratch*"))
+ (if (buffer-live-p buf) buf (get-scratch-buffer-create))
'norecord)))
;; Delete the client if necessary.
@@ -1580,13 +1587,13 @@ specifically for the clients and did not exist before their request for it."
(server-buffer-done (current-buffer))))
(defun server-kill-emacs-query-function ()
- "Ask before exiting Emacs if it has live clients."
- (or (not (let (live-client)
- (dolist (proc server-clients)
- (when (memq t (mapcar #'buffer-live-p
- (process-get proc 'buffers)))
- (setq live-client t)))
- live-client))
+ "Ask before exiting Emacs if it has live clients.
+A \"live client\" is a client with at least one live buffer
+associated with it."
+ (or (not (seq-some (lambda (proc)
+ (seq-some #'buffer-live-p
+ (process-get proc 'buffers)))
+ server-clients))
(yes-or-no-p "This Emacs session has clients; exit anyway? ")))
(defun server-kill-buffer ()
@@ -1716,6 +1723,9 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
(when server-raise-frame
(select-frame-set-input-focus (window-frame)))))
+(defvar server-stop-automatically nil
+ "Internal status variable for `server-stop-automatically'.")
+
;;;###autoload
(defun server-save-buffers-kill-terminal (arg)
;; Called from save-buffers-kill-terminal in files.el.
@@ -1724,27 +1734,103 @@ With ARG non-nil, silently save all file-visiting buffers, then kill.
If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved."
- (let ((proc (frame-parameter nil 'client)))
- (cond ((eq proc 'nowait)
- ;; Nowait frames have no client buffer list.
- (if (cdr (frame-list))
- (progn (save-some-buffers arg)
- (delete-frame))
- ;; If we're the last frame standing, kill Emacs.
- (save-buffers-kill-emacs arg)))
- ((processp proc)
- (let ((buffers (process-get proc 'buffers)))
- (save-some-buffers
- arg (if buffers
- ;; Only files from emacsclient file list.
- (lambda () (memq (current-buffer) buffers))
- ;; No emacsclient file list: don't override
- ;; `save-some-buffers-default-predicate' (unless
- ;; ARG is non-nil), since we're not killing
- ;; Emacs (unlike `save-buffers-kill-emacs').
- (and arg t)))
- (server-delete-client proc)))
- (t (error "Invalid client frame")))))
+ (if server-stop-automatically
+ (server-stop-automatically--handle-delete-frame (selected-frame))
+ (let ((proc (frame-parameter nil 'client)))
+ (cond ((eq proc 'nowait)
+ ;; Nowait frames have no client buffer list.
+ (if (cdr (frame-list))
+ (progn (save-some-buffers arg)
+ (delete-frame))
+ ;; If we're the last frame standing, kill Emacs.
+ (save-buffers-kill-emacs arg)))
+ ((processp proc)
+ (let ((buffers (process-get proc 'buffers)))
+ (save-some-buffers
+ arg (if buffers
+ ;; Only files from emacsclient file list.
+ (lambda () (memq (current-buffer) buffers))
+ ;; No emacsclient file list: don't override
+ ;; `save-some-buffers-default-predicate' (unless
+ ;; ARG is non-nil), since we're not killing
+ ;; Emacs (unlike `save-buffers-kill-emacs').
+ (and arg t)))
+ (server-delete-client proc)))
+ (t (error "Invalid client frame"))))))
+
+(defun server-stop-automatically--handle-delete-frame (frame)
+ "Handle deletion of FRAME when `server-stop-automatically' is used."
+ (when server-stop-automatically
+ (if (if (and (processp (frame-parameter frame 'client))
+ (eq this-command 'save-buffers-kill-terminal))
+ (progn
+ (dolist (f (frame-list))
+ (when (and (eq (frame-parameter frame 'client)
+ (frame-parameter f 'client))
+ (not (eq frame f)))
+ (set-frame-parameter f 'client nil)
+ (let ((server-stop-automatically nil))
+ (delete-frame f))))
+ (if (cddr (frame-list))
+ (let ((server-stop-automatically nil))
+ (delete-frame frame)
+ nil)
+ t))
+ (null (cddr (frame-list))))
+ (let ((server-stop-automatically nil))
+ (save-buffers-kill-emacs)
+ (delete-frame frame)))))
+
+(defun server-stop-automatically--maybe-kill-emacs ()
+ "Handle closing of Emacs daemon when `server-stop-automatically' is used."
+ (unless (cdr (frame-list))
+ (when (and
+ (not (memq t (mapcar (lambda (b)
+ (and (buffer-file-name b)
+ (buffer-modified-p b)))
+ (buffer-list))))
+ (not (memq t (mapcar (lambda (p)
+ (and (memq (process-status p)
+ '(run stop open listen))
+ (process-query-on-exit-flag p)))
+ (process-list)))))
+ (kill-emacs))))
+
+;;;###autoload
+(defun server-stop-automatically (arg)
+ "Automatically stop server as specified by ARG.
+
+If ARG is the symbol `empty', stop the server when it has no
+remaining clients, no remaining unsaved file-visiting buffers,
+and no running processes with a `query-on-exit' flag.
+
+If ARG is the symbol `delete-frame', ask the user when the last
+frame is deleted whether each unsaved file-visiting buffer must
+be saved and each running process with a `query-on-exit' flag
+can be stopped, and if so, stop the server itself.
+
+If ARG is the symbol `kill-terminal', ask the user when the
+terminal is killed with \\[save-buffers-kill-terminal] \
+whether each unsaved file-visiting
+buffer must be saved and each running process with a `query-on-exit'
+flag can be stopped, and if so, stop the server itself.
+
+Any other value of ARG will cause this function to signal an error.
+
+This function is meant to be called from the user init file."
+ (when (daemonp)
+ (setq server-stop-automatically arg)
+ (cond
+ ((eq arg 'empty)
+ (setq server-stop-automatically nil)
+ (run-with-timer 10 2
+ #'server-stop-automatically--maybe-kill-emacs))
+ ((eq arg 'delete-frame)
+ (add-hook 'delete-frame-functions
+ #'server-stop-automatically--handle-delete-frame))
+ ((eq arg 'kill-terminal))
+ (t
+ (error "Unexpected argument")))))
(define-key ctl-x-map "#" 'server-edit)
diff --git a/lisp/ses.el b/lisp/ses.el
index 542fb3d7c87..ba965ff8a5b 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -84,17 +84,14 @@
(defcustom ses-initial-size '(1 . 1)
"Initial size of a new spreadsheet, as a cons (NUMROWS . NUMCOLS)."
- :group 'ses
:type '(cons (integer :tag "numrows") (integer :tag "numcols")))
(defcustom ses-initial-column-width 7
"Initial width of columns in a new spreadsheet."
- :group 'ses
:type '(integer :match (lambda (widget value) (> value 0))))
(defcustom ses-initial-default-printer "%.7g"
"Initial default printer for a new spreadsheet."
- :group 'ses
:type '(choice string
(list :tag "Parenthesized string" string)
function))
@@ -103,15 +100,30 @@
"Things to do after entering a value into a cell.
An abnormal hook that usually runs a cursor-movement function.
Each function is called with ARG=1."
- :group 'ses
:type 'hook
:options '(forward-char backward-char next-line previous-line))
(defcustom ses-mode-hook nil
"Hook functions to be run upon entering SES mode."
- :group 'ses
:type 'hook)
+(defcustom ses-jump-cell-name-function #'upcase
+ "Function to process the string passed to function `ses-jump'.
+Set it to `identity' to make no change.
+Set it to `upcase' to make cell name change case isensitive.
+
+ May return
+
+* a string, in this case this must be a cell name.
+* a (row . col) cons cell, in this case that must be valid cell coordinates."
+ :type 'function)
+
+(defcustom ses-jump-prefix-function #'ses-jump-prefix
+ "Function that takes the prefix argument passed to function `ses-jump'.
+It may return the same sort of thing as `ses-jump-cell-name-function'."
+ :type 'function)
+
+
;;----------------------------------------------------------------------------
;; Global variables and constants
@@ -227,26 +239,18 @@ Used for listing local printers or renamed cells.")
"w" ses-set-column-width
"x" ses-export-keymap
"\M-p" ses-read-column-printer))
- (repl '(;;We'll replace these wherever they appear in the keymap
- clipboard-kill-region ses-kill-override
- end-of-line ses-end-of-line
- kill-line ses-delete-row
- kill-region ses-kill-override
- open-line ses-insert-row))
(numeric "0123456789.-")
(newmap (make-keymap)))
;;Get rid of printables
(suppress-keymap newmap t)
;;These keys insert themselves as the beginning of a numeric value
(dotimes (x (length numeric))
- (define-key newmap (substring numeric x (1+ x)) 'ses-read-cell))
- ;;Override these global functions wherever they're bound
- (while repl
- (substitute-key-definition (car repl) (cadr repl) newmap
- (current-global-map))
- (setq repl (cddr repl)))
- ;;Apparently substitute-key-definition doesn't catch this?
- (define-key newmap [(menu-bar) edit cut] 'ses-kill-override)
+ (define-key newmap (substring numeric x (1+ x)) #'ses-read-cell))
+ (define-key newmap [remap clipboard-kill-region] #'ses-kill-override)
+ (define-key newmap [remap end-of-line] #'ses-end-of-line)
+ (define-key newmap [remap kill-line] #'ses-delete-row)
+ (define-key newmap [remap kill-region] #'ses-kill-override)
+ (define-key newmap [remap open-line] #'ses-insert-row)
;;Define our other local keys
(while keys
(define-key newmap (car keys) (cadr keys))
@@ -353,7 +357,7 @@ printer and then modify its output.")
(t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))
;;; This variable is documented as being permitted in file-locals:
-(put 'ses--symbolic-formulas 'safe-local-variable 'consp)
+(put 'ses--symbolic-formulas 'safe-local-variable #'consp)
(defconst ses-paramlines-plist
'(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3
@@ -1064,8 +1068,7 @@ the old and FORCE is nil."
(defcustom ses-self-reference-early-detection nil
"Non-nil if cycle detection is early for cells that refer to themselves."
:version "24.1"
- :type 'boolean
- :group 'ses)
+ :type 'boolean)
(defun ses-update-cells (list &optional force)
"Recalculate cells in LIST, checking for dependency loops.
@@ -2072,8 +2075,8 @@ formula:
;; Not to use tab characters for safe (tabs may do bad for column
;; calculation).
indent-tabs-mode nil)
- (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t))
- (1value (add-hook 'kill-buffer-hook 'ses-killbuffer-hook nil t))
+ (1value (add-hook 'change-major-mode-hook #'ses-cleanup nil t))
+ (1value (add-hook 'kill-buffer-hook #'ses-killbuffer-hook nil t))
(cl-pushnew (current-buffer) ses--ses-buffer-list :test 'eq)
;; This makes revert impossible if the buffer is read-only.
;; (1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
@@ -2124,8 +2127,8 @@ formula:
;; find-alternate-file, post-command-hook doesn't get run for some reason,
;; so use an idle timer to make sure.
(setq ses--deferred-narrow 'ses-mode)
- (1value (add-hook 'post-command-hook 'ses-command-hook nil t))
- (run-with-idle-timer 0.01 nil 'ses-command-hook)
+ (1value (add-hook 'post-command-hook #'ses-command-hook nil t))
+ (run-with-idle-timer 0.01 nil #'ses-command-hook)
(run-mode-hooks 'ses-mode-hook)))
(put 'ses-mode 'mode-class 'special)
@@ -2241,24 +2244,43 @@ Based on the current set of columns and `window-hscroll' position."
;;----------------------------------------------------------------------------
;; Redisplay and recalculation
;;----------------------------------------------------------------------------
+(defun ses-jump-prefix (prefix-int)
+ "Convert an integer (unversal prefix) into a (ROW . COL).
+Does it by numbering cells starting from 0 from top left to bottom right,
+going row by row."
+ (and (>= prefix-int 0)
+ (< prefix-int (* ses--numcols ses--numrows))
+ (cons (/ prefix-int ses--numcols) (% prefix-int ses--numcols))))
+
-(defun ses-jump (sym)
+(defun ses-jump (&optional sym)
"Move point to cell SYM."
- (interactive (let* (names
- (s (completing-read
- "Jump to cell: "
- (and ses--named-cell-hashmap
- (progn (maphash (lambda (key _val)
- (push (symbol-name key) names))
- ses--named-cell-hashmap)
- names)))))
- (if (string= s "")
- (user-error "Invalid cell name")
- (list (intern s)))))
- (let ((rowcol (ses-sym-rowcol sym)))
+ (interactive "P")
+ (setq sym
+ (if current-prefix-arg
+ (funcall ses-jump-prefix-function (prefix-numeric-value sym))
+ (or sym
+ (completing-read
+ "Jump to cell: "
+ (and ses--named-cell-hashmap
+ (let (names)
+ (maphash (lambda (key _val)
+ (push (symbol-name key) names))
+ ses--named-cell-hashmap)
+ names))))))
+ (and (stringp sym)
+ (not (and ses--named-cell-hashmap (gethash (intern sym) ses--named-cell-hashmap)))
+ (setq sym (funcall ses-jump-cell-name-function sym)))
+ (if (stringp sym)
+ (if (string= sym "")
+ (user-error "Empty cell name")
+ (setq sym (intern sym))))
+ (let ((rowcol (if (consp sym)
+ (prog1 sym (setq sym (ses-cell-symbol (car sym) (cdr sym))))
+ (ses-sym-rowcol sym))))
(or rowcol (error "Invalid cell name"))
(if (eq (symbol-value sym) '*skip*)
- (error "Cell is covered by preceding cell"))
+ (error "Cell is covered by preceding cell"))
(ses-goto-print (car rowcol) (cdr rowcol))))
(defun ses-jump-safe (cell)
@@ -2309,7 +2331,7 @@ Narrow to print area if optional argument NONARROW is nil."
"Recalculate and reprint the current cell or range.
If CURCELL is non nil use it as current cell or range
-without any check, otherwise function (ses-check-curcell 'range)
+without any check, otherwise function (ses-check-curcell \\='range)
is called.
For an individual cell, shows the error if the formula or printer
@@ -2515,7 +2537,7 @@ Return nil if cell formula was unsafe and user declined confirmation."
;; Position cursor inside close-quote.
(setq initial (cons initial (length initial))))
(dolist (key ses-completion-keys)
- (define-key ses-mode-edit-map key 'ses-edit-cell-complete-symbol))
+ (define-key ses-mode-edit-map key #'ses-edit-cell-complete-symbol))
;; make it globally visible, so that it can be visible from the minibuffer.
(setq ses--completion-table ses--named-cell-hashmap)
(list row col
@@ -2612,8 +2634,9 @@ With prefix, deletes several cells."
;;----------------------------------------------------------------------------
(defun ses-read-printer-complete-symbol ()
(interactive)
- (let ((completion-at-point-functions (cons 'ses--read-printer-completion-at-point-function
- completion-at-point-functions)))
+ (let ((completion-at-point-functions
+ (cons #'ses--read-printer-completion-at-point-function
+ completion-at-point-functions)))
(completion-at-point)))
(defun ses--read-printer-completion-at-point-function ()
@@ -2655,7 +2678,7 @@ canceled."
(setq default "")
(setq prompt (format-prompt prompt default)))
(dolist (key ses-completion-keys)
- (define-key ses-mode-edit-map key 'ses-read-printer-complete-symbol))
+ (define-key ses-mode-edit-map key #'ses-read-printer-complete-symbol))
;; make it globally visible, so that it can be visible from the minibuffer.
(setq ses--completion-table ses--local-printer-hashmap)
(let ((new (read-from-minibuffer prompt
@@ -3554,7 +3577,7 @@ With prefix, sorts in REVERSE order."
(push (cons (buffer-substring-no-properties (point) end)
(+ minrow x))
keys))
- (setq keys (sort keys #'(lambda (x y) (string< (car x) (car y)))))
+ (setq keys (sort keys (lambda (x y) (string< (car x) (car y)))))
;;Extract the lines in reverse sorted order
(or reverse
(setq keys (nreverse keys)))
@@ -3751,15 +3774,15 @@ DEFINITION shall be either a string formatter, e.g.:
\"%.2f\" or (\"%.2f\") for left alignment.
or a lambda expression, e.g. for formatting in ISO format dates
-created with a '(calcFunc-date YEAR MONTH DAY)' formula:
+created with a `(calcFunc-date YEAR MONTH DAY)' formula:
(lambda (x)
(cond
((null val) \"\")
- ((eq (car-safe x) 'date)
- (let ((calc-format-date '(X YYYY \"-\" MM \"-\" DD)))
+ ((eq (car-safe x) \\='date)
+ (let ((calc-format-date \\='(X YYYY \"-\" MM \"-\" DD)))
(math-format-date x)))
- (t (ses-center-span val ?# 'ses-prin1))))
+ (t (ses-center-span val ?# \\='ses-prin1))))
If NAME is already used to name a local printer function, then
the current definition is proposed as default value, and the
@@ -3774,7 +3797,9 @@ function is redefined."
(setq name (intern name))
(let* ((cur-printer (gethash name ses--local-printer-hashmap))
(default (and cur-printer (ses--locprn-def cur-printer))))
- (setq def (ses-read-printer (format "Enter definition of printer %S" name)
+ (setq def (ses-read-printer (format-prompt
+ "Enter definition of printer %S"
+ default name)
default)))
(list name def)))
@@ -4085,17 +4110,19 @@ SPAN indicates how many rightward columns to include in width (default = 0)."
(ses-center value span ?- printer))
(defun ses-dashfill-span (value &optional printer)
- "Print VALUE, centered using dashes within the span that starts in the
-current column and continues until the next nonblank column."
+ "Print VALUE, centered using dashes.
+Centers within the span that starts in the current column and continues
+until the next nonblank column."
(ses-center-span value ?- printer))
(defun ses-tildefill-span (value &optional printer)
- "Print VALUE, centered using tildes within the span that starts in the
-current column and continues until the next nonblank column."
+ "Print VALUE, centered using tildes.
+Centers within the span that starts in the current column and continues
+until the next nonblank column."
(ses-center-span value ?~ printer))
(defun ses-prin1 (value)
- "Shorthand for '(prin1-to-string VALUE t)'.
+ "Shorthand for `(prin1-to-string VALUE t)'.
Useful to handle the default behavior in custom lambda based
printer functions."
(prin1-to-string value t))
diff --git a/lisp/shell.el b/lisp/shell.el
index f0115b90a50..85225b128ab 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -98,6 +98,7 @@
(require 'comint)
(require 'pcomplete)
(eval-when-compile (require 'files-x)) ;with-connection-local-variables
+(require 'subr-x)
;;; Customization and Buffer Variables
@@ -330,6 +331,12 @@ Useful for shells like zsh that has this feature."
:group 'shell-directories
:version "28.1")
+(defcustom shell-kill-buffer-on-exit nil
+ "Kill a shell buffer after the shell process terminates."
+ :type 'boolean
+ :group 'shell
+ :version "29.1")
+
(defvar shell-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-f" 'shell-forward-command)
@@ -433,12 +440,11 @@ Useful for shells like zsh that has this feature."
(push (point) begins)
(let ((arg ()))
(while (looking-at
- (eval-when-compile
- (concat
- "\\(?:[^\s\t\n\\\"';]+"
- "\\|'\\([^']*\\)'?"
- "\\|\"\\(\\(?:[^\"\\]\\|\\\\.\\)*\\)\"?"
- "\\|\\\\\\(\\(?:.\\|\n\\)?\\)\\)")))
+ (concat
+ "\\(?:[^\s\t\n\\\"';]+"
+ "\\|'\\([^']*\\)'?"
+ "\\|\"\\(\\(?:[^\"\\]\\|\\\\.\\)*\\)\"?"
+ "\\|\\\\\\(\\(?:.\\|\n\\)?\\)\\)"))
(goto-char (match-end 0))
(cond
((match-beginning 3) ;Backslash escape.
@@ -527,7 +533,7 @@ Shell buffers. It implements `shell-completion-execonly' for
the shell. This is useful for entering passwords. Or, add the function
`comint-watch-for-password-prompt' to `comint-output-filter-functions'.
-If you want to make multiple shell buffers, rename the `*shell*' buffer
+If you want to make multiple shell buffers, rename the \"*shell*\" buffer
using \\[rename-buffer] or \\[rename-uniquely] and start a new shell.
If you want to make shell buffers limited in length, add the function
@@ -570,7 +576,14 @@ the initialization of the input ring history, and history expansion.
Variables `comint-output-filter-functions', a hook, and
`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
control whether input and output cause the window to scroll to the end of the
-buffer."
+buffer.
+
+By default, shell mode does nothing special when it receives a
+\"bell\" character (C-g or ^G). If you
+ (add-hook \\='comint-output-filter-functions #\\='shell-filter-ring-bell nil t)
+from `shell-mode-hook', Emacs will call the `ding' function
+whenever it receives the bell character in output from a
+command."
:interactive nil
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
@@ -681,6 +694,13 @@ This function can be put on `comint-preoutput-filter-functions'."
(replace-regexp-in-string "[\C-a\C-b]" "" string t t)
string))
+(defun shell-filter-ring-bell (string)
+ "Call `ding' if STRING contains a \"^G\" character.
+This function can be put on `comint-output-filter-functions'."
+ (when (string-search "\a" string)
+ (ding))
+ string)
+
(defun shell-write-history-on-exit (process event)
"Called when the shell process is stopped.
@@ -698,7 +718,7 @@ Sentinels will always get the two parameters PROCESS and EVENT."
(insert (format "\nProcess %s %s\n" process event))))))
;;;###autoload
-(defun shell (&optional buffer)
+(defun shell (&optional buffer file-name)
"Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
Interactively, a prefix arg means to prompt for BUFFER.
If `default-directory' is a remote file name, it is also prompted
@@ -709,6 +729,8 @@ If BUFFER exists and shell process is running, just switch to BUFFER.
Program used comes from variable `explicit-shell-file-name',
or (if that is nil) from the ESHELL environment variable,
or (if that is nil) from `shell-file-name'.
+Non-interactively, it can also be specified via the FILE-NAME arg.
+
If a file `~/.emacs_SHELLNAME' exists, or `~/.emacs.d/init_SHELLNAME.sh',
it is given as initial input (but this may be lost, due to a timing
error, if the shell discards input when it starts up).
@@ -732,25 +754,47 @@ Make the shell buffer the current buffer, and return it.
\(Type \\[describe-mode] in the shell buffer for a list of commands.)"
(interactive
- (list
- (and current-prefix-arg
- (prog1
- (read-buffer "Shell buffer: "
- ;; If the current buffer is an inactive
- ;; shell buffer, use it as the default.
- (if (and (eq major-mode 'shell-mode)
- (null (get-buffer-process (current-buffer))))
- (buffer-name)
- (generate-new-buffer-name "*shell*")))
- (if (file-remote-p default-directory)
- ;; It must be possible to declare a local default-directory.
- ;; FIXME: This can't be right: it changes the default-directory
- ;; of the current-buffer rather than of the *shell* buffer.
- (setq default-directory
- (expand-file-name
- (read-directory-name
- "Default directory: " default-directory default-directory
- t nil))))))))
+ (let* ((buffer
+ (and current-prefix-arg
+ (read-buffer "Shell buffer: "
+ ;; If the current buffer is an inactive
+ ;; shell buffer, use it as the default.
+ (if (and (eq major-mode 'shell-mode)
+ (null (get-buffer-process
+ (current-buffer))))
+ (buffer-name)
+ (generate-new-buffer-name "*shell*")))))
+ (buf (if (or buffer (not (derived-mode-p 'shell-mode))
+ (comint-check-proc (current-buffer)))
+ (get-buffer-create (or buffer "*shell*"))
+ ;; If the current buffer is a dead shell buffer, use it.
+ (current-buffer))))
+
+ (with-current-buffer buf
+ (when (and buffer (file-remote-p default-directory))
+ ;; It must be possible to declare a local default-directory.
+ (setq default-directory
+ (expand-file-name
+ (read-directory-name
+ "Default directory: " default-directory default-directory
+ t nil))))
+ (list
+ buffer
+ ;; On remote hosts, the local `shell-file-name' might be useless.
+ (with-connection-local-variables
+ (when (and (file-remote-p default-directory)
+ (null explicit-shell-file-name)
+ (null (getenv "ESHELL")))
+ ;; `expand-file-name' shall not add the MS Windows volume letter
+ ;; (Bug#49229).
+ (replace-regexp-in-string
+ "^[[:alpha:]]:" ""
+ (file-local-name
+ (expand-file-name
+ (read-file-name "Remote shell path: " default-directory
+ shell-file-name t shell-file-name
+ #'file-remote-p))))))))))
+
(setq buffer (if (or buffer (not (derived-mode-p 'shell-mode))
(comint-check-proc (current-buffer)))
(get-buffer-create (or buffer "*shell*"))
@@ -758,24 +802,11 @@ Make the shell buffer the current buffer, and return it.
(current-buffer)))
;; The buffer's window must be correctly set when we call comint
;; (so that comint sets the COLUMNS env var properly).
- (pop-to-buffer-same-window buffer)
+ (pop-to-buffer buffer display-comint-buffer-action)
(with-connection-local-variables
- ;; On remote hosts, the local `shell-file-name' might be useless.
- (when (and (file-remote-p default-directory)
- (called-interactively-p 'any)
- (null explicit-shell-file-name)
- (null (getenv "ESHELL")))
- ;; `expand-file-name' shall not add the MS Windows volume letter
- ;; (Bug#49229).
- (setq-local explicit-shell-file-name
- (replace-regexp-in-string
- "^[[:alpha:]]:" ""
- (file-local-name
- (expand-file-name
- (read-file-name "Remote shell path: " default-directory
- shell-file-name t shell-file-name
- #'file-remote-p))))))
+ (when file-name
+ (setq-local explicit-shell-file-name file-name))
;; Rain or shine, BUFFER must be current by now.
(unless (comint-check-proc buffer)
@@ -783,16 +814,37 @@ Make the shell buffer the current buffer, and return it.
(getenv "ESHELL") shell-file-name))
(name (file-name-nondirectory prog))
(startfile (concat "~/.emacs_" name))
- (xargs-name (intern-soft (concat "explicit-" name "-args"))))
+ (xargs-name (intern-soft (concat "explicit-" name "-args")))
+ (start-point (point)))
(unless (file-exists-p startfile)
- (setq startfile (concat user-emacs-directory "init_" name ".sh")))
+ (setq startfile (locate-user-emacs-file
+ (concat "init_" name ".sh"))))
(setq-local shell--start-prog (file-name-nondirectory prog))
(apply #'make-comint-in-buffer "shell" buffer prog
- (if (file-exists-p startfile) startfile)
+ nil
(if (and xargs-name (boundp xargs-name))
(symbol-value xargs-name)
'("-i")))
- (shell-mode))))
+ (shell-mode)
+ (when (file-exists-p startfile)
+ ;; Wait until the prompt has appeared.
+ (while (= start-point (point))
+ (sleep-for 0.1))
+ (shell-eval-command
+ (with-temp-buffer
+ (insert-file-contents startfile)
+ (buffer-string)))))))
+ (when shell-kill-buffer-on-exit
+ (let* ((buffer (current-buffer))
+ (process (get-buffer-process buffer))
+ (sentinel (process-sentinel process)))
+ (set-process-sentinel
+ process
+ (lambda (proc event)
+ (when sentinel
+ (funcall sentinel proc event))
+ (unless (buffer-live-p proc)
+ (kill-buffer buffer))))))
buffer)
;;; Directory tracking
@@ -1008,7 +1060,9 @@ Environment variables are expanded, see function `substitute-in-file-name'."
"Toggle directory tracking in this shell buffer (Shell Dirtrack mode).
The `dirtrack' package provides an alternative implementation of
-this feature; see the function `dirtrack-mode'."
+this feature; see the function `dirtrack-mode'. Also see
+`comint-osc-directory-tracker' for an escape-sequence based
+solution."
:lighter nil
(setq list-buffers-directory (if shell-dirtrack-mode default-directory))
(if shell-dirtrack-mode
@@ -1025,61 +1079,45 @@ this feature; see the function `dirtrack-mode'."
"Resync the buffer's idea of the current directory stack.
This command queries the shell with the command bound to
`shell-dirstack-query' (default \"dirs\"), reads the next
-line output and parses it to form the new directory stack.
-DON'T issue this command unless the buffer is at a shell prompt.
-Also, note that if some other subprocess decides to do output
-immediately after the query, its output will be taken as the
-new directory stack -- you lose. If this happens, just do the
-command again."
+line output and parses it to form the new directory stack."
(interactive)
- (let* ((proc (get-buffer-process (current-buffer)))
- (pmark (process-mark proc))
- (started-at-pmark (= (point) (marker-position pmark))))
- (save-excursion
- (goto-char pmark)
- ;; If the process echoes commands, don't insert a fake command in
- ;; the buffer or it will appear twice.
- (unless comint-process-echoes
- (insert shell-dirstack-query) (insert "\n"))
- (sit-for 0) ; force redisplay
- (comint-send-string proc shell-dirstack-query)
- (comint-send-string proc "\n")
- (set-marker pmark (point))
- (let ((pt (point))
- (regexp
- (concat
- (if comint-process-echoes
- ;; Skip command echo if the process echoes
- (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)")
- "\\(\\)")
- "\\(.+\n\\)")))
- ;; This extra newline prevents the user's pending input from spoofing us.
- (insert "\n") (backward-char 1)
- ;; Wait for one line.
- (while (not (looking-at regexp))
- (accept-process-output proc)
- (goto-char pt)))
- (goto-char pmark) (delete-char 1) ; remove the extra newline
- ;; That's the dirlist. grab it & parse it.
- (let* ((dl (buffer-substring (match-beginning 2) (1- (match-end 2))))
- (dl-len (length dl))
- (ds '()) ; new dir stack
- (i 0))
- (while (< i dl-len)
- ;; regexp = optional whitespace, (non-whitespace), optional whitespace
- (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
- (setq ds (cons (concat comint-file-name-prefix
- (substring dl (match-beginning 1)
- (match-end 1)))
- ds))
- (setq i (match-end 0)))
- (let ((ds (nreverse ds)))
- (with-demoted-errors "Couldn't cd: %s"
- (shell-cd (car ds))
- (setq shell-dirstack (cdr ds)
- shell-last-dir (car shell-dirstack))
- (shell-dirstack-message)))))
- (if started-at-pmark (goto-char (marker-position pmark)))))
+ (let* ((dls (car
+ (last
+ (string-lines
+ (string-chop-newline
+ (shell-eval-command (concat shell-dirstack-query "\n")))))))
+ (dlsl nil)
+ (pos 0)
+ (ds nil))
+ ;; Split the dirlist into whitespace and non-whitespace chunks.
+ ;; dlsl will be a reversed list of tokens.
+ (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos)
+ (push (match-string 1 dls) dlsl)
+ (setq pos (match-end 1)))
+
+ ;; Prepend trailing entries until they form an existing directory,
+ ;; whitespace and all. Discard the next whitespace and repeat.
+ (while dlsl
+ (let ((newelt "")
+ tem1 tem2)
+ (while newelt
+ ;; We need tem1 because we don't want to prepend
+ ;; `comint-file-name-prefix' repeatedly into newelt via tem2.
+ (setq tem1 (pop dlsl)
+ tem2 (concat comint-file-name-prefix tem1 newelt))
+ (cond ((file-directory-p tem2)
+ (push tem2 ds)
+ (when (string= " " (car dlsl))
+ (pop dlsl))
+ (setq newelt nil))
+ (t
+ (setq newelt (concat tem1 newelt)))))))
+
+ (with-demoted-errors "Couldn't cd: %s"
+ (shell-cd (car ds))
+ (setq shell-dirstack (cdr ds)
+ shell-last-dir (car shell-dirstack))
+ (shell-dirstack-message))))
;; For your typing convenience:
(defalias 'dirs 'shell-resync-dirs)
@@ -1414,6 +1452,36 @@ Returns t if successful."
(point-max)
(shell--prompt-begin-position))))))
+(defun shell-eval-command (command)
+ "Eval COMMAND in the current shell process and return the result."
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (old-filter (process-filter proc))
+ (result "")
+ prev)
+ (unwind-protect
+ (progn
+ (set-process-filter
+ proc
+ (lambda (_proc string)
+ (setq result (concat result string))))
+ (process-send-string proc command)
+ ;; Wait until we get a prompt (which will be a line without
+ ;; a newline). This is far from fool-proof -- if something
+ ;; outputs incomplete data and then sleeps, we'll think
+ ;; we've received the prompt.
+ (while (not (let* ((lines (string-lines result))
+ (last (car (last lines))))
+ (and (length> lines 0)
+ (not (equal last ""))
+ (or (not prev)
+ (not (equal last prev)))
+ (setq prev last))))
+ (accept-process-output proc 0 100)))
+ ;; Restore old filter.
+ (set-process-filter proc old-filter))
+ ;; Remove the prompt.
+ (replace-regexp-in-string "\n.*\\'" "\n" result)))
+
(provide 'shell)
;;; shell.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index a18a614d68e..e048df36951 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -60,6 +60,24 @@ value of 1 means that nothing is amalgamated.")
(defgroup paren-matching nil
"Highlight (un)matching of parens and expressions."
:group 'matching)
+
+(defvar-local escaped-string-quote "\\"
+ "String to insert before a string quote character in a string to escape it.
+This is typically a backslash (in most languages):
+
+ \\='foo\\\\='bar\\='
+ \"foo\\\"bar\"
+
+But in SQL, for instance, it's \"\\='\":
+
+ \\='foo\\='\\='bar\\='
+
+This can also be a function, which is called with the string
+terminator as the argument, and should return a string to be
+used as the escape.
+
+This variable is used by the `yank-in-context' command.")
+
;;; next-error support framework
@@ -494,7 +512,7 @@ buffer causes automatic display of the corresponding source code location."
(error t))))
(defun next-error-message-highlight (error-buffer)
- "Highlight the current error message in the ‘next-error’ buffer."
+ "Highlight the current error message in the `next-error' buffer."
(when next-error-message-highlight
(with-current-buffer error-buffer
(when (and next-error--message-highlight-overlay
@@ -527,21 +545,28 @@ Other major modes are defined by comparison with this one."
(kill-all-local-variables)
(run-mode-hooks))
+(define-derived-mode clean-mode fundamental-mode "Clean"
+ "A mode that removes all overlays and text properties."
+ (kill-all-local-variables t)
+ (let ((inhibit-read-only t))
+ (dolist (overlay (overlays-in (point-min) (point-max)))
+ (delete-overlay overlay))
+ (set-text-properties (point-min) (point-max) nil)
+ (setq-local yank-excluded-properties t)))
+
;; Special major modes to view specially formatted data rather than files.
-(defvar special-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" 'quit-window)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\C-?" 'scroll-down-command)
- (define-key map "?" 'describe-mode)
- (define-key map "h" 'describe-mode)
- (define-key map ">" 'end-of-buffer)
- (define-key map "<" 'beginning-of-buffer)
- (define-key map "g" 'revert-buffer)
- map))
+(defvar-keymap special-mode-map
+ :suppress t
+ "q" #'quit-window
+ "SPC" #'scroll-up-command
+ "S-SPC" #'scroll-down-command
+ "DEL" #'scroll-down-command
+ "?" #'describe-mode
+ "h" #'describe-mode
+ ">" #'end-of-buffer
+ "<" #'beginning-of-buffer
+ "g" #'revert-buffer)
(put 'special-mode 'mode-class 'special)
(define-derived-mode special-mode nil "Special"
@@ -703,9 +728,10 @@ When called from Lisp code, ARG may be a prefix string to copy."
:height 0.1 :background "#505050")
(((type graphic) (background light))
:height 0.1 :background "#a0a0a0")
- (t :foreground "ForestGreen"))
+ (t
+ :foreground "ForestGreen" :underline t))
"Face for separator lines."
- :version "28.1"
+ :version "29.1"
:group 'text)
(defun make-separator-line (&optional length)
@@ -713,11 +739,13 @@ When called from Lisp code, ARG may be a prefix string to copy."
This uses the `separator-line' face.
If LENGTH is nil, use the window width."
- (if (display-graphic-p)
+ (if (or (display-graphic-p)
+ (display-supports-face-attributes-p '(:underline t)))
(if length
(concat (propertize (make-string length ?\s) 'face 'separator-line)
"\n")
(propertize "\n" 'face '(:inherit separator-line :extend t)))
+ ;; In terminals (that don't support underline), use a line of dashes.
(concat (propertize (make-string (or length (1- (window-width))) ?-)
'face 'separator-line)
"\n")))
@@ -1062,15 +1090,26 @@ Leave one space or none, according to the context."
"Delete all spaces and tabs around point.
If BACKWARD-ONLY is non-nil, delete them only before point."
(interactive "*P")
+ (delete-space--internal " \t" backward-only))
+
+(defun delete-all-space (&optional backward-only)
+ "Delete all spaces, tabs, and newlines around point.
+If BACKWARD-ONLY is non-nil, delete them only before point."
+ (interactive "*P")
+ (delete-space--internal " \t\r\n" backward-only))
+
+(defun delete-space--internal (chars backward-only)
+ "Delete CHARS around point.
+If BACKWARD-ONLY is non-nil, delete them only before point."
(let ((orig-pos (point)))
(delete-region
(if backward-only
- orig-pos
+ orig-pos
(progn
- (skip-chars-forward " \t")
- (constrain-to-field nil orig-pos t)))
+ (skip-chars-forward chars)
+ (constrain-to-field nil orig-pos t)))
(progn
- (skip-chars-backward " \t")
+ (skip-chars-backward chars)
(constrain-to-field nil orig-pos)))))
(defun just-one-space (&optional n)
@@ -1078,73 +1117,225 @@ If BACKWARD-ONLY is non-nil, delete them only before point."
If N is negative, delete newlines as well, leaving -N spaces.
See also `cycle-spacing'."
(interactive "*p")
- (cycle-spacing n nil 'single-shot))
+ (let ((orig-pos (point))
+ (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
+ (num (abs (or n 1))))
+ (skip-chars-backward skip-characters)
+ (constrain-to-field nil orig-pos)
+ (let* ((num (- num (skip-chars-forward " " (+ num (point)))))
+ (mid (point))
+ (end (progn
+ (skip-chars-forward skip-characters)
+ (constrain-to-field nil orig-pos t))))
+ (delete-region mid end)
+ (insert (make-string num ?\s)))))
(defvar cycle-spacing--context nil
- "Store context used in consecutive calls to `cycle-spacing' command.
-The first time `cycle-spacing' runs, it saves in this variable:
-its N argument, the original point position, and the original spacing
-around point.")
-
-(defun cycle-spacing (&optional n preserve-nl-back mode)
+ "Stored context used in consecutive calls to `cycle-spacing' command.
+The value is a property list with the following elements:
+- `:orig-pos' The original position of point when starting the
+ sequence.
+- `:whitespace-string' All whitespace characters around point
+ including newlines.
+- `:n' The prefix arg given to the initial invocation
+ which is reused for all actions in this cycle.
+- `:last-action' The last action performed in the cycle.")
+
+(defcustom cycle-spacing-actions
+ '( just-one-space
+ delete-all-space
+ restore)
+ "List of actions cycled through by `cycle-spacing'.
+Supported values are:
+- `just-one-space' Delete all but N (prefix arg) spaces.
+ See that command's docstring for details.
+- `delete-space-after' Delete spaces after point keeping only N.
+- `delete-space-before' Delete spaces before point keeping only N.
+- `delete-all-space' Delete all spaces around point.
+- `restore' Restore the original spacing.
+
+All actions make use of the prefix arg given to `cycle-spacing'
+in the initial invocation, i.e., `just-one-space' keeps this
+amount of spaces deleting surplus ones. `just-one-space' and all
+other actions have the contract that a positive prefix arg (or
+zero) only deletes tabs and spaces whereas a negative prefix arg
+also deletes newlines.
+
+The `delete-space-before' and `delete-space-after' actions handle
+the prefix arg \\[negative-argument] without a number provided
+specially: all spaces before/after point are deleted (as if N was
+0) including newlines (as if N was negative).
+
+In addition to the predefined actions listed above, any function
+which accepts one argument is allowed. It receives the raw
+prefix arg of this cycle.
+
+In addition, an action may take the form (ACTION ARG) where
+ACTION is one of the predefined actions (except for `restore')
+and ARG is either
+- an integer with the meaning that ACTION should always use this
+ fixed integer instead of the actual prefix arg or
+- the symbol `inverted-arg' with the meaning that ACTION should
+ be performed with the inverted actual prefix arg.
+- the symbol `-' with the meaning that ACTION should include
+ newlines but it's up to the ACTION to decide how to interpret
+ it as a number, e.g., `delete-space-before' and
+ `delete-space-after' treat it like 0 whereas `just-one-space'
+ treats it like -1 as is usual."
+ :group 'editing-basics
+ :type (let ((actions
+ '((const :tag "Just N (prefix arg) spaces" just-one-space)
+ (const :tag "Delete spaces after point" delete-space-after)
+ (const :tag "Delete spaces before point" delete-space-before)
+ (const :tag "Delete all spaces around point" delete-all-space)
+ (function :tag "Function receiving a numeric arg"))))
+ `(repeat
+ (choice
+ ,@actions
+ (list :tag "Action with modified arg"
+ (choice ,@actions)
+ (choice (const :tag "Inverted prefix arg" inverted-arg)
+ (integer :tag "Fixed numeric arg")
+ (const :tag "Negative arg" -)))
+ (const :tag "Restore the original spacing" restore))))
+ :version "29.1")
+
+(defun cycle-spacing (&optional n)
"Manipulate whitespace around point in a smart way.
-In interactive use, this function behaves differently in successive
-consecutive calls.
-
-The first call in a sequence acts like `just-one-space'.
-It deletes all spaces and tabs around point, leaving one space
-\(or N spaces). N is the prefix argument. If N is negative,
-it deletes newlines as well, leaving -N spaces.
-\(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.)
-
-The second call in a sequence deletes all spaces.
-
-The third call in a sequence restores the original whitespace (and point).
-
-If MODE is `single-shot', it performs only the first step in the sequence.
-If MODE is `fast' and the first step would not result in any change
-\(i.e., there are exactly (abs N) spaces around point),
-the function goes straight to the second step.
-
-Repeatedly calling the function with different values of N starts a
-new sequence each time."
- (interactive "*p")
- (let ((orig-pos (point))
- (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
- (num (abs (or n 1))))
- (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
- (constrain-to-field nil orig-pos)
- (cond
- ;; Command run for the first time, single-shot mode or different argument
- ((or (eq 'single-shot mode)
- (not (equal last-command this-command))
- (not cycle-spacing--context)
- (not (eq (car cycle-spacing--context) n)))
- (let* ((start (point))
- (num (- num (skip-chars-forward " " (+ num (point)))))
- (mid (point))
- (end (progn
- (skip-chars-forward skip-characters)
- (constrain-to-field nil orig-pos t))))
- (setq cycle-spacing--context ;; Save for later.
- ;; Special handling for case where there was no space at all.
- (unless (= start end)
- (cons n (cons orig-pos (buffer-substring start (point))))))
- ;; If this run causes no change in buffer content, delete all spaces,
- ;; otherwise delete all excess spaces.
- (delete-region (if (and (eq mode 'fast) (zerop num) (= mid end))
- start mid) end)
- (insert (make-string num ?\s))))
-
- ;; Command run for the second time.
- ((not (equal orig-pos (point)))
- (delete-region (point) orig-pos))
-
- ;; Command run for the third time.
- (t
- (insert (cddr cycle-spacing--context))
- (goto-char (cadr cycle-spacing--context))
- (setq cycle-spacing--context nil)))))
+Repeated calls perform the actions in `cycle-spacing-actions' one
+after the other, wrapping around after the last one.
+
+All actions are amendable using a prefix arg N. In general, a
+zero or positive prefix arg allows only for deletion of tabs and
+spaces whereas a negative prefix arg also allows for deleting
+newlines.
+
+The prefix arg given at the first invocation starting a cycle is
+provided to all following actions, i.e.,
+ \\[negative-argument] \\[cycle-spacing] \\[cycle-spacing] \\[cycle-spacing]
+is equivalent to
+ \\[negative-argument] \\[cycle-spacing] \\[negative-argument] \\[cycle-spacing] \\[negative-argument] \\[cycle-spacing].
+
+A new sequence can be started by providing a different prefix arg
+than provided at the initial invocation (except for 1), or by
+doing any other command before the next \\[cycle-spacing]."
+ (interactive "*P")
+ ;; Initialize `cycle-spacing--context' if needed.
+ (when (or (not (equal last-command this-command))
+ (not cycle-spacing--context)
+ ;; With M-5 M-SPC M-SPC... we pass the prefix arg 5 to
+ ;; each action and only start a new cycle when a different
+ ;; prefix arg is given and which is not the default value
+ ;; 1.
+ (and n (not (equal (plist-get cycle-spacing--context :n)
+ n))))
+ (let ((orig-pos (point))
+ (skip-characters " \t\n\r"))
+ (save-excursion
+ (skip-chars-backward skip-characters)
+ (constrain-to-field nil orig-pos)
+ (let ((start (point))
+ (end (progn
+ (skip-chars-forward skip-characters)
+ (constrain-to-field nil orig-pos t))))
+ (setq cycle-spacing--context ;; Save for later.
+ (list :orig-pos orig-pos
+ :whitespace-string (buffer-substring start end)
+ :n n
+ :last-action nil))))))
+
+ ;; Cycle through the actions in `cycle-spacing-actions'.
+ (when cycle-spacing--context
+ (cl-labels ((next-action ()
+ (let* ((l cycle-spacing-actions)
+ (elt (plist-get cycle-spacing--context
+ :last-action)))
+ (if (null elt)
+ (car cycle-spacing-actions)
+ (catch 'found
+ (while l
+ (cond
+ ((null (cdr l))
+ (throw 'found
+ (when (eq elt (car l))
+ (car cycle-spacing-actions))))
+ ((and (eq elt (car l))
+ (cdr l))
+ (throw 'found (cadr l)))
+ (t (setq l (cdr l)))))))))
+ (skip-chars (chars max-dist direction)
+ (if (eq direction 'forward)
+ (skip-chars-forward
+ chars
+ (and max-dist (+ (point) max-dist)))
+ (skip-chars-backward
+ chars
+ (and max-dist (- (point) max-dist)))))
+ (delete-space (n include-newlines direction)
+ (let ((orig-point (point))
+ (chars (if include-newlines
+ " \t\r\n"
+ " \t")))
+ (when (or (zerop n)
+ (= n (abs (skip-chars chars n direction))))
+ (let ((start (point))
+ (end (progn
+ (skip-chars chars nil direction)
+ (point))))
+ (unless (= start end)
+ (delete-region start end))
+ (goto-char (if (eq direction 'forward)
+ orig-point
+ (+ n end)))))))
+ (restore ()
+ (delete-all-space)
+ (insert (plist-get cycle-spacing--context
+ :whitespace-string))
+ (goto-char (plist-get cycle-spacing--context
+ :orig-pos))))
+ (let ((action (next-action)))
+ (atomic-change-group
+ (restore)
+ (unless (eq action 'restore)
+ ;; action can be some-action or (some-action <arg>) where
+ ;; arg is either an integer, the arg to be always used for
+ ;; this action or - to use the inverted context n for this
+ ;; action.
+ (let* ((actual-action (if (listp action)
+ (car action)
+ action))
+ (arg (when (listp action)
+ (nth 1 action)))
+ (context-n (plist-get cycle-spacing--context :n))
+ (actual-n (cond
+ ((integerp arg) arg)
+ ((eq 'inverted-arg arg)
+ (* -1 (prefix-numeric-value context-n)))
+ ((eq '- arg) '-)
+ (t context-n)))
+ (numeric-n (prefix-numeric-value actual-n))
+ (include-newlines (or (eq actual-n '-)
+ (and (integerp actual-n)
+ (< actual-n 0)))))
+ (cond
+ ((eq actual-action 'just-one-space)
+ (just-one-space numeric-n))
+ ((eq actual-action 'delete-space-after)
+ (delete-space (if (eq actual-n '-) 0 (abs numeric-n))
+ include-newlines 'forward))
+ ((eq actual-action 'delete-space-before)
+ (delete-space (if (eq actual-n '-) 0 (abs numeric-n))
+ include-newlines 'backward))
+ ((eq actual-action 'delete-all-space)
+ (if include-newlines
+ (delete-all-space)
+ (delete-horizontal-space)))
+ ((functionp actual-action)
+ (funcall actual-action actual-n))
+ (t
+ (error "Don't know how to handle action %S" action)))))
+ (setf (plist-get cycle-spacing--context :last-action)
+ action))))))
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer.
@@ -1282,6 +1473,11 @@ If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
To disable this, set variable `delete-active-region' to nil.
+If N is positive, characters composed into a single grapheme cluster
+count as a single character and are deleted together. Thus,
+\"\\[universal-argument] 2 \\[delete-forward-char]\" when two grapheme clusters follow point will
+delete the characters composed into both of the grapheme clusters.
+
Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete. If called interactively, a numeric
prefix argument specifies N, and KILLFLAG is also set if a prefix
@@ -1302,6 +1498,34 @@ the actual saved text might be different from what was killed."
(kill-region (region-beginning) (region-end) 'region)
(funcall region-extract-function 'delete-only)))
+ ;; For forward deletion, treat composed characters as a single
+ ;; character to delete.
+ ((>= n 1)
+ (let ((pos (point))
+ start cmp)
+ (setq start pos)
+ (while (> n 0)
+ ;; 'find-composition' will return (FROM TO ....) or nil.
+ (setq cmp (find-composition pos))
+ (setq pos
+ (if cmp
+ (let ((from (car cmp))
+ (to (cadr cmp)))
+ (cond
+ ((= (length cmp) 2) ; static composition
+ to)
+ ;; TO can be at POS, in which case we want
+ ;; to make sure we advance at least by 1
+ ;; character.
+ ((<= to pos)
+ (1+ pos))
+ (t
+ (lgstring-glyph-boundary (nth 2 cmp)
+ from (1+ pos)))))
+ (1+ pos)))
+ (setq n (1- n)))
+ (delete-char (- pos start) killflag)))
+
;; Otherwise, do simple deletion.
(t (delete-char n killflag))))
@@ -1447,53 +1671,67 @@ START and END."
(cond ((not (called-interactively-p 'any))
(count-words start end))
(arg
- (count-words--buffer-message))
+ (message "%s" (count-words--buffer-format)))
(t
- (count-words--message "Region" start end))))
+ (message "%s" (count-words--format "Region" start end)))))
-(defun count-words (start end)
+(defun count-words (start end &optional totals)
"Count words between START and END.
If called interactively, START and END are normally the start and
end of the buffer; but if the region is active, START and END are
the start and end of the region. Print a message reporting the
-number of lines, words, and chars.
+number of lines, sentences, words, and chars. With prefix
+argument, also include the data for the entire (un-narrowed)
+buffer.
If called from Lisp, return the number of words between START and
-END, without printing any message."
- (interactive (list nil nil))
- (cond ((not (called-interactively-p 'any))
- (let ((words 0)
- ;; Count across field boundaries. (Bug#41761)
- (inhibit-field-text-motion t))
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (while (forward-word-strictly 1)
- (setq words (1+ words)))))
- words))
- ((use-region-p)
- (call-interactively 'count-words-region))
- (t
- (count-words--buffer-message))))
-
-(defun count-words--buffer-message ()
- (count-words--message
+END, without printing any message. TOTALS is ignored when called
+from Lisp."
+ (interactive (list nil nil current-prefix-arg))
+ ;; When called from Lisp, return the data.
+ (if (not (called-interactively-p 'any))
+ (let ((words 0)
+ ;; Count across field boundaries. (Bug#41761)
+ (inhibit-field-text-motion t))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (forward-word-strictly 1)
+ (setq words (1+ words)))))
+ words)
+ ;; When called interactively, message the data.
+ (let ((totals (if (and totals
+ (or (use-region-p)
+ (buffer-narrowed-p)))
+ (save-restriction
+ (widen)
+ (count-words--format "; buffer in total"
+ (point-min) (point-max)))
+ "")))
+ (if (use-region-p)
+ (message "%s%s" (count-words--format
+ "Region" (region-beginning) (region-end))
+ totals)
+ (message "%s%s" (count-words--buffer-format) totals)))))
+
+(defun count-words--buffer-format ()
+ (count-words--format
(if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
(point-min) (point-max)))
-(defun count-words--message (str start end)
+(defun count-words--format (str start end)
(let ((lines (count-lines start end))
+ (sentences (count-sentences start end))
(words (count-words start end))
(chars (- end start)))
- (message "%s has %d line%s, %d word%s, and %d character%s."
+ (format "%s has %d line%s, %d sentence%s, %d word%s, and %d character%s"
str
lines (if (= lines 1) "" "s")
+ sentences (if (= sentences 1) "" "s")
words (if (= words 1) "" "s")
chars (if (= chars 1) "" "s"))))
-(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1")
-
(defun what-line ()
"Print the current buffer line number and narrowed line number of point."
(interactive)
@@ -1711,10 +1949,6 @@ Such arguments are used as in `read-from-minibuffer'.)"
;; Used for interactive spec `X'.
(eval (read--expression prompt initial-contents)))
-(defvar minibuffer-completing-symbol nil
- "Non-nil means completing a Lisp symbol in the minibuffer.")
-(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get)
-
(defvar minibuffer-default nil
"The current default value or list of default values in the minibuffer.
The functions `read-from-minibuffer' and `completing-read' bind
@@ -1775,20 +2009,19 @@ display the result of expression evaluation."
PROMPT and optional argument INITIAL-CONTENTS do the same as in
function `read-from-minibuffer'."
- (let ((minibuffer-completing-symbol t))
- (minibuffer-with-setup-hook
- (lambda ()
- ;; FIXME: instead of just applying the syntax table, maybe
- ;; use a special major mode tailored to reading Lisp
- ;; expressions from the minibuffer? (`emacs-lisp-mode'
- ;; doesn't preserve the necessary keybindings.)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (add-hook 'completion-at-point-functions
- #'elisp-completion-at-point nil t)
- (run-hooks 'eval-expression-minibuffer-setup-hook))
- (read-from-minibuffer prompt initial-contents
- read-expression-map t
- 'read-expression-history))))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ ;; FIXME: instead of just applying the syntax table, maybe
+ ;; use a special major mode tailored to reading Lisp
+ ;; expressions from the minibuffer? (`emacs-lisp-mode'
+ ;; doesn't preserve the necessary keybindings.)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (add-hook 'completion-at-point-functions
+ #'elisp-completion-at-point nil t)
+ (run-hooks 'eval-expression-minibuffer-setup-hook))
+ (read-from-minibuffer prompt initial-contents
+ read-expression-map t
+ 'read-expression-history)))
(defun read--expression-try-read ()
"Try to read an Emacs Lisp expression in the minibuffer.
@@ -1971,7 +2204,7 @@ to get different commands to edit and resubmit."
If it's nil, include all the commands.
If it's a function, it will be called with two parameters: the
symbol of the command and a buffer. The predicate should return
-non-nil if the command should be present when doing `M-x TAB'
+non-nil if the command should be present when doing \\`M-x TAB'
in that buffer."
:version "28.1"
:group 'completion
@@ -1980,9 +2213,53 @@ in that buffer."
command-completion-default-include-p)
(function :tag "Other function")))
-(defun read-extended-command ()
+(defun execute-extended-command-cycle ()
+ "Choose the next version of the extended command predicates.
+See `extended-command-versions'."
+ (interactive)
+ (throw 'cycle
+ (cons (minibuffer-contents)
+ (- (point) (minibuffer-prompt-end)))))
+
+(defvar extended-command-versions
+ (list (list "M-x " (lambda () read-extended-command-predicate))
+ (list "M-X " #'command-completion--command-for-this-buffer-function))
+ "Alist of prompts and what the extended command predicate should be.
+This is used by the \\<minibuffer-local-must-match-map>\\[execute-extended-command-cycle] command when reading an extended command.")
+
+(defun read-extended-command (&optional prompt)
"Read command name to invoke in `execute-extended-command'.
This function uses the `read-extended-command-predicate' user option."
+ (let ((default-predicate read-extended-command-predicate)
+ (read-extended-command-predicate read-extended-command-predicate)
+ already-typed ret)
+ ;; If we have a prompt (which is the name of the version of the
+ ;; command), then set up the predicate from
+ ;; `extended-command-versions'.
+ (if (not prompt)
+ (setq prompt (caar extended-command-versions))
+ (setq read-extended-command-predicate
+ (funcall (cadr (assoc prompt extended-command-versions)))))
+ ;; Normally this will only execute once.
+ (while (not (stringp ret))
+ (when (consp (setq ret (catch 'cycle
+ (read-extended-command-1 prompt
+ already-typed))))
+ ;; But if the user hit `M-X', then we `throw'ed out to that
+ ;; `catch', and we cycle to the next setting.
+ (let ((next (or (cadr (memq (assoc prompt extended-command-versions)
+ extended-command-versions))
+ ;; Last one; cycle back to the first.
+ (car extended-command-versions))))
+ ;; Restore the user's default predicate.
+ (setq read-extended-command-predicate default-predicate)
+ ;; Then calculate the next.
+ (setq prompt (car next)
+ read-extended-command-predicate (funcall (cadr next))
+ already-typed ret))))
+ ret))
+
+(defun read-extended-command-1 (prompt initial-input)
(let ((buffer (current-buffer)))
(minibuffer-with-setup-hook
(lambda ()
@@ -2007,8 +2284,8 @@ This function uses the `read-extended-command-predicate' user option."
(cons def (delete def all))
all)))))
;; Read a string, completing from and restricting to the set of
- ;; all defined commands. Don't provide any initial input.
- ;; Save the command read on the extended-command history list.
+ ;; all defined commands. Save the command read on the
+ ;; extended-command history list.
(completing-read
(concat (cond
((eq current-prefix-arg '-) "- ")
@@ -2026,9 +2303,7 @@ This function uses the `read-extended-command-predicate' user option."
;; but actually a prompt other than "M-x" would be confusing,
;; because "M-x" is a well-known prompt to read a command
;; and it serves as a shorthand for "Extended command: ".
- (if (memq 'shift (event-modifiers last-command-event))
- "M-X "
- "M-x "))
+ (or prompt "M-x "))
(lambda (string pred action)
(if (and suggest-key-bindings (eq action 'metadata))
'(metadata
@@ -2067,12 +2342,12 @@ This function uses the `read-extended-command-predicate' user option."
(funcall read-extended-command-predicate sym buffer)
(error (message "read-extended-command-predicate: %s: %s"
sym (error-message-string err))))))))
- t nil 'extended-command-history))))
+ t initial-input 'extended-command-history))))
(defun command-completion-using-modes-p (symbol buffer)
"Say whether SYMBOL has been marked as a mode-specific command in BUFFER."
;; Check the modes.
- (let ((modes (command-modes symbol)))
+ (when-let ((modes (command-modes symbol)))
;; Common fast case: Just a single mode.
(if (null (cdr modes))
(or (provided-mode-derived-p
@@ -2223,6 +2498,11 @@ invoking, give a prefix argument to `execute-extended-command'."
(find-shorter nil))
(unless (commandp function)
(error "`%s' is not a valid command name" command-name))
+ ;; If we're executing a command that's remapped, we can't actually
+ ;; execute that command with the keymapping we've found with
+ ;; `where-is-internal'.
+ (when (and binding (command-remapping function))
+ (setq binding nil))
;; Some features, such as novice.el, rely on this-command-keys
;; including M-x COMMAND-NAME RET.
(set--this-command-keys (concat "\M-x" (symbol-name function) "\r"))
@@ -2293,27 +2573,80 @@ minor modes), as well as commands bound in the active local key
maps."
(declare (interactive-only command-execute))
(interactive
- (let* ((execute-extended-command--last-typed nil)
- (keymaps
- ;; The major mode's keymap and any active minor modes.
- (nconc
- (and (current-local-map) (list (current-local-map)))
- (mapcar
- #'cdr
- (seq-filter
- (lambda (elem)
- (symbol-value (car elem)))
- minor-mode-map-alist))))
- (read-extended-command-predicate
- (lambda (symbol buffer)
- (or (command-completion-using-modes-p symbol buffer)
- (where-is-internal symbol keymaps)))))
+ (let ((execute-extended-command--last-typed nil))
(list current-prefix-arg
- (read-extended-command)
+ (read-extended-command "M-X ")
execute-extended-command--last-typed)))
(with-suppressed-warnings ((interactive-only execute-extended-command))
(execute-extended-command prefixarg command-name typed)))
+(defun command-completion--command-for-this-buffer-function ()
+ (let ((keymaps
+ ;; The major mode's keymap and any active minor modes.
+ (nconc
+ (and (current-local-map) (list (current-local-map)))
+ (mapcar
+ #'cdr
+ (seq-filter
+ (lambda (elem)
+ (symbol-value (car elem)))
+ minor-mode-map-alist)))))
+ (lambda (symbol buffer)
+ (or (command-completion-using-modes-p symbol buffer)
+ ;; Include commands that are bound in a keymap in the
+ ;; current buffer.
+ (and (where-is-internal symbol keymaps)
+ ;; But not if they have a command predicate that
+ ;; says that they shouldn't. (This is the case
+ ;; for `ignore' and `undefined' and similar
+ ;; commands commonly found in keymaps.)
+ (or (null (get symbol 'completion-predicate))
+ (funcall (get symbol 'completion-predicate)
+ symbol buffer)))))))
+
+(cl-defgeneric function-documentation (function)
+ "Extract the raw docstring info from FUNCTION.
+FUNCTION is expected to be a function value rather than, say, a mere symbol.
+This is intended to be specialized via `cl-defmethod' but not called directly:
+if you need a function's documentation use `documentation' which will call this
+function as needed."
+ (let ((docstring-p (lambda (doc)
+ ;; A docstring can be either a string or a reference
+ ;; into either the `etc/DOC' or a `.elc' file.
+ (or (stringp doc)
+ (fixnump doc) (fixnump (cdr-safe doc))))))
+ (pcase function
+ ((pred byte-code-function-p)
+ (when (> (length function) 4)
+ (let ((doc (aref function 4)))
+ (when (funcall docstring-p doc) doc))))
+ ((or (pred stringp) (pred vectorp)) "Keyboard macro.")
+ (`(keymap . ,_)
+ "Prefix command (definition is a keymap associating keystrokes with commands).")
+ ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
+ `(autoload ,_file . ,body))
+ (let ((doc (car body)))
+ (when (and (funcall docstring-p doc)
+ ;; Handle a doc reference--but these never come last
+ ;; in the function body, so reject them if they are last.
+ (or (cdr body) (eq 'autoload (car-safe function))))
+ doc)))
+ (_ (signal 'invalid-function (list function))))))
+
+(cl-defmethod function-documentation ((function accessor))
+ (oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
+
+;; This should be in `oclosure.el' but that file is loaded before `cl-generic'.
+(cl-defgeneric oclosure-interactive-form (_function)
+ "Return the interactive form of FUNCTION or nil if none.
+This is called by `interactive-form' when invoked on OClosures.
+It should return either nil or a two-element list of the form (interactive FORM)
+where FORM is like the first arg of the `interactive' special form.
+Add your methods to this generic function, but always call `interactive-form'
+instead."
+ ;; (interactive-form function)
+ nil)
+
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
@@ -2338,12 +2671,17 @@ don't clear it."
(setq current-prefix-arg prefix-arg)
(setq prefix-arg nil)
(when current-prefix-arg
- (prefix-command-update))))))
+ (prefix-command-update)))))
+ query)
(if (and (symbolp cmd)
(get cmd 'disabled)
- disabled-command-function)
- ;; FIXME: Weird calling convention!
- (run-hooks 'disabled-command-function)
+ (or (and (setq query (and (consp (get cmd 'disabled))
+ (eq (car (get cmd 'disabled)) 'query)))
+ (not (command-execute--query cmd)))
+ (and (not query) disabled-command-function)))
+ (when (not query)
+ ;; FIXME: Weird calling convention!
+ (run-hooks 'disabled-command-function))
(let ((final cmd))
(while
(progn
@@ -2367,6 +2705,21 @@ don't clear it."
(put cmd 'command-execute-obsolete-warned t)
(message "%s" (macroexp--obsolete-warning
cmd (get cmd 'byte-obsolete-info) "command"))))))))))
+
+(defun command-execute--query (command)
+ "Query the user whether to run COMMAND."
+ (let ((query (get command 'disabled)))
+ (funcall (if (nth 1 query) #'yes-or-no-p #'y-or-n-p)
+ (nth 2 query))))
+
+;;;###autoload
+(defun command-query (command query &optional verbose)
+ "Make executing COMMAND issue QUERY to the user.
+This will, by default, use `y-or-n-p', but if VERBOSE,
+`yes-or-no-p' is used instead."
+ (put command 'disabled
+ (list 'query (not (not verbose)) query)))
+
(defvar minibuffer-history nil
"Default minibuffer history list.
@@ -2777,6 +3130,7 @@ Intended to be added to `minibuffer-setup-hook'."
#'minibuffer-history-isearch-wrap)
(setq-local isearch-push-state-function
#'minibuffer-history-isearch-push-state)
+ (setq-local isearch-lazy-count nil)
(add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t))
(defun minibuffer-history-isearch-end ()
@@ -2912,12 +3266,12 @@ the minibuffer contents."
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
"Table mapping redo records to the corresponding undo one.
-A redo record for an undo in region maps to 'undo-in-region.
+A redo record for an undo in region maps to `undo-in-region'.
A redo record for ordinary undo maps to the following (earlier) undo.
A redo record that undoes to the beginning of the undo list maps to t.
In the rare case where there are (erroneously) consecutive nil's in
`buffer-undo-list', `undo' maps the previous valid undo record to
-'empty, if the previous record is a redo record, `undo' doesn't change
+`empty', if the previous record is a redo record, `undo' doesn't change
its mapping.
To be clear, a redo record is just an undo record, the only difference
@@ -3105,7 +3459,7 @@ Interactively, ARG is the prefix numeric argument and defaults to 1."
(let ((undo-in-progress t))
(while (and (consp ul) (eq (car ul) nil))
(setq ul (cdr ul)))
- (primitive-undo arg ul)))
+ (primitive-undo (or arg 1) ul)))
(new-pul (undo--last-change-was-undo-p new-ul)))
(message "Redo%s" (if undo-in-region " in region" ""))
(setq this-command 'undo)
@@ -3164,12 +3518,22 @@ Return what remains of the list."
;; If this records an obsolete save
;; (not matching the actual disk file)
;; then don't mark unmodified.
- (when (or (equal time (visited-file-modtime))
- (and (consp time)
- (equal (list (car time) (cdr time))
- (visited-file-modtime))))
- (unlock-buffer)
- (set-buffer-modified-p nil)))
+ (let ((visited-file-time (visited-file-modtime)))
+ ;; Indirect buffers don't have a visited file, so their
+ ;; file-modtime can be bogus. In that case, use the
+ ;; modtime of the base buffer instead.
+ (if (and (numberp visited-file-time)
+ (= visited-file-time 0)
+ (buffer-base-buffer))
+ (setq visited-file-time
+ (with-current-buffer (buffer-base-buffer)
+ (visited-file-modtime))))
+ (when (or (equal time visited-file-time)
+ (and (consp time)
+ (equal (list (car time) (cdr time))
+ visited-file-time)))
+ (unlock-buffer)
+ (set-buffer-modified-p nil))))
;; Element (nil PROP VAL BEG . END) is property change.
(`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
(when (or (> (point-min) beg) (< (point-max) end))
@@ -3827,7 +4191,10 @@ to the end of the list of defaults just after the default value."
(defvar minibuffer-local-shell-command-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
- (define-key map "\t" 'completion-at-point)
+ (define-key map "\t" #'completion-at-point)
+ (define-key map [M-up] #'minibuffer-previous-completion)
+ (define-key map [M-down] #'minibuffer-next-completion)
+ (define-key map [?\M-\r] #'minibuffer-choose-completion)
map)
"Keymap used for completing shell commands in minibuffer.")
@@ -4082,6 +4449,10 @@ interactively when the prefix argument is given), insert the
output in current buffer after point leaving mark after it. This
cannot be done asynchronously.
+If OUTPUT-BUFFER is a buffer or buffer name different from the
+current buffer, instead of outputting at point in that buffer,
+the output will be appended at the end of that buffer.
+
The user option `shell-command-dont-erase-buffer', which see, controls
whether the output buffer is erased and where to put point after
the shell command.
@@ -4193,25 +4564,21 @@ impose the use of a shell (with its need to quote arguments)."
(cond
((eq async-shell-command-buffer 'confirm-kill-process)
;; If will kill a process, query first.
- (if (yes-or-no-p "A command is running in the default buffer. Kill it? ")
- (kill-process proc)
- (user-error "Shell command in progress")))
+ (shell-command--same-buffer-confirm "Kill it")
+ (kill-process proc))
((eq async-shell-command-buffer 'confirm-new-buffer)
;; If will create a new buffer, query first.
- (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
- (setq buffer (generate-new-buffer bname))
- (user-error "Shell command in progress")))
+ (shell-command--same-buffer-confirm "Use a new buffer")
+ (setq buffer (generate-new-buffer bname)))
((eq async-shell-command-buffer 'new-buffer)
;; It will create a new buffer.
(setq buffer (generate-new-buffer bname)))
((eq async-shell-command-buffer 'confirm-rename-buffer)
;; If will rename the buffer, query first.
- (if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
- (progn
- (with-current-buffer buffer
- (rename-uniquely))
- (setq buffer (get-buffer-create bname)))
- (user-error "Shell command in progress")))
+ (shell-command--same-buffer-confirm "Rename it")
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create bname)))
((eq async-shell-command-buffer 'rename-buffer)
;; It will rename the buffer.
(with-current-buffer buffer
@@ -4259,6 +4626,24 @@ impose the use of a shell (with its need to quote arguments)."
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
+(defun shell-command--same-buffer-confirm (action)
+ (let ((help-form
+ (format
+ "There's a command already running in the default buffer,
+so we can't start a new one in the same one.
+
+Answering \"yes\" will %s.
+
+Answering \"no\" will exit without doing anything, and won't
+start the new command.
+
+Also see the `async-shell-command-buffer' variable."
+ (downcase action))))
+ (unless (yes-or-no-p
+ (format "A command is running in the default buffer. %s? "
+ action))
+ (user-error "Shell command in progress"))))
+
(defun max-mini-window-lines (&optional frame)
"Compute maximum number of lines for echo area in FRAME.
As defined by `max-mini-window-height'. FRAME defaults to the
@@ -4693,6 +5078,8 @@ File name handlers might not support pty association, if PROGRAM is nil."
(forward-line -1)
(beginning-of-line))))
+(declare-function thread-name "thread.c")
+
(defun list-processes--refresh ()
"Recompute the list of processes for the Process List buffer.
Also, delete any process that is exited or signaled."
@@ -4965,17 +5352,6 @@ that `filter-buffer-substring' received. It should return the
buffer substring between BEG and END, after filtering. If DELETE is
non-nil, it should delete the text between BEG and END from the buffer.")
-(defvar buffer-substring-filters nil
- "List of filter functions for `buffer-substring--filter'.
-Each function must accept a single argument, a string, and return a string.
-The buffer substring is passed to the first function in the list,
-and the return value of each function is passed to the next.
-As a special convention, point is set to the start of the buffer text
-being operated on (i.e., the first argument of `buffer-substring--filter')
-before these functions are called.")
-(make-obsolete-variable 'buffer-substring-filters
- 'filter-buffer-substring-function "24.1")
-
(defun filter-buffer-substring (beg end &optional delete)
"Return the buffer substring between BEG and END, after filtering.
If DELETE is non-nil, delete the text between BEG and END from the buffer.
@@ -4996,20 +5372,15 @@ that are special to a buffer, and should not be copied into other buffers."
"Default function to use for `filter-buffer-substring-function'.
Its arguments and return value are as specified for `filter-buffer-substring'.
Also respects the obsolete wrapper hook `filter-buffer-substring-functions'
-\(see `with-wrapper-hook' for details about wrapper hooks),
-and the abnormal hook `buffer-substring-filters'.
+(see `with-wrapper-hook' for details about wrapper hooks).
No filtering is done unless a hook says to."
(subr--with-wrapper-hook-no-warnings
filter-buffer-substring-functions (beg end delete)
(cond
- ((or delete buffer-substring-filters)
+ (delete
(save-excursion
(goto-char beg)
- (let ((string (if delete (delete-and-extract-region beg end)
- (buffer-substring beg end))))
- (dolist (filter buffer-substring-filters)
- (setq string (funcall filter string)))
- string)))
+ (delete-and-extract-region beg end)))
(t
(buffer-substring beg end)))))
@@ -5070,10 +5441,11 @@ interact nicely with `interprogram-cut-function' and
interaction; you may want to use them instead of manipulating the kill
ring directly.")
-(defcustom kill-ring-max 60
+(defcustom kill-ring-max 120
"Maximum length of kill ring before oldest elements are thrown away."
- :type 'integer
- :group 'killing)
+ :type 'natnum
+ :group 'killing
+ :version "29.1")
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
@@ -5351,7 +5723,7 @@ This command's old key binding has been given to `kill-ring-save'."
(let ((str (if region
(funcall region-extract-function nil)
(filter-buffer-substring beg end))))
- (if (eq last-command 'kill-region)
+ (if (eq last-command 'kill-region)
(kill-append str (< end beg))
(kill-new str)))
(setq deactivate-mark t)
@@ -5634,6 +6006,15 @@ See also `yank-handled-properties'."
:group 'killing
:version "24.3")
+(defvar yank-transform-functions nil
+ "Hook run on strings to be yanked.
+Each function in this list will be called (in order) with the
+string to be yanked as the sole argument, and should return the (possibly)
+transformed string.
+
+The functions will be called with the destination buffer as the current
+buffer, and with point at the place where the string is to be inserted.")
+
(defvar yank-window-start nil)
(defvar yank-undo-function nil
"If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
@@ -5705,6 +6086,11 @@ property, as described below.
Properties listed in `yank-handled-properties' are processed,
then those listed in `yank-excluded-properties' are discarded.
+STRING will be run through `yank-transform-functions'.
+`yank-in-context' is a command that uses this mechanism to
+provide a `yank' alternative that conveniently preserves
+string/comment syntax.
+
If STRING has a non-nil `yank-handler' property anywhere, the
normal insert behavior is altered, and instead, for each contiguous
segment of STRING that has a given value of the `yank-handler'
@@ -5755,6 +6141,88 @@ With ARG, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
+(defun yank-in-context (&optional arg)
+ "Insert the last stretch of killed text while preserving syntax.
+In particular, if point is inside a string, any quote characters
+in the killed text will be quoted, so that the string remains a
+valid string.
+
+If point is inside a comment, ensure that the inserted text is
+also marked as a comment.
+
+This command otherwise behaves as `yank'. See that command for
+explanation of ARG.
+
+This function uses the `escaped-string-quote' buffer-local
+variable to determine how strings should be escaped."
+ (interactive "*P")
+ (let ((yank-transform-functions (cons #'yank-in-context--transform
+ yank-transform-functions)))
+ (yank arg)))
+
+(defun yank-in-context--transform (string)
+ (let ((ppss (syntax-ppss)))
+ (cond
+ ;; We're in a string.
+ ((ppss-string-terminator ppss)
+ (string-replace
+ (string (ppss-string-terminator ppss))
+ (concat (if (functionp escaped-string-quote)
+ (funcall escaped-string-quote
+ (ppss-string-terminator ppss))
+ escaped-string-quote)
+ (string (ppss-string-terminator ppss)))
+ string))
+ ;; We're in a comment.
+ ((or (ppss-comment-depth ppss)
+ (and (bolp)
+ (not (eobp))
+ ;; If we're in the middle of a bunch of commented text,
+ ;; we probably want to be commented. This is quite DWIM.
+ (or (bobp)
+ (save-excursion
+ (forward-line -1)
+ (forward-char 1)
+ (ppss-comment-depth (syntax-ppss))))
+ (ppss-comment-depth
+ (setq ppss (save-excursion
+ (forward-char 1)
+ (syntax-ppss))))))
+ (cond
+ ((and (eq (ppss-comment-depth ppss) t)
+ (> (length comment-end) 0)
+ (string-search comment-end string))
+ (user-error "Can't insert a string containing a comment terminator in a comment"))
+ ;; If this is a comment syntax that has an explicit end, then
+ ;; we can just insert as is.
+ ((> (length comment-end) 0) string)
+ ;; Line-based comment formats.
+ ((or (string-search "\n" string)
+ (bolp))
+ (let ((mode major-mode)
+ (bolp (bolp))
+ (eolp (eolp))
+ (comment-style 'plain))
+ (with-temp-buffer
+ (funcall mode)
+ (insert string)
+ (when (string-match-p "\n\\'" string)
+ (cond
+ ((not eolp) (delete-char -1))
+ (bolp (insert "\n"))))
+ (comment-normalize-vars)
+ (comment-region-default-1
+ (if bolp
+ (point-min)
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line 1)
+ (point)))
+ (point-max))
+ (buffer-string))))
+ (t string)))
+ (t string))))
+
(defvar read-from-kill-ring-history)
(defun read-from-kill-ring (prompt)
"Read a `kill-ring' entry using completion and minibuffer history.
@@ -5893,7 +6361,7 @@ Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
If Transient Mark mode is enabled, the mark is active, and ARG is 1,
delete the text in the region and deactivate the mark instead.
-To disable this, set option ‘delete-active-region’ to nil.
+To disable this, set option `delete-active-region' to nil.
Interactively, ARG is the prefix arg (default 1)
and KILLP is t if a prefix arg was specified."
@@ -5923,21 +6391,34 @@ and KILLP is t if a prefix arg was specified."
;; Avoid warning about delete-backward-char
(with-no-warnings (delete-backward-char n killp))))
-(defun zap-to-char (arg char)
+(defun char-uppercase-p (char)
+ "Return non-nil if CHAR is an upper-case character.
+If the Unicode tables are not yet available, e.g. during bootstrap,
+then gives correct answers only for ASCII characters."
+ (cond ((unicode-property-table-internal 'lowercase)
+ (characterp (get-char-code-property char 'lowercase)))
+ ((and (>= char ?A) (<= char ?Z)))))
+
+(defun zap-to-char (arg char &optional interactive)
"Kill up to and including ARGth occurrence of CHAR.
+When run interactively, the argument INTERACTIVE is non-nil.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found.
-See also `zap-up-to-char'."
+See also `zap-up-to-char'.
+If called interactively, do a case sensitive search if CHAR
+is an upper-case character."
(interactive (list (prefix-numeric-value current-prefix-arg)
(read-char-from-minibuffer "Zap to char: "
- nil 'read-char-history)))
+ nil 'read-char-history)
+ t))
;; Avoid "obsolete" warnings for translation-table-for-input.
(with-no-warnings
(if (char-table-p translation-table-for-input)
(setq char (or (aref translation-table-for-input char) char))))
- (kill-region (point) (progn
- (search-forward (char-to-string char) nil nil arg)
- (point))))
+ (let ((case-fold-search (if (and interactive (char-uppercase-p char))
+ nil
+ case-fold-search)))
+ (kill-region (point) (search-forward (char-to-string char) nil nil arg))))
;; kill-line and its subroutines.
@@ -6412,27 +6893,38 @@ An example is a rectangular region handled as a list of
separate contiguous regions for each line."
(cdr (region-bounds)))
+(defun redisplay--unhighlight-overlay-function (rol)
+ "If ROL is an overlay, call `delete-overlay'."
+ (when (overlayp rol) (delete-overlay rol)))
+
(defvar redisplay-unhighlight-region-function
- (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
+ #'redisplay--unhighlight-overlay-function
+ "Function to remove the region-highlight overlay.")
+
+(defun redisplay--highlight-overlay-function (start end window rol &optional face)
+ "Update the overlay ROL in WINDOW with FACE in range START-END."
+ (unless face (setq face 'region))
+ (if (not (overlayp rol))
+ (let ((nrol (make-overlay start end)))
+ (funcall redisplay-unhighlight-region-function rol)
+ (overlay-put nrol 'window window)
+ (overlay-put nrol 'face face)
+ ;; Normal priority so that a large region doesn't hide all the
+ ;; overlays within it, but high secondary priority so that if it
+ ;; ends/starts in the middle of a small overlay, that small overlay
+ ;; won't hide the region's boundaries.
+ (overlay-put nrol 'priority '(nil . 100))
+ nrol)
+ (unless (eq (overlay-get rol 'face) face)
+ (overlay-put rol 'face face))
+ (unless (and (eq (overlay-buffer rol) (current-buffer))
+ (eq (overlay-start rol) start)
+ (eq (overlay-end rol) end))
+ (move-overlay rol start end (current-buffer)))
+ rol))
(defvar redisplay-highlight-region-function
- (lambda (start end window rol)
- (if (not (overlayp rol))
- (let ((nrol (make-overlay start end)))
- (funcall redisplay-unhighlight-region-function rol)
- (overlay-put nrol 'window window)
- (overlay-put nrol 'face 'region)
- ;; Normal priority so that a large region doesn't hide all the
- ;; overlays within it, but high secondary priority so that if it
- ;; ends/starts in the middle of a small overlay, that small overlay
- ;; won't hide the region's boundaries.
- (overlay-put nrol 'priority '(nil . 100))
- nrol)
- (unless (and (eq (overlay-buffer rol) (current-buffer))
- (eq (overlay-start rol) start)
- (eq (overlay-end rol) end))
- (move-overlay rol start end (current-buffer)))
- rol))
+ #'redisplay--highlight-overlay-function
"Function to move the region-highlight overlay.
This function is called with four parameters, START, END, WINDOW
and OVERLAY. If OVERLAY is nil, a new overlay is created. In
@@ -6457,8 +6949,33 @@ The overlay is returned by the function.")
(funcall redisplay-highlight-region-function
start end window rol)))
(unless (equal new rol)
- (set-window-parameter window 'internal-region-overlay
- new))))))
+ (set-window-parameter window 'internal-region-overlay new))))))
+
+(defcustom cursor-face-highlight-nonselected-window nil
+ "Non-nil means highlight text with `cursor-face' even in nonselected windows.
+This variable is similar to `highlight-nonselected-windows'."
+ :local t
+ :type 'boolean
+ :version "29.1")
+
+(defun redisplay--update-cursor-face-highlight (window)
+ "Highlights the overlay used to highlight text with cursor-face."
+ (let ((rol (window-parameter window 'internal-cursor-face-overlay)))
+ (if-let* (((or cursor-face-highlight-nonselected-window
+ (eq window (selected-window))
+ (and (window-minibuffer-p)
+ (eq window (minibuffer-selected-window)))))
+ (pt (window-point window))
+ (cursor-face (get-text-property pt 'cursor-face)))
+ (let* ((start (previous-single-property-change
+ (1+ pt) 'cursor-face nil (point-min)))
+ (end (next-single-property-change
+ pt 'cursor-face nil (point-max)))
+ (new (redisplay--highlight-overlay-function
+ start end window rol cursor-face)))
+ (unless (equal new rol)
+ (set-window-parameter window 'internal-cursor-face-overlay new)))
+ (redisplay--unhighlight-overlay-function rol))))
(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight)
"Hook run just before redisplay.
@@ -6466,6 +6983,15 @@ It is called in each window that is to be redisplayed. It takes one argument,
which is the window that will be redisplayed. When run, the `current-buffer'
is set to the buffer displayed in that window.")
+(define-minor-mode cursor-face-highlight-mode
+ "When enabled, respect the cursor-face property."
+ :global nil
+ (if cursor-face-highlight-mode
+ (add-hook 'pre-redisplay-functions
+ #'redisplay--update-cursor-face-highlight nil t)
+ (remove-hook 'pre-redisplay-functions
+ #'redisplay--update-cursor-face-highlight t)))
+
(defun redisplay--pre-redisplay-functions (windows)
(with-demoted-errors "redisplay--pre-redisplay-functions: %S"
(if (null windows)
@@ -6475,9 +7001,11 @@ is set to the buffer displayed in that window.")
(with-current-buffer (window-buffer win)
(run-hook-with-args 'pre-redisplay-functions win))))))
-(add-function :before pre-redisplay-function
- #'redisplay--pre-redisplay-functions)
-
+(when (eq pre-redisplay-function #'ignore)
+ ;; Override the default set in the C code.
+ ;; This is not done using `add-function' so as to loosen the bootstrap
+ ;; dependencies.
+ (setq pre-redisplay-function #'redisplay--pre-redisplay-functions))
(defvar-local mark-ring nil
"The list of former marks of the current buffer, most recent first.")
@@ -6485,7 +7013,7 @@ is set to the buffer displayed in that window.")
(defcustom mark-ring-max 16
"Maximum size of mark ring. Start discarding off end if gets this big."
- :type 'integer
+ :type 'natnum
:group 'editing-basics)
(defvar global-mark-ring nil
@@ -6494,7 +7022,7 @@ is set to the buffer displayed in that window.")
(defcustom global-mark-ring-max 16
"Maximum size of global mark ring. \
Start discarding off end if gets this big."
- :type 'integer
+ :type 'natnum
:group 'editing-basics)
(defun pop-to-mark-command ()
@@ -7607,31 +8135,28 @@ For motion by visual lines, see `beginning-of-visual-line'."
(put 'set-goal-column 'disabled t)
(defun set-goal-column (arg)
- "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
+ "Set the current horizontal position as a goal column.
+This goal column will affect the \\[next-line] and \\[previous-line] commands,
+as well as the \\[scroll-up-command] and \\[scroll-down-command] commands.
+
Those commands will move to this position in the line moved to
rather than trying to keep the same horizontal position.
-With a non-nil argument ARG, clears out the goal column
-so that \\[next-line] and \\[previous-line] resume vertical motion.
-The goal column is stored in the variable `goal-column'.
-This is a buffer-local setting."
+
+With a non-nil argument ARG, clears out the goal column so that
+these commands resume normal motion.
+
+The goal column is stored in the variable `goal-column'. This is
+a buffer-local setting."
(interactive "P")
(if arg
(progn
(setq goal-column nil)
(message "No goal column"))
(setq goal-column (current-column))
- ;; The older method below can be erroneous if `set-goal-column' is bound
- ;; to a sequence containing %
- ;;(message (substitute-command-keys
- ;;"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
- ;;goal-column)
- (message "%s"
- (concat
- (format "Goal column %d " goal-column)
- (substitute-command-keys
- "(use \\[set-goal-column] with an arg to unset it)")))
-
- )
+ (message "Goal column %d %s"
+ goal-column
+ (substitute-command-keys
+ "(use \\[set-goal-column] with an arg to unset it)")))
nil)
;;; Editing based on visual lines, as opposed to logical lines.
@@ -8071,10 +8596,10 @@ constitute a word."
(defcustom fill-prefix nil
"String for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
- string)
+ string)
+ :safe #'string-or-null-p
:group 'fill)
(make-variable-buffer-local 'fill-prefix)
-(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
(defcustom auto-fill-inhibit-regexp nil
"Regexp to match lines that should not be auto-filled."
@@ -8266,7 +8791,8 @@ Just \\[universal-argument] as argument means to use the current column."
;; We used to use current-column silently, but C-x f is too easily
;; typed as a typo for C-x C-f, so we turned it into an error and
;; now an interactive prompt.
- (read-number "Set fill-column to: " (current-column)))))
+ (read-number (format "Change fill-column from %s to: " fill-column)
+ (current-column)))))
(if (consp arg)
(setq arg (current-column)))
(if (not (integerp arg))
@@ -8585,40 +9111,43 @@ The function should return non-nil if the two tokens do not match.")
(current-buffer))
(sit-for blink-matching-delay))
(delete-overlay blink-matching--overlay)))))
- (t
- (let ((open-paren-line-string
- (save-excursion
- (goto-char blinkpos)
- ;; Show what precedes the open in its line, if anything.
- (cond
- ((save-excursion (skip-chars-backward " \t") (not (bolp)))
- (buffer-substring (line-beginning-position)
- (1+ blinkpos)))
- ;; Show what follows the open in its line, if anything.
- ((save-excursion
- (forward-char 1)
- (skip-chars-forward " \t")
- (not (eolp)))
- (buffer-substring blinkpos
- (line-end-position)))
- ;; Otherwise show the previous nonblank line,
- ;; if there is one.
- ((save-excursion (skip-chars-backward "\n \t") (not (bobp)))
- (concat
- (buffer-substring (progn
- (skip-chars-backward "\n \t")
- (line-beginning-position))
- (progn (end-of-line)
- (skip-chars-backward " \t")
- (point)))
- ;; Replace the newline and other whitespace with `...'.
- "..."
- (buffer-substring blinkpos (1+ blinkpos))))
- ;; There is nothing to show except the char itself.
- (t (buffer-substring blinkpos (1+ blinkpos)))))))
- (minibuffer-message
- "Matches %s"
- (substring-no-properties open-paren-line-string))))))))
+ ((not show-paren-context-when-offscreen)
+ (minibuffer-message
+ "Matches %s"
+ (substring-no-properties
+ (blink-paren-open-paren-line-string blinkpos))))))))
+
+(defun blink-paren-open-paren-line-string (pos)
+ "Return the line string that contains the openparen at POS."
+ (save-excursion
+ (goto-char pos)
+ ;; Show what precedes the open in its line, if anything.
+ (cond
+ ((save-excursion (skip-chars-backward " \t") (not (bolp)))
+ (buffer-substring (line-beginning-position)
+ (1+ pos)))
+ ;; Show what follows the open in its line, if anything.
+ ((save-excursion
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (not (eolp)))
+ (buffer-substring pos
+ (line-end-position)))
+ ;; Otherwise show the previous nonblank line,
+ ;; if there is one.
+ ((save-excursion (skip-chars-backward "\n \t") (not (bobp)))
+ (concat
+ (buffer-substring (progn
+ (skip-chars-backward "\n \t")
+ (line-beginning-position))
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Replace the newline and other whitespace with `...'.
+ "..."
+ (buffer-substring pos (1+ pos))))
+ ;; There is nothing to show except the char itself.
+ (t (buffer-substring pos (1+ pos))))))
(defvar blink-paren-function 'blink-matching-open
"Function called, if non-nil, whenever a close parenthesis is inserted.
@@ -8911,7 +9440,7 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally.
When called interactively, the user is prompted for VARIABLE and
then VALUE. The current value of VARIABLE will be put in the
-minibuffer history so that it can be accessed with `M-n', which
+minibuffer history so that it can be accessed with \\`M-n', which
makes it easier to edit it."
(interactive
(let* ((default-var (variable-at-point))
@@ -8979,6 +9508,7 @@ makes it easier to edit it."
(define-key map [down-mouse-2] nil)
(define-key map "\C-m" 'choose-completion)
(define-key map "\e\e\e" 'delete-completion-window)
+ (define-key map [remap keyboard-quit] #'delete-completion-window)
(define-key map [left] 'previous-completion)
(define-key map [right] 'next-completion)
(define-key map [?\t] 'next-completion)
@@ -9009,6 +9539,16 @@ Its value is a list of the form (START END) where START is the place
where the completion should be inserted and END (if non-nil) is the end
of the text to replace. If END is nil, point is used instead.")
+(defvar completion-base-affixes nil
+ "Base context of the text corresponding to the shown completions.
+This variable is used in the *Completions* buffer.
+Its value is a list of the form (PREFIX SUFFIX) where PREFIX is the text
+before the place where completion should be inserted, and SUFFIX is the text
+after the completion.")
+
+(defvar completion-use-base-affixes nil
+ "Non-nil means to restore original prefix and suffix in the minibuffer.")
+
(defvar completion-list-insert-choice-function #'completion--replace
"Function to use to insert the text chosen in *Completions*.
Called with three arguments (BEG END TEXT), it should replace the text
@@ -9026,73 +9566,160 @@ Go to the window from which completion was requested."
(if (get-buffer-window buf)
(select-window (get-buffer-window buf))))))
+(defcustom completion-auto-wrap t
+ "Non-nil means to wrap around when selecting completion options.
+This affects the commands `next-completion' and `previous-completion'.
+When `completion-auto-select' is t, it wraps through the minibuffer."
+ :type 'boolean
+ :version "29.1"
+ :group 'completion)
+
+(defcustom completion-auto-select nil
+ "Non-nil means to automatically select the *Completions* buffer.
+When the value is t, pressing TAB will switch to the completion list
+buffer when Emacs pops up a window showing that buffer.
+If the value is `second-tab', then the first TAB will pop up the
+window showing the completions list buffer, and the next TAB will
+switch to that window.
+See `completion-auto-help' for controlling when the window showing
+the completions is popped up and down."
+ :type '(choice (const :tag "Don't auto-select completions window" nil)
+ (const :tag "Select completions window on first TAB" t)
+ (const :tag "Select completions window on second TAB"
+ second-tab))
+ :version "29.1"
+ :group 'completion)
+
+(defun first-completion ()
+ "Move to the first item in the completion list."
+ (interactive)
+ (goto-char (point-min))
+ (unless (get-text-property (point) 'mouse-face)
+ (when-let ((pos (next-single-property-change (point) 'mouse-face)))
+ (goto-char pos))))
+
+(defun last-completion ()
+ "Move to the last item in the completion list."
+ (interactive)
+ (goto-char (previous-single-property-change
+ (point-max) 'mouse-face nil (point-min)))
+ ;; Move to the start of last one.
+ (unless (get-text-property (point) 'mouse-face)
+ (when-let ((pos (previous-single-property-change (point) 'mouse-face)))
+ (goto-char pos))))
+
(defun previous-completion (n)
- "Move to the previous item in the completion list."
+ "Move to the previous item in the completion list.
+With prefix argument N, move back N items (negative N means move
+forward).
+
+Also see the `completion-auto-wrap' variable."
(interactive "p")
(next-completion (- n)))
(defun next-completion (n)
"Move to the next item in the completion list.
-With prefix argument N, move N items (negative N means move backward)."
+With prefix argument N, move N items (negative N means move
+backward).
+
+Also see the `completion-auto-wrap' variable."
(interactive "p")
- (let ((beg (point-min)) (end (point-max)))
- (while (and (> n 0) (not (eobp)))
- ;; If in a completion, move to the end of it.
- (when (get-text-property (point) 'mouse-face)
- (goto-char (next-single-property-change (point) 'mouse-face nil end)))
- ;; Move to start of next one.
- (unless (get-text-property (point) 'mouse-face)
- (goto-char (next-single-property-change (point) 'mouse-face nil end)))
- (setq n (1- n)))
- (while (and (< n 0) (not (bobp)))
- (let ((prop (get-text-property (1- (point)) 'mouse-face)))
- ;; If in a completion, move to the start of it.
- (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
- (goto-char (previous-single-property-change
- (point) 'mouse-face nil beg)))
- ;; Move to end of the previous completion.
- (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
- (goto-char (previous-single-property-change
- (point) 'mouse-face nil beg)))
- ;; Move to the start of that one.
- (goto-char (previous-single-property-change
- (point) 'mouse-face nil beg))
- (setq n (1+ n))))))
-
-(defun choose-completion (&optional event)
+ (let ((tabcommand (member (this-command-keys) '("\t" [backtab])))
+ pos)
+ (catch 'bound
+ (while (> n 0)
+ (setq pos (point))
+ ;; If in a completion, move to the end of it.
+ (when (get-text-property pos 'mouse-face)
+ (setq pos (next-single-property-change pos 'mouse-face)))
+ (when pos (setq pos (next-single-property-change pos 'mouse-face)))
+ (if pos
+ ;; Move to the start of next one.
+ (goto-char pos)
+ ;; If at the last completion option, wrap or skip
+ ;; to the minibuffer, if requested.
+ (when completion-auto-wrap
+ (if (and (eq completion-auto-select t) tabcommand
+ (minibufferp completion-reference-buffer))
+ (throw 'bound nil)
+ (first-completion))))
+ (setq n (1- n)))
+
+ (while (< n 0)
+ (setq pos (point))
+ ;; If in a completion, move to the start of it.
+ (when (and (get-text-property pos 'mouse-face)
+ (not (bobp))
+ (get-text-property (1- pos) 'mouse-face))
+ (setq pos (previous-single-property-change pos 'mouse-face)))
+ (when pos (setq pos (previous-single-property-change pos 'mouse-face)))
+ (if pos
+ (progn
+ (goto-char pos)
+ ;; Move to the start of that one.
+ (unless (get-text-property (point) 'mouse-face)
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil (point-min)))))
+ ;; If at the first completion option, wrap or skip
+ ;; to the minibuffer, if requested.
+ (when completion-auto-wrap
+ (if (and (eq completion-auto-select t) tabcommand
+ (minibufferp completion-reference-buffer))
+ (progn
+ (throw 'bound nil))
+ (last-completion))))
+ (setq n (1+ n))))
+
+ (when (/= 0 n)
+ (switch-to-minibuffer))))
+
+(defun choose-completion (&optional event no-exit no-quit)
"Choose the completion at point.
-If EVENT, use EVENT's position to determine the starting position."
- (interactive (list last-nonmenu-event))
+If EVENT, use EVENT's position to determine the starting position.
+With prefix argument NO-EXIT, insert the completion at point to the
+minibuffer, but don't exit the minibuffer. When the prefix argument
+is not provided, then whether to exit the minibuffer depends on the value
+of `completion-no-auto-exit'.
+If NO-QUIT is non-nil, insert the completion at point to the
+minibuffer, but don't quit the completions window."
+ (interactive (list last-nonmenu-event current-prefix-arg))
;; In case this is run via the mouse, give temporary modes such as
;; isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(with-current-buffer (window-buffer (posn-window (event-start event)))
(let ((buffer completion-reference-buffer)
(base-position completion-base-position)
+ (base-affixes completion-base-affixes)
(insert-function completion-list-insert-choice-function)
+ (completion-no-auto-exit (if no-exit t completion-no-auto-exit))
(choice
(save-excursion
(goto-char (posn-point (event-start event)))
(let (beg)
(cond
- ((and (not (eobp)) (get-text-property (point) 'mouse-face))
+ ((and (not (eobp))
+ (get-text-property (point) 'completion--string))
(setq beg (1+ (point))))
((and (not (bobp))
- (get-text-property (1- (point)) 'mouse-face))
+ (get-text-property (1- (point)) 'completion--string))
(setq beg (point)))
(t (error "No completion here")))
- (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq beg (or (previous-single-property-change
+ beg 'completion--string)
+ beg))
(substring-no-properties
(get-text-property beg 'completion--string))))))
(unless (buffer-live-p buffer)
(error "Destination buffer is dead"))
- (quit-window nil (posn-window (event-start event)))
+ (unless no-quit
+ (quit-window nil (posn-window (event-start event))))
(with-current-buffer buffer
(choose-completion-string
choice buffer
- (or base-position
+ (or (and completion-use-base-affixes base-affixes)
+ base-position
;; If all else fails, just guess.
(list (choose-completion-guess-base-position choice)))
insert-function)))))
@@ -9241,19 +9868,24 @@ Called from `temp-buffer-show-hook'."
;; - With fancy completion styles, the code below will not always
;; find the right base directory.
(if minibuffer-completing-file-name
- (file-name-as-directory
+ (file-name-directory
(expand-file-name
(buffer-substring (minibuffer-prompt-end) (point)))))))
(with-current-buffer standard-output
(let ((base-position completion-base-position)
+ (base-affixes completion-base-affixes)
(insert-fun completion-list-insert-choice-function))
(completion-list-mode)
(setq-local completion-base-position base-position)
+ (setq-local completion-base-affixes base-affixes)
(setq-local completion-list-insert-choice-function insert-fun))
(setq-local completion-reference-buffer mainbuf)
(if base-dir (setq default-directory base-dir))
(when completion-tab-width
(setq tab-width completion-tab-width))
+ ;; Maybe enable cursor completions-highlight.
+ (when completions-highlight-face
+ (cursor-face-highlight-mode 1))
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
@@ -9268,16 +9900,18 @@ select the completion near point.\n\n"))))))
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
- (let ((window (or (get-buffer-window "*Completions*" 0)
- ;; Make sure we have a completions window.
- (progn (minibuffer-completion-help)
- (get-buffer-window "*Completions*" 0)))))
- (when window
- (select-window window)
- ;; In the new buffer, go to the first completion.
- ;; FIXME: Perhaps this should be done in `minibuffer-completion-help'.
- (when (bobp)
- (next-completion 1)))))
+ (when-let ((window (or (get-buffer-window "*Completions*" 0)
+ ;; Make sure we have a completions window.
+ (progn (minibuffer-completion-help)
+ (get-buffer-window "*Completions*" 0)))))
+ (select-window window)
+ (when (bobp)
+ (cond
+ ((and (memq this-command '(completion-at-point minibuffer-complete))
+ (equal (this-command-keys) [backtab]))
+ (goto-char (point-max))
+ (last-completion))
+ (t (first-completion))))))
(defun read-expression-switch-to-completions ()
"Select the completion list window while reading an expression."
@@ -9393,9 +10027,6 @@ PREFIX is the string that represents this modifier in an event type symbol."
(defvar clone-buffer-hook nil
"Normal hook to run in the new buffer at the end of `clone-buffer'.")
-(defvar clone-indirect-buffer-hook nil
- "Normal hook to run in the new buffer at the end of `clone-indirect-buffer'.")
-
(defun clone-process (process &optional newname)
"Create a twin copy of PROCESS.
If NEWNAME is nil, it defaults to PROCESS' name;
@@ -9548,8 +10179,6 @@ Returns the newly created indirect buffer."
(setq newname (substring newname 0 (match-beginning 0))))
(let* ((name (generate-new-buffer-name newname))
(buffer (make-indirect-buffer (current-buffer) name t)))
- (with-current-buffer buffer
- (run-hooks 'clone-indirect-buffer-hook))
(when display-flag
(pop-to-buffer buffer nil norecord))
buffer))
@@ -9615,7 +10244,7 @@ call `normal-erase-is-backspace-mode' (which see) instead."
(if (if (eq normal-erase-is-backspace 'maybe)
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
- (memq window-system '(w32 ns))
+ (memq window-system '(w32 ns pgtk))
(and (eq window-system 'x)
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))
@@ -9789,24 +10418,7 @@ If it does not exist, create it and switch it to `messages-buffer-mode'."
;; versions together with bad values. This is therefore not as
;; flexible as it could be. See the thread:
;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00300.html
-(defconst bad-packages-alist
- ;; Not sure exactly which semantic versions have problems.
- ;; Definitely 2.0pre3, probably all 2.0pre's before this.
- '((semantic semantic-version "\\`2\\.0pre[1-3]\\'"
- "The version of `semantic' loaded does not work in Emacs 22.
-It can cause constant high CPU load.
-Upgrade to at least Semantic 2.0pre4 (distributed with CEDET 1.0pre4).")
- ;; CUA-mode does not work with GNU Emacs version 22.1 and newer.
- ;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode
- ;; provided the `CUA-mode' feature. Since this is no longer true,
- ;; we can warn the user if the `CUA-mode' feature is ever provided.
- (CUA-mode t nil
-"CUA-mode is now part of the standard GNU Emacs distribution,
-so you can now enable CUA via the Options menu or by customizing `cua-mode'.
-
-You have loaded an older version of CUA-mode which does not work
-correctly with this version of Emacs. You should remove the old
-version and use the one distributed with Emacs."))
+(defconst bad-packages-alist nil
"Alist of packages known to cause problems in this version of Emacs.
Each element has the form (PACKAGE SYMBOL REGEXP STRING).
PACKAGE is either a regular expression to match file names, or a
@@ -9814,25 +10426,22 @@ symbol (a feature name), like for `with-eval-after-load'.
SYMBOL is either the name of a string variable, or t. Upon
loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
warning using STRING as the message.")
+(make-obsolete-variable 'bad-packages-alist nil "29.1")
(defun bad-package-check (package)
"Run a check using the element from `bad-packages-alist' matching PACKAGE."
+ (declare (obsolete nil "29.1"))
(condition-case nil
(let* ((list (assoc package bad-packages-alist))
(symbol (nth 1 list)))
(and list
(boundp symbol)
(or (eq symbol t)
- (and (stringp (setq symbol (eval symbol)))
+ (and (stringp (setq symbol (symbol-value symbol)))
(string-match-p (nth 2 list) symbol)))
(display-warning package (nth 3 list) :warning)))
(error nil)))
-(dolist (elem bad-packages-alist)
- (let ((pkg (car elem)))
- (with-eval-after-load pkg
- (bad-package-check pkg))))
-
;;; Generic dispatcher commands
@@ -9869,6 +10478,7 @@ does not have any effect until this variable is set.
CUSTOMIZATIONS, if non-nil, should be composed of alternating
`defcustom' keywords and values to add to the declaration of
`COMMAND-alternatives' (typically :group and :version)."
+ (declare (indent defun))
(let* ((command-name (symbol-name command))
(varalt-name (concat command-name "-alternatives"))
(varalt-sym (intern varalt-name))
@@ -9965,15 +10575,89 @@ This is an integer between 1 and 12 (inclusive). January is 1.")
(year nil :documentation "This is a four digit integer.")
(weekday nil :documentation "\
This is a number between 0 and 6, and 0 is Sunday.")
- (dst nil :documentation "\
+ (dst -1 :documentation "\
This is t if daylight saving time is in effect, nil if it is not
-in effect, and -1 if daylight saving information is not
-available.")
+in effect, and -1 if daylight saving information is not available.
+Also see `decoded-time-dst'.")
(zone nil :documentation "\
This is an integer indicating the UTC offset in seconds, i.e.,
the number of seconds east of Greenwich.")
)
+;; Document that decoded-time-dst is problematic on 6-element lists.
+;; It should return -1 indicating unknown DST, but currently returns
+;; nil indicating standard time.
+(put 'decoded-time-dst 'function-documentation
+ "Access slot \"dst\" of `decoded-time' struct CL-X.
+This is t if daylight saving time is in effect, nil if it is not
+in effect, and -1 if daylight saving information is not available.
+As a special case, return an unspecified value when given a list
+too short to have a dst element.
+
+(fn CL-X)")
+
+(defun get-scratch-buffer-create ()
+ "Return the *scratch* buffer, creating a new one if needed."
+ (or (get-buffer "*scratch*")
+ (let ((scratch (get-buffer-create "*scratch*")))
+ ;; Don't touch the buffer contents or mode unless we know that
+ ;; we just created it.
+ (with-current-buffer scratch
+ (when initial-scratch-message
+ (insert (substitute-command-keys initial-scratch-message))
+ (set-buffer-modified-p nil))
+ (funcall initial-major-mode))
+ scratch)))
+
+(defun scratch-buffer ()
+ "Switch to the *scratch* buffer.
+If the buffer doesn't exist, create it first."
+ (interactive)
+ (pop-to-buffer-same-window (get-scratch-buffer-create)))
+
+(defun kill-buffer--possibly-save (buffer)
+ (let ((response
+ (cadr
+ (read-multiple-choice
+ (format "Buffer %s modified; kill anyway?"
+ (buffer-name))
+ '((?y "yes" "kill buffer without saving")
+ (?n "no" "exit without doing anything")
+ (?s "save and then kill" "save the buffer and then kill it"))
+ nil nil (not use-short-answers)))))
+ (if (equal response "no")
+ nil
+ (unless (equal response "yes")
+ (with-current-buffer buffer
+ (save-buffer)))
+ t)))
+
+(defsubst string-empty-p (string)
+ "Check whether STRING is empty."
+ (string= string ""))
+
+(defun read-signal-name ()
+ "Read a signal number or name."
+ (let ((value
+ (completing-read "Signal code or name: "
+ (signal-names)
+ nil
+ (lambda (value)
+ (or (string-match "\\`[0-9]+\\'" value)
+ (member value (signal-names)))))))
+ (if (string-match "\\`[0-9]+\\'" value)
+ (string-to-number value)
+ (intern (concat "sig" (downcase value))))))
+
+(defun lax-plist-get (plist prop)
+ "Extract a value from a property list, comparing with `equal'."
+ (declare (obsolete plist-get "29.1"))
+ (plist-get plist prop #'equal))
+
+(defun lax-plist-put (plist prop val)
+ "Change value in PLIST of PROP to VAL, comparing with `equal'."
+ (declare (obsolete plist-put "29.1"))
+ (plist-put plist prop val #'equal))
(provide 'simple)
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index fda9f514263..1bfc29f34e3 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -37,7 +37,8 @@
;; page 2: paired insertion
;; page 3: mirror-mode, an example for setting up paired insertion
-(defvaralias 'skeleton-transformation 'skeleton-transformation-function)
+(define-obsolete-variable-alias 'skeleton-transformation
+ 'skeleton-transformation-function "29.1")
(defvar skeleton-transformation-function 'identity
"If non-nil, function applied to literal strings before they are inserted.
@@ -65,7 +66,8 @@ region.")
"Hook called at end of skeleton but before going to point of interest.
The variables `v1' and `v2' are still set when calling this.")
-(defvaralias 'skeleton-filter 'skeleton-filter-function)
+(define-obsolete-variable-alias 'skeleton-filter
+ 'skeleton-filter-function "29.1")
;;;###autoload
(defvar skeleton-filter-function 'identity
@@ -113,7 +115,8 @@ are integer buffer positions in the reverse order of the insertion order.")
"Define a user-configurable COMMAND that enters a statement skeleton.
DOCUMENTATION is that of the command.
SKELETON is as defined under `skeleton-insert'."
- (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec)))
+ (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec))
+ (indent defun))
(if skeleton-debug
(set command skeleton))
`(progn
diff --git a/lisp/so-long.el b/lisp/so-long.el
index 17af532249c..82ce2e1755d 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -684,8 +684,8 @@ subsequently called."
(function :tag "Action")
(function :tag "Revert")))
:set #'so-long--action-alist-setter
+ :risky t
:package-version '(so-long . "1.0"))
-(put 'so-long-action-alist 'risky-local-variable t)
(defcustom so-long-action 'so-long-mode
"The action taken by `so-long' when long lines are detected.
@@ -1518,14 +1518,14 @@ The variables are set in accordance with what was remembered in `so-long'."
(kill-local-variable variable))))
(defun so-long-mode-maintain-preserved-variables ()
- "Set any 'preserved' variables.
+ "Set any \"preserved\" variables.
The variables are set in accordance with what was remembered in `so-long'."
(dolist (var (so-long-original 'so-long-mode-preserved-variables))
(so-long-restore-variable var)))
(defun so-long-mode-maintain-preserved-minor-modes ()
- "Enable or disable 'preserved' minor modes.
+ "Enable or disable \"preserved\" minor modes.
The modes are set in accordance with what was remembered in `so-long'."
(dolist (mode (so-long-original 'so-long-mode-preserved-minor-modes))
diff --git a/lisp/sort.el b/lisp/sort.el
index 1d6c22ff89b..d04f075abd1 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -29,6 +29,8 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
+
(defgroup sort nil
"Commands to sort text in an Emacs buffer."
:group 'data)
@@ -111,7 +113,8 @@ as start and end positions), and with `string<' otherwise."
(lambda (a b) (string< (car a) (car b)))))))
(if reverse (setq sort-lists (nreverse sort-lists)))
(if messages (message "Reordering buffer..."))
- (sort-reorder-buffer sort-lists old)))
+ (with-buffer-unmodified-if-unchanged
+ (sort-reorder-buffer sort-lists old))))
(if messages (message "Reordering buffer... Done"))))
nil)
@@ -286,25 +289,30 @@ FIELD, BEG and END. BEG and END specify region to sort."
(interactive "p\nr")
(let ;; To make `end-of-line' and etc. to ignore fields.
((inhibit-field-text-motion t))
- (sort-fields-1 field beg end
- (lambda ()
- (sort-skip-fields field)
- (let* ((case-fold-search t)
- (base
- (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]")
- (cond ((match-beginning 1)
- (goto-char (match-end 1))
- 16)
- ((match-beginning 2)
- (goto-char (match-end 2))
- 8)
- (t nil)))))
- (string-to-number (buffer-substring (point)
- (save-excursion
- (forward-sexp 1)
- (point)))
- (or base sort-numeric-base))))
- nil)))
+ (sort-fields-1
+ field beg end
+ (lambda ()
+ ;; Don't try to parse blank lines (they'll be
+ ;; sorted at the start).
+ (if (looking-at "[\t ]*$")
+ 0
+ (sort-skip-fields field)
+ (let* ((case-fold-search t)
+ (base
+ (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]")
+ (cond ((match-beginning 1)
+ (goto-char (match-end 1))
+ 16)
+ ((match-beginning 2)
+ (goto-char (match-end 2))
+ 8)
+ (t nil)))))
+ (string-to-number (buffer-substring (point)
+ (save-excursion
+ (forward-sexp 1)
+ (point)))
+ (or base sort-numeric-base)))))
+ nil)))
;;;;;###autoload
;;(defun sort-float-fields (field beg end)
@@ -540,8 +548,8 @@ Use \\[untabify] to convert tabs to spaces before sorting."
(narrow-to-region beg1 end1)
(goto-char beg1)
(sort-subr reverse 'forward-line 'end-of-line
- #'(lambda () (move-to-column col-start) nil)
- #'(lambda () (move-to-column col-end) nil))))))))
+ (lambda () (move-to-column col-start) nil)
+ (lambda () (move-to-column col-end) nil))))))))
;;;###autoload
(defun reverse-region (beg end)
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 1b6dc809521..9184d6c5254 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -306,10 +306,9 @@ attached to and added to this list before the new frame is initialized."
(symbol :tag "Parameter")
(sexp :tag "Value"))))
-(defcustom speedbar-use-imenu-flag (fboundp 'imenu)
+(defcustom speedbar-use-imenu-flag t
"Non-nil means use imenu for file parsing, nil to use etags.
-XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
-use etags instead. Etags support is not as robust as imenu support."
+Etags support is not as robust as imenu support." ; See Bug#51102
:tag "Use Imenu for tags"
:group 'speedbar
:type 'boolean)
@@ -704,8 +703,6 @@ If you want to change this while speedbar is active, either use
(defvar speedbar-update-flag-disable nil
"Permanently disable changing of the update flag.")
-(define-obsolete-variable-alias
- 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1")
(defvar speedbar-mode-syntax-table
(let ((st (make-syntax-table)))
;; Turn off paren matching around here.
@@ -720,8 +717,6 @@ If you want to change this while speedbar is active, either use
st)
"Syntax-table used on the speedbar.")
-
-(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1")
(defvar speedbar-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
@@ -800,15 +795,10 @@ This basically creates a sparse keymap, and makes its parent be
["Auto Update" speedbar-toggle-updates
:active (not speedbar-update-flag-disable)
:style toggle :selected speedbar-update-flag])
- (if (and (or (fboundp 'defimage)
- (fboundp 'make-image-specifier))
- (if (fboundp 'display-graphic-p)
- (display-graphic-p)
- window-system))
- (list
- ["Use Images" speedbar-toggle-images
- :style toggle :selected speedbar-use-images]))
- )
+ (when (and (fboundp 'defimage) (display-graphic-p))
+ (list
+ ["Use Images" speedbar-toggle-images
+ :style toggle :selected speedbar-use-images])))
"Base part of the speedbar menu.")
(defvar speedbar-easymenu-definition-special
@@ -938,7 +928,10 @@ supported at a time.
;; hscroll
(setq-local auto-hscroll-mode nil)
;; reset the selection variable
- (setq speedbar-last-selected-file nil))
+ (setq speedbar-last-selected-file nil)
+ (unless (display-graphic-p)
+ (message (substitute-command-keys
+ "Use \\[speedbar-get-focus] to see the speedbar window"))))
(defun speedbar-frame-reposition-smartly ()
"Reposition the speedbar frame to be next to the attached frame."
@@ -2274,9 +2267,7 @@ the list."
(with-current-buffer (get-file-buffer f)
speedbar-tag-hierarchy-method)
speedbar-tag-hierarchy-method))
- (lst (if (fboundp 'copy-tree)
- (copy-tree lst)
- lst)))
+ (lst (copy-tree lst)))
(while methods
(setq lst (funcall (car methods) lst)
methods (cdr methods)))
@@ -3694,27 +3685,21 @@ regular expression EXPR."
;;; BUFFER DISPLAY mode.
;;
-(defvar speedbar-buffers-key-map nil
+(defvar speedbar-buffers-key-map
+ (let ((map (speedbar-make-specialized-keymap)))
+ ;; Basic tree features
+ (define-key map "e" #'speedbar-edit-line)
+ (define-key map "\C-m" #'speedbar-edit-line)
+ (define-key map "+" #'speedbar-expand-line)
+ (define-key map "=" #'speedbar-expand-line)
+ (define-key map "-" #'speedbar-contract-line)
+ (define-key map " " #'speedbar-toggle-line-expansion)
+ ;; Buffer specific keybindings
+ (define-key map "k" #'speedbar-buffer-kill-buffer)
+ (define-key map "r" #'speedbar-buffer-revert-buffer)
+ map)
"Keymap used when in the buffers display mode.")
-(if speedbar-buffers-key-map
- nil
- (setq speedbar-buffers-key-map (speedbar-make-specialized-keymap))
-
- ;; Basic tree features
- (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line)
- (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line)
- (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
- (define-key speedbar-buffers-key-map "=" 'speedbar-expand-line)
- (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
- (define-key speedbar-buffers-key-map " " 'speedbar-toggle-line-expansion)
-
- ;; Buffer specific keybindings
- (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer)
- (define-key speedbar-buffers-key-map "r" 'speedbar-buffer-revert-buffer)
-
- )
-
(defvar speedbar-buffer-easymenu-definition
'(["Jump to buffer" speedbar-edit-line t]
["Expand File Tags" speedbar-expand-line
diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el
new file mode 100644
index 00000000000..fb2ceab383f
--- /dev/null
+++ b/lisp/sqlite-mode.el
@@ -0,0 +1,225 @@
+;;; sqlite-mode.el --- Mode for examining sqlite3 database files -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(eval-when-compile (require 'subr-x))
+
+(declare-function sqlite-execute "sqlite.c")
+(declare-function sqlite-more-p "sqlite.c")
+(declare-function sqlite-next "sqlite.c")
+(declare-function sqlite-columns "sqlite.c")
+(declare-function sqlite-finalize "sqlite.c")
+(declare-function sqlite-select "sqlite.c")
+(declare-function sqlite-open "sqlite.c")
+
+(defvar-keymap sqlite-mode-map
+ "g" #'sqlite-mode-list-tables
+ "c" #'sqlite-mode-list-columns
+ "RET" #'sqlite-mode-list-data
+ "DEL" #'sqlite-mode-delete)
+
+(define-derived-mode sqlite-mode special-mode "Sqlite"
+ "This mode lists the contents of an .sqlite3 file"
+ :interactive nil
+ (buffer-disable-undo)
+ (setq-local buffer-read-only t
+ truncate-lines t))
+
+(defvar sqlite--db nil)
+
+;;;###autoload
+(defun sqlite-mode-open-file (file)
+ "Browse the contents of an sqlite file."
+ (interactive "fSQLite file name: ")
+ (unless (sqlite-available-p)
+ (error "This Emacs doesn't have SQLite support, so it can't view SQLite files"))
+ (pop-to-buffer (get-buffer-create
+ (format "*SQLite %s*" (file-name-nondirectory file))))
+ (sqlite-mode)
+ (setq-local sqlite--db (sqlite-open file))
+ (sqlite-mode-list-tables))
+
+(defun sqlite-mode-list-tables ()
+ "Re-list the tables from the currently selected database."
+ (interactive nil sqlite-mode)
+ (let ((inhibit-read-only t)
+ (db sqlite--db)
+ (entries nil))
+ (erase-buffer)
+ (dolist (table (sqlite-select db "select name from sqlite_master where type = 'table' and name not like 'sqlite_%' order by name"))
+ (push (list (car table)
+ (caar (sqlite-select db (format "select count(*) from %s"
+ (car table)))))
+ entries))
+ (sqlite-mode--tablify '("Table Name" "Number of Rows")
+ (nreverse entries)
+ 'table)
+ (goto-char (point-min))))
+
+(defun sqlite-mode--tablify (columns rows type &optional prefix)
+ (let ((widths
+ (mapcar
+ (lambda (i)
+ (1+ (seq-max (mapcar (lambda (row)
+ (length (format "%s" (nth i row))))
+ (cons columns rows)))))
+ (number-sequence 0 (1- (length columns))))))
+ (when prefix
+ (insert prefix))
+ (dotimes (i (length widths))
+ (insert (propertize (format (format "%%-%ds " (nth i widths))
+ (nth i columns))
+ 'face 'header-line)))
+ (insert "\n")
+ (dolist (row rows)
+ (let ((start (point)))
+ (when prefix
+ (insert prefix))
+ (dotimes (i (length widths))
+ (let ((elem (nth i row)))
+ (insert (format (format "%%%s%ds "
+ (if (numberp elem)
+ "" "-")
+ (nth i widths))
+ (if (numberp elem)
+ (nth i row)
+ (string-replace "\n" " " (or elem "")))))))
+ (put-text-property start (point) 'sqlite--row row)
+ (put-text-property start (point) 'sqlite--type type)
+ (insert "\n")))))
+
+(defun sqlite-mode-list-columns ()
+ "List the columns of the table under point."
+ (interactive nil sqlite-mode)
+ (let ((row (get-text-property (point) 'sqlite--row)))
+ (unless row
+ (user-error "No table under point"))
+ (let ((columns (sqlite-mode--column-names (car row)))
+ (inhibit-read-only t))
+ (save-excursion
+ (forward-line 1)
+ (if (looking-at " ")
+ ;; Delete the info.
+ (delete-region (point) (if (re-search-forward "^[^ ]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ ;; Insert the info.
+ (dolist (column columns)
+ (insert (format " %s\n" column))))))))
+
+(defun sqlite-mode--column-names (table)
+ "Return a list of the column names for TABLE."
+ (let ((sql
+ (caar
+ (sqlite-select
+ sqlite--db
+ "select sql from sqlite_master where tbl_name = ? AND type = 'table'"
+ (list table)))))
+ (with-temp-buffer
+ (insert sql)
+ (mapcar #'string-trim
+ (split-string
+ ;; Extract the args to CREATE TABLE. Point is
+ ;; currently at its end.
+ (buffer-substring
+ (1- (point)) ; right before )
+ (1+ (progn (backward-sexp) (point)))) ; right after (
+ ",")))))
+
+(defun sqlite-mode-list-data ()
+ "List the data from the table under point."
+ (interactive nil sqlite-mode)
+ (let ((row (and (eq (get-text-property (point) 'sqlite--type) 'table)
+ (get-text-property (point) 'sqlite--row))))
+ (unless row
+ (user-error "No table under point"))
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (forward-line 1)
+ (if (looking-at " ")
+ ;; Delete the info.
+ (delete-region (point) (if (re-search-forward "^[^ ]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (sqlite--mode--list-data (list (car row) 0)))))))
+
+(defun sqlite-mode--more-data (stmt)
+ (let ((inhibit-read-only t))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (sqlite--mode--list-data stmt)))
+
+(defun sqlite--mode--list-data (data)
+ (let* ((table (car data))
+ (rowid (cadr data))
+ stmt)
+ (unwind-protect
+ (progn
+ (setq stmt
+ (sqlite-select
+ sqlite--db
+ (format "select rowid, * from %s where rowid >= ?" table)
+ (list rowid)
+ 'set))
+ (sqlite-mode--tablify (sqlite-columns stmt)
+ (cl-loop for i from 0 upto 1000
+ for row = (sqlite-next stmt)
+ while row
+ do (setq rowid (car row))
+ collect row)
+ (cons 'row table)
+ " ")
+ (when (sqlite-more-p stmt)
+ (insert (buttonize " More data...\n" #'sqlite-mode--more-data
+ (list table rowid)))))
+ (when stmt
+ (sqlite-finalize stmt)))))
+
+(defun sqlite-mode-delete ()
+ "Delete the row under point."
+ (interactive nil sqlite-mode)
+ (let ((table (get-text-property (point) 'sqlite--type))
+ (row (get-text-property (point) 'sqlite--row))
+ (inhibit-read-only t))
+ (when (or (not (consp table))
+ (not (eq (car table) 'row)))
+ (user-error "No row under point"))
+ (unless (yes-or-no-p "Really delete the row under point? ")
+ (user-error "Not deleting"))
+ (sqlite-execute
+ sqlite--db
+ (format "delete from %s where %s"
+ (cdr table)
+ (string-join
+ (mapcar (lambda (column)
+ (format "%s = ?" (car (split-string column " "))))
+ (cons "rowid" (sqlite-mode--column-names (cdr table))))
+ " and "))
+ row)
+ (delete-region (line-beginning-position) (progn (forward-line 1) (point)))))
+
+(provide 'sqlite-mode)
+
+;;; sqlite-mode.el ends here
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
new file mode 100644
index 00000000000..6a8a53a699e
--- /dev/null
+++ b/lisp/sqlite.el
@@ -0,0 +1,43 @@
+;;; sqlite.el --- Functions for interacting with sqlite3 databases -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defmacro with-sqlite-transaction (db &rest body)
+ "Execute BODY while holding a transaction for DB."
+ (declare (indent 1) (debug (form body)))
+ (let ((db-var (gensym))
+ (func-var (gensym)))
+ `(let ((,db-var ,db)
+ (,func-var (lambda () ,@body)))
+ (if (sqlite-available-p)
+ (unwind-protect
+ (progn
+ (sqlite-transaction ,db-var)
+ (funcall ,func-var))
+ (sqlite-commit ,db-var))
+ (funcall ,func-var)))))
+
+(provide 'sqlite)
+
+;;; sqlite.el ends here
diff --git a/lisp/startup.el b/lisp/startup.el
index 9ebd4c1a707..6c5549e2c64 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -519,10 +519,60 @@ DIRS are relative."
xdg-dir)
(t emacs-d-dir))))
+(defvar comp--compilable)
+(defvar comp--delayed-sources)
+(defun startup--require-comp-safely ()
+ "Require the native compiler avoiding circular dependencies."
+ (when (featurep 'native-compile)
+ ;; Require comp with `comp--compilable' set to nil to break
+ ;; circularity.
+ (let ((comp--compilable nil))
+ (require 'comp))
+ (native--compile-async comp--delayed-sources nil 'late)
+ (setq comp--delayed-sources nil)))
+
+(declare-function native--compile-async "comp.el"
+ (files &optional recursively load selector))
+(defun startup--honor-delayed-native-compilations ()
+ "Honor pending delayed deferred native compilations."
+ (when (and (native-comp-available-p)
+ comp--delayed-sources)
+ (startup--require-comp-safely))
+ (setq comp--compilable t))
+
(defvar native-comp-eln-load-path)
(defvar native-comp-deferred-compilation)
(defvar comp-enable-subr-trampolines)
+(defvar startup--original-eln-load-path nil
+ "Original value of `native-comp-eln-load-path'.")
+
+(defun startup-redirect-eln-cache (cache-directory)
+ "Redirect the user's eln-cache directory to CACHE-DIRECTORY.
+CACHE-DIRECTORY must be a single directory, a string.
+This function destructively changes `native-comp-eln-load-path'
+so that its first element is CACHE-DIRECTORY. If CACHE-DIRECTORY
+is not an absolute file name, it is interpreted relative
+to `user-emacs-directory'.
+For best results, call this function in your early-init file,
+so that the rest of initialization and package loading uses
+the updated value."
+ ;; Remove the original eln-cache.
+ (setq native-comp-eln-load-path (cdr native-comp-eln-load-path))
+ ;; Add the new eln-cache.
+ (push (expand-file-name (file-name-as-directory cache-directory)
+ user-emacs-directory)
+ native-comp-eln-load-path))
+
+(defun startup--update-eln-cache ()
+ "Update the user eln-cache directory due to user customizations."
+ ;; Don't override user customizations!
+ (when (equal native-comp-eln-load-path
+ startup--original-eln-load-path)
+ (startup-redirect-eln-cache "eln-cache")
+ (setq startup--original-eln-load-path
+ (copy-sequence native-comp-eln-load-path))))
+
(defun normal-top-level ()
"Emacs calls this function when it first starts up.
It sets `command-line-processed', processes the command-line,
@@ -556,18 +606,8 @@ It is the default value of the variable `top-level'."
(unless (string= "" path)
(push path native-comp-eln-load-path)))))
(push (expand-file-name "eln-cache/" user-emacs-directory)
- native-comp-eln-load-path)
- ;; When $HOME is set to '/nonexistent' means we are running the
- ;; testsuite, add a temporary folder in front to produce there
- ;; new compilations.
- (when (and (equal (getenv "HOME") "/nonexistent")
- ;; We may be running in a chroot environment where we
- ;; can't write anything.
- (file-writable-p (expand-file-name
- (or temporary-file-directory ""))))
- (let ((tmp-dir (make-temp-file "emacs-testsuite-" t)))
- (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t)))
- (push tmp-dir native-comp-eln-load-path))))
+ native-comp-eln-load-path))
+
;; Look in each dir in load-path for a subdirs.el file. If we
;; find one, load it, which will add the appropriate subdirs of
;; that dir into load-path. This needs to be done before setting
@@ -663,7 +703,9 @@ It is the default value of the variable `top-level'."
;; native-comp-eln-load-path.
(expand-file-name
(decode-coding-string dir coding t)))
- npath))))
+ npath)))
+ (setq startup--original-eln-load-path
+ (copy-sequence native-comp-eln-load-path)))
(dolist (filesym '(data-directory doc-directory exec-directory
installation-directory
invocation-directory invocation-name
@@ -713,6 +755,7 @@ It is the default value of the variable `top-level'."
(let ((old-face-font-rescale-alist face-font-rescale-alist))
(unwind-protect
(command-line)
+
;; Do this again, in case .emacs defined more abbreviations.
(if default-directory
(setq default-directory (abbreviate-file-name default-directory)))
@@ -757,10 +800,12 @@ It is the default value of the variable `top-level'."
;; face-font-rescale-alist into account. For such
;; situations, we ought to have a way to find all font
;; objects and regenerate them; currently we do not. As a
- ;; workaround, we specifically reset te default face's :font
- ;; attribute here. See bug#1785.
- (unless (eq face-font-rescale-alist
- old-face-font-rescale-alist)
+ ;; workaround, we specifically reset the default face's :font
+ ;; attribute here, if it was rescaled. See bug#1785.
+ (when (and (not (eq face-font-rescale-alist
+ old-face-font-rescale-alist))
+ (assoc (font-xlfd-name (face-attribute 'default :font))
+ face-font-rescale-alist #'string-match-p))
(set-face-attribute 'default nil :font (font-spec)))
;; Modify the initial frame based on what .emacs puts into
@@ -779,6 +824,7 @@ It is the default value of the variable `top-level'."
(font-menu-add-default))
(unless inhibit-startup-hooks
(run-hooks 'window-setup-hook))))
+
;; Subprocesses of Emacs do not have direct access to the terminal, so
;; unless told otherwise they should only assume a dumb terminal.
;; We are careful to do it late (after term-setup-hook), although the
@@ -796,7 +842,8 @@ It is the default value of the variable `top-level'."
(if (string-match "\\`DISPLAY=" varval)
(setq display varval))))
(when display
- (delete display process-environment)))))
+ (delete display process-environment))))
+ (startup--honor-delayed-native-compilations))
;; Precompute the keyboard equivalents in the menu bar items.
;; Command-line options supported by tty's:
@@ -975,7 +1022,11 @@ init-file, or to a default value if loading is not possible."
(debug-on-error-initial
(if (eq init-file-debug t)
'startup
- init-file-debug)))
+ init-file-debug))
+ ;; The init file might contain byte-code with embedded NULs,
+ ;; which can cause problems when read back, so disable nul
+ ;; byte detection. (Bug#52554)
+ (inhibit-null-byte-detection t))
(let ((debug-on-error debug-on-error-initial))
(condition-case-unless-debug error
(when init-file-user
@@ -1053,6 +1104,9 @@ the `--debug-init' option to view a complete error backtrace."
(when debug-on-error-should-be-set
(setq debug-on-error debug-on-error-from-init-file))))
+(defvar lisp-directory nil
+ "Directory where Emacs's own *.el and *.elc Lisp files are installed.")
+
(defun command-line ()
"A subroutine of `normal-top-level'.
Amongst another things, it parses the command-line arguments."
@@ -1084,8 +1138,7 @@ Amongst another things, it parses the command-line arguments."
(let ((simple-file-name
;; Look for simple.el or simple.elc and use their directory
;; as the place where all Lisp files live.
- (locate-file "simple" load-path (get-load-suffixes)))
- lisp-dir)
+ (locate-file "simple" load-path (get-load-suffixes))))
;; Don't abort if simple.el cannot be found, but print a warning.
;; Although in most usage we are going to cryptically abort a moment
;; later anyway, due to missing required bidi data files (eg bug#13430).
@@ -1101,12 +1154,13 @@ please check its value")
(unless (file-readable-p lispdir)
(princ (format "Lisp directory %s not readable?" lispdir))
(terpri)))
- (setq lisp-dir (file-truename (file-name-directory simple-file-name)))
+ (setq lisp-directory
+ (file-truename (file-name-directory simple-file-name)))
(setq load-history
(mapcar (lambda (elt)
(if (and (stringp (car elt))
(not (file-name-absolute-p (car elt))))
- (cons (concat lisp-dir
+ (cons (concat lisp-directory
(car elt))
(cdr elt))
elt))
@@ -1139,7 +1193,8 @@ please check its value")
("--no-x-resources") ("--debug-init")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")
- ("--dump-file") ("--temacs") ("--seccomp")))
+ ("--dump-file") ("--temacs") ("--seccomp")
+ ("--init-directory")))
(argi (pop args))
(orig-argi argi)
argval)
@@ -1159,6 +1214,14 @@ please check its value")
(t
(setq argval nil
argi orig-argi)))))
+
+ ;; We handle "-scripteval" further down, but we have to
+ ;; inhibit loading the user init file first. (This is for
+ ;; "emacs -x" handling.)
+ (when (equal argi "-scripteval")
+ (setq init-file-user nil
+ noninteractive t))
+
(cond
;; The --display arg is handled partly in C, partly in Lisp.
;; When it shows up here, we just put it back to be handled
@@ -1179,6 +1242,9 @@ please check its value")
(push '(vertical-scroll-bars . nil) initial-frame-alist))
((member argi '("-q" "-no-init-file"))
(setq init-file-user nil))
+ ((member argi '("-init-directory"))
+ (setq user-emacs-directory (or argval (pop args))
+ argval nil))
((member argi '("-u" "-user"))
(setq init-file-user (or argval (pop args))
argval nil))
@@ -1211,12 +1277,16 @@ please check its value")
(setcdr command-line-args args)))
;; Re-evaluate predefined variables whose initial value depends on
- ;; the runtime context.
- (when (listp custom-delayed-init-variables)
- (mapc #'custom-reevaluate-setting
- ;; Initialize them in the same order they were loaded, in
- ;; case there are dependencies between them.
- (reverse custom-delayed-init-variables)))
+ ;; the runtime context. But delay the warning about
+ ;; `user-emacs-directory' being inaccessible until after processing
+ ;; the init file and the command-line arguments, in case the user
+ ;; customized `user-emacs-directory-warning' to nil via those.
+ (let ((user-emacs-directory-warning nil))
+ (when (listp custom-delayed-init-variables)
+ (mapc #'custom-reevaluate-setting
+ ;; Initialize them in the same order they were loaded, in
+ ;; case there are dependencies between them.
+ (reverse custom-delayed-init-variables))))
(setq custom-delayed-init-variables t)
;; Warn for invalid user name.
@@ -1255,7 +1325,8 @@ please check its value")
(and (eq xdg-dir user-emacs-directory)
(not (eq xdg-dir startup--xdg-config-default))))
user-emacs-directory
- ;; The name is not obvious, so access more directories to calculate it.
+ ;; The name is not obvious, so access more directories
+ ;; to calculate it.
(setq xdg-dir (concat "~" init-file-user "/.config/emacs/"))
(startup--xdg-or-homedot xdg-dir init-file-user)))
@@ -1271,6 +1342,12 @@ please check its value")
startup-init-directory)))
(setq early-init-file user-init-file)
+ ;; Amend `native-comp-eln-load-path', since the early-init file may
+ ;; have altered `user-emacs-directory' and/or changed the eln-cache
+ ;; directory.
+ (when (featurep 'native-compile)
+ (startup--update-eln-cache))
+
;; If any package directory exists, initialize the package system.
(and user-init-file
package-enable-at-startup
@@ -1405,6 +1482,12 @@ please check its value")
startup-init-directory))
t)
+ ;; Amend `native-comp-eln-load-path' again, since the early-init
+ ;; file may have altered `user-emacs-directory' and/or changed the
+ ;; eln-cache directory.
+ (when (featurep 'native-compile)
+ (startup--update-eln-cache))
+
(when (and deactivate-mark transient-mark-mode)
(with-current-buffer (window-buffer)
(deactivate-mark)))
@@ -1464,9 +1547,21 @@ please check its value")
(list 'error
(substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs")))
+ ;; Reevaluate `user-emacs-directory-warning' before processing
+ ;; '--eval' arguments, so that the user could override the default
+ ;; value in the '--eval' forms.
+ (custom-reevaluate-setting 'user-emacs-directory-warning)
+
;; Process the remaining args.
(command-line-1 (cdr command-line-args))
+ ;; Check if `user-emacs-directory' is accessible and warn if it
+ ;; isn't, unless `user-emacs-directory-warning' was customized to
+ ;; disable that warning.
+ (when (and user-emacs-directory-warning
+ (not (file-accessible-directory-p user-emacs-directory)))
+ (locate-user-emacs-file ""))
+
;; This is a problem because, e.g. if emacs.d/gnus.el exists,
;; trying to load gnus could load the wrong file.
;; OK, it would not matter if .emacs.d were at the end of load-path.
@@ -1567,17 +1662,22 @@ If this is nil, no message will be displayed."
`((:face (variable-pitch font-lock-comment-face)
"Welcome to "
:link ("GNU Emacs"
- ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/"))
+ ,(lambda (_button)
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/software/emacs/")))
"Browse https://www.gnu.org/software/emacs/")
", one component of the "
:link
,(lambda ()
(if (eq system-type 'gnu/linux)
`("GNU/Linux"
- ,(lambda (_button) (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html"))
+ ,(lambda (_button)
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html")))
"Browse https://www.gnu.org/gnu/linux-and-gnu.html")
`("GNU" ,(lambda (_button)
- (browse-url "https://www.gnu.org/gnu/thegnuproject.html"))
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/gnu/thegnuproject.html")))
"Browse https://www.gnu.org/gnu/thegnuproject.html")))
" operating system.\n\n"
:face variable-pitch
@@ -1610,7 +1710,8 @@ If this is nil, no message will be displayed."
"\n"
:link ("Emacs Guided Tour"
,(lambda (_button)
- (browse-url "https://www.gnu.org/software/emacs/tour/"))
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/software/emacs/tour/")))
"Browse https://www.gnu.org/software/emacs/tour/")
"\tOverview of Emacs features at gnu.org\n"
:link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
@@ -1633,22 +1734,31 @@ Each element in the list should be a list of strings or pairs
`((:face (variable-pitch font-lock-comment-face)
"This is "
:link ("GNU Emacs"
- ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/"))
+ ,(lambda (_button)
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/software/emacs/")))
"Browse https://www.gnu.org/software/emacs/")
- ", one component of the "
+ ", a text editor and more.\nIt's a component of the "
:link
,(lambda ()
(if (eq system-type 'gnu/linux)
`("GNU/Linux"
,(lambda (_button)
- (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html"))
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html")))
"Browse https://www.gnu.org/gnu/linux-and-gnu.html")
- `("GNU" ,(lambda (_button) (describe-gnu-project))
+ `("GNU" ,(lambda (_button)
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (describe-gnu-project)))
"Display info on the GNU project.")))
" operating system.\n"
:face (variable-pitch font-lock-builtin-face)
"\n"
- ,(lambda () (emacs-version))
+ ,(lambda ()
+ (with-temp-buffer
+ (insert (emacs-version))
+ (fill-region (point-min) (point-max))
+ (buffer-string)))
"\n"
:face (variable-pitch (:height 0.8))
,(lambda () emacs-copyright)
@@ -1663,7 +1773,9 @@ Each element in the list should be a list of strings or pairs
,(lambda (_button) (info "(emacs)Contributing")))
"\tHow to report bugs and contribute improvements to Emacs\n"
"\n"
- :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project)))
+ :link ("GNU and Freedom" ,(lambda (_button)
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (describe-gnu-project))))
"\tWhy we developed GNU Emacs, and the GNU operating system\n"
:link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
"\tGNU Emacs comes with "
@@ -1701,7 +1813,8 @@ Each element in the list should be a list of strings or pairs
"\n"
:link ("Emacs Guided Tour"
,(lambda (_button)
- (browse-url "https://www.gnu.org/software/emacs/tour/"))
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/software/emacs/tour/")))
"Browse https://www.gnu.org/software/emacs/tour/")
"\tSee an overview of Emacs features at gnu.org\n"
:link ("Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
@@ -1823,7 +1936,9 @@ a face or button specification."
(make-button (prog1 (point) (insert-image img)) (point)
'face 'default
'help-echo "mouse-2, RET: Browse https://www.gnu.org/"
- 'action (lambda (_button) (browse-url "https://www.gnu.org/"))
+ 'action (lambda (_button)
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (browse-url "https://www.gnu.org/")))
'follow-link t)
(insert "\n\n")))))
@@ -1832,28 +1947,35 @@ a face or button specification."
(unless concise
(fancy-splash-insert
:face 'variable-pitch
- "\nTo start... "
+ "\nTo start...\t"
:link `("Open a File"
,(lambda (_button) (call-interactively 'find-file))
"Specify a new file's name, to edit the file")
- " "
+ "\t\t"
:link `("Open Home Directory"
,(lambda (_button) (dired "~"))
"Open your home directory, to operate on its files")
- " "
+ "\n\t"
:link `("Customize Startup"
,(lambda (_button) (customize-group 'initialization))
"Change initialization settings including this screen")
+ "\t"
+ :link `("Explore Packages"
+ ,(lambda (_button) (call-interactively 'package-list-packages))
+ "Explore, install and remove Emacs packages (requires Internet connection)")
"\n"))
(fancy-splash-insert
:face 'variable-pitch "To quit a partially entered command, type "
:face 'default "Control-g"
:face 'variable-pitch ".\n")
- (fancy-splash-insert :face '(variable-pitch font-lock-builtin-face)
- "\nThis is "
- (emacs-version)
- "\n"
- :face '(variable-pitch (:height 0.8))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (fancy-splash-insert :face '(variable-pitch font-lock-builtin-face)
+ "\nThis is "
+ (emacs-version)
+ "\n")
+ (fill-region (point-min) (point-max)))
+ (fancy-splash-insert :face '(variable-pitch (:height 0.8))
emacs-copyright
"\n")
(when auto-save-list-file-prefix
@@ -1937,7 +2059,6 @@ splash screen in another window."
(insert "\n")
(fancy-startup-tail concise))
(use-local-map splash-screen-keymap)
- (setq-local browse-url-browser-function 'eww-browse-url)
(setq tab-width 22
buffer-read-only t)
(set-buffer-modified-p nil)
@@ -1975,11 +2096,11 @@ splash screen in another window."
(goto-char (point-min))
(force-mode-line-update))
(use-local-map splash-screen-keymap)
- (setq-local browse-url-browser-function 'eww-browse-url)
(setq tab-width 22)
(setq buffer-read-only t)
+ ;; Place point somewhere it doesn't cover a character.
(goto-char (point-min))
- (forward-line 3))))
+ (re-search-forward "\n$" nil nil 2))))
(defun fancy-splash-frame ()
"Return the frame to use for the fancy splash screen.
@@ -1991,6 +2112,8 @@ we put it on this frame."
;; frame visible.
(if (eq (window-system) 'w32)
(sit-for 0 t))
+ (if (eq (window-system) 'pgtk)
+ (sit-for 0.1 t))
(dolist (frame (append (frame-list) (list (selected-frame))))
(if (and (frame-visible-p frame)
(not (window-minibuffer-p (frame-selected-window frame))))
@@ -2132,8 +2255,11 @@ To quit a partially entered command, type Control-g.\n")
'follow-link t)
(insert "\tChange initialization settings including this screen\n")
- (insert "\n" (emacs-version)
- "\n" emacs-copyright))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert "\n" (emacs-version) "\n")
+ (fill-region (point-min) (point-max)))
+ (insert emacs-copyright))
(defun normal-no-mouse-startup-screen ()
"Show a splash screen suitable for displays without mouse support."
@@ -2210,10 +2336,14 @@ If you have no Meta key, you may instead type ESC followed by the character.)"))
(insert "\t\t")
(insert-button "Open *scratch* buffer"
'action (lambda (_button) (switch-to-buffer
- (startup--get-buffer-create-scratch)))
+ (get-scratch-buffer-create)))
'follow-link t)
(insert "\n")
- (insert "\n" (emacs-version) "\n" emacs-copyright "\n")
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert "\n" (emacs-version) "\n")
+ (fill-region (point-min) (point-max)))
+ (insert emacs-copyright "\n")
(insert (substitute-command-keys
"
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
@@ -2253,7 +2383,9 @@ Type \\[describe-distribution] for information on "))
(insert "\tHow to report bugs and contribute improvements to Emacs\n\n")
(insert-button "GNU and Freedom"
- 'action (lambda (_button) (describe-gnu-project))
+ 'action (lambda (_button)
+ (let ((browse-url-browser-function 'eww-browse-url))
+ (describe-gnu-project)))
'follow-link t)
(insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
@@ -2336,12 +2468,6 @@ A fancy display is used on graphic displays, normal otherwise."
(defalias 'about-emacs 'display-about-screen)
(defalias 'display-splash-screen 'display-startup-screen)
-(defun startup--get-buffer-create-scratch ()
- (or (get-buffer "*scratch*")
- (with-current-buffer (get-buffer-create "*scratch*")
- (set-buffer-major-mode (current-buffer))
- (current-buffer))))
-
;; This avoids byte-compiler warning in the unexec build.
(declare-function pdumper-stats "pdumper.c" ())
@@ -2394,6 +2520,7 @@ A fancy display is used on graphic displays, normal otherwise."
;; and long versions of what's on command-switch-alist.
(longopts
(append '("--funcall" "--load" "--insert" "--kill"
+ "--dump-file" "--seccomp"
"--directory" "--eval" "--execute" "--no-splash"
"--find-file" "--visit" "--file" "--no-desktop")
(mapcar (lambda (elt) (concat "-" (car elt)))
@@ -2533,12 +2660,23 @@ nil default-directory" name)
;; This is used to handle -script. It's not clear
;; we need to document it (it is totally internal).
- ((member argi '("-scriptload"))
+ ((member argi '("-scriptload" "-scripteval"))
(let* ((file (command-line-normalize-file-name
(or argval (pop command-line-args-left))))
;; Take file from default dir.
- (file-ex (file-truename (expand-file-name file))))
- (load file-ex nil t t)))
+ (file-ex (expand-file-name file))
+ (truename (file-truename file-ex)))
+ ;; We want to use the truename here if we can,
+ ;; because that makes `eval-after-load' work
+ ;; more reliably. But if the file is, for
+ ;; instance, /dev/stdin, the truename doesn't
+ ;; actually exist on some systems.
+ (when (file-exists-p truename)
+ (setq file-ex truename))
+ (if (equal argi "-scripteval")
+ ;; This will kill Emacs.
+ (command-line--eval-script file-ex)
+ (command-line--load-script file-ex))))
((equal argi "-insert")
(setq inhibit-startup-screen t)
@@ -2547,6 +2685,11 @@ nil default-directory" name)
(error "File name omitted from `-insert' option"))
(insert-file-contents (command-line-normalize-file-name tem)))
+ ((or (equal argi "-dump-file")
+ (equal argi "-seccomp"))
+ ;; This was processed in C.
+ (or argval (pop command-line-args-left)))
+
((equal argi "-kill")
(kill-emacs t))
@@ -2616,7 +2759,7 @@ nil default-directory" name)
(when (eq initial-buffer-choice t)
;; When `initial-buffer-choice' equals t make sure that *scratch*
;; exists.
- (startup--get-buffer-create-scratch))
+ (get-scratch-buffer-create))
;; If *scratch* exists and is empty, insert initial-scratch-message.
;; Do this before switching to *scratch* below to handle bug#9605.
@@ -2640,7 +2783,7 @@ nil default-directory" name)
((functionp initial-buffer-choice)
(funcall initial-buffer-choice))
((eq initial-buffer-choice t)
- (startup--get-buffer-create-scratch))
+ (get-scratch-buffer-create))
(t
(error "`initial-buffer-choice' must be a string, a function, or t")))))
(unless (buffer-live-p buf)
@@ -2655,13 +2798,28 @@ nil default-directory" name)
;; `nondisplayed-buffers-p' is true if there exist buffers
;; in `displayable-buffers' that were not displayed to the
;; user.
- (nondisplayed-buffers-p nil))
+ (nondisplayed-buffers-p nil)
+ (old-face-font-rescale-alist face-font-rescale-alist))
(when (> displayable-buffers-len 0)
(switch-to-buffer (car displayable-buffers)))
- (when (> displayable-buffers-len 1)
- (switch-to-buffer-other-window (car (cdr displayable-buffers)))
+ (cond
+ ;; Two buffers; display them both.
+ ((= displayable-buffers-len 2)
+ (switch-to-buffer-other-window (cadr displayable-buffers))
;; Focus on the first buffer.
(other-window -1))
+ ;; More than two buffers: Ensure that the buffer display order
+ ;; reflects the order they were given on the command line.
+ ;; (This will end up with a `next-buffer' order that's in
+ ;; reverse order -- the final file is the focused one, and then
+ ;; the rest are in `next-buffer' in descending order.
+ ((> displayable-buffers-len 2)
+ (let ((bufs (reverse (cdr displayable-buffers))))
+ (switch-to-buffer-other-window (pop bufs))
+ (dolist (buf bufs)
+ (switch-to-buffer buf nil t))
+ ;; Focus on the first buffer.
+ (other-window -1))))
(when (> displayable-buffers-len 2)
(setq nondisplayed-buffers-p t))
@@ -2685,6 +2843,14 @@ nil default-directory" name)
;; before doing any output.
(run-hooks 'emacs-startup-hook 'term-setup-hook)
+ ;; See the commentary in `normal-top-level' for why we do
+ ;; this.
+ (when (and (not (eq face-font-rescale-alist
+ old-face-font-rescale-alist))
+ (assoc (font-xlfd-name (face-attribute 'default :font))
+ face-font-rescale-alist #'string-match-p))
+ (set-face-attribute 'default nil :font (font-spec)))
+
;; It's important to notice the user settings before we
;; display the startup message; otherwise, the settings
;; won't take effect until the user gives the first
@@ -2708,6 +2874,35 @@ nil default-directory" name)
(display-startup-screen (> displayable-buffers-len 0))))))
+(defun command-line--load-script (file)
+ (load-with-code-conversion
+ file file nil t
+ (lambda (buffer file)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ ;; Removing the #! and then calling `eval-buffer' will make the
+ ;; reader not signal an error if it then turns out that the
+ ;; buffer is empty.
+ (when (looking-at "#!")
+ (delete-line))
+ (eval-buffer buffer nil file nil t)))))
+
+(defun command-line--eval-script (file)
+ (load-with-code-conversion
+ file file nil t
+ (lambda (buffer _)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (when (looking-at "#!")
+ (forward-line))
+ (let (value form)
+ (while (ignore-error 'end-of-file
+ (setq form (read (current-buffer))))
+ (setq value (eval form t)))
+ (kill-emacs (if (numberp value)
+ value
+ 0)))))))
+
(defun command-line-normalize-file-name (file)
"Collapse multiple slashes to one, to handle non-Emacs file names."
(save-match-data
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 32f657d1149..d7a95393166 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -252,7 +252,7 @@ WARNING: Changing the value of this variable will gravely affect the
figure out what it should be based on your needs and on how
quick the particular platform(s) you're operating on, and
only then start programming in your custom strokes."
- :type 'integer)
+ :type 'natnum)
(defcustom strokes-file (locate-user-emacs-file "strokes" ".strokes")
"File containing saved strokes for Strokes mode."
@@ -1031,13 +1031,11 @@ o Strokes are a bit computer-dependent in that they depend somewhat on
(help-mode)
(help-print-return-message)))
-(define-obsolete-function-alias 'strokes-report-bug #'report-emacs-bug "24.1")
-
(defun strokes-window-configuration-changed-p ()
"Non-nil if the `strokes-window-configuration' frame properties changed.
This is based on the last time `strokes-window-configuration' was updated."
- (compare-window-configurations (current-window-configuration)
- strokes-window-configuration))
+ (window-configuration-equal-p (current-window-configuration)
+ strokes-window-configuration))
(defun strokes-update-window-configuration ()
"Ensure that `strokes-window-configuration' is up-to-date."
@@ -1395,14 +1393,19 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
(strokes-load-user-strokes))
(add-hook 'kill-emacs-query-functions
#'strokes-prompt-user-save-strokes)
- (add-hook 'select-frame-hook
- #'strokes-update-window-configuration)
+ ;; FIXME: Should this be something like `focus-in-hook'?
+ ;; That variable is obsolete, but `select-frame-hook' has
+ ;; never existed in Emacs.
+ ;;(add-hook 'select-frame-hook
+ ;; #'strokes-update-window-configuration)
(strokes-update-window-configuration))
(t ; turn off strokes
(if (get-buffer strokes-buffer-name)
- (kill-buffer (get-buffer strokes-buffer-name)))
- (remove-hook 'select-frame-hook
- #'strokes-update-window-configuration))))
+ (kill-buffer (get-buffer strokes-buffer-name)))
+ ;; FIXME: Same as above.
+ ;;(remove-hook 'select-frame-hook
+ ;; #'strokes-update-window-configuration)
+ )))
;;;; strokes-xpm stuff (later may be separate)...
diff --git a/lisp/subr.el b/lisp/subr.el
index 921853de607..ef2edcff102 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -61,7 +61,8 @@ must be the first non-whitespace on a line.
For more information, see Info node `(elisp)Declaring Functions'."
(declare (advertised-calling-convention
(fn file &optional arglist fileonly) nil))
- ;; Does nothing - byte-compile-declare-function does the work.
+ ;; Does nothing - `byte-compile-macroexpand-declare-function' does
+ ;; the work.
nil)
@@ -193,7 +194,7 @@ set earlier in the `setq-local'. The return value of the
"Define VAR as a buffer-local variable with default value VAL.
Like `defvar' but additionally marks the variable as being automatically
buffer-local wherever it is set."
- (declare (debug defvar) (doc-string 3))
+ (declare (debug defvar) (doc-string 3) (indent 2))
;; Can't use backquote here, it's too early in the bootstrap.
(list 'progn (list 'defvar var val docstring)
(list 'make-variable-buffer-local (list 'quote var))))
@@ -206,6 +207,39 @@ Also see `local-variable-p'."
(:success t)
(void-variable nil)))
+(defmacro buffer-local-set-state (&rest pairs)
+ "Like `setq-local', but allow restoring the previous state of locals later.
+This macro returns an object that can be passed to `buffer-local-restore-state'
+in order to restore the state of the local variables set via this macro.
+
+\(fn [VARIABLE VALUE]...)"
+ (declare (debug setq))
+ (unless (zerop (mod (length pairs) 2))
+ (error "PAIRS must have an even number of variable/value members"))
+ `(prog1
+ (buffer-local-set-state--get ',pairs)
+ (setq-local ,@pairs)))
+
+(defun buffer-local-set-state--get (pairs)
+ (let ((states nil))
+ (while pairs
+ (push (list (car pairs)
+ (and (boundp (car pairs))
+ (local-variable-p (car pairs)))
+ (and (boundp (car pairs))
+ (symbol-value (car pairs))))
+ states)
+ (setq pairs (cddr pairs)))
+ (nreverse states)))
+
+(defun buffer-local-restore-state (states)
+ "Restore values of buffer-local variables recorded in STATES.
+STATES should be an object returned by `buffer-local-set-state'."
+ (pcase-dolist (`(,variable ,local ,value) states)
+ (if local
+ (set variable value)
+ (kill-local-variable variable))))
+
(defmacro push (newelt place)
"Add NEWELT to the list stored in the generalized variable PLACE.
This is morally equivalent to (setf PLACE (cons NEWELT PLACE)),
@@ -242,18 +276,14 @@ change the list."
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil.
When COND yields non-nil, eval BODY forms sequentially and return
-value of last one, or nil if there are none.
-
-\(fn COND BODY...)"
+value of last one, or nil if there are none."
(declare (indent 1) (debug t))
(list 'if cond (cons 'progn body)))
(defmacro unless (cond &rest body)
"If COND yields nil, do BODY, else return nil.
When COND yields nil, eval BODY forms sequentially and return
-value of last one, or nil if there are none.
-
-\(fn COND BODY...)"
+value of last one, or nil if there are none."
(declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
@@ -411,7 +441,10 @@ To signal with MESSAGE without interpreting format characters
like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE).
In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period. Please follow this convention
-for the sake of consistency."
+for the sake of consistency.
+
+To alter the look of the displayed error messages, you can use
+the `command-error-function' variable."
(declare (advertised-calling-convention (string &rest args) "23.1"))
(signal 'error (list (apply #'format-message args))))
@@ -427,7 +460,10 @@ To signal with MESSAGE without interpreting format characters
like `%', `\\=`' and `\\='', use (user-error \"%s\" MESSAGE).
In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period. Please follow this convention
-for the sake of consistency."
+for the sake of consistency.
+
+To alter the look of the displayed error messages, you can use
+the `command-error-function' variable."
(signal 'user-error (list (apply #'format-message format args))))
(defun define-error (name message &optional parent)
@@ -504,12 +540,12 @@ i.e., subtract 2 * `most-negative-fixnum' from VALUE before shifting it."
;; you may want to amend the other, too.
(defun internal--compiler-macro-cXXr (form x)
(let* ((head (car form))
- (n (symbol-name (car form)))
+ (n (symbol-name head))
(i (- (length n) 2)))
(if (not (string-match "c[ad]+r\\'" n))
(if (and (fboundp head) (symbolp (symbol-function head)))
- (internal--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
- x)
+ (internal--compiler-macro-cXXr
+ (cons (symbol-function head) (cdr form)) x)
(error "Compiler macro for cXXr applied to non-cXXr form"))
(while (> i (match-beginning 0))
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
@@ -928,16 +964,44 @@ side-effects, and the argument LIST is not modified."
(defun kbd (keys)
"Convert KEYS to the internal Emacs key representation.
KEYS should be a string in the format returned by commands such
-as `C-h k' (`describe-key').
+as \\[describe-key] (`describe-key').
+
This is the same format used for saving keyboard macros (see
`edmacro-mode').
+Here's some example key sequences:
+
+ \"f\"
+ \"C-c C-c\"
+ \"H-<left>\"
+ \"M-RET\"
+ \"C-M-<return>\"
+
For an approximate inverse of this, see `key-description'."
- ;; Don't use a defalias, since the `pure' property is true only for
- ;; the calling convention of `kbd'.
(declare (pure t) (side-effect-free t))
- ;; A pure function is expected to preserve the match data.
- (save-match-data (read-kbd-macro keys)))
+ (let ((res (key-parse keys)))
+ ;; For historical reasons, parse "C-x ( C-d C-x )" as "C-d", since
+ ;; `kbd' used to be a wrapper around `read-kbd-macro'.
+ (when (and (>= (length res) 4)
+ (eq (aref res 0) ?\C-x)
+ (eq (aref res 1) ?\()
+ (eq (aref res (- (length res) 2)) ?\C-x)
+ (eq (aref res (- (length res) 1)) ?\)))
+ (setq res (apply #'vector (let ((lres (append res nil)))
+ ;; Remove the first and last two elements.
+ (setq lres (cddr lres))
+ (setq lres (nreverse lres))
+ (setq lres (cddr lres))
+ (nreverse lres)))))
+
+ (if (not (memq nil (mapcar (lambda (ch)
+ (and (numberp ch)
+ (<= 0 ch 127)))
+ res)))
+ ;; Return a string.
+ (concat (mapcar #'identity res))
+ ;; Return a vector.
+ res)))
(defun undefined ()
"Beep to tell the user this binding is undefined."
@@ -988,6 +1052,9 @@ PARENT if non-nil should be a keymap."
(defun define-key-after (keymap key definition &optional after)
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
+This is a legacy function; see `keymap-set-after' for the
+recommended function to use instead.
+
This is like `define-key' except that the binding for KEY is placed
just after the binding for the event AFTER, instead of at the beginning
of the map. Note that AFTER must be an event type (like KEY), NOT a command
@@ -1000,6 +1067,7 @@ Bindings are always added before any inherited map.
The order of bindings in a keymap matters only when it is used as
a menu, so this function is not useful for non-menu keymaps."
+ (declare (indent defun))
(unless after (setq after t))
(or (keymapp keymap)
(signal 'wrong-type-argument (list 'keymapp keymap)))
@@ -1130,8 +1198,17 @@ Subkeymaps may be modified but are not canonicalized."
(setq map (map-keymap ;; -internal
(lambda (key item)
(if (consp key)
- ;; Treat char-ranges specially.
- (push (cons key item) ranges)
+ (if (= (car key) (1- (cdr key)))
+ ;; If we have a two-character range, then
+ ;; treat it as two separate characters
+ ;; (because this makes `describe-bindings'
+ ;; look better and shouldn't affect
+ ;; anything else).
+ (progn
+ (push (cons (car key) item) bindings)
+ (push (cons (cdr key) item) bindings))
+ ;; Treat char-ranges specially.
+ (push (cons key item) ranges))
(push (cons key item) bindings)))
map)))
;; Create the new map.
@@ -1157,6 +1234,9 @@ Subkeymaps may be modified but are not canonicalized."
(defun keyboard-translate (from to)
"Translate character FROM to TO on the current terminal.
+This is a legacy function; see `keymap-translate' for the
+recommended function to use instead.
+
This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it."
(or (char-table-p keyboard-translate-table)
@@ -1168,6 +1248,9 @@ and then modifies one entry in it."
(defun global-set-key (key command)
"Give KEY a global binding as COMMAND.
+This is a legacy function; see `keymap-global-set' for the
+recommended function to use instead.
+
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
KEY is a key sequence; noninteractively, it is a string or vector
@@ -1189,6 +1272,9 @@ that you make with this function."
(defun local-set-key (key command)
"Give KEY a local binding as COMMAND.
+This is a legacy function; see `keymap-local-set' for the
+recommended function to use instead.
+
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
KEY is a key sequence; noninteractively, it is a string or vector
@@ -1207,12 +1293,18 @@ cases is shared with all other buffers in the same major mode."
(defun global-unset-key (key)
"Remove global binding of KEY.
+This is a legacy function; see `keymap-global-unset' for the
+recommended function to use instead.
+
KEY is a string or vector representing a sequence of keystrokes."
(interactive "kUnset key globally: ")
(global-set-key key nil))
(defun local-unset-key (key)
"Remove local binding of KEY.
+This is a legacy function; see `keymap-local-unset' for the
+recommended function to use instead.
+
KEY is a string or vector representing a sequence of keystrokes."
(interactive "kUnset key locally: ")
(if (current-local-map)
@@ -1221,6 +1313,9 @@ KEY is a string or vector representing a sequence of keystrokes."
(defun local-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current local keymap only.
+This is a legacy function; see `keymap-local-binding' for the
+recommended function to use instead.
+
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
@@ -1232,6 +1327,9 @@ about this."
(defun global-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current global keymap only.
+This is a legacy function; see `keymap-global-binding' for the
+recommended function to use instead.
+
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
This function's return values are the same as those of `lookup-key'
@@ -1250,6 +1348,9 @@ about this."
(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
"Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
+This is a legacy function; see `keymap-substitute' for the
+recommended function to use instead.
+
In other words, OLDDEF is replaced with NEWDEF wherever it appears.
Alternatively, if optional fourth argument OLDMAP is specified, we redefine
in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP.
@@ -1441,21 +1542,21 @@ the `click' modifier."
;; sure the symbol has already been parsed.
(cdr (internal-event-symbol-parse-modifiers type))
(let ((list nil)
- (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
- ?\H-\^@ ?\s-\^@ ?\A-\^@)))))
- (if (not (zerop (logand type ?\M-\^@)))
+ (char (logand type (lognot (logior ?\M-\0 ?\C-\0 ?\S-\0
+ ?\H-\0 ?\s-\0 ?\A-\0)))))
+ (if (not (zerop (logand type ?\M-\0)))
(push 'meta list))
- (if (or (not (zerop (logand type ?\C-\^@)))
+ (if (or (not (zerop (logand type ?\C-\0)))
(< char 32))
(push 'control list))
- (if (or (not (zerop (logand type ?\S-\^@)))
+ (if (or (not (zerop (logand type ?\S-\0)))
(/= char (downcase char)))
(push 'shift list))
- (or (zerop (logand type ?\H-\^@))
+ (or (zerop (logand type ?\H-\0))
(push 'hyper list))
- (or (zerop (logand type ?\s-\^@))
+ (or (zerop (logand type ?\s-\0))
(push 'super list))
- (or (zerop (logand type ?\A-\^@))
+ (or (zerop (logand type ?\A-\0))
(push 'alt list))
list))))
@@ -1469,7 +1570,7 @@ in the current Emacs session, then this function may return nil."
(setq event (car event)))
(if (symbolp event)
(car (get event 'event-symbol-elements))
- (let* ((base (logand event (1- ?\A-\^@)))
+ (let* ((base (logand event (1- ?\A-\0)))
(uncontrolled (if (< base 32) (logior base 64) base)))
;; There are some numbers that are invalid characters and
;; cause `downcase' to get an error.
@@ -1604,13 +1705,19 @@ pixels. POSITION should be a list of the form returned by
(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
-(defun posn-col-row (position)
+(defun posn-col-row (position &optional use-window)
"Return the nominal column and row in POSITION, measured in characters.
The column and row values are approximations calculated from the x
and y coordinates in POSITION and the frame's default character width
and default line height, including spacing.
+
+If USE-WINDOW is non-nil, use the typical width of a character in
+the window indicated by POSITION instead of the frame. (This
+makes a difference is a window has a zoom level.)
+
For a scroll-bar event, the result column is 0, and the row
corresponds to the vertical position of the click in the scroll bar.
+
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
(let* ((pair (posn-x-y position))
@@ -1628,20 +1735,23 @@ and `event-end' functions."
((eq area 'horizontal-scroll-bar)
(cons (scroll-bar-scale pair (window-width window)) 0))
(t
- ;; FIXME: This should take line-spacing properties on
- ;; newlines into account.
- (let* ((spacing (when (display-graphic-p frame)
- (or (with-current-buffer
- (window-buffer (frame-selected-window frame))
- line-spacing)
- (frame-parameter frame 'line-spacing)))))
- (cond ((floatp spacing)
- (setq spacing (truncate (* spacing
- (frame-char-height frame)))))
- ((null spacing)
- (setq spacing 0)))
- (cons (/ (car pair) (frame-char-width frame))
- (/ (cdr pair) (+ (frame-char-height frame) spacing))))))))
+ (if use-window
+ (cons (/ (car pair) (window-font-width window))
+ (/ (cdr pair) (window-font-height window)))
+ ;; FIXME: This should take line-spacing properties on
+ ;; newlines into account.
+ (let* ((spacing (when (display-graphic-p frame)
+ (or (with-current-buffer
+ (window-buffer (frame-selected-window frame))
+ line-spacing)
+ (frame-parameter frame 'line-spacing)))))
+ (cond ((floatp spacing)
+ (setq spacing (truncate (* spacing
+ (frame-char-height frame)))))
+ ((null spacing)
+ (setq spacing 0)))
+ (cons (/ (car pair) (frame-char-width frame))
+ (/ (cdr pair) (+ (frame-char-height frame) spacing)))))))))
(defun posn-actual-col-row (position)
"Return the window row number in POSITION and character number in that row.
@@ -1746,12 +1856,11 @@ be a list of the form returned by `event-start' and `event-end'."
;;;; Obsolescence declarations for variables, and aliases.
(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1")
-(make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1")
-(make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1")
(make-obsolete-variable 'redisplay-dont-pause nil "24.5")
(make-obsolete 'window-redisplay-end-trigger nil "23.1")
(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
(make-obsolete-variable 'operating-system-release nil "28.1")
+(make-obsolete-variable 'inhibit-changing-match-data 'save-match-data "29.1")
(make-obsolete 'run-window-configuration-change-hook nil "27.1")
@@ -1772,11 +1881,8 @@ be a list of the form returned by `event-start' and `event-end'."
(make-obsolete-variable 'load-dangerous-libraries
"no longer used." "27.1")
-(defvar inhibit--record-char nil
- "Obsolete variable.
-This was used internally by quail.el and keyboard.c in Emacs 27.
-It does nothing in Emacs 28.")
-(make-obsolete-variable 'inhibit--record-char nil "28.1")
+(define-obsolete-function-alias 'compare-window-configurations
+ #'window-configuration-equal-p "29.1")
;; We can't actually make `values' obsolete, because that will result
;; in warnings when using `values' in let-bindings.
@@ -1852,7 +1958,9 @@ performance impact when running `add-hook' and `remove-hook'."
(set (make-local-variable hook) (list t)))
;; Detect the case where make-local-variable was used on a hook
;; and do what we used to do.
- (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
+ (when (and (local-variable-if-set-p hook)
+ (not (and (consp (symbol-value hook))
+ (memq t (symbol-value hook)))))
(setq local t)))
(let ((hook-value (if local (symbol-value hook) (default-value hook))))
;; If the hook value is a single function, turn it into a list.
@@ -1860,26 +1968,34 @@ performance impact when running `add-hook' and `remove-hook'."
(setq hook-value (list hook-value)))
;; Do the actual addition if necessary
(unless (member function hook-value)
- (when (stringp function) ;FIXME: Why?
- (setq function (purecopy function)))
- ;; All those `equal' tests performed between functions can end up being
- ;; costly since those functions may be large recursive and even cyclic
- ;; structures, so we index `hook--depth-alist' with `eq'. (bug#46326)
- (when (or (get hook 'hook--depth-alist) (not (zerop depth)))
- ;; Note: The main purpose of the above `when' test is to avoid running
- ;; this `setf' before `gv' is loaded during bootstrap.
- (push (cons function depth) (get hook 'hook--depth-alist)))
- (setq hook-value
- (if (< 0 depth)
- (append hook-value (list function))
- (cons function hook-value)))
- (let ((depth-alist (get hook 'hook--depth-alist)))
- (when depth-alist
- (setq hook-value
- (sort (if (< 0 depth) hook-value (copy-sequence hook-value))
- (lambda (f1 f2)
- (< (alist-get f1 depth-alist 0 nil #'eq)
- (alist-get f2 depth-alist 0 nil #'eq))))))))
+ (let ((depth-sym (get hook 'hook--depth-alist)))
+ ;; While the `member' test above has to use `equal' for historical
+ ;; reasons, `equal' is a performance problem on large/cyclic functions,
+ ;; so we index `hook--depth-alist' with `eql'. (bug#46326)
+ (unless (zerop depth)
+ (unless depth-sym
+ (setq depth-sym (make-symbol "depth-alist"))
+ (set depth-sym nil)
+ (setf (get hook 'hook--depth-alist) depth-sym))
+ (if local (make-local-variable depth-sym))
+ (setf (alist-get function
+ (if local (symbol-value depth-sym)
+ (default-value depth-sym))
+ 0)
+ depth))
+ (setq hook-value
+ (if (< 0 depth)
+ (append hook-value (list function))
+ (cons function hook-value)))
+ (when depth-sym
+ (let ((depth-alist (if local (symbol-value depth-sym)
+ (default-value depth-sym))))
+ (when depth-alist
+ (setq hook-value
+ (sort (if (< 0 depth) hook-value (copy-sequence hook-value))
+ (lambda (f1 f2)
+ (< (alist-get f1 depth-alist 0 nil #'eq)
+ (alist-get f2 depth-alist 0 nil #'eq))))))))))
;; Set the actual variable
(if local
(progn
@@ -1927,7 +2043,7 @@ one will be removed."
(format "%s hook to remove: "
(if local "Buffer-local" "Global"))
fn-alist
- nil t)
+ nil t nil 'set-variable-value-history)
fn-alist nil nil #'string=)))
(list hook function local)))
(or (boundp hook) (set hook nil))
@@ -1952,9 +2068,14 @@ one will be removed."
(when old-fun
;; Remove auxiliary depth info to avoid leaks (bug#46414)
;; and to avoid the list growing too long.
- (let* ((depths (get hook 'hook--depth-alist))
- (di (assq old-fun depths)))
- (when di (put hook 'hook--depth-alist (delq di depths)))))
+ (let* ((depth-sym (get hook 'hook--depth-alist))
+ (depth-alist (if depth-sym (if local (symbol-value depth-sym)
+ (default-value depth-sym))))
+ (di (assq old-fun depth-alist)))
+ (when di
+ (setf (if local (symbol-value depth-sym)
+ (default-value depth-sym))
+ (remq di depth-alist)))))
;; If the function is on the global hook, we need to shadow it locally
;;(when (and local (member function (default-value hook))
;; (not (member (cons 'not function) hook-value)))
@@ -2116,7 +2237,7 @@ can do the job."
(not (macroexp-const-p append)))
exp
(let* ((sym (cadr list-var))
- (append (eval append))
+ (append (eval append lexical-binding))
(msg (format-message
"`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
sym))
@@ -2303,6 +2424,102 @@ Affects only hooks run in the current buffer."
(let ((delay-mode-hooks t))
,@body)))
+;;; `when-let' and friends.
+
+(defun internal--build-binding (binding prev-var)
+ "Check and build a single BINDING with PREV-VAR."
+ (setq binding
+ (cond
+ ((symbolp binding)
+ (list binding binding))
+ ((null (cdr binding))
+ (list (make-symbol "s") (car binding)))
+ (t binding)))
+ (when (> (length binding) 2)
+ (signal 'error
+ (cons "`let' bindings can have only one value-form" binding)))
+ (let ((var (car binding)))
+ `(,var (and ,prev-var ,(cadr binding)))))
+
+(defun internal--build-bindings (bindings)
+ "Check and build conditional value forms for BINDINGS."
+ (let ((prev-var t))
+ (mapcar (lambda (binding)
+ (let ((binding (internal--build-binding binding prev-var)))
+ (setq prev-var (car binding))
+ binding))
+ bindings)))
+
+(defmacro if-let* (varlist then &rest else)
+ "Bind variables according to VARLIST and evaluate THEN or ELSE.
+This is like `if-let' but doesn't handle a VARLIST of the form
+\(SYMBOL SOMETHING) specially."
+ (declare (indent 2)
+ (debug ((&rest [&or symbolp (symbolp form) (form)])
+ body)))
+ (if varlist
+ `(let* ,(setq varlist (internal--build-bindings varlist))
+ (if ,(caar (last varlist))
+ ,then
+ ,@else))
+ `(let* () ,then)))
+
+(defmacro when-let* (varlist &rest body)
+ "Bind variables according to VARLIST and conditionally evaluate BODY.
+This is like `when-let' but doesn't handle a VARLIST of the form
+\(SYMBOL SOMETHING) specially."
+ (declare (indent 1) (debug if-let*))
+ (list 'if-let* varlist (macroexp-progn body)))
+
+(defmacro and-let* (varlist &rest body)
+ "Bind variables according to VARLIST and conditionally evaluate BODY.
+Like `when-let*', except if BODY is empty and all the bindings
+are non-nil, then the result is non-nil."
+ (declare (indent 1) (debug if-let*))
+ (let (res)
+ (if varlist
+ `(let* ,(setq varlist (internal--build-bindings varlist))
+ (when ,(setq res (caar (last varlist)))
+ ,@(or body `(,res))))
+ `(let* () ,@(or body '(t))))))
+
+(defmacro if-let (spec then &rest else)
+ "Bind variables according to SPEC and evaluate THEN or ELSE.
+Evaluate each binding in turn, as in `let*', stopping if a
+binding value is nil. If all are non-nil return the value of
+THEN, otherwise the last form in ELSE.
+
+Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
+SYMBOL to the value of VALUEFORM. An element can additionally be
+of the form (VALUEFORM), which is evaluated and checked for nil;
+i.e. SYMBOL can be omitted if only the test result is of
+interest. It can also be of the form SYMBOL, then the binding of
+SYMBOL is checked for nil.
+
+As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
+like \((SYMBOL SOMETHING)). This exists for backward compatibility
+with an old syntax that accepted only one binding."
+ (declare (indent 2)
+ (debug ([&or (symbolp form) ; must be first, Bug#48489
+ (&rest [&or symbolp (symbolp form) (form)])]
+ body)))
+ (when (and (<= (length spec) 2)
+ (not (listp (car spec))))
+ ;; Adjust the single binding case
+ (setq spec (list spec)))
+ (list 'if-let* spec then (macroexp-progn else)))
+
+(defmacro when-let (spec &rest body)
+ "Bind variables according to SPEC and conditionally evaluate BODY.
+Evaluate each binding in turn, stopping if a binding value is nil.
+If all are non-nil, return the value of the last form in BODY.
+
+The variable list SPEC is the same as in `if-let'."
+ (declare (indent 1) (debug if-let))
+ (list 'if-let spec (macroexp-progn body)))
+
+
+
;; PUBLIC: find if the current mode derives from another.
(defun provided-mode-derived-p (mode &rest modes)
@@ -2651,7 +2868,8 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'."
(defun memory-limit ()
"Return an estimate of Emacs virtual memory usage, divided by 1024."
- (or (cdr (assq 'vsize (process-attributes (emacs-pid)))) 0))
+ (let ((default-directory temporary-file-directory))
+ (or (cdr (assq 'vsize (process-attributes (emacs-pid)))) 0)))
;;;; Input and display facilities.
@@ -2665,7 +2883,7 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'."
(defconst read-key-full-map
(let ((map (make-sparse-keymap)))
- (define-key map [t] 'dummy)
+ (define-key map [t] #'ignore) ;Dummy binding.
;; ESC needs to be unbound so that escape sequences in
;; `input-decode-map' are still processed by `read-key-sequence'.
@@ -2822,6 +3040,7 @@ by doing (clear-string STRING)."
(use-local-map read-passwd-map)
(setq-local inhibit-modification-hooks nil) ;bug#15501.
(setq-local show-paren-mode nil) ;bug#16091.
+ (setq-local inhibit--record-char t)
(add-hook 'post-command-hook #'read-password--hide-password nil t))
(unwind-protect
(let ((enable-recursive-minibuffers t)
@@ -2847,7 +3066,8 @@ DEFAULT specifies a default value to return if the user just types RET.
The value of DEFAULT is inserted into PROMPT.
HIST specifies a history list variable. See `read-from-minibuffer'
for details of the HIST argument.
-This function is used by the `interactive' code letter `n'."
+
+This function is used by the `interactive' code letter \"n\"."
(let ((n nil)
(default1 (if (consp default) (car default) default)))
(when default1
@@ -3079,7 +3299,7 @@ Optional argument CHARS, if non-nil, should be a list of characters;
the function will ignore any input that is not one of CHARS.
Optional argument HISTORY, if non-nil, should be a symbol that
specifies the history list variable to use for navigating in input
-history using `M-p' and `M-n', with `RET' to select a character from
+history using \\`M-p' and \\`M-n', with \\`RET' to select a character from
history.
If you bind the variable `help-form' to a non-nil value
while calling this function, then pressing `help-char'
@@ -3207,6 +3427,15 @@ switch back again to the minibuffer before entering the
character. This is not possible when using `read-key', but using
`read-key' may be less confusing to some users.")
+(defvar from--tty-menu-p nil
+ "Non-nil means the current command was invoked from a TTY menu.")
+(defun use-dialog-box-p ()
+ "Say whether the current command should prompt the user via a dialog box."
+ (and last-input-event ; not during startup
+ (or (listp last-nonmenu-event) ; invoked by a mouse event
+ from--tty-menu-p) ; invoked via TTY menu
+ use-dialog-box))
+
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question.
Return t if answer is \"y\" and nil if it is \"n\".
@@ -3253,8 +3482,11 @@ like) while `y-or-n-p' is running)."
(format "(y, n or %s) "
(key-description
(vector help-char)))
- "(y or n) "
- )))))))
+ "(y or n) "))))))
+ ;; Preserve the actual command that eventually called
+ ;; `y-or-n-p' (otherwise `repeat' will be repeating
+ ;; `exit-minibuffer').
+ (real-this-command real-this-command))
(cond
(noninteractive
(setq prompt (funcall padded prompt))
@@ -3266,10 +3498,7 @@ like) while `y-or-n-p' is running)."
((and (member str '("h" "H")) help-form) (print help-form))
(t (setq temp-prompt (concat "Please answer y or n. "
prompt))))))))
- ((and (display-popup-menus-p)
- last-input-event ; not during startup
- (listp last-nonmenu-event)
- use-dialog-box)
+ ((use-dialog-box-p)
(setq prompt (funcall padded prompt t)
answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
(y-or-n-p-use-read-key
@@ -3370,6 +3599,29 @@ user can undo the change normally."
(accept-change-group ,handle)
(cancel-change-group ,handle))))))
+(defmacro with-undo-amalgamate (&rest body)
+ "Like `progn' but perform BODY with amalgamated undo barriers.
+
+This allows multiple operations to be undone in a single step.
+When undo is disabled this behaves like `progn'."
+ (declare (indent 0) (debug t))
+ (let ((handle (make-symbol "--change-group-handle--")))
+ `(let ((,handle (prepare-change-group))
+ ;; Don't truncate any undo data in the middle of this,
+ ;; otherwise Emacs might truncate part of the resulting
+ ;; undo step: we want to mimic the behavior we'd get if the
+ ;; undo-boundaries were never added in the first place.
+ (undo-outer-limit nil)
+ (undo-limit most-positive-fixnum)
+ (undo-strong-limit most-positive-fixnum))
+ (unwind-protect
+ (progn
+ (activate-change-group ,handle)
+ ,@body)
+ (progn
+ (accept-change-group ,handle)
+ (undo-amalgamate-change-group ,handle))))))
+
(defun prepare-change-group (&optional buffer)
"Return a handle for the current buffer's state, for a change group.
If you specify BUFFER, make a handle for BUFFER's state instead.
@@ -3569,6 +3821,9 @@ If either NAME or VAL are specified, both should be specified."
(defvar suspend-resume-hook nil
"Normal hook run by `suspend-emacs', after Emacs is continued.")
+(defvar after-pdump-load-hook nil
+ "Normal hook run after loading the .pdmp file.")
+
(defvar temp-buffer-show-hook nil
"Normal hook run by `with-output-to-temp-buffer' after displaying the buffer.
When the hook runs, the temporary buffer is current, and the window it
@@ -3660,14 +3915,18 @@ Note: :data and :device are currently not supported on Windows."
(declare-function w32-shell-dos-semantics "w32-fns" nil)
-(defun shell-quote-argument (argument)
+(defun shell-quote-argument (argument &optional posix)
"Quote ARGUMENT for passing as argument to an inferior shell.
This function is designed to work with the syntax of your system's
standard shell, and might produce incorrect results with unusual shells.
-See Info node `(elisp)Security Considerations'."
- (cond
- ((eq system-type 'ms-dos)
+See Info node `(elisp)Security Considerations'.
+
+If the optional POSIX argument is non-nil, ARGUMENT is quoted
+according to POSIX shell quoting rules, regardless of the
+system's shell."
+(cond
+ ((and (not posix) (eq system-type 'ms-dos))
;; Quote using double quotes, but escape any existing quotes in
;; the argument with backslashes.
(let ((result "")
@@ -3682,7 +3941,7 @@ See Info node `(elisp)Security Considerations'."
start (1+ end))))
(concat "\"" result (substring argument start) "\"")))
- ((and (eq system-type 'windows-nt) (w32-shell-dos-semantics))
+ ((and (not posix) (eq system-type 'windows-nt) (w32-shell-dos-semantics))
;; First, quote argument so that CommandLineToArgvW will
;; understand it. See
@@ -3748,6 +4007,11 @@ Otherwise, return nil."
(setq object (indirect-function object)))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
+(defun plistp (object)
+ "Non-nil if and only if OBJECT is a valid plist."
+ (let ((len (proper-list-p object)))
+ (and len (zerop (% len 2)))))
+
(defun macrop (object)
"Non-nil if and only if OBJECT is a macro."
(let ((def (indirect-function object)))
@@ -3825,7 +4089,12 @@ remove properties specified by `yank-excluded-properties'."
This function is like `insert', except it honors the variables
`yank-handled-properties' and `yank-excluded-properties', and the
-`yank-handler' text property, in the way that `yank' does."
+`yank-handler' text property, in the way that `yank' does.
+
+It also runs the string through `yank-transform-functions'."
+ ;; Allow altering the yank string.
+ (run-hook-wrapped 'yank-transform-functions
+ (lambda (f) (setq string (funcall f string)) nil))
(let (to)
(while (setq to (next-single-property-change 0 'yank-handler string))
(insert-for-yank-1 (substring string 0 to))
@@ -3989,7 +4258,7 @@ BUFFER is the buffer (or buffer name) to associate with the process.
Process output goes at end of that buffer, unless you specify
an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
- with any buffer
+ with any buffer.
COMMAND is the shell command to run."
;; We used to use `exec' to replace the shell with the command,
;; but that failed to handle (...) and semicolon, etc.
@@ -4226,11 +4495,13 @@ in which case `save-window-excursion' cannot help."
(defmacro with-output-to-temp-buffer (bufname &rest body)
"Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
-This construct makes buffer BUFNAME empty before running BODY.
-It does not make the buffer current for BODY.
-Instead it binds `standard-output' to that buffer, so that output
-generated with `prin1' and similar functions in BODY goes into
-the buffer.
+This is a convenience macro meant for displaying help buffers and
+the like. It empties the BUFNAME buffer before evaluating BODY
+and disables undo in that buffer.
+
+It does not make the buffer current for BODY. Instead it binds
+`standard-output' to that buffer, so that output generated with
+`prin1' and similar functions in BODY goes into the buffer.
At the end of BODY, this marks buffer BUFNAME unmodified and displays
it in a window, but does not select it. The normal way to do this is
@@ -4356,8 +4627,9 @@ of that nature."
(unwind-protect
(progn
,@body)
- (unless ,modified
- (restore-buffer-modified-p nil))))))
+ (when (or (not ,modified)
+ (eq ,modified 'autosaved))
+ (restore-buffer-modified-p ,modified))))))
(defmacro with-output-to-string (&rest body)
"Execute BODY, return the text it sent to `standard-output', as a string."
@@ -4386,12 +4658,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
;; Without this, it will not be handled until the next function
;; call, and that might allow it to exit thru a condition-case
;; that intends to handle the quit signal next time.
- (eval '(ignore nil)))))
-
-;; Don't throw `throw-on-input' on those events by default.
-(setq while-no-input-ignore-events
- '(focus-in focus-out help-echo iconify-frame
- make-frame-visible selection-request))
+ (eval '(ignore nil) t))))
(defmacro while-no-input (&rest body)
"Execute BODY only as long as there's no pending input.
@@ -4441,9 +4708,6 @@ even if this catches the signal."
,@(cdr handler)))
handlers)))
-(define-obsolete-function-alias 'condition-case-no-debug
- 'condition-case-unless-debug "24.1")
-
(defmacro with-demoted-errors (format &rest body)
"Run BODY and demote any errors to simple messages.
FORMAT is a string passed to `message' to format any error message.
@@ -4451,19 +4715,21 @@ It should contain a single %-sequence; e.g., \"Error: %S\".
If `debug-on-error' is non-nil, run BODY without catching its errors.
This is to be used around code that is not expected to signal an error
-but that should be robust in the unexpected case that an error is signaled.
-
-For backward compatibility, if FORMAT is not a constant string, it
-is assumed to be part of BODY, in which case the message format
-used is \"Error: %S\"."
+but that should be robust in the unexpected case that an error is signaled."
(declare (debug t) (indent 1))
- (let ((err (make-symbol "err"))
- (format (if (and (stringp format) body) format
- (prog1 "Error: %S"
- (if format (push format body))))))
- `(condition-case-unless-debug ,err
- ,(macroexp-progn body)
- (error (message ,format ,err) nil))))
+ (let* ((err (make-symbol "err"))
+ (orig-body body)
+ (format (if (and (stringp format) body) format
+ (prog1 "Error: %S"
+ (if format (push format body)))))
+ (exp
+ `(condition-case-unless-debug ,err
+ ,(macroexp-progn body)
+ (error (message ,format ,err) nil))))
+ (if (eq orig-body body) exp
+ ;; The use without `format' is obsolete, let's warn when we bump
+ ;; into any such remaining uses.
+ (macroexp-warn-and-return "Missing format argument" exp nil nil format))))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
@@ -4765,14 +5031,12 @@ wherever possible, since it is slow."
(defsubst looking-at-p (regexp)
"\
Same as `looking-at' except this function does not change the match data."
- (let ((inhibit-changing-match-data t))
- (looking-at regexp)))
+ (looking-at regexp t))
(defsubst string-match-p (regexp string &optional start)
"\
Same as `string-match' except this function does not change the match data."
- (let ((inhibit-changing-match-data t))
- (string-match regexp string start)))
+ (string-match regexp string start t))
(defun subregexp-context-p (regexp pos &optional start)
"Return non-nil if POS is in a normal subregexp context in REGEXP.
@@ -5577,6 +5841,7 @@ If HOOKVAR is nil, `mail-send-hook' is used.
The properties used on SYMBOL are `composefunc', `sendfunc',
`abortfunc', and `hookvar'."
+ (declare (indent defun))
(put symbol 'composefunc composefunc)
(put symbol 'sendfunc sendfunc)
(put symbol 'abortfunc (or abortfunc #'kill-buffer))
@@ -5746,7 +6011,16 @@ To test whether a function can be called interactively, use
(define-obsolete-function-alias
'set-temporary-overlay-map #'set-transient-map "24.4")
-(defun set-transient-map (map &optional keep-pred on-exit)
+(defvar set-transient-map-timeout nil
+ "Timeout in seconds for deactivation of a transient keymap.
+If this is a number, it specifies the amount of idle time
+after which to deactivate the keymap set by `set-transient-map',
+thus overriding the value of the TIMEOUT argument to that function.")
+
+(defvar set-transient-map-timer nil
+ "Timer for `set-transient-map-timeout'.")
+
+(defun set-transient-map (map &optional keep-pred on-exit message timeout)
"Set MAP as a temporary keymap taking precedence over other keymaps.
Normally, MAP is used only once, to look up the very next key.
However, if the optional argument KEEP-PRED is t, MAP stays
@@ -5757,24 +6031,52 @@ if it returns non-nil, then MAP stays active.
Optional arg ON-EXIT, if non-nil, specifies a function that is
called, with no arguments, after MAP is deactivated.
-This uses `overriding-terminal-local-map', which takes precedence over all
-other keymaps. As usual, if no match for a key is found in MAP, the normal
-key lookup sequence then continues.
+Optional arg MESSAGE, if non-nil, requests display of an informative
+message after activating the transient map. If MESSAGE is a string,
+it specifies the format string for the message to display, and the %k
+specifier in the string is replaced with the list of keys from the
+transient map. Any other non-nil value of MESSAGE means to use the
+message format string \"Repeat with %k\". Upon deactivating the map,
+the displayed message will be cleared out.
+
+Optional arg TIMEOUT, if non-nil, should be a number specifying the
+number of seconds of idle time after which the map is deactivated.
+The variable `set-transient-map-timeout', if non-nil, overrides the
+value of TIMEOUT.
+
+This function uses `overriding-terminal-local-map', which takes precedence
+over all other keymaps. As usual, if no match for a key is found in MAP,
+the normal key lookup sequence then continues.
This returns an \"exit function\", which can be called with no argument
to deactivate this transient map, regardless of KEEP-PRED."
- (let* ((clearfun (make-symbol "clear-transient-map"))
+ (let* ((timeout (or set-transient-map-timeout timeout))
+ (message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'"
+ (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
(exitfun
(lambda ()
(internal-pop-keymap map 'overriding-terminal-local-map)
(remove-hook 'pre-command-hook clearfun)
+ ;; Clear the prompt after exiting.
+ (when message (message ""))
+ (when set-transient-map-timer (cancel-timer set-transient-map-timer))
(when on-exit (funcall on-exit)))))
;; Don't use letrec, because equal (in add/remove-hook) could get trapped
;; in a cycle. (bug#46326)
(fset clearfun
(lambda ()
(with-demoted-errors "set-transient-map PCH: %S"
- (unless (cond
+ (if (cond
((null keep-pred) nil)
((and (not (eq map (cadr overriding-terminal-local-map)))
(memq map (cddr overriding-terminal-local-map)))
@@ -5791,13 +6093,23 @@ to deactivate this transient map, regardless of KEEP-PRED."
t)
((eq t keep-pred)
(let ((mc (lookup-key map (this-command-keys-vector))))
+ ;; We may have a remapped command, so chase
+ ;; down that.
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
;; If the key is unbound `this-command` is
;; nil and so is `mc`.
(and mc (eq this-command mc))))
(t (funcall keep-pred)))
+ ;; Repeat the message for the next command.
+ (when message (message "%s" message))
(funcall exitfun)))))
(add-hook 'pre-command-hook clearfun)
(internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when set-transient-map-timer (cancel-timer set-transient-map-timer))
+ (setq set-transient-map-timer (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
exitfun))
;;;; Progress reporters.
@@ -6464,4 +6776,193 @@ not a list, return a one-element list containing OBJECT."
object
(list object)))
+(defmacro with-delayed-message (args &rest body)
+ "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds.
+The MESSAGE form will be evaluated immediately, but the resulting
+string will be displayed only if BODY takes longer than TIMEOUT seconds.
+
+\(fn (timeout message) &rest body)"
+ (declare (indent 1))
+ `(funcall-with-delayed-message ,(car args) ,(cadr args)
+ (lambda ()
+ ,@body)))
+
+(defun function-alias-p (func &optional noerror)
+ "Return nil if FUNC is not a function alias.
+If FUNC is a function alias, return the function alias chain.
+
+If the function alias chain contains loops, an error will be
+signalled. If NOERROR, the non-loop parts of the chain is returned."
+ (declare (side-effect-free t))
+ (let ((chain nil)
+ (orig-func func))
+ (nreverse
+ (catch 'loop
+ (while (and (symbolp func)
+ (setq func (symbol-function func))
+ (symbolp func))
+ (when (or (memq func chain)
+ (eq func orig-func))
+ (if noerror
+ (throw 'loop chain)
+ (signal 'cyclic-function-indirection (list orig-func))))
+ (push func chain))
+ chain))))
+
+(defun readablep (object)
+ "Say whether OBJECT has a readable syntax.
+This means that OBJECT can be printed out and then read back
+again by the Lisp reader. This function returns nil if OBJECT is
+unreadable, and the printed representation (from `prin1') of
+OBJECT if it is readable."
+ (declare (side-effect-free t))
+ (catch 'unreadable
+ (let ((print-unreadable-function
+ (lambda (_object _escape)
+ (throw 'unreadable nil))))
+ (prin1-to-string object))))
+
+(defun delete-line ()
+ "Delete the current line."
+ (delete-region (line-beginning-position)
+ (progn
+ (forward-line 1)
+ (point))))
+
+(defun ensure-empty-lines (&optional lines)
+ "Ensure that there are LINES number of empty lines before point.
+If LINES is nil or omitted, ensure that there is a single empty
+line before point.
+
+If called interactively, LINES is given by the prefix argument.
+
+If there are more than LINES empty lines before point, the number
+of empty lines is reduced to LINES.
+
+If point is not at the beginning of a line, a newline character
+is inserted before adjusting the number of empty lines."
+ (interactive "p")
+ (unless (bolp)
+ (insert "\n"))
+ (let ((lines (or lines 1))
+ (start (save-excursion
+ (if (re-search-backward "[^\n]" nil t)
+ (+ (point) 2)
+ (point-min)))))
+ (cond
+ ((> (- (point) start) lines)
+ (delete-region (point) (- (point) (- (point) start lines))))
+ ((< (- (point) start) lines)
+ (insert (make-string (- lines (- (point) start)) ?\n))))))
+
+(defun string-lines (string &optional omit-nulls keep-newlines)
+ "Split STRING into a list of lines.
+If OMIT-NULLS, empty lines will be removed from the results.
+If KEEP-NEWLINES, don't strip trailing newlines from the result
+lines."
+ (if (equal string "")
+ (if omit-nulls
+ nil
+ (list ""))
+ (let ((lines nil)
+ (start 0))
+ (while (< start (length string))
+ (let ((newline (string-search "\n" string start)))
+ (if newline
+ (progn
+ (when (or (not omit-nulls)
+ (not (= start newline)))
+ (let ((line (substring string start
+ (if keep-newlines
+ (1+ newline)
+ newline))))
+ (when (not (and keep-newlines omit-nulls
+ (equal line "\n")))
+ (push line lines))))
+ (setq start (1+ newline)))
+ ;; No newline in the remaining part.
+ (if (zerop start)
+ ;; Avoid a string copy if there are no newlines at all.
+ (push string lines)
+ (push (substring string start) lines))
+ (setq start (length string)))))
+ (nreverse lines))))
+
+(defun buffer-match-p (condition buffer-or-name &optional arg)
+ "Return non-nil if BUFFER-OR-NAME matches CONDITION.
+CONDITION is either:
+- a regular expression, to match a buffer name,
+- a predicate function that takes a buffer object and ARG as
+ arguments, and returns non-nil if the buffer matches,
+- a cons-cell, where the car describes how to interpret the cdr.
+ The car can be one of the following:
+ * `derived-mode': the buffer matches if the buffer's major mode
+ is derived from the major mode in the cons-cell's cdr.
+ * `major-mode': the buffer matches if the buffer's major mode
+ is eq to the cons-cell's cdr. Prefer using `derived-mode'
+ instead when both can work.
+ * `not': the cdr is interpreted as a negation of a condition.
+ * `and': the cdr is a list of recursive conditions, that all have
+ to be met.
+ * `or': the cdr is a list of recursive condition, of which at
+ least one has to be met."
+ (letrec
+ ((buffer (get-buffer buffer-or-name))
+ (match
+ (lambda (conditions)
+ (catch 'match
+ (dolist (condition conditions)
+ (when (cond
+ ((stringp condition)
+ (string-match-p condition (buffer-name buffer)))
+ ((functionp condition)
+ (if (eq 1 (cdr (func-arity condition)))
+ (funcall condition buffer)
+ (funcall condition buffer arg)))
+ ((eq (car-safe condition) 'major-mode)
+ (eq
+ (buffer-local-value 'major-mode buffer)
+ (cdr condition)))
+ ((eq (car-safe condition) 'derived-mode)
+ (provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ (cdr condition)))
+ ((eq (car-safe condition) 'not)
+ (not (funcall match (cdr condition))))
+ ((eq (car-safe condition) 'or)
+ (funcall match (cdr condition)))
+ ((eq (car-safe condition) 'and)
+ (catch 'fail
+ (dolist (c (cdr conditions))
+ (unless (funcall match c)
+ (throw 'fail nil)))
+ t)))
+ (throw 'match t)))))))
+ (funcall match (list condition))))
+
+(defun match-buffers (condition &optional buffers arg)
+ "Return a list of buffers that match CONDITION.
+See `buffer-match' for details on CONDITION. By default all
+buffers are checked, this can be restricted by passing an
+optional argument BUFFERS, set to a list of buffers to check.
+ARG is passed to `buffer-match', for predicate conditions in
+CONDITION."
+ (let (bufs)
+ (dolist (buf (or buffers (buffer-list)))
+ (when (buffer-match-p condition (get-buffer buf) arg)
+ (push buf bufs)))
+ bufs))
+
+(defmacro with-memoization (place &rest code)
+ "Return the value of CODE and stash it in PLACE.
+If PLACE's value is non-nil, then don't bother evaluating CODE
+and return the value found in PLACE instead."
+ (declare (indent 1) (debug (gv-place body)))
+ (gv-letplace (getter setter) place
+ `(or ,getter
+ ,(macroexp-let2 nil val (macroexp-progn code)
+ `(progn
+ ,(funcall setter val)
+ ,val)))))
+
;;; subr.el ends here
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 5bfad5f9b11..fdfbe207b5f 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -229,7 +229,7 @@ a list of frames to update."
(defun tab-bar--key-to-number (key)
"Return the tab number represented by KEY.
-If KEY is a symbol 'tab-N', where N is a tab number, the value is N.
+If KEY is a symbol `tab-N', where N is a tab number, the value is N.
If KEY is \\='current-tab, the value is nil.
For any other value of KEY, the value is t."
(cond
@@ -426,7 +426,7 @@ on each new frame when the global `tab-bar-mode' is disabled,
or if you want to disable the tab bar individually on each
new frame when the global `tab-bar-mode' is enabled, by using
- (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)"
+ (add-hook \\='after-make-frame-functions #\\='toggle-frame-tab-bar)"
(interactive)
(set-frame-parameter frame 'tab-bar-lines
(if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1))
@@ -474,18 +474,22 @@ you can use the command `toggle-frame-tab-bar'."
If t, start a new tab with the current buffer, i.e. the buffer
that was current before calling the command that adds a new tab
(this is the same what `make-frame' does by default).
+If the value is the symbol `window', then keep the selected
+window as a single window on the new tab, and keep all its
+window parameters except `window-atom' and `window-side'.
If the value is a string, use it as a buffer name to switch to
if such buffer exists, or switch to a buffer visiting the file or
directory that the string specifies. If the value is a function,
call it with no arguments and switch to the buffer that it returns.
-If nil, duplicate the contents of the tab that was active
+If `clone', duplicate the contents of the tab that was active
before calling the command that adds a new tab."
:type '(choice (const :tag "Current buffer" t)
+ (const :tag "Current window" window)
(string :tag "Buffer" "*scratch*")
(directory :tag "Directory" :value "~/")
(file :tag "File" :value "~/.emacs")
(function :tag "Function")
- (const :tag "Duplicate tab" nil))
+ (const :tag "Duplicate tab" clone))
:group 'tab-bar
:version "27.1")
@@ -614,7 +618,7 @@ Also add the number of windows in the window configuration."
"Maximum length of the tab name from the current buffer.
Effective when `tab-bar-tab-name-function' is customized
to `tab-bar-tab-name-truncated'."
- :type 'integer
+ :type 'natnum
:group 'tab-bar
:version "27.1")
@@ -751,9 +755,13 @@ Used by `tab-bar-format-menu-bar'."
(menu-bar-keymap))
(popup-menu menu event)))
+(defvar tab-bar-menu-bar-button
+ (propertize "Menu" 'face 'tab-bar-tab-inactive)
+ "Button for the menu bar.")
+
(defun tab-bar-format-menu-bar ()
"Produce the Menu button for the tab bar that shows the menu bar."
- `((menu-bar menu-item (propertize "Menu" 'face 'tab-bar-tab-inactive)
+ `((menu-bar menu-item ,tab-bar-menu-bar-button
tab-bar-menu-bar :help "Menu Bar")))
(defun tab-bar-format-history ()
@@ -907,8 +915,8 @@ when the tab is current. Return the result as a keymap."
(let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format)))
(rest (tab-bar-format-list rest))
(rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
- (hpos (length rest))
- (str (propertize " " 'display `(space :align-to (- right ,hpos)))))
+ (hpos (string-pixel-width (propertize rest 'face 'tab-bar)))
+ (str (propertize " " 'display `(space :align-to (- right (,hpos))))))
`((align-right menu-item ,str ignore))))
(defun tab-bar-format-global ()
@@ -918,7 +926,7 @@ When `tab-bar-format-global' is added to `tab-bar-format'
then modes that display information on the mode line
using `global-mode-string' will display the same text
on the tab bar instead."
- `((global menu-item ,(string-trim-right (format-mode-line global-mode-string)) ignore)))
+ `((global menu-item ,(format-mode-line global-mode-string) ignore)))
(defun tab-bar-format-list (format-list)
(let ((i 0))
@@ -982,10 +990,11 @@ on the tab bar instead."
(wc-point . ,(point-marker))
(wc-bl . ,bl)
(wc-bbl . ,bbl)
- (wc-history-back . ,(gethash (or frame (selected-frame))
- tab-bar-history-back))
- (wc-history-forward . ,(gethash (or frame (selected-frame))
- tab-bar-history-forward))
+ ,@(when tab-bar-history-mode
+ `((wc-history-back . ,(gethash (or frame (selected-frame))
+ tab-bar-history-back))
+ (wc-history-forward . ,(gethash (or frame (selected-frame))
+ tab-bar-history-forward))))
;; Copy other possible parameters
,@(mapcan (lambda (param)
(unless (memq (car param)
@@ -1126,19 +1135,21 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar."
(when wc-bl (set-frame-parameter nil 'buffer-list wc-bl))
(when wc-bbl (set-frame-parameter nil 'buried-buffer-list wc-bbl))
- (puthash (selected-frame)
- (and (window-configuration-p (alist-get 'wc (car wc-history-back)))
- wc-history-back)
- tab-bar-history-back)
- (puthash (selected-frame)
- (and (window-configuration-p (alist-get 'wc (car wc-history-forward)))
- wc-history-forward)
- tab-bar-history-forward)))
+ (when tab-bar-history-mode
+ (puthash (selected-frame)
+ (and (window-configuration-p (alist-get 'wc (car wc-history-back)))
+ wc-history-back)
+ tab-bar-history-back)
+ (puthash (selected-frame)
+ (and (window-configuration-p (alist-get 'wc (car wc-history-forward)))
+ wc-history-forward)
+ tab-bar-history-forward))))
(ws
(window-state-put ws nil 'safe)))
- (setq tab-bar-history-omit t)
+ (when tab-bar-history-mode
+ (setq tab-bar-history-omit t))
(when from-index
(setf (nth from-index tabs) from-tab))
@@ -1193,7 +1204,9 @@ Interactively, ARG is the prefix numeric argument and defaults to 1."
Default values are tab names sorted by recency, so you can use \
\\<minibuffer-local-map>\\[next-history-element]
to get the name of the most recently visited tab, the second
-most recent, and so on."
+most recent, and so on.
+When the tab with that NAME doesn't exist, create a new tab
+and rename it to NAME."
(interactive
(let* ((recent-tabs (mapcar (lambda (tab)
(alist-get 'name tab))
@@ -1201,7 +1214,11 @@ most recent, and so on."
(list (completing-read (format-prompt "Switch to tab by name"
(car recent-tabs))
recent-tabs nil nil nil nil recent-tabs))))
- (tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0))))
+ (let ((tab-index (tab-bar--tab-index-by-name name)))
+ (if tab-index
+ (tab-bar-select-tab (1+ tab-index))
+ (tab-bar-new-tab)
+ (tab-bar-rename-tab name))))
(defalias 'tab-bar-select-tab-by-name 'tab-bar-switch-to-tab)
@@ -1301,7 +1318,8 @@ configuration."
(let ((tab-bar-new-tab-choice 'window))
(tab-bar-new-tab))
(tab-bar-switch-to-recent-tab)
- (delete-window)
+ (let ((ignore-window-parameters t))
+ (delete-window))
(tab-bar-switch-to-recent-tab))
@@ -1348,14 +1366,26 @@ After the tab is created, the hooks in
;; Handle the case when it's called in the active minibuffer.
(when (minibuffer-selected-window)
(select-window (minibuffer-selected-window)))
+ ;; Remove window parameters that can cause problems
+ ;; with `delete-other-windows' and `split-window'.
+ (unless (eq tab-bar-new-tab-choice 'clone)
+ (set-window-parameter nil 'window-atom nil)
+ (set-window-parameter nil 'window-side nil))
(let ((ignore-window-parameters t))
- (delete-other-windows))
- (unless (eq tab-bar-new-tab-choice 'window)
- ;; Create a new window to get rid of old window parameters
- ;; (e.g. prev/next buffers) of old window.
- (split-window) (delete-window))
+ (if (eq tab-bar-new-tab-choice 'clone)
+ ;; Create new unique windows with the same layout
+ (window-state-put (window-state-get))
+ (delete-other-windows)
+ (if (eq tab-bar-new-tab-choice 'window)
+ ;; Create new unique window from remaining window
+ (window-state-put (window-state-get))
+ ;; Create a new window to get rid of old window parameters
+ ;; (e.g. prev/next buffers) of old window.
+ (split-window) (delete-window))))
+
(let ((buffer
- (if (functionp tab-bar-new-tab-choice)
+ (if (and (functionp tab-bar-new-tab-choice)
+ (not (memq tab-bar-new-tab-choice '(clone window))))
(funcall tab-bar-new-tab-choice)
(if (stringp tab-bar-new-tab-choice)
(or (get-buffer tab-bar-new-tab-choice)
@@ -1388,6 +1418,11 @@ After the tab is created, the hooks in
;; `pushnew' handles the head of tabs but not frame-parameter
(tab-bar-tabs-set tabs))
+ (when tab-bar-history-mode
+ (puthash (selected-frame) nil tab-bar-history-back)
+ (puthash (selected-frame) nil tab-bar-history-forward)
+ (setq tab-bar-history-omit t))
+
(run-hook-with-args 'tab-bar-tab-post-open-functions
(nth to-index tabs)))
@@ -1426,7 +1461,7 @@ If FROM-NUMBER is a tab number, a new tab is created from that tab."
"Clone the current tab to ARG positions to the right.
ARG and FROM-NUMBER have the same meaning as in `tab-bar-new-tab'."
(interactive "P")
- (let ((tab-bar-new-tab-choice nil)
+ (let ((tab-bar-new-tab-choice 'clone)
(tab-bar-new-tab-group t))
(tab-bar-new-tab arg from-number)))
@@ -1624,9 +1659,10 @@ happens interactively)."
(setq index (max 0 (min index (length tabs))))
(cl-pushnew tab (nthcdr index tabs))
(when (eq index 0)
- ;; pushnew handles the head of tabs but not frame-parameter
+ ;; `pushnew' handles the head of tabs but not frame-parameter
(tab-bar-tabs-set tabs))
- (tab-bar-select-tab (1+ index))))
+ (tab-bar-select-tab (1+ index)))
+ (tab-bar--update-tab-bar-lines))
(message "No more closed tabs to undo")))
@@ -1803,30 +1839,34 @@ Interactively, prompt for GROUP-NAME."
(defvar tab-bar-history-old nil
"Window configuration before the current command.")
-(defvar tab-bar-history-old-minibuffer-depth 0
- "Minibuffer depth before the current command.")
+(defvar tab-bar-history-pre-command nil
+ "Command set to `this-command' by `pre-command-hook'.")
+
+(defvar tab-bar-history-done-command nil
+ "Command handled by `window-configuration-change-hook'.")
(defun tab-bar--history-pre-change ()
- (setq tab-bar-history-old-minibuffer-depth (minibuffer-depth))
- ;; Store window-configuration before possibly entering the minibuffer.
- (when (zerop tab-bar-history-old-minibuffer-depth)
+ ;; Reset before the command could set it
+ (setq tab-bar-history-omit nil)
+ (setq tab-bar-history-pre-command this-command)
+ (when (zerop (minibuffer-depth))
(setq tab-bar-history-old
`((wc . ,(current-window-configuration))
(wc-point . ,(point-marker))))))
(defun tab-bar--history-change ()
- (when (and (not tab-bar-history-omit)
- tab-bar-history-old
- ;; Store window-configuration before possibly entering
- ;; the minibuffer.
- (zerop tab-bar-history-old-minibuffer-depth))
+ (when (and (not tab-bar-history-omit) tab-bar-history-old
+ ;; Don't register changes performed by the same command
+ ;; repeated in sequence, such as incremental window resizing.
+ (not (eq tab-bar-history-done-command tab-bar-history-pre-command))
+ (zerop (minibuffer-depth)))
(puthash (selected-frame)
(seq-take (cons tab-bar-history-old
(gethash (selected-frame) tab-bar-history-back))
tab-bar-history-limit)
- tab-bar-history-back))
- (when tab-bar-history-omit
- (setq tab-bar-history-omit nil)))
+ tab-bar-history-back)
+ (setq tab-bar-history-old nil))
+ (setq tab-bar-history-done-command tab-bar-history-pre-command))
(defun tab-bar-history-back ()
"Restore a previous window configuration used in the current tab.
@@ -1866,6 +1906,10 @@ This navigates forward in the history of window configurations."
(goto-char wc-point)))
(message "No more tab forward history"))))
+(defvar-keymap tab-bar-history-mode-map
+ "C-c <left>" #'tab-bar-history-back
+ "C-c <right>" #'tab-bar-history-forward)
+
(define-minor-mode tab-bar-history-mode
"Toggle tab history mode for the tab bar.
Tab history mode remembers window configurations used in every tab,
@@ -2276,9 +2320,9 @@ Interactively, prompt for the buffer to switch to."
(declare (advertised-calling-convention (buffer-or-name) "28.1"))
(interactive
(list (read-buffer-to-switch "Switch to buffer in other tab: ")))
- (display-buffer (window-normalize-buffer-to-switch-to buffer-or-name)
- '((display-buffer-in-tab)
- (inhibit-same-window . nil))))
+ (pop-to-buffer (window-normalize-buffer-to-switch-to buffer-or-name)
+ '((display-buffer-in-tab)
+ (inhibit-same-window . nil))))
(defun find-file-other-tab (filename &optional wildcards)
"Edit file FILENAME, in another tab.
@@ -2381,7 +2425,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(define-key map "o" 'tab-next)
(define-key map "O" 'tab-previous)
map)
- "Keymap to repeat tab switch key sequences `C-x t o o O'.
+ "Keymap to repeat tab switch key sequences \\`C-x t o o O'.
Used in `repeat-mode'.")
(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
@@ -2391,7 +2435,7 @@ Used in `repeat-mode'.")
(define-key map "m" 'tab-move)
(define-key map "M" 'tab-bar-move-tab-backward)
map)
- "Keymap to repeat tab move key sequences `C-x t m m M'.
+ "Keymap to repeat tab move key sequences \\`C-x t m m M'.
Used in `repeat-mode'.")
(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
(put 'tab-bar-move-tab-backward 'repeat-map 'tab-bar-move-repeat-map)
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 6aa3a858101..3e3b4c95595 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -288,7 +288,7 @@ variable `tab-line-tab-name-function'."
"Maximum length of the tab name from the current buffer.
Effective when `tab-line-tab-name-function' is customized
to `tab-line-tab-name-truncated-buffer'."
- :type 'integer
+ :type 'natnum
:group 'tab-line
:version "27.1")
@@ -486,7 +486,7 @@ which the tab will represent."
(funcall tab-line-tab-name-function tab tabs)
(cdr (assq 'name tab))))
(face (if selected-p
- (if (eq (selected-window) (old-selected-window))
+ (if (mode-line-window-selected-p)
'tab-line-tab-current
'tab-line-tab)
'tab-line-tab-inactive)))
@@ -495,6 +495,8 @@ which the tab will represent."
(apply 'propertize
(concat (propertize name
'keymap tab-line-tab-map
+ 'help-echo (if selected-p "Current tab"
+ "Click to select tab")
;; Don't turn mouse-1 into mouse-2 (bug#49247)
'follow-link 'ignore)
(or (and (or buffer-p (assq 'buffer tab) (assq 'close tab))
@@ -556,8 +558,9 @@ inherit from `tab-line-tab-inactive-alternate'. For use in
When TAB is a non-file-visiting buffer, make FACE inherit from
`tab-line-tab-special'. For use in
`tab-line-tab-face-functions'."
- (when (and buffer-p (not (buffer-file-name tab)))
- (setf face `(:inherit (tab-line-tab-special ,face))))
+ (let ((buffer (if buffer-p tab (cdr (assq 'buffer tab)))))
+ (when (and buffer (not (buffer-file-name buffer)))
+ (setf face `(:inherit (tab-line-tab-special ,face)))))
face)
(defun tab-line-tab-face-modified (tab _tabs face buffer-p _selected-p)
@@ -565,8 +568,9 @@ When TAB is a non-file-visiting buffer, make FACE inherit from
When TAB is a modified, file-backed buffer, make FACE inherit
from `tab-line-tab-modified'. For use in
`tab-line-tab-face-functions'."
- (when (and buffer-p (buffer-file-name tab) (buffer-modified-p tab))
- (setf face `(:inherit (tab-line-tab-modified ,face))))
+ (let ((buffer (if buffer-p tab (cdr (assq 'buffer tab)))))
+ (when (and buffer (buffer-file-name buffer) (buffer-modified-p buffer))
+ (setf face `(:inherit (tab-line-tab-modified ,face)))))
face)
(defun tab-line-tab-face-group (tab _tabs face _buffer-p _selected-p)
@@ -587,7 +591,7 @@ For use in `tab-line-tab-face-functions'."
;; handle tab-line scrolling
(window-parameter nil 'tab-line-hscroll)
;; for setting face 'tab-line-tab-current'
- (eq (selected-window) (old-selected-window))
+ (mode-line-window-selected-p)
(and (memq 'tab-line-tab-face-modified
tab-line-tab-face-functions)
(buffer-file-name) (buffer-modified-p))))
@@ -798,7 +802,9 @@ Its effect is the same as using the `previous-buffer' command
(if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers)
(switch-to-prev-buffer window)
(with-selected-window (or window (selected-window))
- (let* ((tabs (funcall tab-line-tabs-function))
+ (let* ((tabs (seq-filter
+ (lambda (tab) (or (bufferp tab) (assq 'buffer tab)))
+ (funcall tab-line-tabs-function)))
(pos (seq-position
tabs (current-buffer)
(lambda (tab buffer)
@@ -822,7 +828,9 @@ Its effect is the same as using the `next-buffer' command
(if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers)
(switch-to-next-buffer window)
(with-selected-window (or window (selected-window))
- (let* ((tabs (funcall tab-line-tabs-function))
+ (let* ((tabs (seq-filter
+ (lambda (tab) (or (bufferp tab) (assq 'buffer tab)))
+ (funcall tab-line-tabs-function)))
(pos (seq-position
tabs (current-buffer)
(lambda (tab buffer)
@@ -899,7 +907,14 @@ sight of the tab line."
(define-minor-mode tab-line-mode
"Toggle display of tab line in the windows displaying the current buffer."
:lighter nil
- (setq tab-line-format (when tab-line-mode '(:eval (tab-line-format)))))
+ (let ((default-value '(:eval (tab-line-format))))
+ (if tab-line-mode
+ ;; Preserve the existing tab-line set outside of this mode
+ (unless tab-line-format
+ (setq tab-line-format default-value))
+ ;; Reset only values set by this mode
+ (when (equal tab-line-format default-value)
+ (setq tab-line-format nil)))))
(defcustom tab-line-exclude-modes
'(completion-list-mode)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index d9085323d9a..ed48b568423 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -467,8 +467,8 @@ checksum before doing the check."
(defun tar-clip-time-string (time)
(declare (obsolete format-time-string "27.1"))
- (let ((str (current-time-string time)))
- (concat " " (substring str 4 16) (format-time-string " %Y" time))))
+ (let ((system-time-locale "C"))
+ (format-time-string " %b %e %H:%M %Y" time)))
(defun tar-grind-file-mode (mode)
"Construct a `rw-r--r--' string indicating MODE.
diff --git a/lisp/term.el b/lisp/term.el
index 68ec9db800a..a28d8c5d761 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -303,6 +303,7 @@
(require 'ange-ftp)
(require 'cl-lib))
(require 'comint) ; Password regexp.
+(require 'ansi-color)
(require 'ehelp)
(require 'ring)
(require 'shell)
@@ -522,6 +523,16 @@ This means text can automatically reflow if the window is resized."
(make-obsolete-variable 'term-suppress-hard-newline nil
"27.1")
+(defcustom term-clear-full-screen-programs t
+ "Whether to clear contents of full-screen terminal programs after exit.
+If non-nil, output of full-screen terminal programs is cleared after
+exiting them. Note however that a minority of such programs
+don't send an appropriate escape sequence to the terminal before
+exiting so their output isn't cleared regardless of this option."
+ :version "29.1"
+ :type 'boolean
+ :group 'term)
+
;; Where gud-display-frame should put the debugging arrow. This is
;; set by the marker-filter, which scans the debugger's output for
;; indications of the current pc.
@@ -710,13 +721,20 @@ Buffer local variable.")
(defvar term-ansi-at-save-pwd nil)
(defvar term-ansi-at-save-anon nil)
(defvar term-ansi-current-bold nil)
+(defvar term-ansi-current-faint nil)
+(defvar term-ansi-current-italic nil)
+(defvar term-ansi-current-underline nil)
+(defvar term-ansi-current-slow-blink nil)
+(defvar term-ansi-current-fast-blink nil)
(defvar term-ansi-current-color 0)
(defvar term-ansi-face-already-done nil)
(defvar term-ansi-current-bg-color 0)
-(defvar term-ansi-current-underline nil)
(defvar term-ansi-current-reverse nil)
(defvar term-ansi-current-invisible nil)
+(make-obsolete-variable 'term-ansi-face-already-done
+ "it doesn't have any effect." "29.1")
+
;;; Faces
(defvar ansi-term-color-vector
[term
@@ -765,12 +783,36 @@ Buffer local variable.")
:group 'term
:version "28.1")
+(defface term-faint
+ '((t :inherit ansi-color-faint))
+ "Default face to use for faint text."
+ :group 'term
+ :version "29.1")
+
+(defface term-italic
+ '((t :inherit ansi-color-italic))
+ "Default face to use for italic text."
+ :group 'term
+ :version "29.1")
+
(defface term-underline
'((t :inherit ansi-color-underline))
"Default face to use for underlined text."
:group 'term
:version "28.1")
+(defface term-slow-blink
+ '((t :inherit ansi-color-slow-blink))
+ "Default face to use for slowly blinking text."
+ :group 'term
+ :version "29.1")
+
+(defface term-fast-blink
+ '((t :inherit ansi-color-fast-blink))
+ "Default face to use for rapidly blinking text."
+ :group 'term
+ :version "29.1")
+
(defface term-color-black
'((t :inherit ansi-color-black))
"Face used to render black color code."
@@ -873,9 +915,16 @@ Term buffers are truncated from the top to be no greater than this number.
Notice that a setting of 0 means \"don't truncate anything\". This variable
is buffer-local."
:group 'term
- :type 'integer
+ :type 'natnum
:version "27.1")
+(defcustom term-bind-function-keys nil
+ "If nil, don't alter <f1>, <f2> and so on.
+If non-nil, bind these keys in `term-mode' and send them to the
+underlying shell."
+ :type 'boolean
+ :version "29.1")
+
;; Set up term-raw-map, etc.
@@ -916,6 +965,10 @@ is buffer-local."
(define-key map [next] 'term-send-next)
(define-key map [xterm-paste] #'term--xterm-paste)
(define-key map [?\C-/] #'term-send-C-_)
+
+ (when term-bind-function-keys
+ (dotimes (key 21)
+ (keymap-set map (format "<f%d>" key) #'term-send-function-key)))
map)
"Keyboard map for sending characters directly to the inferior process.")
@@ -999,11 +1052,10 @@ is buffer-local."
"Change `term-escape-char' and keymaps that depend on it."
(when term-escape-char
;; Undo previous term-set-escape-char.
- (define-key term-raw-map term-escape-char 'term-send-raw))
+ (define-key term-raw-map term-escape-char 'term-send-raw)
+ (define-key term-raw-escape-map term-escape-char nil t))
(setq term-escape-char (if (vectorp key) key (vector key)))
(define-key term-raw-map term-escape-char term-raw-escape-map)
- ;; FIXME: If we later call term-set-escape-char again with another key,
- ;; we should undo this binding.
(define-key term-raw-escape-map term-escape-char 'term-send-raw))
(term-set-escape-char (or term-escape-char ?\C-c))
@@ -1034,15 +1086,15 @@ is buffer-local."
(defun term-ansi-reset ()
(setq term-current-face 'term)
- (setq term-ansi-current-underline nil)
(setq term-ansi-current-bold nil)
+ (setq term-ansi-current-faint nil)
+ (setq term-ansi-current-italic nil)
+ (setq term-ansi-current-underline nil)
+ (setq term-ansi-current-slow-blink nil)
+ (setq term-ansi-current-fast-blink nil)
(setq term-ansi-current-reverse nil)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible nil)
- ;; Stefan thought this should be t, but could not remember why.
- ;; Setting it to t seems to cause bug#11785. Setting it to nil
- ;; again to see if there are other consequences...
- (setq term-ansi-face-already-done nil)
(setq term-ansi-current-bg-color 0))
(define-derived-mode term-mode fundamental-mode "Term"
@@ -1238,7 +1290,8 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(when (/= width term-width)
(save-excursion
(term--remove-fake-newlines)))
- (let ((point (point)))
+ (let ((point (point))
+ (home-marker (marker-position term-home-marker)))
(setq term-height height)
(setq term-width width)
(setq term-start-line-column nil)
@@ -1247,11 +1300,20 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(term--reset-scroll-region)
;; `term-set-scroll-region' causes these to be set, we have to
;; clear them again since we're changing point (Bug#30544).
+ (term--unwrap-visible-long-lines width)
(setq term-start-line-column nil)
(setq term-current-row nil)
(setq term-current-column nil)
- (goto-char point))
- (term--unwrap-visible-long-lines width)))
+ (goto-char point)
+
+ (when (term-using-alternate-sub-buffer)
+ (term-handle-deferred-scroll)
+ ;; When using an alternative sub-buffer, the home marker should
+ ;; not move forward. Bring it back by deleting text in front of
+ ;; it.
+ (when (> term-home-marker home-marker)
+ (let ((inhibit-read-only t))
+ (delete-region home-marker term-home-marker)))))))
;; Recursive routine used to check if any string in term-kill-echo-list
;; matches part of the buffer before point.
@@ -1359,14 +1421,31 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(defun term-send-del () (interactive) (term-send-raw-string "\e[3~"))
(defun term-send-backspace () (interactive) (term-send-raw-string "\C-?"))
(defun term-send-C-_ () (interactive) (term-send-raw-string "\C-_"))
+
+(defun term-send-function-key ()
+ "If bound to a function key, this will send that key to the underlying shell."
+ (interactive)
+ (let ((key (this-command-keys-vector)))
+ (when (and (= (length key) 1)
+ (symbolp (elt key 0)))
+ (let ((name (symbol-name (elt key 0))))
+ (when (string-match "\\`f\\([0-9]+\\)\\'" name)
+ (let* ((num (string-to-number (match-string 1 name)))
+ (ansi
+ (cond
+ ((<= num 5) (+ num 10))
+ ((<= num 10) (+ num 11))
+ ((<= num 14) (+ num 12))
+ ((<= num 16) (+ num 13))
+ ((<= num 20) (+ num 14)))))
+ (when ansi
+ (term-send-raw-string (format "\e[%d~" ansi)))))))))
+
(defun term-char-mode ()
"Switch to char (\"raw\") sub-mode of term mode.
Each character you type is sent directly to the inferior without
-intervention from Emacs, except for the escape character (usually C-c).
-
-This command will send existing partial lines to the terminal
-process."
+intervention from Emacs, except for the escape character (usually C-c)."
(interactive)
;; FIXME: Emit message? Cfr ilisp-raw-message
(when (term-in-line-mode)
@@ -1385,10 +1464,10 @@ process."
(when (> (point) pmark)
(unwind-protect
(progn
- (add-function :override term-input-sender #'term-send-string)
+ (add-function :override (local 'term-input-sender) #'term-send-string)
(end-of-line)
(term-send-input))
- (remove-function term-input-sender #'term-send-string))))
+ (remove-function (local 'term-input-sender) #'term-send-string))))
(term-update-mode-line)))
(defun term-line-mode ()
@@ -1498,10 +1577,10 @@ commands to use in that buffer.
(or explicit-shell-file-name
(getenv "ESHELL")
shell-file-name))))
- (set-buffer (make-term "terminal" program))
- (term-mode)
+ (let ((prog (split-string-shell-command program)))
+ (set-buffer (apply #'make-term "terminal" (car prog) nil (cdr prog))))
(term-char-mode)
- (switch-to-buffer "*terminal*"))
+ (pop-to-buffer-same-window "*terminal*"))
(defun term-exec (buffer name command startfile switches)
"Start up a process in buffer for term modes.
@@ -1580,11 +1659,14 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.")
"%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH\
:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\
:al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=^J\
+:NR:te=\\E[47l:ti=\\E[47h\
:dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\
+:mb=\\E[5m:mh=\\E[2m:ZR=\\E[23m:ZH=\\E[3m\
:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
:kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
-:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\
+:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#256:pa#32767\
+:AB=\\E[48;5;%%dm:AF=\\E[38;5;%%dm:cr=^M\
:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E[24m\
:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:"
;; : -undefine ic
@@ -2375,7 +2457,14 @@ Checks if STRING contains a password prompt as defined by
(when (term-in-line-mode)
(when (let ((case-fold-search t))
(string-match comint-password-prompt-regexp string))
- (term-send-invisible (read-passwd string)))))
+ ;; Use `run-at-time' in order not to pause execution of the
+ ;; process filter with a minibuffer
+ (run-at-time
+ 0 nil
+ (lambda (current-buf)
+ (with-current-buffer current-buf
+ (term-send-invisible (read-passwd string))))
+ (current-buffer)))))
;;; Low-level process communication
@@ -2384,7 +2473,7 @@ Checks if STRING contains a password prompt as defined by
"Long inputs send to term processes are broken up into chunks of this size.
If your process is choking on big inputs, try lowering the value."
:group 'term
- :type 'integer)
+ :type 'natnum)
(defun term-send-string (proc str)
"Send to PROC the contents of STR as input.
@@ -3104,30 +3193,34 @@ See `term-prompt-regexp'."
(term-horizontal-column)
term-ansi-current-bg-color
term-ansi-current-bold
+ term-ansi-current-faint
+ term-ansi-current-italic
+ term-ansi-current-underline
+ term-ansi-current-slow-blink
+ term-ansi-current-fast-blink
term-ansi-current-color
term-ansi-current-invisible
term-ansi-current-reverse
- term-ansi-current-underline
term-current-face)))
(?8 ;; Restore cursor (terminfo: rc, [ctlseqs]
;; "DECRC").
(when term-saved-cursor
(term-goto (nth 0 term-saved-cursor)
(nth 1 term-saved-cursor))
- (setq term-ansi-current-bg-color
- (nth 2 term-saved-cursor)
- term-ansi-current-bold
- (nth 3 term-saved-cursor)
- term-ansi-current-color
- (nth 4 term-saved-cursor)
- term-ansi-current-invisible
- (nth 5 term-saved-cursor)
- term-ansi-current-reverse
- (nth 6 term-saved-cursor)
- term-ansi-current-underline
- (nth 7 term-saved-cursor)
- term-current-face
- (nth 8 term-saved-cursor))))
+ (pcase-setq
+ `( ,_ ,_
+ ,term-ansi-current-bg-color
+ ,term-ansi-current-bold
+ ,term-ansi-current-faint
+ ,term-ansi-current-italic
+ ,term-ansi-current-underline
+ ,term-ansi-current-slow-blink
+ ,term-ansi-current-fast-blink
+ ,term-ansi-current-color
+ ,term-ansi-current-invisible
+ ,term-ansi-current-reverse
+ ,term-current-face)
+ term-saved-cursor)))
(?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS").
;; This is used by the "clear" program.
(term-reset-terminal))
@@ -3256,13 +3349,16 @@ Called as a buffer-local `post-command-hook' function in
`term-char-mode' to prevent commands from putting the buffer into
an inconsistent state by unexpectedly moving point.
-Mouse events are ignored so that mouse selection is unimpeded.
+Mouse and wheel events are ignored so that mouse selection and
+mouse wheel scrolling are unimpeded.
Only acts when the pre-command position of point was equal to the
process mark, and the `term-char-mode-point-at-process-mark'
option is enabled. See `term-set-goto-process-mark'."
(when term-goto-process-mark
- (unless (mouse-event-p last-command-event)
+ (unless (or (mouse-event-p last-command-event)
+ (memq (event-basic-type last-command-event)
+ '(wheel-down wheel-up)))
(goto-char (term-process-mark)))))
(defun term-process-mark ()
@@ -3285,133 +3381,141 @@ option is enabled. See `term-set-goto-process-mark'."
(setq term-current-row 0)
(setq term-current-column 1)
(term--reset-scroll-region)
- (setq term-insert-mode nil)
- ;; FIXME: No idea why this is here, it looks wrong. --Stef
- (setq term-ansi-face-already-done nil))
-
-(defun term--maybe-brighten-color (color bold)
- "Possibly convert COLOR to its bright variant.
-COLOR is an index into `ansi-term-color-vector'. If BOLD and
-`ansi-color-bold-is-bright' are non-nil and COLOR is a regular color,
-return the bright version of COLOR; otherwise, return COLOR."
- (if (and ansi-color-bold-is-bright bold (<= 1 color 8))
- (+ color 8)
- color))
+ (setq term-insert-mode nil))
+
+(defun term--color-as-hex (for-foreground)
+ "Return the current ANSI color as a hexadecimal color string.
+Use the current background color if FOR-FOREGROUND is nil,
+otherwise use the current foreground color."
+ (let ((color (if for-foreground term-ansi-current-color
+ term-ansi-current-bg-color)))
+ (or (ansi-color--code-as-hex (1- color))
+ (progn
+ (and ansi-color-bold-is-bright term-ansi-current-bold
+ (<= 1 color 8)
+ (setq color (+ color 8)))
+ (if for-foreground
+ (face-foreground (elt ansi-term-color-vector color)
+ nil 'default)
+ (face-background (elt ansi-term-color-vector color)
+ nil 'default))))))
;; New function to deal with ansi colorized output, as you can see you can
;; have any bold/underline/fg/bg/reverse combination. -mm
(defun term-handle-colors-array (parameter)
- (cond
-
- ;; Bold (terminfo: bold)
- ((eq parameter 1)
- (setq term-ansi-current-bold t))
-
- ;; Underline
- ((eq parameter 4)
- (setq term-ansi-current-underline t))
-
- ;; Blink (unsupported by Emacs), will be translated to bold.
- ;; This may change in the future though.
- ((eq parameter 5)
- (setq term-ansi-current-bold t))
-
- ;; Reverse (terminfo: smso)
- ((eq parameter 7)
- (setq term-ansi-current-reverse t))
-
- ;; Invisible
- ((eq parameter 8)
- (setq term-ansi-current-invisible t))
-
- ;; Reset underline (terminfo: rmul)
- ((eq parameter 24)
- (setq term-ansi-current-underline nil))
-
- ;; Reset reverse (terminfo: rmso)
- ((eq parameter 27)
- (setq term-ansi-current-reverse nil))
-
- ;; Foreground
- ((and (>= parameter 30) (<= parameter 37))
- (setq term-ansi-current-color (- parameter 29)))
-
- ;; Bright foreground
- ((and (>= parameter 90) (<= parameter 97))
- (setq term-ansi-current-color (- parameter 81)))
-
- ;; Reset foreground
- ((eq parameter 39)
- (setq term-ansi-current-color 0))
-
- ;; Background
- ((and (>= parameter 40) (<= parameter 47))
- (setq term-ansi-current-bg-color (- parameter 39)))
-
- ;; Bright foreground
- ((and (>= parameter 100) (<= parameter 107))
- (setq term-ansi-current-bg-color (- parameter 91)))
-
- ;; Reset background
- ((eq parameter 49)
- (setq term-ansi-current-bg-color 0))
-
- ;; 0 (Reset) or unknown (reset anyway)
- (t
- (term-ansi-reset)))
-
- ;; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d"
- ;; term-ansi-current-underline
- ;; term-ansi-current-reverse
- ;; term-ansi-current-bold
- ;; term-ansi-current-invisible
- ;; term-ansi-face-already-done
- ;; term-ansi-current-color
- ;; term-ansi-current-bg-color)
-
- (unless term-ansi-face-already-done
- (let ((current-color (term--maybe-brighten-color
- term-ansi-current-color
- term-ansi-current-bold))
- (current-bg-color (term--maybe-brighten-color
- term-ansi-current-bg-color
- term-ansi-current-bold)))
- (if term-ansi-current-invisible
- (let ((color
- (if term-ansi-current-reverse
- (face-foreground
- (elt ansi-term-color-vector current-color)
- nil 'default)
- (face-background
- (elt ansi-term-color-vector current-bg-color)
- nil 'default))))
- (setq term-current-face
- (list :background color
- :foreground color))
- ) ;; No need to bother with anything else if it's invisible.
- (setq term-current-face
- (list :foreground
- (face-foreground
- (elt ansi-term-color-vector current-color)
- nil 'default)
- :background
- (face-background
- (elt ansi-term-color-vector current-bg-color)
- nil 'default)
- :inverse-video term-ansi-current-reverse))
-
- (when term-ansi-current-bold
- (setq term-current-face
- `(,term-current-face :inherit term-bold)))
-
- (when term-ansi-current-underline
- (setq term-current-face
- `(,term-current-face :inherit term-underline))))))
-
- ;; (message "Debug %S" term-current-face)
- ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef
- (setq term-ansi-face-already-done nil))
+ (declare (obsolete term--handle-colors-list "29.1"))
+ (term--handle-colors-list (list parameter)))
+
+(defun term--handle-colors-list (parameters)
+ (while parameters
+ (pcase (pop parameters)
+ (1 (setq term-ansi-current-bold t)) ; (terminfo: bold)
+ (2 (setq term-ansi-current-faint t)) ; (terminfo: dim)
+ (3 (setq term-ansi-current-italic t)) ; (terminfo: sitm)
+ (4 (setq term-ansi-current-underline t)) ; (terminfo: smul)
+ (5 (setq term-ansi-current-slow-blink t)) ; (terminfo: blink)
+ (6 (setq term-ansi-current-fast-blink t))
+ (7 (setq term-ansi-current-reverse t)) ; (terminfo: smso, rev)
+ (8 (setq term-ansi-current-invisible t)) ; (terminfo: invis)
+ (21 (setq term-ansi-current-bold nil))
+ (22 (setq term-ansi-current-bold nil)
+ (setq term-ansi-current-faint nil))
+ (23 (setq term-ansi-current-italic nil)) ; (terminfo: ritm)
+ (24 (setq term-ansi-current-underline nil)) ; (terminfo: rmul)
+ (25 (setq term-ansi-current-slow-blink nil)
+ (setq term-ansi-current-fast-blink nil))
+ (27 (setq term-ansi-current-reverse nil)) ; (terminfo: rmso)
+
+ ;; Foreground (terminfo: setaf)
+ ((and param (guard (<= 30 param 37)))
+ (setq term-ansi-current-color (- param 29)))
+
+ ;; Bright foreground (terminfo: setaf)
+ ((and param (guard (<= 90 param 97)))
+ (setq term-ansi-current-color (- param 81)))
+
+ ;; Extended foreground (terminfo: setaf)
+ (38
+ (pcase (pop parameters)
+ ;; 256 color
+ (5 (if (setq term-ansi-current-color (pop parameters))
+ (cl-incf term-ansi-current-color)
+ (term-ansi-reset)))
+ ;; Full 24-bit color
+ (2 (cl-loop with color = (1+ 256) ; Base
+ for i from 16 downto 0 by 8
+ if (pop parameters)
+ do (setq color (+ color (ash it i)))
+ else return (term-ansi-reset)
+ finally
+ (if (> color (+ 1 256 #xFFFFFF))
+ (term-ansi-reset)
+ (setq term-ansi-current-color color))))
+ (_ (term-ansi-reset))))
+
+ ;; Reset foreground (terminfo: op)
+ (39 (setq term-ansi-current-color 0))
+
+ ;; Background (terminfo: setab)
+ ((and param (guard (<= 40 param 47)))
+ (setq term-ansi-current-bg-color (- param 39)))
+
+ ;; Bright background (terminfo: setab)
+ ((and param (guard (<= 100 param 107)))
+ (setq term-ansi-current-bg-color (- param 91)))
+
+ ;; Extended background (terminfo: setab)
+ (48
+ (pcase (pop parameters)
+ ;; 256 color
+ (5 (if (setq term-ansi-current-bg-color (pop parameters))
+ (cl-incf term-ansi-current-bg-color)
+ (term-ansi-reset)))
+ ;; Full 24-bit color
+ (2 (cl-loop with color = (1+ 256) ; Base
+ for i from 16 downto 0 by 8
+ if (pop parameters)
+ do (setq color (+ color (ash it i)))
+ else return (term-ansi-reset)
+ finally
+ (if (> color (+ 1 256 #xFFFFFF))
+ (term-ansi-reset)
+ (setq term-ansi-current-bg-color color))))
+ (_ (term-ansi-reset))))
+
+ ;; Reset background (terminfo: op)
+ (49 (setq term-ansi-current-bg-color 0))
+
+ ;; 0 (Reset) (terminfo: sgr0) or unknown (reset anyway)
+ (_ (term-ansi-reset))))
+
+ (let (fg bg)
+ (if term-ansi-current-invisible
+ (setq bg (term--color-as-hex term-ansi-current-reverse)
+ fg bg)
+ (setq fg (term--color-as-hex t)
+ bg (term--color-as-hex nil)))
+ (setq term-current-face
+ `( :foreground ,fg
+ :background ,bg
+ ,@(unless term-ansi-current-invisible
+ (list :inverse-video term-ansi-current-reverse)))))
+
+ (setq term-current-face
+ `(,term-current-face
+ ,@(when term-ansi-current-bold
+ '(term-bold))
+ ,@(when term-ansi-current-faint
+ '(term-faint))
+ ,@(when term-ansi-current-italic
+ '(term-italic))
+ ,@(when term-ansi-current-underline
+ '(term-underline))
+ ,@(when term-ansi-current-slow-blink
+ '(term-slow-blink))
+ ,@(when term-ansi-current-fast-blink
+ '(term-fast-blink)))))
;; Handle a character assuming (eq terminal-state 2) -
@@ -3484,22 +3588,20 @@ return the bright version of COLOR; otherwise, return COLOR."
((eq char ?h)
(cond ((eq (car params) 4) ;; (terminfo: smir)
(setq term-insert-mode t))
- ;; ((eq (car params) 47) ;; (terminfo: smcup)
- ;; (term-switch-to-alternate-sub-buffer t))
- ))
+ ((eq (car params) 47) ;; (terminfo: smcup)
+ (term-switch-to-alternate-sub-buffer t))))
;; \E[?l - DEC Private Mode Reset
((eq char ?l)
(cond ((eq (car params) 4) ;; (terminfo: rmir)
(setq term-insert-mode nil))
- ;; ((eq (car params) 47) ;; (terminfo: rmcup)
- ;; (term-switch-to-alternate-sub-buffer nil))
- ))
+ ((eq (car params) 47) ;; (terminfo: rmcup)
+ (term-switch-to-alternate-sub-buffer nil))))
;; Modified to allow ansi coloring -mm
;; \E[m - Set/reset modes, set bg/fg
- ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
+ ;;(terminfo: smso,rmso,smul,rmul,rev,bold,dim,sitm,ritm,blink,sgr0,invis,op,setab,setaf)
((eq char ?m)
- (mapc #'term-handle-colors-array params))
+ (term--handle-colors-list params))
;; \E[6n - Report cursor position (terminfo: u7)
((eq char ?n)
@@ -3540,32 +3642,35 @@ The top-most line is line 0."
(term-move-columns (- (term-current-column)))
(term-goto 0 0))
-;; (defun term-switch-to-alternate-sub-buffer (set)
-;; ;; If asked to switch to (from) the alternate sub-buffer, and already (not)
-;; ;; using it, do nothing. This test is needed for some programs (including
-;; ;; Emacs) that emit the ti termcap string twice, for unknown reason.
-;; (term-handle-deferred-scroll)
-;; (if (eq set (not (term-using-alternate-sub-buffer)))
-;; (let ((row (term-current-row))
-;; (col (term-horizontal-column)))
-;; (cond (set
-;; (goto-char (point-max))
-;; (if (not (eq (preceding-char) ?\n))
-;; (term-insert-char ?\n 1))
-;; (setq term-scroll-with-delete t)
-;; (setq term-saved-home-marker (copy-marker term-home-marker))
-;; (set-marker term-home-marker (point)))
-;; (t
-;; (setq term-scroll-with-delete
-;; (not (and (= term-scroll-start 0)
-;; (= term-scroll-end term-height))))
-;; (set-marker term-home-marker term-saved-home-marker)
-;; (set-marker term-saved-home-marker nil)
-;; (setq term-saved-home-marker nil)
-;; (goto-char term-home-marker)))
-;; (setq term-current-column nil)
-;; (setq term-current-row 0)
-;; (term-goto row col))))
+(defun term-switch-to-alternate-sub-buffer (set)
+ ;; If asked to switch to (from) the alternate sub-buffer, and already (not)
+ ;; using it, do nothing. This test is needed for some programs (including
+ ;; Emacs) that emit the ti termcap string twice, for unknown reason.
+ (term-handle-deferred-scroll)
+ (when (eq set (not (term-using-alternate-sub-buffer)))
+ (cond
+ (set
+ (goto-char (point-max))
+ (if (not (eq (preceding-char) ?\n))
+ (term-insert-char ?\n 1))
+ (setq term-scroll-with-delete t)
+ (setq term-saved-home-marker (copy-marker term-home-marker))
+ (set-marker term-home-marker (point)))
+ (t
+ (setq term-scroll-with-delete
+ (not (and (= term-scroll-start 0)
+ (= term-scroll-end (term--last-line)))))
+ (goto-char (point-max))
+ (when term-clear-full-screen-programs
+ (delete-region term-home-marker (point))
+ (set-marker term-home-marker term-saved-home-marker))
+ (set-marker term-saved-home-marker nil)
+ (setq term-saved-home-marker nil)))
+
+ (setq term-start-line-column nil)
+ (setq term-current-column nil)
+ (setq term-current-row nil)
+ (term-handle-deferred-scroll)))
;; Default value for the symbol term-command-function.
@@ -4268,7 +4373,7 @@ the process. Any more args are arguments to PROGRAM."
(defun ansi-term (program &optional new-buffer-name)
"Start a terminal-emulator in a new buffer.
This is almost the same as `term' apart from always creating a new buffer,
-and `C-x' being marked as a `term-escape-char'."
+and \\`C-x' being marked as a `term-escape-char'."
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
@@ -4291,7 +4396,10 @@ and `C-x' being marked as a `term-escape-char'."
;; for now they have the *term-ansi-term*<?> form but we'll see...
(setq term-ansi-buffer-name (generate-new-buffer-name term-ansi-buffer-name))
- (setq term-ansi-buffer-name (term-ansi-make-term term-ansi-buffer-name program))
+ (let ((prog (split-string-shell-command program)))
+ (setq term-ansi-buffer-name
+ (apply #'term-ansi-make-term term-ansi-buffer-name (car prog)
+ nil (cdr prog))))
(set-buffer term-ansi-buffer-name)
(term-mode)
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 7a48fc04c6c..f7faba9cb7c 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -59,21 +59,19 @@
(setq system-key-alist
(list
;; These are special "keys" used to pass events from C to lisp.
- (cons 1 'ns-power-off)
- (cons 2 'ns-open-file)
- (cons 3 'ns-open-temp-file)
- (cons 4 'ns-drag-file)
- (cons 5 'ns-drag-color)
- (cons 6 'ns-drag-text)
- (cons 7 'ns-change-font)
- (cons 8 'ns-open-file-line)
-;;; (cons 9 'ns-insert-working-text)
-;;; (cons 10 'ns-delete-working-text)
- (cons 11 'ns-spi-service-call)
- (cons 12 'ns-new-frame)
- (cons 13 'ns-toggle-toolbar)
- (cons 14 'ns-show-prefs)
- ))))
+ (cons 1 (make-non-key-event 'ns-power-off))
+ (cons 2 (make-non-key-event 'ns-open-file))
+ (cons 3 (make-non-key-event 'ns-open-temp-file))
+ (cons 4 (make-non-key-event 'ns-drag-file))
+ (cons 5 (make-non-key-event 'ns-drag-color))
+ (cons 6 (make-non-key-event 'ns-drag-text))
+ (cons 8 (make-non-key-event 'ns-open-file-line))
+;;; (cons 9 (make-non-key-event 'ns-insert-working-text))
+;;; (cons 10 (make-non-key-event 'ns-delete-working-text))
+ (cons 11 (make-non-key-event 'ns-spi-service-call))
+ (cons 12 (make-non-key-event 'ns-new-frame))
+ (cons 13 (make-non-key-event 'ns-toggle-toolbar))
+ (cons 14 (make-non-key-event 'ns-show-prefs))))))
(set-terminal-parameter frame 'x-setup-function-keys t)))
(defvar x-invocation-args)
@@ -419,6 +417,16 @@ the operating system.")
(setq defined-colors (cons this-color defined-colors))))
defined-colors)))
+;;;; Session management.
+
+(defvar emacs-save-session-functions nil
+ "Special hook run when a save-session event occurs.
+The functions do not get any argument.
+Functions can return non-nil to inform the session manager that the
+window system shutdown should be aborted.
+
+See also `emacs-session-save'.")
+
(provide 'term/common-win)
;;; common-win.el ends here
diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el
new file mode 100644
index 00000000000..f6e4829cad4
--- /dev/null
+++ b/lisp/term/haiku-win.el
@@ -0,0 +1,516 @@
+;;; haiku-win.el --- set up windowing on Haiku -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Support for using Haiku's BeOS derived windowing system.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
+(unless (featurep 'haiku)
+ (error "%s: Loading haiku-win without having Haiku"
+ invocation-name))
+
+;; Documentation-purposes only: actually loaded in loadup.el.
+(require 'frame)
+(require 'mouse)
+(require 'scroll-bar)
+(require 'menu-bar)
+(require 'fontset)
+(require 'dnd)
+
+(add-to-list 'display-format-alist '(".*" . haiku))
+
+;;;; Command line argument handling.
+
+(defvar x-invocation-args)
+(defvar x-command-line-resources)
+
+(defvar haiku-initialized)
+(defvar haiku-signal-invalid-refs)
+(defvar haiku-drag-track-function)
+(defvar haiku-allowed-ui-colors)
+
+(defvar haiku-dnd-selection-value nil
+ "The local value of the special `XdndSelection' selection.")
+
+(defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string)
+ (FILE_NAME . haiku-dnd-convert-file-name)
+ (text/uri-list . haiku-dnd-convert-text-uri-list))
+ "Alist of X selection types to functions that act as selection converters.
+The functions should accept a single argument VALUE, describing
+the value of the drag-and-drop selection, and return a list of
+two elements TYPE and DATA, where TYPE is a string containing the
+MIME type of DATA, and DATA is a unibyte string, or nil if the
+data could not be converted.
+
+DATA may also be a list of items; that means to add every
+individual item in DATA to the serialized message, instead of
+DATA in its entirety.
+
+DATA can optionally have a text property `type', which specifies
+the type of DATA inside the system message (see the doc string of
+`haiku-drag-message' for more details). If DATA is a list, then
+that property is obtained from the first element of DATA.")
+
+(defvar haiku-normal-selection-encoders '(haiku-select-encode-xstring
+ haiku-select-encode-utf-8-string
+ haiku-select-encode-file-name)
+ "List of functions which act as selection encoders.
+These functions accept two arguments SELECTION and VALUE, and
+return an association appropriate for a serialized system
+message (or nil if VALUE is not applicable to the encoder) that
+will be put into the system selection SELECTION. VALUE is the
+content that is being put into the selection by
+`gui-set-selection'. See the doc string of `haiku-drag-message'
+for more details on the structure of the associations.")
+
+;; This list has to be set correctly, otherwise Emacs will crash upon
+;; encountering an invalid color.
+(setq haiku-allowed-ui-colors
+ ["B_PANEL_BACKGROUND_COLOR" "B_MENU_BACKGROUND_COLOR"
+ "B_WINDOW_TAB_COLOR" "B_KEYBOARD_NAVIGATION_COLOR"
+ "B_DESKTOP_COLOR" "B_MENU_SELECTED_BACKGROUND_COLOR"
+ "B_MENU_ITEM_TEXT_COLOR" "B_MENU_SELECTED_ITEM_TEXT_COLOR"
+ "B_MENU_SELECTED_BORDER_COLOR" "B_PANEL_TEXT_COLOR"
+ "B_DOCUMENT_BACKGROUND_COLOR" "B_DOCUMENT_TEXT_COLOR"
+ "B_CONTROL_BACKGROUND_COLOR" "B_CONTROL_TEXT_COLOR"
+ "B_CONTROL_BORDER_COLOR" "B_CONTROL_HIGHLIGHT_COLOR"
+ "B_NAVIGATION_PULSE_COLOR" "B_SHINE_COLOR"
+ "B_SHADOW_COLOR" "B_TOOLTIP_BACKGROUND_COLOR"
+ "B_TOOLTIP_TEXT_COLOR" "B_WINDOW_TEXT_COLOR"
+ "B_WINDOW_INACTIVE_TAB_COLOR" "B_WINDOW_INACTIVE_TEXT_COLOR"
+ "B_WINDOW_BORDER_COLOR" "B_WINDOW_INACTIVE_BORDER_COLOR"
+ "B_CONTROL_MARK_COLOR" "B_LIST_BACKGROUND_COLOR"
+ "B_LIST_SELECTED_BACKGROUND_COLOR" "B_LIST_ITEM_TEXT_COLOR"
+ "B_LIST_SELECTED_ITEM_TEXT_COLOR" "B_SCROLL_BAR_THUMB_COLOR"
+ "B_LINK_TEXT_COLOR" "B_LINK_HOVER_COLOR"
+ "B_LINK_VISITED_COLOR" "B_LINK_ACTIVE_COLOR"
+ "B_STATUS_BAR_COLOR" "B_SUCCESS_COLOR" "B_FAILURE_COLOR"])
+
+(defvar x-colors)
+;; Also update `x-colors' to take that into account.
+(setq x-colors (append haiku-allowed-ui-colors x-colors))
+
+(defun haiku-selection-bounds (value)
+ "Return bounds of selection value VALUE.
+The return value is a list (BEG END BUF) if VALUE is a cons of
+two markers or an overlay. Otherwise, it is nil."
+ (cond ((bufferp value)
+ (with-current-buffer value
+ (when (mark t)
+ (list (mark t) (point) value))))
+ ((and (consp value)
+ (markerp (car value))
+ (markerp (cdr value)))
+ (when (and (marker-buffer (car value))
+ (buffer-name (marker-buffer (car value)))
+ (eq (marker-buffer (car value))
+ (marker-buffer (cdr value))))
+ (list (marker-position (car value))
+ (marker-position (cdr value))
+ (marker-buffer (car value)))))
+ ((overlayp value)
+ (when (overlay-buffer value)
+ (list (overlay-start value)
+ (overlay-end value)
+ (overlay-buffer value))))))
+
+(defun haiku-dnd-convert-string (value)
+ "Convert VALUE to a UTF-8 string and appropriate MIME type.
+Return a list of the appropriate MIME type, and UTF-8 data of
+VALUE as a unibyte string, or nil if VALUE was not a string."
+ (unless (stringp value)
+ (when-let ((bounds (haiku-selection-bounds value)))
+ (setq value (ignore-errors
+ (with-current-buffer (nth 2 bounds)
+ (buffer-substring (nth 0 bounds)
+ (nth 1 bounds)))))))
+ (when (stringp value)
+ (list "text/plain" (string-to-unibyte
+ (encode-coding-string value 'utf-8)))))
+
+(defun haiku-dnd-convert-file-name (value)
+ "Convert VALUE to a file system reference if it is a file name."
+ (cond ((and (stringp value)
+ (not (file-remote-p value))
+ (file-exists-p value))
+ (list "refs" (propertize (expand-file-name value)
+ 'type 'ref)))
+ ((vectorp value)
+ (list "refs"
+ (cl-loop for item across value
+ collect (propertize (expand-file-name item)
+ 'type 'ref))))))
+
+(defun haiku-dnd-convert-text-uri-list (value)
+ "Convert VALUE to a list of URLs."
+ (cond
+ ((stringp value) (list "text/uri-list"
+ (concat (url-encode-url value) "\n")))
+ ((vectorp value) (list "text/uri-list"
+ (with-temp-buffer
+ (cl-loop for tem across value
+ do (progn
+ (insert (url-encode-url tem))
+ (insert "\n")))
+ (buffer-string))))))
+
+(eval-and-compile
+ (defun haiku-get-numeric-enum (name)
+ "Return the numeric value of the system enumerator NAME."
+ (or (get name 'haiku-numeric-enum)
+ (let ((value 0)
+ (offset 0)
+ (string (symbol-name name)))
+ (cl-loop for octet across string
+ do (progn
+ (when (or (< octet 0)
+ (> octet 255))
+ (error "Out of range octet: %d" octet))
+ (setq value
+ (logior value
+ (lsh octet
+ (- (* (1- (length string)) 8)
+ offset))))
+ (setq offset (+ offset 8))))
+ (prog1 value
+ (put name 'haiku-enumerator-id value))))))
+
+(defmacro haiku-numeric-enum (name)
+ "Expand to the numeric value NAME as a system identifier."
+ (haiku-get-numeric-enum name))
+
+(declare-function x-open-connection "haikufns.c")
+(declare-function x-handle-args "common-win")
+(declare-function haiku-selection-data "haikuselect.c")
+(declare-function haiku-selection-put "haikuselect.c")
+(declare-function haiku-selection-owner-p "haikuselect.c")
+(declare-function haiku-put-resource "haikufns.c")
+(declare-function haiku-drag-message "haikuselect.c")
+
+(defun haiku--handle-x-command-line-resources (command-line-resources)
+ "Handle command line X resources specified with the option `-xrm'.
+The resources should be a list of strings in COMMAND-LINE-RESOURCES."
+ (dolist (s command-line-resources)
+ (let ((components (split-string s ":")))
+ (when (car components)
+ (haiku-put-resource (car components)
+ (string-trim-left
+ (mapconcat #'identity (cdr components) ":")))))))
+
+(cl-defmethod window-system-initialization (&context (window-system haiku)
+ &optional display)
+ "Set up the window system. WINDOW-SYSTEM must be HAIKU.
+DISPLAY may be set to the name of a display that will be initialized."
+ (cl-assert (not haiku-initialized))
+ (create-default-fontset)
+ (when x-command-line-resources
+ (haiku--handle-x-command-line-resources
+ (split-string x-command-line-resources "\n")))
+ (x-open-connection (or display "be") x-command-line-resources t)
+ (setq haiku-initialized t))
+
+(cl-defmethod frame-creation-function (params &context (window-system haiku))
+ (x-create-frame-with-faces params))
+
+(cl-defmethod handle-args-function (args &context (window-system haiku))
+ (x-handle-args args))
+
+(defun haiku--selection-type-to-mime (type)
+ "Convert symbolic selection type TYPE to its MIME equivalent.
+If TYPE is nil, return \"text/plain\"."
+ (cond
+ ((eq type 'STRING) "text/plain;charset=iso-8859-1")
+ ((eq type 'UTF8_STRING) "text/plain")
+ ((stringp type) type)
+ ((symbolp type) (symbol-name type))
+ (t "text/plain")))
+
+(defun haiku-selection-targets (clipboard)
+ "Find the types of data available from CLIPBOARD.
+CLIPBOARD should be the symbol `PRIMARY', `SECONDARY' or
+`CLIPBOARD'. Return the available types as a list of strings."
+ (mapcar #'car (haiku-selection-data clipboard nil)))
+
+(defun haiku-select-encode-xstring (_selection value)
+ "Convert VALUE to a system message association.
+VALUE will be encoded as Latin-1 (like on X Windows) and stored
+under the type `text/plain;charset=iso-8859-1'."
+ (unless (stringp value)
+ (when-let ((bounds (haiku-selection-bounds value)))
+ (setq value (ignore-errors
+ (with-current-buffer (nth 2 bounds)
+ (buffer-substring (nth 0 bounds)
+ (nth 1 bounds)))))))
+ (when (and (stringp value) (not (string-empty-p value)))
+ (list "text/plain;charset=iso-8859-1" (haiku-numeric-enum MIME)
+ (encode-coding-string value 'iso-latin-1))))
+
+(defun haiku-select-encode-utf-8-string (_selection value)
+ "Convert VALUE to a system message association.
+VALUE will be encoded as UTF-8 and stored under the type
+`text/plain'."
+ (unless (stringp value)
+ (when-let ((bounds (haiku-selection-bounds value)))
+ (setq value (ignore-errors
+ (with-current-buffer (nth 2 bounds)
+ (buffer-substring (nth 0 bounds)
+ (nth 1 bounds)))))))
+ (when (and (stringp value) (not (string-empty-p value)))
+ (list "text/plain" (haiku-numeric-enum MIME)
+ (encode-coding-string value 'utf-8-unix))))
+
+(defun haiku-select-encode-file-name (_selection value)
+ "Convert VALUE to a system message association.
+This takes the file name of VALUE's buffer (if it is an overlay
+or a pair of markers) and turns it into a file system reference."
+ (when (setq value (xselect--selection-bounds value))
+ (list "refs" 'ref (buffer-file-name (nth 2 value)))))
+
+(cl-defmethod gui-backend-get-selection (type data-type
+ &context (window-system haiku))
+ (if (eq data-type 'TARGETS)
+ (apply #'vector (mapcar #'intern
+ (haiku-selection-targets type)))
+ (if (eq type 'XdndSelection)
+ haiku-dnd-selection-value
+ (haiku-selection-data type (haiku--selection-type-to-mime data-type)))))
+
+(cl-defmethod gui-backend-set-selection (type value
+ &context (window-system haiku))
+ (if (eq type 'XdndSelection)
+ (setq haiku-dnd-selection-value value)
+ (let ((message nil))
+ (dolist (encoder haiku-normal-selection-encoders)
+ (let ((result (funcall encoder type value)))
+ (when result
+ (push result message))))
+ (haiku-selection-put type message))))
+
+(cl-defmethod gui-backend-selection-exists-p (selection
+ &context (window-system haiku))
+ (haiku-selection-data selection "text/plain"))
+
+(cl-defmethod gui-backend-selection-owner-p (selection &context (window-system haiku))
+ (haiku-selection-owner-p selection))
+
+(declare-function haiku-read-file-name "haikufns.c")
+
+(defun x-file-dialog (prompt dir &optional default-filename mustmatch only-dir-p)
+ "SKIP: real doc in xfns.c."
+ (if (eq (framep-on-display (selected-frame)) 'haiku)
+ (haiku-read-file-name (if (not (string-suffix-p ": " prompt))
+ prompt
+ (substring prompt 0 (- (length prompt) 2)))
+ (selected-frame)
+ (or dir (and default-filename
+ (file-name-directory default-filename)))
+ mustmatch only-dir-p
+ (and default-filename
+ (file-name-nondirectory default-filename)))
+ (error "x-file-dialog on a tty frame")))
+
+(defun haiku-parse-drag-actions (message)
+ "Given the drag-and-drop message MESSAGE, retrieve the desired action."
+ (let ((actions (cddr (assoc "be:actions" message)))
+ (sorted nil))
+ (dolist (action (list (haiku-numeric-enum DDCP)
+ (haiku-numeric-enum DDMV)
+ (haiku-numeric-enum DDLN)))
+ (when (member action actions)
+ (push sorted action)))
+ (cond
+ ((eql (car sorted) (haiku-numeric-enum DDCP)) 'copy)
+ ((eql (car sorted) (haiku-numeric-enum DDMV)) 'move)
+ ((eql (car sorted) (haiku-numeric-enum DDLN)) 'link)
+ (t 'private))))
+
+(defun haiku-drag-and-drop (event)
+ "Handle specified drag-n-drop EVENT."
+ (interactive "e")
+ (let* ((string (caddr event))
+ (window (posn-window (event-start event))))
+ (if (eq string 'lambda) ; This means the mouse moved.
+ (dnd-handle-movement (event-start event))
+ (let ((action (haiku-parse-drag-actions string)))
+ (cond
+ ;; Don't allow dropping on something other than the text area.
+ ;; It does nothing and doesn't work with text anyway.
+ ((posn-area (event-start event)))
+ ((assoc "refs" string)
+ (with-selected-window window
+ (dolist (filename (cddr (assoc "refs" string)))
+ (dnd-handle-one-url window action
+ (concat "file:" filename)))))
+ ((assoc "text/uri-list" string)
+ (dolist (text (cddr (assoc "text/uri-list" string)))
+ (let ((uri-list (split-string text "[\0\r\n]" t)))
+ (dolist (bf uri-list)
+ (dnd-handle-one-url window action bf)))))
+ ((assoc "text/plain" string)
+ (with-selected-window window
+ (dolist (text (cddr (assoc "text/plain" string)))
+ (unless mouse-yank-at-point
+ (goto-char (posn-point (event-start event))))
+ (dnd-insert-text window action
+ (if (multibyte-string-p text)
+ text
+ (decode-coding-string text 'undecided))))))
+ ((not (eq (cdr (assq 'type string))
+ 3003)) ; Type of the placeholder message Emacs uses
+ ; to cancel a drop on C-g.
+ (message "Don't know how to drop any of: %s"
+ (mapcar #'car string))))))))
+
+(define-key special-event-map [drag-n-drop] 'haiku-drag-and-drop)
+
+(defvaralias 'haiku-use-system-tooltips 'use-system-tooltips)
+
+(defun haiku-use-system-tooltips-watcher (&rest _ignored)
+ "Variable watcher to force a menu bar update when `use-system-tooltip' changes.
+This is necessary because on Haiku `use-system-tooltip' doesn't
+take effect on menu items until the menu bar is updated again."
+ (force-mode-line-update t))
+
+;; Note that `mouse-position' can't return the actual frame the mouse
+;; pointer is under, so this only works for the frame where the drop
+;; started.
+(defun haiku-dnd-drag-handler ()
+ "Handle mouse movement during drag-and-drop."
+ (let ((track-mouse 'drag-source)
+ (mouse-position (mouse-pixel-position)))
+ (when (car mouse-position)
+ (dnd-handle-movement (posn-at-x-y (cadr mouse-position)
+ (cddr mouse-position)
+ (car mouse-position)))
+ (redisplay))))
+
+(setq haiku-drag-track-function #'haiku-dnd-drag-handler)
+
+(defun x-begin-drag (targets &optional action frame _return-frame
+ allow-current-frame follow-tooltip)
+ "SKIP: real doc in xfns.c."
+ (unless haiku-dnd-selection-value
+ (error "No local value for XdndSelection"))
+ (let ((message nil)
+ (mouse-highlight nil)
+ (haiku-signal-invalid-refs nil))
+ (dolist (target targets)
+ (let* ((target-atom (intern target))
+ (selection-converter (cdr (assoc target-atom
+ haiku-dnd-selection-converters)))
+ (value (if (stringp haiku-dnd-selection-value)
+ (or (get-text-property 0 target-atom
+ haiku-dnd-selection-value)
+ haiku-dnd-selection-value)
+ haiku-dnd-selection-value)))
+ (when selection-converter
+ (let ((selection-result (funcall selection-converter value)))
+ (when selection-result
+ (let* ((field (cdr (assoc (car selection-result) message)))
+ (maybe-string (if (stringp (cadr selection-result))
+ (cadr selection-result)
+ (caadr selection-result))))
+ (unless (cadr field)
+ ;; Add B_MIME_TYPE to the message if the type was not
+ ;; previously specified, or the type if it was.
+ (push (or (get-text-property 0 'type maybe-string)
+ (haiku-numeric-enum MIME))
+ (alist-get (car selection-result) message
+ nil nil #'equal))))
+ (if (not (consp (cadr selection-result)))
+ (push (cadr selection-result)
+ (cdr (alist-get (car selection-result) message
+ nil nil #'equal)))
+ (dolist (tem (cadr selection-result))
+ (push tem
+ (cdr (alist-get (car selection-result) message
+ nil nil #'equal))))))))))
+ (prog1 (or (and (symbolp action)
+ action)
+ 'XdndActionCopy)
+ (haiku-drag-message (or frame (selected-frame))
+ message allow-current-frame
+ follow-tooltip))))
+
+(add-variable-watcher 'use-system-tooltips #'haiku-use-system-tooltips-watcher)
+
+
+;;;; Session management.
+
+(declare-function haiku-save-session-reply "haikufns.c")
+
+(defun emacs-session-save ()
+ "SKIP: real doc in x-win.el."
+ (with-temp-buffer ; Saving sessions is not yet supported.
+ (condition-case nil
+ ;; A return of t means cancel the shutdown.
+ (run-hook-with-args-until-success
+ 'emacs-save-session-functions)
+ (error t))))
+
+(defun handle-save-session (_event)
+ "SKIP: real doc in xsmfns.c."
+ (interactive "e")
+ (let ((cancel-shutdown t))
+ (unwind-protect
+ (setq cancel-shutdown (emacs-session-save))
+ (haiku-save-session-reply (not cancel-shutdown)))
+ ;; The App Server will kill Emacs after receiving the reply, but
+ ;; the Deskbar will not, so kill ourself here.
+ (unless cancel-shutdown (kill-emacs))))
+
+
+;;;; Cursors.
+
+;; We use the same interface as X, but the cursor numbers are
+;; different, and there are also less cursors.
+
+(defconst x-pointer-X-cursor 5) ; B_CURSOR_ID_CROSS_HAIR
+(defconst x-pointer-arrow 1) ; B_CURSOR_ID_SYSTEM_DEFAULT
+(defconst x-pointer-bottom-left-corner 22) ; B_CURSOR_ID_RESIZE_SOUTH_WEST
+(defconst x-pointer-bottom-right-corner 21) ; B_CURSOR_ID_RESIZE_SOUTH_EAST
+(defconst x-pointer-bottom-side 17) ; B_CURSOR_ID_RESIZE_SOUTH
+(defconst x-pointer-clock 14) ; B_CURSOR_ID_PROGRESS
+(defconst x-pointer-cross 5) ; B_CURSOR_ID_CROSS_HAIR
+(defconst x-pointer-cross-reverse 5) ; B_CURSOR_ID_CROSS_HAIR
+(defconst x-pointer-crosshair 5) ; B_CURSOR_ID_CROSS_HAIR
+(defconst x-pointer-diamond-cross 5) ; B_CURSOR_ID_CROSS_HAIR
+(defconst x-pointer-hand1 7) ; B_CURSOR_ID_GRAB
+(defconst x-pointer-hand2 8) ; B_CURSOR_ID_GRABBING
+(defconst x-pointer-left-side 18) ; B_CURSOR_ID_RESIZE_WEST
+(defconst x-pointer-right-side 16) ; B_CURSOR_ID_RESIZE_EAST
+(defconst x-pointer-sb-down-arrow 17) ; B_CURSOR_ID_RESIZE_SOUTH
+(defconst x-pointer-sb-left-arrow 18) ; B_CURSOR_ID_RESIZE_WEST
+(defconst x-pointer-sb-right-arrow 16) ; B_CURSOR_ID_RESIZE_EAST
+(defconst x-pointer-sb-up-arrow 16) ; B_CURSOR_ID_RESIZE_NORTH
+(defconst x-pointer-target 5) ; B_CURSOR_ID_CROSS_HAIR
+(defconst x-pointer-top-left-corner 20) ; B_CURSOR_ID_RESIZE_NORTH_WEST
+(defconst x-pointer-top-right-corner 19) ; B_CURSOR_ID_RESIZE_NORTH_EAST
+(defconst x-pointer-top-side 16) ; B_CURSOR_ID_RESIZE_NORTH
+(defconst x-pointer-watch 14) ; B_CURSOR_ID_PROGRESS
+(defconst x-pointer-invisible 12) ; B_CURSOR_ID_NO_CURSOR
+
+(provide 'haiku-win)
+(provide 'term/haiku-win)
+
+;;; haiku-win.el ends here
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index ffcd7a852c2..e26191b33b4 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -97,8 +97,6 @@ The properties returned may include `top', `left', `height', and `width'."
;;;; Keyboard mapping.
-(define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1")
-
;; Here are some Nextstep-like bindings for command key sequences.
(define-key global-map [?\s-,] 'customize)
(define-key global-map [?\s-'] 'next-window-any-frame)
@@ -142,7 +140,7 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [?\s-p] 'ns-print-buffer)
(define-key global-map [?\s-q] 'save-buffers-kill-emacs)
(define-key global-map [?\s-s] 'save-buffer)
-(define-key global-map [?\s-t] 'ns-popup-font-panel)
+(define-key global-map [?\s-t] 'menu-set-font)
(define-key global-map [?\s-u] 'revert-buffer)
(define-key global-map [?\s-v] 'yank)
(define-key global-map [?\s-w] 'delete-frame)
@@ -176,7 +174,6 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [ns-power-off] 'save-buffers-kill-emacs)
(define-key global-map [ns-open-file] 'ns-find-file)
(define-key global-map [ns-open-temp-file] [ns-open-file])
-(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
(define-key global-map [ns-new-frame] 'make-frame)
@@ -508,25 +505,28 @@ unless the current buffer is a scratch buffer."
Switch to a buffer editing the last file dropped, or insert the
string dropped into the current buffer."
(interactive "e")
- (let* ((window (posn-window (event-start event)))
- (arg (car (cdr (cdr event))))
- (type (car arg))
- (operations (car (cdr arg)))
- (objects (cdr (cdr arg)))
- (string (mapconcat 'identity objects "\n")))
- (set-frame-selected-window nil window)
- (raise-frame)
- (setq window (selected-window))
- (cond ((or (memq 'ns-drag-operation-generic operations)
- (memq 'ns-drag-operation-copy operations))
- ;; Perform the default/copy action.
- (dolist (data objects)
- (dnd-handle-one-url window 'private (if (eq type 'file)
- (concat "file:" data)
- data))))
- (t
- ;; Insert the text as is.
- (dnd-insert-text window 'private string)))))
+ (if (eq (car-safe (cdr-safe (cdr-safe event))) 'lambda)
+ (dnd-handle-movement (event-start event))
+ (let* ((window (posn-window (event-start event)))
+ (arg (car (cdr (cdr event))))
+ (type (car arg))
+ (operations (car (cdr arg)))
+ (objects (cdr (cdr arg)))
+ (string (mapconcat 'identity objects "\n")))
+ (set-frame-selected-window nil window)
+ (raise-frame)
+ (setq window (selected-window))
+ (goto-char (posn-point (event-start event)))
+ (cond ((or (memq 'ns-drag-operation-generic operations)
+ (memq 'ns-drag-operation-copy operations))
+ ;; Perform the default/copy action.
+ (dolist (data objects)
+ (dnd-handle-one-url window 'private (if (eq type 'file)
+ (concat "file:" data)
+ data))))
+ (t
+ ;; Insert the text as is.
+ (dnd-insert-text window 'private string))))))
(global-set-key [drag-n-drop] 'ns-drag-n-drop)
@@ -620,34 +620,6 @@ If FRAME is nil, the change applies to the selected frame."
;; Needed for font listing functions under both backend and normal
(setq scalable-fonts-allowed t)
-;; Set to use font panel instead
-(declare-function ns-popup-font-panel "nsfns.m" (&optional frame))
-(defalias 'x-select-font 'ns-popup-font-panel "Pop up the font panel.
-This function has been overloaded in Nextstep.")
-(defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel.
-This function has been overloaded in Nextstep.")
-
-;; nsterm.m
-(defvar ns-input-font)
-(defvar ns-input-fontsize)
-
-(defun ns-respond-to-change-font ()
- "Set the font chosen in the font-picker panel.
-Respond to changeFont: event, expecting ns-input-font and
-ns-input-fontsize of new font."
- (interactive)
- (let ((face 'default))
- (set-face-attribute face t
- :family ns-input-font
- :height (* 10 ns-input-fontsize))
- (set-face-attribute face (selected-frame)
- :family ns-input-font
- :height (* 10 ns-input-fontsize))
- (let ((spec (list (list t (face-attr-construct 'default)))))
- (put face 'customized-face spec)
- (custom-push-theme 'theme-face face 'user 'set spec)
- (put face 'face-modified nil))))
-
;; Default fontset for macOS. This is mainly here to show how a fontset
;; can be set up manually. Ordinarily, fontsets are auto-created whenever
;; a font is chosen by
@@ -708,10 +680,6 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;;;; Pasteboard support.
-(define-obsolete-function-alias 'ns-store-cut-buffer-internal
- 'gui-set-selection "24.1")
-
-
(defun ns-copy-including-secondary ()
(interactive)
(call-interactively 'kill-ring-save)
@@ -867,10 +835,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; For Darwin nothing except UTF-8 makes sense.
(when (eq system-type 'darwin)
(add-hook 'before-init-hook
- #'(lambda ()
- (setq locale-coding-system 'utf-8-unix)
- (setq default-process-coding-system
- '(utf-8-unix . utf-8-unix)))))
+ (lambda ()
+ (setq locale-coding-system 'utf-8-unix)
+ (setq default-process-coding-system
+ '(utf-8-unix . utf-8-unix)))))
;; Mac OS X Lion introduces PressAndHold, which is unsupported by this port.
;; See this thread for more details:
@@ -896,12 +864,18 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(declare-function ns-disown-selection-internal "nsselect.m" (selection))
(declare-function ns-selection-owner-p "nsselect.m" (&optional selection))
(declare-function ns-selection-exists-p "nsselect.m" (&optional selection))
+(declare-function ns-begin-drag "nsselect.m")
+
+(defvar ns-dnd-selection-value nil
+ "The value of the special `XdndSelection' selection on NS.")
+
(declare-function ns-get-selection "nsselect.m" (selection-symbol target-type))
-(cl-defmethod gui-backend-set-selection (selection value
- &context (window-system ns))
- (if value (ns-own-selection-internal selection value)
- (ns-disown-selection-internal selection)))
+(cl-defmethod gui-backend-set-selection (selection value &context (window-system ns))
+ (if (eq selection 'XdndSelection)
+ (setq ns-dnd-selection-value value)
+ (if value (ns-own-selection-internal selection value)
+ (ns-disown-selection-internal selection))))
(cl-defmethod gui-backend-selection-owner-p (selection
&context (window-system ns))
@@ -915,6 +889,41 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
&context (window-system ns))
(ns-get-selection selection-symbol target-type))
+(defun x-begin-drag (targets &optional action frame return-frame
+ allow-current-frame follow-tooltip)
+ "SKIP: real doc in xfns.c."
+ (unless ns-dnd-selection-value
+ (error "No local value for XdndSelection"))
+ (let ((pasteboard nil))
+ (when (and (member "STRING" targets)
+ (stringp ns-dnd-selection-value))
+ (push (cons 'string ns-dnd-selection-value) pasteboard))
+ (when (and (member "FILE_NAME" targets)
+ (file-exists-p ns-dnd-selection-value))
+ (let ((value (if (stringp ns-dnd-selection-value)
+ (or (get-text-property 0 'FILE_NAME
+ ns-dnd-selection-value)
+ ns-dnd-selection-value)
+ ns-dnd-selection-value)))
+ (if (vectorp value)
+ (push (cons 'file
+ (cl-loop for file across value
+ collect (expand-file-name file)))
+ pasteboard)
+ (push (cons 'file
+ (url-encode-url (concat "file://"
+ (expand-file-name
+ ns-dnd-selection-value))))
+ pasteboard))))
+ (ns-begin-drag frame pasteboard action return-frame
+ allow-current-frame follow-tooltip)))
+
+(defun ns-handle-drag-motion (frame x y)
+ "Handle mouse movement on FRAME at X and Y during drag-and-drop.
+This moves point to the current mouse position if
+ `dnd-indicate-insertion-point' is enabled."
+ (dnd-handle-movement (posn-at-x-y x y frame)))
+
(provide 'ns-win)
(provide 'term/ns-win)
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 327d51f2759..514267a52d6 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -246,6 +246,14 @@ Consult the selection. Treat empty strings as if they were unset."
;; if it does not exist, or exists and compares
;; equal with the last text we've put into the
;; Windows clipboard.
+ ;; NOTE: that variable is actually the last text any program
+ ;; (not just Emacs) has put into the windows clipboard (up
+ ;; until the last time Emacs read or set the clipboard), so
+ ;; it's not suitable for checking actual selection
+ ;; ownership. This should not result in a bug for the current
+ ;; uses of gui-backend-selection-owner however, since they
+ ;; don't actually care about selection ownership, but about
+ ;; the selected text having changed.
(cond
((not text) t)
((equal text gui--last-selected-text-clipboard) text)
diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el
new file mode 100644
index 00000000000..ee1aad3d0ec
--- /dev/null
+++ b/lisp/term/pgtk-win.el
@@ -0,0 +1,400 @@
+;;; pgtk-win.el --- parse relevant switches and set up for Pure-GTK -*- lexical-binding: t -*-
+
+;; Copyright (C) 1995, 2001-2020, 2022 Free Software Foundation, Inc.
+
+;; Author: FSF
+;; Keywords: terminals
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(unless (featurep 'pgtk)
+ (error "%s: Loading pgtk-win.el but not compiled with PGTK."
+ invocation-name))
+
+;; Documentation-purposes only: actually loaded in loadup.el.
+(require 'term/common-win)
+(require 'frame)
+(require 'mouse)
+(require 'scroll-bar)
+(require 'faces)
+(require 'menu-bar)
+(require 'fontset)
+(require 'dnd)
+(require 'pgtk-dnd)
+
+(defvar x-invocation-args)
+(defvar x-command-line-resources)
+(defvar pgtk-input-file)
+(defvar pgtk-use-im-context-on-new-connection)
+
+(declare-function pgtk-use-im-context "pgtkim.c")
+
+(defun pgtk-drag-n-drop (event &optional new-frame force-text)
+ "Edit the files listed in the drag-n-drop EVENT.
+Switch to a buffer editing the last file dropped."
+ (interactive "e")
+ (let* ((window (posn-window (event-start event)))
+ (arg (car (cdr (cdr event))))
+ (type (car arg))
+ (data (car (cdr arg)))
+ (url-or-string (cond ((eq type 'file)
+ (concat "file:" data))
+ (t data))))
+ (set-frame-selected-window nil window)
+ (when new-frame
+ (select-frame (make-frame)))
+ (raise-frame)
+ (setq window (selected-window))
+ (if force-text
+ (dnd-insert-text window 'private data)
+ (dnd-handle-one-url window 'private url-or-string))))
+
+(defun pgtk-drag-n-drop-other-frame (event)
+ "Edit the files listed in the drag-n-drop EVENT, in other frames.
+May create new frames, or reuse existing ones. The frame editing
+the last file dropped is selected."
+ (interactive "e")
+ (pgtk-drag-n-drop event t))
+
+(defun pgtk-drag-n-drop-as-text (event)
+ "Drop the data in EVENT as text."
+ (interactive "e")
+ (pgtk-drag-n-drop event nil t))
+
+(defun pgtk-drag-n-drop-as-text-other-frame (event)
+ "Drop the data in EVENT as text in a new frame."
+ (interactive "e")
+ (pgtk-drag-n-drop event t t))
+
+(global-set-key [drag-n-drop] 'pgtk-drag-n-drop)
+
+(defun pgtk-suspend-error ()
+ "Don't allow suspending if any of the frames are PGTK frames."
+ (if (memq 'pgtk (mapcar 'window-system (frame-list)))
+ (error "Cannot suspend Emacs while a PGTK GUI frame exists")))
+
+(defvar pgtk-initialized nil
+ "Non-nil if pure-GTK windowing has been initialized.")
+
+(declare-function x-handle-args "common-win" (args))
+(declare-function x-open-connection "pgtkfns.c"
+ (display &optional xrm-string must-succeed))
+(declare-function pgtk-set-resource "pgtkfns.c" (attribute value))
+
+;; Do the actual window system setup here; the above code just defines
+;; functions and variables that we use now.
+(cl-defmethod window-system-initialization (&context (window-system pgtk)
+ &optional display)
+ "Initialize the PGTK window system.
+WINDOW-SYSTEM is, aptly, `pgtk'.
+DISPLAY is the name of the display Emacs should connect to."
+ (cl-assert (not pgtk-initialized))
+
+ ;; PENDING: not needed?
+ (setq command-line-args (x-handle-args command-line-args))
+
+ ;; Make sure we have a valid resource name.
+ (when (boundp 'x-resource-name)
+ (unless (stringp x-resource-name)
+ (let (i)
+ (setq x-resource-name (copy-sequence invocation-name))
+
+ ;; Change any . or * characters in x-resource-name to hyphens,
+ ;; so as not to choke when we use it in X resource queries.
+ (while (setq i (string-match "[.*]" x-resource-name))
+ (aset x-resource-name i ?-)))))
+
+ ;; Setup the default fontset.
+ (create-default-fontset)
+ ;; Create the standard fontset.
+ (condition-case err
+ (create-fontset-from-fontset-spec standard-fontset-spec t)
+ (error (display-warning
+ 'initialization
+ (format "Creation of the standard fontset failed: %s" err)
+ :error)))
+
+ (x-open-connection (or display
+ x-display-name)
+ x-command-line-resources
+ ;; Exit Emacs with fatal error if this fails and we
+ ;; are the initial display.
+ (= (length (frame-list)) 0))
+
+ (x-apply-session-resources)
+
+ ;; Don't let Emacs suspend under PGTK.
+ (add-hook 'suspend-hook 'pgtk-suspend-error)
+
+ (setq pgtk-initialized t))
+
+;; Any display name is OK.
+(add-to-list 'display-format-alist '(".*" . pgtk))
+
+(cl-defmethod handle-args-function (args &context (window-system pgtk))
+ (x-handle-args args))
+
+(cl-defmethod frame-creation-function (params &context (window-system pgtk))
+ (x-create-frame-with-faces params))
+
+(declare-function pgtk-own-selection-internal "pgtkselect.c" (selection value &optional frame))
+(declare-function pgtk-disown-selection-internal "pgtkselect.c" (selection &optional terminal))
+(declare-function pgtk-selection-owner-p "pgtkselect.c" (&optional selection terminal))
+(declare-function pgtk-selection-exists-p "pgtkselect.c" (&optional selection terminal))
+(declare-function pgtk-get-selection-internal "pgtkselect.c" (selection-symbol target-type &optional terminal))
+
+(cl-defmethod gui-backend-set-selection (selection value
+ &context (window-system pgtk))
+ (if value (pgtk-own-selection-internal selection value)
+ (pgtk-disown-selection-internal selection)))
+
+(cl-defmethod gui-backend-selection-owner-p (selection
+ &context (window-system pgtk))
+ (pgtk-selection-owner-p selection))
+
+(cl-defmethod gui-backend-selection-exists-p (selection
+ &context (window-system pgtk))
+ (pgtk-selection-exists-p selection))
+
+(cl-defmethod gui-backend-get-selection (selection-symbol target-type
+ &context (window-system pgtk))
+ (pgtk-get-selection-internal selection-symbol target-type))
+
+
+(defvar pgtk-preedit-overlay nil)
+
+(defun pgtk-preedit-text (event)
+ "An internal function to display preedit text from input method.
+
+EVENT is a `preedit-text-event'."
+ (interactive "e")
+ (when pgtk-preedit-overlay
+ (delete-overlay pgtk-preedit-overlay))
+ (setq pgtk-preedit-overlay nil)
+
+ (let ((ovstr "")
+ (idx 0)
+ atts ov str color face-name)
+ (dolist (part (nth 1 event))
+ (setq str (car part))
+ (setq face-name (intern (format "pgtk-im-%d" idx)))
+ (eval
+ `(defface ,face-name nil "face of input method preedit"))
+ (setq atts nil)
+ (when (setq color (cdr-safe (assq 'fg (cdr part))))
+ (setq atts (append atts `(:foreground ,color))))
+ (when (setq color (cdr-safe (assq 'bg (cdr part))))
+ (setq atts (append atts `(:background ,color))))
+ (when (setq color (cdr-safe (assq 'ul (cdr part))))
+ (setq atts (append atts `(:underline ,color))))
+ (face-spec-set face-name `((t . ,atts)))
+ (add-text-properties 0 (length str) `(face ,face-name) str)
+ (setq ovstr (concat ovstr str))
+ (setq idx (1+ idx)))
+
+ (setq ov (make-overlay (point) (point)))
+ (overlay-put ov 'before-string ovstr)
+ (setq pgtk-preedit-overlay ov)))
+
+(define-key special-event-map [preedit-text] 'pgtk-preedit-text)
+
+(defun pgtk-use-im-context-handler ()
+ "Set up input context usage after Emacs initialization."
+ (when (eq window-system 'pgtk)
+ (pgtk-use-im-context pgtk-use-im-context-on-new-connection)))
+
+(add-hook 'after-init-hook #'pgtk-use-im-context-handler)
+
+(defcustom x-gtk-stock-map
+ (mapcar (lambda (arg)
+ (cons (purecopy (car arg)) (purecopy (cdr arg))))
+ '(
+ ("etc/images/new" . ("document-new" "gtk-new"))
+ ("etc/images/open" . ("document-open" "gtk-open"))
+ ("etc/images/diropen" . "n:system-file-manager")
+ ("etc/images/close" . ("window-close" "gtk-close"))
+ ("etc/images/save" . ("document-save" "gtk-save"))
+ ("etc/images/saveas" . ("document-save-as" "gtk-save-as"))
+ ("etc/images/undo" . ("edit-undo" "gtk-undo"))
+ ("etc/images/cut" . ("edit-cut" "gtk-cut"))
+ ("etc/images/copy" . ("edit-copy" "gtk-copy"))
+ ("etc/images/paste" . ("edit-paste" "gtk-paste"))
+ ("etc/images/search" . ("edit-find" "gtk-find"))
+ ("etc/images/print" . ("document-print" "gtk-print"))
+ ("etc/images/preferences" . ("preferences-system" "gtk-preferences"))
+ ("etc/images/help" . ("help-browser" "gtk-help"))
+ ("etc/images/left-arrow" . ("go-previous" "gtk-go-back"))
+ ("etc/images/right-arrow" . ("go-next" "gtk-go-forward"))
+ ("etc/images/home" . ("go-home" "gtk-home"))
+ ("etc/images/jump-to" . ("go-jump" "gtk-jump-to"))
+ ("etc/images/index" . ("gtk-search" "gtk-index"))
+ ("etc/images/exit" . ("application-exit" "gtk-quit"))
+ ("etc/images/cancel" . "gtk-cancel")
+ ("etc/images/info" . ("dialog-information" "gtk-info"))
+ ("etc/images/bookmark_add" . "n:bookmark_add")
+ ;; Used in Gnus and/or MH-E:
+ ("etc/images/attach" . ("mail-attachment" "gtk-attach"))
+ ("etc/images/connect" . "gtk-connect")
+ ("etc/images/contact" . "gtk-contact")
+ ("etc/images/delete" . ("edit-delete" "gtk-delete"))
+ ("etc/images/describe" . ("document-properties" "gtk-properties"))
+ ("etc/images/disconnect" . "gtk-disconnect")
+ ;; ("etc/images/exit" . "gtk-exit")
+ ("etc/images/lock-broken" . "gtk-lock_broken")
+ ("etc/images/lock-ok" . "gtk-lock_ok")
+ ("etc/images/lock" . "gtk-lock")
+ ("etc/images/next-page" . "gtk-next-page")
+ ("etc/images/refresh" . ("view-refresh" "gtk-refresh"))
+ ("etc/images/search-replace" . "edit-find-replace")
+ ("etc/images/sort-ascending" . ("view-sort-ascending" "gtk-sort-ascending"))
+ ("etc/images/sort-column-ascending" . "gtk-sort-column-ascending")
+ ("etc/images/sort-criteria" . "gtk-sort-criteria")
+ ("etc/images/sort-descending" . ("view-sort-descending"
+ "gtk-sort-descending"))
+ ("etc/images/sort-row-ascending" . "gtk-sort-row-ascending")
+ ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check"))
+ ("images/gnus/toggle-subscription" . "gtk-task-recurring")
+ ("images/mail/compose" . ("mail-message-new" "gtk-mail-compose"))
+ ("images/mail/copy" . "gtk-mail-copy")
+ ("images/mail/forward" . "gtk-mail-forward")
+ ("images/mail/inbox" . "gtk-inbox")
+ ("images/mail/move" . "gtk-mail-move")
+ ("images/mail/not-spam" . "gtk-not-spam")
+ ("images/mail/outbox" . "gtk-outbox")
+ ("images/mail/reply-all" . "gtk-mail-reply-to-all")
+ ("images/mail/reply" . "gtk-mail-reply")
+ ("images/mail/save-draft" . "gtk-mail-handling")
+ ("images/mail/send" . ("mail-send" "gtk-mail-send"))
+ ("images/mail/spam" . "gtk-spam")
+ ;; Used for GDB Graphical Interface
+ ("images/gud/break" . "gtk-no")
+ ("images/gud/recstart" . ("media-record" "gtk-media-record"))
+ ("images/gud/recstop" . ("media-playback-stop" "gtk-media-stop"))
+ ;; No themed versions available:
+ ;; mail/preview (combining stock_mail and stock_zoom)
+ ;; mail/save (combining stock_mail, stock_save and stock_convert)
+ ))
+ "How icons for tool bars are mapped to Gtk+ stock items.
+Emacs must be compiled with the Gtk+ toolkit for this to have any effect.
+A value that begins with n: denotes a named icon instead of a stock icon."
+ :version "22.2"
+ :type '(choice (repeat
+ (choice symbol
+ (cons (string :tag "Emacs icon")
+ (choice (group (string :tag "Named")
+ (string :tag "Stock"))
+ (string :tag "Stock/named"))))))
+ :group 'pgtk)
+
+(defcustom icon-map-list '(x-gtk-stock-map)
+ "A list of alists that map icon file names to stock/named icons.
+The alists are searched in the order they appear. The first match is used.
+The keys in the alists are file names without extension and with two directory
+components. For example, to map /usr/share/emacs/22.1.1/etc/images/open.xpm
+to stock item gtk-open, use:
+
+ (\"etc/images/open\" . \"gtk-open\")
+
+Themes also have named icons. To map to one of those, use n: before the name:
+
+ (\"etc/images/diropen\" . \"n:system-file-manager\")
+
+The list elements are either the symbol name for the alist or the
+alist itself.
+
+If you don't want stock icons, set the variable to nil."
+ :version "22.2"
+ :type '(choice (const :tag "Don't use stock icons" nil)
+ (repeat (choice symbol
+ (cons (string :tag "Emacs icon")
+ (string :tag "Stock/named")))))
+ :group 'pgtk)
+
+(defconst x-gtk-stock-cache (make-hash-table :weakness t :test 'equal))
+
+(defun x-gtk-map-stock (file)
+ "Map icon with file name FILE to a Gtk+ stock name.
+This uses `icon-map-list' to map icon file names to stock icon names."
+ (when (stringp file)
+ (or (gethash file x-gtk-stock-cache)
+ (puthash
+ file
+ (save-match-data
+ (let* ((file-sans (file-name-sans-extension file))
+ (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)"
+ file-sans)
+ (match-string 1 file-sans)))
+ (icon-map icon-map-list)
+ elem value)
+ (while (and (null value) icon-map)
+ (setq elem (car icon-map)
+ value (assoc-string (or key file-sans)
+ (if (symbolp elem)
+ (symbol-value elem)
+ elem))
+ icon-map (cdr icon-map)))
+ (and value (cdr value))))
+ x-gtk-stock-cache))))
+
+(declare-function accelerate-menu "pgtkmenu.c" (&optional frame) t)
+
+(defun pgtk-menu-bar-open (&optional frame)
+ "Open the menu bar if it is shown.
+`popup-menu' is used if it is off."
+ (interactive "i")
+ (cond
+ ((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0)))
+ (fboundp 'accelerate-menu))
+ (accelerate-menu frame))
+ (t
+ (popup-menu (mouse-menu-bar-map) last-nonmenu-event))))
+
+(defun pgtk-device-class (name)
+ "Return the device class of NAME.
+Users should not call this function; see `device-class' instead."
+ (cond
+ ((string-match-p "XTEST" name) 'test)
+ ((string= "Virtual core pointer" name) 'core-pointer)
+ ((string= "Virtual core keyboard" name) 'core-keyboard)
+ (t (let ((number (ignore-errors
+ (string-to-number name))))
+ (when number
+ (cl-case number
+ (0 'mouse)
+ (1 'pen)
+ (2 'eraser)
+ (3 'puck)
+ (4 'keyboard)
+ (5 'touchscreen)
+ (6 'touchpad)
+ (7 'trackpoint)
+ (8 'pad)))))))
+
+(defvaralias 'x-gtk-use-system-tooltips 'use-system-tooltips)
+
+
+(define-key special-event-map [drag-n-drop] #'pgtk-dnd-handle-drag-n-drop-event)
+(add-hook 'after-make-frame-functions #'pgtk-dnd-init-frame)
+
+(provide 'pgtk-win)
+(provide 'term/pgtk-win)
+
+;;; pgtk-win.el ends here
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 8b39ed9d86e..993f1d43208 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -81,7 +81,6 @@
(&optional frame exclude-proportional))
(defvar w32-color-map) ;; defined in w32fns.c
-(make-obsolete 'w32-default-color-map nil "24.1")
(declare-function w32-send-sys-command "w32fns.c")
(declare-function set-message-beep "w32fns.c")
@@ -274,6 +273,9 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
'(gif "libgif-6.dll" "giflib5.dll" "gif.dll")
'(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll")))
'(svg "librsvg-2-2.dll")
+ '(webp "libwebp-7.dll" "libwebp.dll")
+ '(webpdemux "libwebpdemux-2.dll" "libwebpdemux.dll")
+ '(sqlite3 "libsqlite3-0.dll")
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
'(glib "libglib-2.0-0.dll")
'(gio "libgio-2.0-0.dll")
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 62cd9848667..3a0bd65f29c 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -85,6 +85,8 @@
(defvar x-selection-timeout)
(defvar x-session-id)
(defvar x-session-previous-id)
+(defvar x-dnd-movement-function)
+(defvar x-dnd-unsupported-drop-function)
(defun x-handle-no-bitmap-icon (_switch)
(setq default-frame-alist (cons '(icon-type) default-frame-alist)))
@@ -107,14 +109,6 @@
(setq x-session-previous-id (car x-invocation-args)
x-invocation-args (cdr x-invocation-args)))
-(defvar emacs-save-session-functions nil
- "Special hook run when a save-session event occurs.
-The functions do not get any argument.
-Functions can return non-nil to inform the session manager that the
-window system shutdown should be aborted.
-
-See also `emacs-session-save'.")
-
(defun emacs-session-filename (session-id)
"Construct a filename to save the session in based on SESSION-ID.
Return a filename in `user-emacs-directory', unless the session file
@@ -247,7 +241,9 @@ exists."
(defconst x-pointer-ur-angle 148)
(defconst x-pointer-watch 150)
(defconst x-pointer-xterm 152)
-(defconst x-pointer-invisible 255)
+(defconst x-pointer-invisible 65536) ;; This value is larger than a
+ ;; CARD16, so it cannot be a
+ ;; valid cursor.
;;;; Keysyms
@@ -1175,9 +1171,6 @@ as returned by `x-server-vendor'."
;;;; Selections
-(define-obsolete-function-alias 'x-cut-buffer-or-selection-value
- 'x-selection-value "24.1")
-
;; Arrange for the kill and yank functions to set and check the clipboard.
(defun x-clipboard-yank ()
@@ -1186,8 +1179,12 @@ as returned by `x-server-vendor'."
(interactive "*")
(let ((clipboard-text (gui--selection-value-internal 'CLIPBOARD))
(select-enable-clipboard t))
- (if (and clipboard-text (> (length clipboard-text) 0))
- (kill-new clipboard-text))
+ (when (and clipboard-text (> (length clipboard-text) 0))
+ ;; Avoid asserting ownership of CLIPBOARD, which will cause
+ ;; `gui-selection-value' to return nil in the future.
+ ;; (bug#56273)
+ (let ((select-enable-clipboard nil))
+ (kill-new clipboard-text)))
(yank)))
(declare-function accelerate-menu "xmenu.c" (&optional frame) t)
@@ -1295,14 +1292,6 @@ This returns an error if any Emacs frames are X frames."
(cons (cons 'width (cdr (assq 'width parsed)))
default-frame-alist))))))
- ;; Check the reverseVideo resource.
- (let ((case-fold-search t))
- (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
- (if (and rv
- (string-match "^\\(true\\|yes\\|on\\)$" rv))
- (setq default-frame-alist
- (cons '(reverse . t) default-frame-alist)))))
-
;; Set x-selection-timeout, measured in milliseconds.
(let ((res-selection-timeout (x-get-resource "selectionTimeout"
"SelectionTimeout")))
@@ -1378,7 +1367,8 @@ This returns an error if any Emacs frames are X frames."
(cl-defmethod gui-backend-get-selection (selection-symbol target-type
&context (window-system x)
&optional time-stamp terminal)
- (x-get-selection-internal selection-symbol target-type time-stamp terminal))
+ (x-get-selection-internal selection-symbol target-type
+ time-stamp terminal))
;; Initiate drag and drop
(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
@@ -1489,6 +1479,12 @@ If you don't want stock icons, set the variable to nil."
(string :tag "Stock/named")))))
:group 'x)
+(defcustom x-display-cursor-at-start-of-preedit-string nil
+ "If non-nil, display the cursor at the start of any pre-edit text."
+ :version "29.1"
+ :type 'boolean
+ :group 'x)
+
(defconst x-gtk-stock-cache (make-hash-table :weakness t :test 'equal))
(defun x-gtk-map-stock (file)
@@ -1517,6 +1513,106 @@ This uses `icon-map-list' to map icon file names to stock icon names."
(global-set-key [XF86WakeUp] 'ignore)
+
+(defvar x-preedit-overlay nil
+ "The overlay currently used to display preedit text from a compose sequence.")
+
+;; With some input methods, text gets inserted before Emacs is told to
+;; remove any preedit text that was displayed, which causes both the
+;; preedit overlay and the text to be visible for a brief period of
+;; time. This pre-command-hook clears the overlay before any command
+;; and should be set whenever a preedit overlay is visible.
+(defun x-clear-preedit-text ()
+ "Clear the pre-edit overlay and remove itself from pre-command-hook.
+This function should be installed in `pre-command-hook' whenever
+preedit text is displayed."
+ (when x-preedit-overlay
+ (delete-overlay x-preedit-overlay)
+ (setq x-preedit-overlay nil))
+ (remove-hook 'pre-command-hook #'x-clear-preedit-text))
+
+(defun x-preedit-text (event)
+ "Display preedit text from a compose sequence in EVENT.
+EVENT is a preedit-text event."
+ (interactive "e")
+ (when x-preedit-overlay
+ (delete-overlay x-preedit-overlay)
+ (setq x-preedit-overlay nil)
+ (remove-hook 'pre-command-hook #'x-clear-preedit-text))
+ (when (nth 1 event)
+ (let ((string (propertize (nth 1 event) 'face '(:underline t))))
+ (setq x-preedit-overlay (make-overlay (point) (point)))
+ (add-hook 'pre-command-hook #'x-clear-preedit-text)
+ (overlay-put x-preedit-overlay 'window (selected-window))
+ (overlay-put x-preedit-overlay 'before-string
+ (if x-display-cursor-at-start-of-preedit-string
+ (propertize string 'cursor t)
+ string)))))
+
+(define-key special-event-map [preedit-text] 'x-preedit-text)
+
+(defvaralias 'x-gtk-use-system-tooltips 'use-system-tooltips)
+
+(declare-function x-internal-focus-input-context "xfns.c" (focus))
+
+(defun x-gtk-use-native-input-watcher (_symbol newval &rest _ignored)
+ "Variable watcher for `x-gtk-use-native-input'.
+If NEWVAL is non-nil, focus the GTK input context of focused
+frames on all displays."
+ (when (and (featurep 'gtk)
+ (eq (framep (selected-frame)) 'x))
+ (x-internal-focus-input-context newval)))
+
+(add-variable-watcher 'x-gtk-use-native-input
+ #'x-gtk-use-native-input-watcher)
+
+(defun x-dnd-movement (_frame position)
+ "Handle movement to POSITION during drag-and-drop."
+ (dnd-handle-movement position)
+ (redisplay))
+
+(defun x-device-class (name)
+ "Return the device class of NAME.
+Users should not call this function; see `device-class' instead."
+ (let ((downcased-name (downcase name)))
+ (cond
+ ((string-match-p "XTEST" name) 'test)
+ ((string= "Virtual core pointer" name) 'core-pointer)
+ ((string= "Virtual core keyboard" name) 'core-keyboard)
+ ((string-match-p "eraser" downcased-name) 'eraser)
+ ((string-match-p " pad" downcased-name) 'pad)
+ ((or (or (string-match-p "wacom" downcased-name)
+ (string-match-p "pen" downcased-name))
+ (string-match-p "stylus" downcased-name))
+ 'pen)
+ ((or (string-prefix-p "xwayland-touch:" name)
+ (string-match-p "touchscreen" downcased-name))
+ 'touchscreen)
+ ((or (string-match-p "trackpoint" downcased-name)
+ (string-match-p "stick" downcased-name))
+ 'trackpoint)
+ ((or (string-match-p "mouse" downcased-name)
+ (string-match-p "optical" downcased-name)
+ (string-match-p "pointer" downcased-name))
+ 'mouse)
+ ((string-match-p "cursor" downcased-name) 'puck)
+ ((or (string-match-p "keyboard" downcased-name)
+ ;; One of my cheap keyboards is really named this...
+ (string= name "USB USB Keykoard"))
+ 'keyboard)
+ ((string-match-p "button" downcased-name) 'power-button)
+ ((string-match-p "touchpad" downcased-name) 'touchpad)
+ ((or (string-match-p "midi" downcased-name)
+ (string-match-p "piano" downcased-name))
+ 'piano)
+ ((or (string-match-p "wskbd" downcased-name) ; NetBSD/OpenBSD
+ (and (string-match-p "/dev" downcased-name)
+ (string-match-p "kbd" downcased-name)))
+ 'keyboard))))
+
+(setq x-dnd-movement-function #'x-dnd-movement)
+(setq x-dnd-unsupported-drop-function #'x-dnd-handle-unsupported-drop)
+
(provide 'x-win)
(provide 'term/x-win)
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index a7e257f41c5..08e38c9a050 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -66,7 +66,7 @@ If you select a region larger than this size, it won't be copied to your system
clipboard. Since clipboard data is base 64 encoded, the actual number of
string bytes that can be copied is 3/4 of this value."
:version "25.1"
- :type 'integer)
+ :type 'natnum)
(defcustom xterm-set-window-title nil
"Whether Emacs should set window titles to an Emacs frame in an XTerm."
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index e6fddd216d7..2cf9ded04bf 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -184,7 +184,6 @@
;; Variables
-(defconst artist-version "1.2.6")
(defconst artist-maintainer-address "tab@lysator.liu.se, bug-gnu-emacs@gnu.org")
(defvar x-pointer-crosshair)
@@ -338,7 +337,8 @@ Example:
(defvar artist-pointer-shape (if (eq window-system 'x) x-pointer-crosshair nil)
"If in X Windows, use this pointer shape while drawing with the mouse.")
-(defvaralias 'artist-text-renderer 'artist-text-renderer-function)
+(define-obsolete-variable-alias 'artist-text-renderer
+ 'artist-text-renderer-function "29.1")
(defcustom artist-text-renderer-function 'artist-figlet
"Function for doing text rendering."
@@ -474,60 +474,57 @@ This variable is initialized by the `artist-make-prev-next-op-alist' function.")
(defvar artist-arrow-point-1 nil)
(defvar artist-arrow-point-2 nil)
-(defvar artist-mode-map
- (let ((map (make-sparse-keymap)))
- (setq artist-mode-map (make-sparse-keymap))
- (define-key map [down-mouse-1] 'artist-down-mouse-1)
- (define-key map [S-down-mouse-1] 'artist-down-mouse-1)
- (define-key map [down-mouse-2] 'artist-mouse-choose-operation)
- (define-key map [S-down-mouse-2] 'artist-mouse-choose-operation)
- (define-key map [down-mouse-3] 'artist-down-mouse-3)
- (define-key map [S-down-mouse-3] 'artist-down-mouse-3)
- (define-key map [C-mouse-4] 'artist-select-prev-op-in-list)
- (define-key map [C-mouse-5] 'artist-select-next-op-in-list)
- (define-key map "\r" 'artist-key-set-point) ; return
- (define-key map [up] 'artist-previous-line)
- (define-key map "\C-p" 'artist-previous-line)
- (define-key map [down] 'artist-next-line)
- (define-key map "\C-n" 'artist-next-line)
- (define-key map [left] 'artist-backward-char)
- (define-key map "\C-b" 'artist-backward-char)
- (define-key map [right] 'artist-forward-char)
- (define-key map "\C-f" 'artist-forward-char)
- (define-key map "<" 'artist-toggle-first-arrow)
- (define-key map ">" 'artist-toggle-second-arrow)
- (define-key map "\C-c\C-a\C-e" 'artist-select-erase-char)
- (define-key map "\C-c\C-a\C-f" 'artist-select-fill-char)
- (define-key map "\C-c\C-a\C-l" 'artist-select-line-char)
- (define-key map "\C-c\C-a\C-o" 'artist-select-operation)
- (define-key map "\C-c\C-a\C-r" 'artist-toggle-rubber-banding)
- (define-key map "\C-c\C-a\C-t" 'artist-toggle-trim-line-endings)
- (define-key map "\C-c\C-a\C-s" 'artist-toggle-borderless-shapes)
- (define-key map "\C-c\C-c" 'artist-mode-off)
- (define-key map "\C-c\C-al" 'artist-select-op-line)
- (define-key map "\C-c\C-aL" 'artist-select-op-straight-line)
- (define-key map "\C-c\C-ar" 'artist-select-op-rectangle)
- (define-key map "\C-c\C-aR" 'artist-select-op-square)
- (define-key map "\C-c\C-as" 'artist-select-op-square)
- (define-key map "\C-c\C-ap" 'artist-select-op-poly-line)
- (define-key map "\C-c\C-aP" 'artist-select-op-straight-poly-line)
- (define-key map "\C-c\C-ae" 'artist-select-op-ellipse)
- (define-key map "\C-c\C-ac" 'artist-select-op-circle)
- (define-key map "\C-c\C-at" 'artist-select-op-text-see-thru)
- (define-key map "\C-c\C-aT" 'artist-select-op-text-overwrite)
- (define-key map "\C-c\C-aS" 'artist-select-op-spray-can)
- (define-key map "\C-c\C-az" 'artist-select-op-spray-set-size)
- (define-key map "\C-c\C-a\C-d" 'artist-select-op-erase-char)
- (define-key map "\C-c\C-aE" 'artist-select-op-erase-rectangle)
- (define-key map "\C-c\C-av" 'artist-select-op-vaporize-line)
- (define-key map "\C-c\C-aV" 'artist-select-op-vaporize-lines)
- (define-key map "\C-c\C-a\C-k" 'artist-select-op-cut-rectangle)
- (define-key map "\C-c\C-a\M-w" 'artist-select-op-copy-rectangle)
- (define-key map "\C-c\C-a\C-y" 'artist-select-op-paste)
- (define-key map "\C-c\C-af" 'artist-select-op-flood-fill)
- (define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report)
- map)
- "Keymap for `artist-mode'.")
+(defvar-keymap artist-mode-map
+ :doc "Keymap for `artist-mode'."
+ "<down-mouse-1>" #'artist-down-mouse-1
+ "S-<down-mouse-1>" #'artist-down-mouse-1
+ "<down-mouse-2>" #'artist-mouse-choose-operation
+ "S-<down-mouse-2>" #'artist-mouse-choose-operation
+ "<down-mouse-3>" #'artist-down-mouse-3
+ "S-<down-mouse-3>" #'artist-down-mouse-3
+ "C-<mouse-4>" #'artist-select-prev-op-in-list
+ "C-<mouse-5>" #'artist-select-next-op-in-list
+ "RET" #'artist-key-set-point ; return
+ "<up>" #'artist-previous-line
+ "C-p" #'artist-previous-line
+ "<down>" #'artist-next-line
+ "C-n" #'artist-next-line
+ "<left>" #'artist-backward-char
+ "C-b" #'artist-backward-char
+ "<right>" #'artist-forward-char
+ "C-f" #'artist-forward-char
+ "<" #'artist-toggle-first-arrow
+ ">" #'artist-toggle-second-arrow
+ "C-c C-a C-e" #'artist-select-erase-char
+ "C-c C-a C-f" #'artist-select-fill-char
+ "C-c C-a C-l" #'artist-select-line-char
+ "C-c C-a C-o" #'artist-select-operation
+ "C-c C-a C-r" #'artist-toggle-rubber-banding
+ "C-c C-a C-t" #'artist-toggle-trim-line-endings
+ "C-c C-a C-s" #'artist-toggle-borderless-shapes
+ "C-c C-c" #'artist-mode-off
+ "C-c C-a l" #'artist-select-op-line
+ "C-c C-a L" #'artist-select-op-straight-line
+ "C-c C-a r" #'artist-select-op-rectangle
+ "C-c C-a R" #'artist-select-op-square
+ "C-c C-a s" #'artist-select-op-square
+ "C-c C-a p" #'artist-select-op-poly-line
+ "C-c C-a P" #'artist-select-op-straight-poly-line
+ "C-c C-a e" #'artist-select-op-ellipse
+ "C-c C-a c" #'artist-select-op-circle
+ "C-c C-a t" #'artist-select-op-text-see-thru
+ "C-c C-a T" #'artist-select-op-text-overwrite
+ "C-c C-a S" #'artist-select-op-spray-can
+ "C-c C-a z" #'artist-select-op-spray-set-size
+ "C-c C-a C-d" #'artist-select-op-erase-char
+ "C-c C-a E" #'artist-select-op-erase-rectangle
+ "C-c C-a v" #'artist-select-op-vaporize-line
+ "C-c C-a V" #'artist-select-op-vaporize-lines
+ "C-c C-a C-k" #'artist-select-op-cut-rectangle
+ "C-c C-a M-w" #'artist-select-op-copy-rectangle
+ "C-c C-a C-y" #'artist-select-op-paste
+ "C-c C-a f" #'artist-select-op-flood-fill
+ "C-c C-a C-b" #'artist-submit-bug-report)
(easy-menu-define artist-menu-map artist-mode-map
"Menu for `artist-mode'."
@@ -1370,8 +1367,11 @@ Keymap summary
(t
;; Turn mode on
(artist-mode-init)
- (let ((font (face-attribute 'default :font)))
- (when (and (fontp font) (not (font-get font :spacing)))
+ (let* ((font (face-attribute 'default :font))
+ (spacing-prop (if (fontp font)
+ (font-get font :spacing)
+ t)))
+ (when (or (null spacing-prop) (eq spacing-prop 0))
(message "The default font isn't monospaced, so the drawings in this buffer may look odd"))))))
;; Init and exit
@@ -2840,9 +2840,8 @@ Returns a list of strings."
(if (memq system-type '(windows-nt ms-dos))
(artist-figlet-get-font-list-windows)
(artist-figlet-get-font-list)))
- (font (completing-read (concat "Select font (default "
- artist-figlet-default-font
- "): ")
+ (font (completing-read (format-prompt "Select font"
+ artist-figlet-default-font)
(mapcar
(lambda (font) (cons font font))
avail-fonts))))
@@ -4916,7 +4915,7 @@ The event, EV, is the mouse event."
(arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
(ev-start (event-start ev))
(initial-win (posn-window ev-start))
- (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
+ (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start t)))
(x1 (artist--adjust-x (car ev-start-pos)))
(y1 (cdr ev-start-pos))
(timer nil))
@@ -4932,7 +4931,7 @@ The event, EV, is the mouse event."
(while (or (mouse-movement-p ev)
(member 'down (event-modifiers ev)))
(setq ev-start-pos (artist-coord-win-to-buf
- (posn-col-row (event-start ev))))
+ (posn-col-row (event-start ev) t)))
(setq x1 (artist--adjust-x (car ev-start-pos)))
(setq y1 (cdr ev-start-pos))
@@ -5012,7 +5011,7 @@ The event, EV, is the mouse event."
(arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
(ev-start (event-start ev))
(initial-win (posn-window ev-start))
- (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
+ (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start t)))
(x1-last (artist--adjust-x (car ev-start-pos)))
(y1-last (cdr ev-start-pos))
(x2 x1-last)
@@ -5104,7 +5103,7 @@ The event, EV, is the mouse event."
;; set x2 and y2
;;
(setq ev-start-pos (artist-coord-win-to-buf
- (posn-col-row (event-start ev))))
+ (posn-col-row (event-start ev) t)))
(setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
@@ -5131,7 +5130,7 @@ The event, EV, is the mouse event."
;;
;; set x2 and y2
(setq ev-start-pos (artist-coord-win-to-buf
- (posn-col-row (event-start ev))))
+ (posn-col-row (event-start ev) t)))
(setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
@@ -5215,7 +5214,8 @@ Operation is done once. The event, EV, is the mouse event."
(arrow-pred (artist-go-get-arrow-pred-from-symbol op))
(arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
(ev-start (event-start ev))
- (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
+ (ev-start-pos (artist-coord-win-to-buf
+ (posn-col-row ev-start t)))
(x1 (artist--adjust-x (car ev-start-pos)))
(y1 (cdr ev-start-pos)))
(select-window (posn-window ev-start))
@@ -5249,7 +5249,8 @@ The event, EV, is the mouse event."
(arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
(ev-start (event-start ev))
(initial-win (posn-window ev-start))
- (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
+ (ev-start-pos (artist-coord-win-to-buf
+ (posn-col-row ev-start t)))
(x1 (artist--adjust-x (car ev-start-pos)))
(y1 (cdr ev-start-pos))
(x2)
@@ -5263,7 +5264,7 @@ The event, EV, is the mouse event."
(while (or (mouse-movement-p ev)
(member 'down (event-modifiers ev)))
(setq ev-start-pos (artist-coord-win-to-buf
- (posn-col-row (event-start ev))))
+ (posn-col-row (event-start ev) t)))
(setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
@@ -5359,7 +5360,7 @@ The event, EV, is the mouse event."
(setq vars (delq x vars)))) vars)
(reporter-submit-bug-report
artist-maintainer-address
- (concat "artist.el " artist-version)
+ (concat "artist.el in Emacs " emacs-version)
vars
nil nil
(concat "Hello Tomas,\n\n"
@@ -5367,6 +5368,9 @@ The event, EV, is the mouse event."
(define-obsolete-function-alias 'artist-uniq #'seq-uniq "28.1")
+(defconst artist-version "1.2.6")
+(make-obsolete-variable 'artist-version 'emacs-version "29.1")
+
(provide 'artist)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index e4df28d03de..6763da046ff 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -316,8 +316,6 @@ If parsing fails, try to set this variable to nil."
(option (choice :tag "Alternative" :value nil
(const nil) integer)))))))
-(define-obsolete-variable-alias 'bibtex-entry-field-alist
- 'bibtex-BibTeX-entry-alist "24.1")
(defcustom bibtex-BibTeX-entry-alist
'(("Article" "Article in Journal"
(("author")
@@ -764,6 +762,20 @@ for a new entry."
("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
("url") ("urldate")))
+ ("Conference" "Article in Conference Proceedings" ; same as InProceedings
+ (("author")
+ ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)"))
+ (("booktitle" "Name of the conference proceedings")
+ ("year"))
+ (("editor")
+ ("volume" "Volume of the conference proceedings in the series")
+ ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
+ ("series" "Series in which the conference proceedings appeared")
+ ("pages" "Pages in the conference proceedings")
+ ("month") ("address")
+ ("organization" "Sponsoring organization of the conference")
+ ("publisher" "Publishing company, its location")
+ ("note")))
("Reference" "Single-Volume Work of Reference" ; same as @collection
(("editor") ("title") ("date" nil nil 1) ("year" nil nil -1))
nil
@@ -839,6 +851,33 @@ for a new entry."
("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
("url") ("urldate")))
+ ("PhdThesis" "PhD Thesis"
+ (("author")
+ ("title" "Title of the PhD thesis")
+ ("school" "School where the PhD thesis was written")
+ ("year"))
+ nil
+ (("type" "Type of the PhD thesis")
+ ("address" "Address of the school (if not part of field \"school\") or country")
+ ("month") ("note")))
+ ("MastersThesis" "Master's Thesis"
+ (("author")
+ ("title" "Title of the master's thesis (BibTeX converts it to lowercase)")
+ ("school" "School where the master's thesis was written")
+ ("year"))
+ nil
+ (("type" "Type of the master's thesis (if other than \"Master's thesis\")")
+ ("address" "Address of the school (if not part of field \"school\") or country")
+ ("month") ("note")))
+ ("TechReport" "Technical Report"
+ (("author")
+ ("title" "Title of the technical report (BibTeX converts it to lowercase)")
+ ("institution" "Sponsoring institution of the report")
+ ("year"))
+ nil
+ (("type" "Type of the report (if other than \"technical report\")")
+ ("number" "Number of the technical report")
+ ("address") ("month") ("note")))
("Unpublished" "Unpublished"
(("author") ("title") ("date" nil nil 1) ("year" nil nil -1))
nil
@@ -1193,8 +1232,8 @@ See `bibtex-generate-autokey' for details."
:type '(repeat (cons (regexp :tag "Old")
(string :tag "New"))))
-(defvaralias 'bibtex-autokey-name-case-convert
- 'bibtex-autokey-name-case-convert-function)
+(define-obsolete-variable-alias 'bibtex-autokey-name-case-convert
+ 'bibtex-autokey-name-case-convert-function "29.1")
(defcustom bibtex-autokey-name-case-convert-function #'downcase
"Function called for each name to perform case conversion.
@@ -1268,8 +1307,8 @@ Case is significant. See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
:type '(repeat regexp))
-(defvaralias 'bibtex-autokey-titleword-case-convert
- 'bibtex-autokey-titleword-case-convert-function)
+(define-obsolete-variable-alias 'bibtex-autokey-titleword-case-convert
+ 'bibtex-autokey-titleword-case-convert-function "29.1")
(defcustom bibtex-autokey-titleword-case-convert-function #'downcase
"Function called for each titleword to perform case conversion.
@@ -2257,11 +2296,17 @@ is non-nil, FUN is not called for @String entries."
(set-marker-insertion-type end-marker t)
(save-excursion
(goto-char (point-min))
- (while (setq found (bibtex-skip-to-valid-entry))
- (set-marker end-marker (cdr found))
- (looking-at bibtex-any-entry-maybe-empty-head)
- (funcall fun (bibtex-key-in-head "") (car found) end-marker)
- (goto-char end-marker)))))
+ (let ((prev nil))
+ (while (setq found (bibtex-skip-to-valid-entry))
+ ;; If we have invalid entries, ensure that we have forward
+ ;; progress so that we don't infloop.
+ (if (equal (point) prev)
+ (forward-line 1)
+ (setq prev (point))
+ (set-marker end-marker (cdr found))
+ (looking-at bibtex-any-entry-maybe-empty-head)
+ (funcall fun (bibtex-key-in-head "") (car found) end-marker)
+ (goto-char end-marker)))))))
(defun bibtex-progress-message (&optional flag interval)
"Echo a message about progress of current buffer.
@@ -3626,14 +3671,6 @@ if that value is non-nil.
(if (not (consp (nth 1 (car entry-alist))))
;; new format
entry-alist
- ;; Convert old format of `bibtex-entry-field-alist'
- (unless (get var 'entry-list-format)
- (put var 'entry-list-format "pre-24")
- (message "Old format of `%s' (pre GNU Emacs 24).
-Please convert to the new format."
- (if (eq (indirect-variable 'bibtex-entry-field-alist) var)
- 'bibtex-entry-field-alist var))
- (sit-for 3))
(let (lst)
(dolist (entry entry-alist)
(let ((fl (nth 1 entry)) req xref opt)
@@ -4101,11 +4138,11 @@ Optional arg POS is the position of the BibTeX entry to use."
(goto-char pnt)))))
(defun bibtex-mark-entry ()
- "Put mark at beginning, point at end of current BibTeX entry.
+ "Put mark at end, point at beginning of current BibTeX entry.
Activate mark in Transient Mark mode."
(interactive)
- (push-mark (bibtex-beginning-of-entry) t t)
- (bibtex-end-of-entry))
+ (push-mark (bibtex-end-of-entry) t t)
+ (bibtex-beginning-of-entry))
(defun bibtex-count-entries (&optional count-string-entries)
"Count number of entries in current buffer or region.
@@ -4317,8 +4354,6 @@ for a crossref key, t otherwise."
(eqb (goto-char pos))
(t (set-buffer buffer) (goto-char pos)))
pos))
-;; backward compatibility
-(defalias 'bibtex-find-crossref 'bibtex-search-crossref)
(defun bibtex-dist (pos beg end)
"Return distance between POS and region delimited by BEG and END."
@@ -4381,8 +4416,6 @@ A prefix arg negates the value of `bibtex-search-entry-globally'."
(if display (bibtex-reposition-window)))
(display (message "Key `%s' not found" key)))
pnt)))
-;; backward compatibility
-(defalias 'bibtex-find-entry 'bibtex-search-entry)
(defun bibtex-prepare-new-entry (index)
"Prepare a new BibTeX entry with index INDEX.
@@ -4996,7 +5029,7 @@ on the value of `bibtex-entry-format'.
If the reference key of the entry is empty or a prefix argument is given,
calculate a new reference key. (Note: this works only if fields in entry
begin on separate lines prior to calling `bibtex-clean-entry' or if
-'realign is contained in `bibtex-entry-format'.)
+`realign' is contained in `bibtex-entry-format'.)
Don't call `bibtex-clean-entry' on @Preamble entries.
At end of the cleaning process, the functions in
`bibtex-clean-entry-hook' are called with region narrowed to entry."
@@ -5275,7 +5308,6 @@ entries from minibuffer."
(goto-char (point-max))
(message "Buffer is now parsable. Please save it.")))
-(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1")
(defun bibtex-completion-at-point-function ()
(let ((pnt (point))
(case-fold-search t)
@@ -5608,5 +5640,8 @@ If APPEND is non-nil, append ENTRIES to those already displayed."
(setq buffer-read-only t)
(goto-char (point-min)))
+(define-obsolete-function-alias 'bibtex-find-crossref #'bibtex-search-crossref "29.1")
+(define-obsolete-function-alias 'bibtex-find-entry #'bibtex-search-entry "29.1")
+
(provide 'bibtex)
;;; bibtex.el ends here
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 1139fd1976e..a2a7774aba7 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -269,6 +269,10 @@
("resize" "none" "both" "horizontal" "vertical")
("text-overflow" "clip" "ellipsis" string)
+ ;; CSS Cascading and Inheritance Level 3
+ ;; (https://www.w3.org/TR/css-cascade-3/#property-index)
+ ("all")
+
;; CSS Color Module Level 3
;; (https://www.w3.org/TR/css3-color/#property)
("color" color)
@@ -304,27 +308,27 @@
;; CSS Box Alignment Module Level 3
;; (https://www.w3.org/TR/css-align-3/#property-index)
- ("align-content"
- baseline-position content-distribution overflow-position content-position)
- ("align-items"
- "normal" "stretch" baseline-position overflow-position self-position)
- ("align-self"
- "auto" "normal" "stretch"
- baseline-position overflow-position self-position)
- ("justify-content" "normal"
- content-distribution overflow-position content-position "left" "right")
- ("justify-items"
- "normal" "stretch" baseline-position overflow-position self-position
- "left" "right" "legacy")
- ("justify-self"
- "auto" "normal" "stretch" baseline-position overflow-position self-position
- "left" "right")
+ ("align-content" baseline-position content-distribution
+ overflow-position content-position)
+ ("align-items" "normal" "stretch" baseline-position
+ overflow-position self-position)
+ ("align-self" "auto" "normal" "stretch" baseline-position
+ overflow-position self-position)
+ ("column-gap" "normal" length-percentage)
+ ("gap" row-gap column-gap)
+ ("justify-content" "normal" content-distribution overflow-position
+ content-position "left" "right")
+ ("justify-items" "normal" "stretch" baseline-position
+ overflow-position self-position "left" "right" "legacy" "center")
+ ("justify-self" "auto" "normal" "stretch" baseline-position
+ overflow-position self-position "left" "right")
("place-content" align-content justify-content)
("place-items" align-items justify-items)
("place-self" justify-self align-self)
+ ("row-gap" "normal" length-percentage)
- ;; CSS Flexible Box Layout Module Level 2
- ;; (https://www.w3.org/TR/css-flexbox-2/#property-index)
+ ;; CSS Flexible Box Layout Module Level 1
+ ;; (https://www.w3.org/TR/css-flexbox-1/#property-index)
("flex" "none" flex-grow flex-shrink flex-basis)
("flex-basis" "auto" "content" width)
("flex-direction" "row" "row-reverse" "column" "column-reverse")
@@ -413,21 +417,20 @@
("mask-type" "luminance" "alpha")
("clip" "rect()" "auto")
- ;; CSS Multi-column Layout Module
+ ;; CSS Multi-column Layout Module Level 1
;; (https://www.w3.org/TR/css3-multicol/#property-index)
;; "break-after", "break-before", and "break-inside" are left out
;; below, because they're already included in CSS Fragmentation
;; Module Level 3.
- ("column-count" integer "auto")
- ("column-fill" "auto" "balance")
- ("column-gap" length "normal")
+ ("column-count" "auto" integer)
+ ("column-fill" "auto" "balance" "balance-all")
("column-rule" column-rule-width column-rule-style
- column-rule-color "transparent")
+ column-rule-color)
("column-rule-color" color)
- ("column-rule-style" border-style)
- ("column-rule-width" border-width)
+ ("column-rule-style" line-style)
+ ("column-rule-width" line-width)
("column-span" "none" "all")
- ("column-width" length "auto")
+ ("column-width" "auto" length)
("columns" column-width column-count)
;; CSS Overflow Module Level 3
@@ -925,6 +928,32 @@ cannot be completed sensibly: `custom-ident',
(defface css-proprietary-property '((t :inherit (css-property italic)))
"Face to use for vendor-specific properties.")
+(defun css--selector-regexp (sassy)
+ (concat
+ "\\(?:"
+ (if (not sassy)
+ "[-_%*#.>[:alnum:]]+"
+ ;; Same as for non-sassy except we do want to allow { and }
+ ;; chars in selectors in the case of #{$foo}
+ ;; variable interpolation!
+ (concat "\\(?:[-_%*#.>&+~[:alnum:]]*" scss--hash-re
+ "\\|[-_%*#.>&+~[:alnum:]]+\\)"))
+ ;; Even though pseudo-elements should be prefixed by ::, a
+ ;; single colon is accepted for backward compatibility.
+ "\\(?:\\(:" (regexp-opt (append css-pseudo-class-ids
+ css-pseudo-element-ids)
+ t)
+ "\\|::" (regexp-opt css-pseudo-element-ids t) "\\)\\)?"
+ ;; Braces after selectors.
+ "\\(?:\\[[^]\n]+\\]\\)?"
+ ;; Parentheses after selectors.
+ "\\(?:([^)]+)\\)?"
+ ;; Main bit over. But perhaps just [target]?
+ "\\|\\[[^]\n]+\\]"
+ ;; :root, ::marker and the like.
+ "\\|::?[[:alnum:]]+\\(?:([^)]+)\\)?"
+ "\\)"))
+
(defun css--font-lock-keywords (&optional sassy)
`((,(concat "!\\s-*" (regexp-opt css--bang-ids))
(0 font-lock-builtin-face))
@@ -945,28 +974,16 @@ cannot be completed sensibly: `custom-ident',
;; selector between [...] should simply not be highlighted.
(,(concat
"^[ \t]*\\("
- (if (not sassy)
- ;; We don't allow / as first char, so as not to
- ;; take a comment as the beginning of a selector.
- "[^@/:{}() \t\n][^:{}()]*"
- ;; Same as for non-sassy except we do want to allow { and }
- ;; chars in selectors in the case of #{$foo}
- ;; variable interpolation!
- (concat "\\(?:" scss--hash-re
- "\\|[^@/:{}() \t\n#]\\)"
- "[^:{}()#]*\\(?:" scss--hash-re "[^:{}()#]*\\)*"))
- ;; Even though pseudo-elements should be prefixed by ::, a
- ;; single colon is accepted for backward compatibility.
- "\\(?:\\(:" (regexp-opt (append css-pseudo-class-ids
- css-pseudo-element-ids)
- t)
- "\\|::" (regexp-opt css-pseudo-element-ids t) "\\)"
- "\\(?:([^)]+)\\)?"
- (if (not sassy)
- "[^:{}()\n]*"
- (concat "[^:{}()\n#]*\\(?:" scss--hash-re "[^:{}()\n#]*\\)*"))
+ ;; We have at least one selector.
+ (css--selector-regexp sassy)
+ ;; And then possibly more.
+ "\\(?:"
+ ;; Separators between selectors.
+ "[ \n\t,+~>]+"
+ (css--selector-regexp sassy)
"\\)*"
- "\\)\\(?:\n[ \t]*\\)*{")
+ ;; And then a brace.
+ "\\)[ \n\t]*{")
(1 'css-selector keep))
;; In the above rule, we allow the open-brace to be on some subsequent
;; line. This will only work if we properly mark the intervening text
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index d4acbe24ebb..42d547504c1 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -110,11 +110,11 @@
"26.1" 'set)
(defcustom dns-mode-font-lock-keywords
- `((,(concat "^\\$" (regexp-opt dns-mode-control-entities))
+ `((,(concat "^\\$" (regexp-opt dns-mode-control-entities) "\\>")
0 ,dns-mode-control-entity-face)
("^\\$[a-z0-9A-Z]+" 0 ,dns-mode-bad-control-entity-face)
- (,(regexp-opt dns-mode-classes) 0 ,dns-mode-class-face)
- (,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face))
+ (,(regexp-opt dns-mode-classes 'words) 0 ,dns-mode-class-face)
+ (,(regexp-opt dns-mode-types 'words) 0 ,dns-mode-type-face))
"Font lock keywords used to highlight text in DNS master file mode."
:version "26.1"
:type 'sexp)
diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el
new file mode 100644
index 00000000000..af0aa2ddeab
--- /dev/null
+++ b/lisp/textmodes/emacs-news-mode.el
@@ -0,0 +1,269 @@
+;;; emacs-news-mode.el --- major mode to edit and view the NEWS file -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Keywords: tools
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'outline)
+
+(defgroup emacs-news-mode nil
+ "Major mode for editing and viewing the Emacs NEWS file."
+ :group 'lisp)
+
+(defface emacs-news-is-documented
+ '((t :inherit font-lock-type-face))
+ "Face used for displaying the \"is documented\" tag."
+ :version "29.1")
+
+(defface emacs-news-does-not-need-documentation
+ '((t :inherit font-lock-preprocessor-face))
+ "Face used for displaying the \"does not need documentation\" tag."
+ :version "29.1")
+
+(defvar-keymap emacs-news-common-map
+ ;; Navigation like `org-mode'/`outline-minor-mode'.
+ "C-c C-f" #'outline-forward-same-level
+ "C-c C-b" #'outline-backward-same-level
+ "C-c C-n" #'outline-next-visible-heading
+ "C-c C-p" #'outline-previous-visible-heading
+ "C-c C-u" #'outline-up-heading)
+
+(defvar-keymap emacs-news-mode-map
+ :parent emacs-news-common-map
+ "C-c C-s" #'emacs-news-next-untagged-entry
+ "C-c C-r" #'emacs-news-previous-untagged-entry
+ "C-c C-t" #'emacs-news-toggle-tag
+ "C-c C-g" #'emacs-news-goto-section
+ "C-c C-j" #'emacs-news-find-heading
+ "C-c C-e" #'emacs-news-count-untagged-entries
+ "<remap> <open-line>" #'emacs-news-open-line)
+
+(defvar-keymap emacs-news-view-mode-map
+ :parent emacs-news-common-map)
+
+(defvar emacs-news-mode-font-lock-keywords
+ `(("^---$" 0 'emacs-news-does-not-need-documentation)
+ ("^\\+\\+\\+$" 0 'emacs-news-is-documented)))
+
+(defun emacs-news--mode-common ()
+ (setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t))
+ (setq-local outline-regexp "\\*+ "
+ outline-minor-mode-cycle t
+ ;; We subtract one from the level, because we have a
+ ;; space after the asterisks.
+ outline-level (lambda () (1- (length (match-string 0))))
+ outline-minor-mode-highlight 'append)
+ (outline-minor-mode))
+
+;;;###autoload
+(define-derived-mode emacs-news-mode text-mode "NEWS"
+ "Major mode for editing the Emacs NEWS file."
+ (setq-local fill-paragraph-function #'emacs-news--fill-paragraph)
+ (emacs-news--mode-common))
+
+;;;###autoload
+(define-derived-mode emacs-news-view-mode special-mode "NEWS"
+ "Major mode for viewing the Emacs NEWS file."
+ (setq buffer-read-only t)
+ (emacs-news--buttonize)
+ (button-mode)
+ (emacs-news--mode-common))
+
+(defun emacs-news--fill-paragraph (&optional justify)
+ (cond
+ ;; We're in a heading -- do nothing.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at "\\*+ "))
+ )
+ ;; We're in a news item -- exclude the heading before filling.
+ ((and (save-excursion
+ (re-search-backward (concat "^\\(?:" paragraph-start "\\|\\*+ \\)")
+ nil t))
+ (= (char-after (match-beginning 0)) ?*))
+ (save-restriction
+ (narrow-to-region (save-excursion
+ (goto-char (match-beginning 0))
+ (forward-line 1)
+ (point))
+ (point-max))
+ (fill-paragraph justify)))
+ ;; Fill normally.
+ (t
+ (fill-paragraph justify))))
+
+(defun emacs-news-next-untagged-entry (&optional reverse)
+ "Go to the next untagged NEWS entry.
+If REVERSE (interactively, the prefix), go to the previous
+untagged NEWS entry."
+ (interactive "P" emacs-news-mode)
+ (let ((start (point))
+ (found nil))
+ ;; Don't consider the current line, because that would stop
+ ;; progress if calling this command repeatedly.
+ (unless reverse
+ (forward-line 1))
+ (while (and (not found)
+ (funcall (if reverse #'re-search-backward
+ #'re-search-forward)
+ "^\\(\\*+\\) " nil t))
+ (when (and (not (save-excursion
+ (forward-line -1)
+ (looking-at "---$\\|\\+\\+\\+$")))
+ ;; We have an entry without a tag before it, but
+ ;; check whether it's a heading (which we can
+ ;; determine if the next entry has more asterisks).
+ (not (emacs-news--heading-p)))
+ ;; It wasn't a sub-heading, so we've found one.
+ (setq found t)))
+ (if found
+ (progn
+ (push-mark start)
+ (message "Untagged entry")
+ (beginning-of-line)
+ t)
+ (message "No further untagged entries")
+ (goto-char start)
+ nil)))
+
+(defun emacs-news--heading-p ()
+ (save-excursion
+ (beginning-of-line)
+ ;; A heading starts with * characters, and then a blank line, and
+ ;; then paragraphs with more * characters than in the heading.
+ (and (looking-at "\\(\\*+\\) ")
+ (let ((level (length (match-string 1))))
+ (forward-line 1)
+ (and (looking-at "$")
+ (re-search-forward "^\\(\\*+\\) " nil t)
+ (> (length (match-string 1)) level))))))
+
+(defun emacs-news-previous-untagged-entry ()
+ "Go to the previous untagged NEWS entry."
+ (interactive nil emacs-news-mode)
+ (emacs-news-next-untagged-entry t))
+
+(defun emacs-news-toggle-tag ()
+ "Toggle documentation tag of current headline in the Emacs NEWS file."
+ (interactive nil emacs-news-mode)
+ (save-excursion
+ (goto-char (line-beginning-position))
+ (cond ((or (looking-at (rx bol (or "---" "+++") eol)))
+ (forward-line 2))
+ ((or (looking-at (rx bol "*** ")))
+ (forward-line 1)))
+ (outline-previous-visible-heading 1)
+ (forward-line -1)
+ (cond ((not (looking-at (rx bol (or "---" "+++") eol)))
+ (insert "\n---"))
+ ((looking-at (rx bol "---" eol))
+ (delete-char 3)
+ (insert "+++"))
+ ((looking-at (rx bol "+++" eol))
+ (delete-char 4))
+ (t (user-error "Invalid headline tag; can't toggle")))))
+
+(defun emacs-news-count-untagged-entries ()
+ "Say how many untagged entries there are in the current NEWS buffer."
+ (interactive nil emacs-news-mode)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((i 0))
+ (while (emacs-news-next-untagged-entry)
+ (setq i (1+ i)))
+ (message (if (= i 1)
+ "There's 1 untagged entry"
+ (format "There are %s untagged entries" i))))))
+
+(defun emacs-news--buttonize ()
+ "Make manual and symbol references into buttons."
+ (save-excursion
+ (with-silent-modifications
+ (let ((inhibit-read-only t))
+ ;; Do functions and variables.
+ (goto-char (point-min))
+ (search-forward "\f" nil t)
+ (while (re-search-forward "'\\([^-][^ \t\n]+\\)'" nil t)
+ ;; Filter out references to key sequences.
+ (let ((string (match-string 1)))
+ (when-let ((symbol (intern-soft string)))
+ (when (or (boundp symbol)
+ (fboundp symbol))
+ (buttonize-region (match-beginning 1) (match-end 1)
+ (lambda (symbol)
+ (describe-symbol symbol))
+ symbol)))))
+ ;; Do manual references.
+ (goto-char (point-min))
+ (search-forward "\f" nil t)
+ (while (re-search-forward "\"\\(([a-z0-9]+)[ \n][^\"]\\{1,80\\}\\)\""
+ nil t)
+ (buttonize-region (match-beginning 1) (match-end 1)
+ (lambda (node) (info node))
+ (match-string 1)))))))
+
+(defun emacs-news--sections (regexp)
+ (let ((sections nil))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^" regexp "\\(.*\\)") nil t)
+ (when (save-match-data (emacs-news--heading-p))
+ (push (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))
+ sections))))
+ (nreverse sections)))
+
+(defun emacs-news-goto-section (section)
+ "Go to SECTION in the Emacs NEWS file."
+ (interactive (list
+ (completing-read "Goto section: " (emacs-news--sections "\\* ")
+ nil t))
+ emacs-news-mode)
+ (goto-char (point-min))
+ (when (search-forward (concat "\n* " section) nil t)
+ (beginning-of-line)))
+
+(defun emacs-news-find-heading (heading)
+ "Go to HEADING in the Emacs NEWS file."
+ (interactive (list
+ (completing-read "Goto heading: "
+ (emacs-news--sections "\\*\\*\\*? ")
+ nil t))
+ emacs-news-mode)
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^*+ " (regexp-quote heading)) nil t)
+ (beginning-of-line)))
+
+(defun emacs-news-open-line (n)
+ "Open a new line in a NEWS file.
+This is like `open-line', but skips any temporary NEWS-style
+documentation marks on the previous line."
+ (interactive "*p" emacs-news-mode)
+ (when (save-excursion (forward-line -1)
+ (looking-at (rx bol (or "---" "+++") eol)))
+ (forward-line -1))
+ (open-line n))
+
+(provide 'emacs-news-mode)
+
+;;; emacs-news-mode.el ends here
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 50ff668a9ff..935be06812f 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -539,6 +539,30 @@ the range of text to assign text property SYMBOL with value VALUE."
(list start end 'display prop)
(list start end 'display (list 'disable-eval prop)))))
+(defvar enriched--markup-shown)
+(defun enriched-toggle-markup ()
+ "Toggle whether to see markup in the current buffer."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (with-silent-modifications
+ (if (bound-and-true-p enriched--markup-shown)
+ (progn
+ (setq-local enriched--markup-shown nil)
+ ;; Remove any faces, because they will be decoded, too.
+ (goto-char (point-min))
+ (let (match)
+ (while (setq match (text-property-search-forward 'face))
+ (put-text-property (prop-match-beginning match)
+ (prop-match-end match)
+ 'face nil)))
+ (enriched-decode (point-min) (point-max))
+ (enriched-mode 1))
+ (setq-local enriched--markup-shown t)
+ (enriched-encode (point-min) (point-max) (current-buffer))
+ (enriched-mode -1))))))
+
(provide 'enriched)
;;; enriched.el ends here
diff --git a/lisp/textmodes/etc-authors-mode.el b/lisp/textmodes/etc-authors-mode.el
index 3912b829d20..7eabdd4c2b8 100644
--- a/lisp/textmodes/etc-authors-mode.el
+++ b/lisp/textmodes/etc-authors-mode.el
@@ -115,12 +115,10 @@ With a prefix arg ARG, move point that many authors backward."
(interactive "p" etc-authors-mode)
(etc-authors-next-author (- arg)))
-(defvar etc-authors-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" #'etc-authors-next-author)
- (define-key map "p" #'etc-authors-prev-author)
- map)
- "Keymap for `etc-authors-mode'.")
+(defvar-keymap etc-authors-mode-map
+ :doc "Keymap for `etc-authors-mode'."
+ "n" #'etc-authors-next-author
+ "p" #'etc-authors-prev-author)
;;;###autoload
(define-derived-mode etc-authors-mode special-mode "Authors View"
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index ff84c353aa8..23ba1a24f1f 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -29,6 +29,8 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
+
(defgroup fill nil
"Indenting and filling text."
:link '(custom-manual "(emacs)Filling")
@@ -44,8 +46,8 @@ A value of nil means that any change in indentation starts a new paragraph."
(defcustom colon-double-space nil
"Non-nil means put two spaces after a colon when filling."
- :type 'boolean)
-(put 'colon-double-space 'safe-local-variable #'booleanp)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom fill-separate-heterogeneous-words-with-space nil
"Non-nil means to use a space to separate words of a different kind.
@@ -396,12 +398,8 @@ and `fill-nobreak-invisible'."
(save-excursion
(skip-chars-backward " ")
(and (eq (preceding-char) ?.)
- (looking-at " \\([^ ]\\|$\\)"))))
- ;; Another approach to the same problem.
- (save-excursion
- (skip-chars-backward " ")
- (and (eq (preceding-char) ?.)
- (not (progn (forward-char -1) (looking-at (sentence-end))))))
+ ;; There's something more after the space.
+ (looking-at " [^ \n]"))))
;; Don't split a line if the rest would look like a new paragraph.
(unless use-hard-newlines
(save-excursion
@@ -716,7 +714,10 @@ space does not end a sentence, so don't break a line there."
(goto-char from-plus-indent))
(if (not (> to (point)))
- nil ;; There is no paragraph, only whitespace: exit now.
+ ;; There is no paragraph, only whitespace: exit now.
+ (progn
+ (set-marker to nil)
+ nil)
(or justify (setq justify (current-justification)))
@@ -792,6 +793,7 @@ space does not end a sentence, so don't break a line there."
;; Leave point after final newline.
(goto-char to)
(unless (eobp) (forward-char 1))
+ (set-marker to nil)
;; Return the fill-prefix we used
fill-prefix)))
@@ -839,75 +841,67 @@ region, instead of just filling the current paragraph."
(interactive (progn
(barf-if-buffer-read-only)
(list (if current-prefix-arg 'full) t)))
- (let ((hash (and (not (buffer-modified-p))
- (buffer-hash))))
- (prog1
- (or
- ;; 1. Fill the region if it is active when called interactively.
- (and region transient-mark-mode mark-active
- (not (eq (region-beginning) (region-end)))
- (or (fill-region (region-beginning) (region-end) justify) t))
- ;; 2. Try fill-paragraph-function.
- (and (not (eq fill-paragraph-function t))
- (or fill-paragraph-function
- (and (minibufferp (current-buffer))
- (= 1 (point-min))))
- (let ((function (or fill-paragraph-function
- ;; In the minibuffer, don't count
- ;; the width of the prompt.
- 'fill-minibuffer-function))
- ;; If fill-paragraph-function is set, it probably
- ;; takes care of comments and stuff. If not, it
- ;; will have to set fill-paragraph-handle-comment
- ;; back to t explicitly or return nil.
- (fill-paragraph-handle-comment nil)
- (fill-paragraph-function t))
- (funcall function justify)))
- ;; 3. Try our syntax-aware filling code.
- (and fill-paragraph-handle-comment
- ;; Our code only handles \n-terminated comments right now.
- comment-start (equal comment-end "")
- (let ((fill-paragraph-handle-comment nil))
- (fill-comment-paragraph justify)))
- ;; 4. If it all fails, default to the good ol' text paragraph filling.
- (let ((before (point))
- (paragraph-start paragraph-start)
- ;; Fill prefix used for filling the paragraph.
- fill-pfx)
- ;; Try to prevent code sections and comment sections from being
- ;; filled together.
- (when (and fill-paragraph-handle-comment comment-start-skip)
- (setq paragraph-start
- (concat paragraph-start "\\|[ \t]*\\(?:"
- comment-start-skip "\\)")))
- (save-excursion
- ;; To make sure the return value of forward-paragraph is
- ;; meaningful, we have to start from the beginning of
- ;; line, otherwise skipping past the last few chars of a
- ;; paragraph-separator would count as a paragraph (and
- ;; not skipping any chars at EOB would not count as a
- ;; paragraph even if it is).
- (move-to-left-margin)
- (if (not (zerop (fill-forward-paragraph 1)))
- ;; There's no paragraph at or after point: give up.
- (setq fill-pfx "")
- (let ((end (point))
- (beg (progn (fill-forward-paragraph -1) (point))))
- (goto-char before)
- (setq fill-pfx
- (if use-hard-newlines
- ;; Can't use fill-region-as-paragraph, since this
- ;; paragraph may still contain hard newlines. See
- ;; fill-region.
- (fill-region beg end justify)
- (fill-region-as-paragraph beg end justify))))))
- fill-pfx))
- ;; If we didn't change anything in the buffer (and the buffer
- ;; was previously unmodified), then flip the modification status
- ;; back to "unchanged".
- (when (and hash
- (equal hash (buffer-hash)))
- (set-buffer-modified-p nil)))))
+ (with-buffer-unmodified-if-unchanged
+ (or
+ ;; 1. Fill the region if it is active when called interactively.
+ (and region transient-mark-mode mark-active
+ (not (eq (region-beginning) (region-end)))
+ (or (fill-region (region-beginning) (region-end) justify) t))
+ ;; 2. Try fill-paragraph-function.
+ (and (not (eq fill-paragraph-function t))
+ (or fill-paragraph-function
+ (and (minibufferp (current-buffer))
+ (= 1 (point-min))))
+ (let ((function (or fill-paragraph-function
+ ;; In the minibuffer, don't count
+ ;; the width of the prompt.
+ 'fill-minibuffer-function))
+ ;; If fill-paragraph-function is set, it probably
+ ;; takes care of comments and stuff. If not, it
+ ;; will have to set fill-paragraph-handle-comment
+ ;; back to t explicitly or return nil.
+ (fill-paragraph-handle-comment nil)
+ (fill-paragraph-function t))
+ (funcall function justify)))
+ ;; 3. Try our syntax-aware filling code.
+ (and fill-paragraph-handle-comment
+ ;; Our code only handles \n-terminated comments right now.
+ comment-start (equal comment-end "")
+ (let ((fill-paragraph-handle-comment nil))
+ (fill-comment-paragraph justify)))
+ ;; 4. If it all fails, default to the good ol' text paragraph filling.
+ (let ((before (point))
+ (paragraph-start paragraph-start)
+ ;; Fill prefix used for filling the paragraph.
+ fill-pfx)
+ ;; Try to prevent code sections and comment sections from being
+ ;; filled together.
+ (when (and fill-paragraph-handle-comment comment-start-skip)
+ (setq paragraph-start
+ (concat paragraph-start "\\|[ \t]*\\(?:"
+ comment-start-skip "\\)")))
+ (save-excursion
+ ;; To make sure the return value of forward-paragraph is
+ ;; meaningful, we have to start from the beginning of
+ ;; line, otherwise skipping past the last few chars of a
+ ;; paragraph-separator would count as a paragraph (and
+ ;; not skipping any chars at EOB would not count as a
+ ;; paragraph even if it is).
+ (move-to-left-margin)
+ (if (not (zerop (fill-forward-paragraph 1)))
+ ;; There's no paragraph at or after point: give up.
+ (setq fill-pfx "")
+ (let ((end (point))
+ (beg (progn (fill-forward-paragraph -1) (point))))
+ (goto-char before)
+ (setq fill-pfx
+ (if use-hard-newlines
+ ;; Can't use fill-region-as-paragraph, since this
+ ;; paragraph may still contain hard newlines. See
+ ;; fill-region.
+ (fill-region beg end justify)
+ (fill-region-as-paragraph beg end justify))))))
+ fill-pfx))))
(declare-function comment-search-forward "newcomment" (limit &optional noerror))
(declare-function comment-string-strip "newcomment" (str beforep afterp))
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 21612cd5e38..2c5e30fecd8 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1942,9 +1942,7 @@ before point that's highlighted as misspelled."
'face 'flyspell-incorrect
string))
(setq pos (cdr pos)))
- (if (fboundp 'display-message)
- (display-message 'no-log string)
- (message "%s" string))))
+ (message "%s" string)))
;;*---------------------------------------------------------------------*/
;;* flyspell-abbrev-table ... */
@@ -2273,17 +2271,8 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
;;*---------------------------------------------------------------------*/
(defun flyspell-emacs-popup (event poss word)
"The Emacs popup menu."
- (if (and (not event)
- (display-mouse-p))
- (let* ((mouse-pos (mouse-position))
- (mouse-pos (if (nth 1 mouse-pos)
- mouse-pos
- (set-mouse-position (car mouse-pos)
- (/ (frame-width) 2) 2)
- (mouse-position))))
- (setq event (list (list (car (cdr mouse-pos))
- (1+ (cdr (cdr mouse-pos))))
- (car mouse-pos)))))
+ (unless event
+ (setq event (popup-menu-normalize-position (point))))
(let* ((corrects (flyspell-sort (car (cdr (cdr poss))) word))
(cor-menu (if (consp corrects)
(mapcar (lambda (correct)
diff --git a/lisp/textmodes/glyphless-mode.el b/lisp/textmodes/glyphless-mode.el
new file mode 100644
index 00000000000..4d48d90b562
--- /dev/null
+++ b/lisp/textmodes/glyphless-mode.el
@@ -0,0 +1,68 @@
+;;; glyphless-mode.el --- minor mode for displaying glyphless characters -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(defcustom glyphless-mode-types '(all)
+ "Which glyphless characters to display.
+The value can be any of the groups supported by
+`glyphless-char-display-control' (which see), and in addition
+`all', for all glyphless characters."
+ :version "29.1"
+ :type '(repeat (choice (const :tag "All" all)
+ (const :tag "No font" no-font)
+ (const :tag "C0 Control" c0-control)
+ (const :tag "C1 Control" c1-control)
+ (const :tag "Format Control" format-control)
+ (const :tag "Bidirectional Control" bidi-control)
+ (const :tag "Variation Selectors" variation-selectors)
+ (const :tag "No Font" no-font)))
+ :group 'display)
+
+;;;###autoload
+(define-minor-mode glyphless-display-mode
+ "Minor mode for displaying glyphless characters in the current buffer.
+If enabled, all glyphless characters will be displayed as boxes
+that display their acronyms."
+ :lighter " Glyphless"
+ (if glyphless-display-mode
+ (progn
+ (setq-local glyphless-char-display
+ (let ((table (make-display-table)))
+ (set-char-table-parent table glyphless-char-display)
+ table))
+ (glyphless-mode--setup))
+ (kill-local-variable 'glyphless-char-display)))
+
+(defun glyphless-mode--setup ()
+ (let ((types (if (memq 'all glyphless-mode-types)
+ '(c0-control c1-control format-control
+ variation-selectors no-font)
+ glyphless-mode-types)))
+ (when types
+ (update-glyphless-char-display
+ nil (mapcar (lambda (e) (cons e 'acronym)) types)))))
+
+(provide 'glyphless-mode)
+
+;;; glyphless-mode.el ends here
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index a4bf454fdcb..8c8522a6e5e 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -296,7 +296,8 @@ The following values are supported:
"Non-nil means suppress messages in `ispell-word'."
:type 'boolean)
-(defvaralias 'ispell-format-word 'ispell-format-word-function)
+(define-obsolete-variable-alias 'ispell-format-word
+ 'ispell-format-word-function "29.1")
(defcustom ispell-format-word-function (function upcase)
"Formatting function for displaying word being spell checked.
@@ -796,6 +797,9 @@ See `ispell-buffer-with-debug' for an example of use."
"An alist of parsed Aspell dicts and associated parameters.
Internal use.")
+(defvar ispell--aspell-found-dictionaries nil
+ "An alist of identified aspell dictionaries.")
+
(defun ispell-find-aspell-dictionaries ()
"Find Aspell's dictionaries, and record in `ispell-aspell-dictionary-alist'."
(let* ((dictionaries
@@ -809,7 +813,8 @@ Internal use.")
(mapcar #'ispell-aspell-find-dictionary dictionaries))))
;; Ensure aspell's alias dictionary will override standard
;; definitions.
- (setq found (ispell-aspell-add-aliases found))
+ (setq found (ispell-aspell-add-aliases found)
+ ispell--aspell-found-dictionaries (copy-sequence found))
;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist
;; which have no element in FOUND at all.
(dolist (dict ispell-dictionary-base-alist)
@@ -1377,9 +1382,11 @@ The variable `ispell-library-directory' defines their location."
(if (and name
(or
;; Include all for Aspell (we already know existing dicts)
- ispell-really-aspell
+ (and ispell-really-aspell
+ (assoc name ispell--aspell-found-dictionaries))
;; Include all if `ispell-library-directory' is nil (Hunspell)
- (not ispell-library-directory)
+ (and (not ispell-really-aspell)
+ (not ispell-library-directory))
;; If explicit (-d with an absolute path) and existing dict.
(and dict-explt
(file-name-absolute-p dict-explt)
@@ -1672,14 +1679,13 @@ Valid forms include:
("\\\\bibliographystyle" ispell-tex-arg-end)
("\\\\makebox" ispell-tex-arg-end 0)
("\\\\e?psfig" ispell-tex-arg-end)
- ("\\\\document\\(class\\|style\\)" .
- "\\\\begin[ \t\n]*{[ \t\n]*document[ \t\n]*}"))
+ ("\\\\document\\(class\\|style\\)" . "\\\\begin[ \t\n]*{document}"))
(;; delimited with \begin. In ispell: displaymath, eqnarray, eqnarray*,
;; equation, minipage, picture, tabular, tabular* (ispell)
("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0)
("list" ispell-tex-arg-end 2)
- ("program" . "\\\\end[ \t\n]*{[ \t\n]*program[ \t\n]*}")
- ("verbatim\\*?" . "\\\\end[ \t\n]*{[ \t\n]*verbatim\\*?[ \t\n]*}"))))
+ ("program" . "\\\\end[ \t]*{program}")
+ ("verbatim\\*?" . "\\\\end[ \t]*{verbatim\\*?}"))))
"Lists of regions to be skipped in TeX mode.
First list is used raw.
Second list has key placed inside \\begin{}.
@@ -2398,24 +2404,24 @@ Global `ispell-quit' set to start location to continue spell session."
Selections are:
-DIGIT: Replace the word with a digit offered in the *Choices* buffer.
-SPC: Accept word this time.
-`i': Accept word and insert into private dictionary.
-`a': Accept word for this session.
-`A': Accept word and place in `buffer-local dictionary'.
-`r': Replace word with typed-in value. Rechecked.
-`R': Replace word with typed-in value. Query-replaced in buffer. Rechecked.
-`?': Show these commands.
-`x': Exit spelling buffer. Move cursor to original point.
-`X': Exit spelling buffer. Leaves cursor at the current point, and permits
+\\`0'..\\`9' Replace the word with a digit offered in the *Choices* buffer.
+\\`SPC' Accept word this time.
+\\`i' Accept word and insert into private dictionary.
+\\`a' Accept word for this session.
+\\`A' Accept word and place in `buffer-local dictionary'.
+\\`r' Replace word with typed-in value. Rechecked.
+\\`R' Replace word with typed-in value. Query-replaced in buffer. Rechecked.
+\\`?' Show these commands.
+\\`x' Exit spelling buffer. Move cursor to original point.
+\\`X' Exit spelling buffer. Leaves cursor at the current point, and permits
the aborted check to be completed later.
-`q': Quit spelling session (Kills ispell process).
-`l': Look up typed-in replacement in alternate dictionary. Wildcards okay.
-`u': Like `i', but the word is lower-cased first.
-`m': Place typed-in value in personal dictionary, then recheck current word.
-`C-l': Redraw screen.
-`C-r': Recursive edit.
-`C-z': Suspend Emacs or iconify frame."
+\\`q' Quit spelling session (Kills ispell process).
+\\`l' Look up typed-in replacement in alternate dictionary. Wildcards okay.
+\\`u' Like \\`i', but the word is lower-cased first.
+\\`m' Place typed-in value in personal dictionary, then recheck current word.
+\\`C-l' Redraw screen.
+\\`C-r' Recursive edit.
+\\`C-z' Suspend Emacs or iconify frame."
(if (equal ispell-help-in-bufferp 'electric)
(progn
@@ -2428,26 +2434,28 @@ SPC: Accept word this time.
;;(if (< (window-height) 15)
;; (enlarge-window
;; (- 15 (ispell-adjusted-window-height))))
- (princ "Selections are:
-
-DIGIT: Replace the word with a digit offered in the *Choices* buffer.
-SPC: Accept word this time.
-`i': Accept word and insert into private dictionary.
-`a': Accept word for this session.
-`A': Accept word and place in `buffer-local dictionary'.
-`r': Replace word with typed-in value. Rechecked.
-`R': Replace word with typed-in value. Query-replaced in buffer. Rechecked.
-`?': Show these commands.
-`x': Exit spelling buffer. Move cursor to original point.
-`X': Exit spelling buffer. Leaves cursor at the current point, and permits
- the aborted check to be completed later.
-`q': Quit spelling session (Kills ispell process).
-`l': Look up typed-in replacement in alternate dictionary. Wildcards okay.
-`u': Like `i', but the word is lower-cased first.
-`m': Place typed-in value in personal dictionary, then recheck current word.
-`C-l': Redraw screen.
-`C-r': Recursive edit.
-`C-z': Suspend Emacs or iconify frame.")
+ (princ
+ (substitute-command-keys
+ "Selections are:
+
+\\`0'..\\`9' Replace the word with a digit offered in the *Choices* buffer.
+\\`SPC' Accept word this time.
+\\`i' Accept word and insert into private dictionary.
+\\`a' Accept word for this session.
+\\`A' Accept word and place in `buffer-local dictionary'.
+\\`r' Replace word with typed-in value. Rechecked.
+\\`R' Replace word with typed-in value. Query-replaced in buffer. Rechecked.
+\\`?' Show these commands.
+\\`x' Exit spelling buffer. Move cursor to original point.
+\\`X' Exit spelling buffer. Leaves cursor at the current point, and permits
+ the aborted check to be completed later.
+\\`q' Quit spelling session (Kills ispell process).
+\\`l' Look up typed-in replacement in alternate dictionary. Wildcards okay.
+\\`u' Like \\`i', but the word is lower-cased first.
+\\`m' Place typed-in value in personal dictionary, then recheck current word.
+\\`C-l' Redraw screen.
+\\`C-r' Recursive edit.
+\\`C-z' Suspend Emacs or iconify frame."))
nil)))
@@ -2607,15 +2615,18 @@ Optional REFRESH will unhighlighted then highlight, using block cursor
(text (buffer-substring-no-properties start end))
; Save highlight region.
(inhibit-quit t) ; inhibit interrupt processing here.
- (buffer-undo-list t)) ; don't clutter the undo list.
+ (buffer-undo-list t) ; don't clutter the undo list.
+ (end1 (if (markerp end) (marker-position end) end)))
(goto-char end)
(delete-region start end)
- (insert-char ? (- end start)) ; minimize amount of redisplay
+ (insert-char ? (- end1 start)) ; minimize amount of redisplay
(sit-for 0) ; update display
(if highlight (setq inverse-video (not inverse-video))) ; toggle video
- (delete-region start end) ; delete whitespace
+ (delete-region start end1) ; delete whitespace
(insert text) ; insert text in inverse video.
(sit-for 0) ; update display showing inverse video.
+ (if (markerp end)
+ (set-marker end end1)) ; restore marker position
(if (not highlight)
(goto-char end)
(setq inverse-video (not inverse-video)) ; toggle video
@@ -2984,8 +2995,7 @@ By just answering RET you can find out what the current dictionary is."
(interactive
(list (completing-read
"Use new dictionary (RET for current, SPC to complete): "
- (and (fboundp 'ispell-valid-dictionary-list)
- (mapcar #'list (ispell-valid-dictionary-list)))
+ (mapcar #'list (ispell-valid-dictionary-list))
nil t)
current-prefix-arg))
(ispell-set-spellchecker-params) ; Initialize variables and dicts alists
@@ -3045,6 +3055,8 @@ when needed."
;;;###autoload
(defun ispell-region (reg-start reg-end &optional recheckp shift)
"Interactively check a region for spelling errors.
+Leave the mark at the last misspelled word that the user was queried about.
+
Return nil if spell session was terminated, otherwise returns shift offset
amount for last line processed."
(interactive "r") ; Don't flag errors on read-only bufs.
@@ -3056,7 +3068,8 @@ amount for last line processed."
(region-type (if (and (= reg-start (point-min)) (= reg-end (point-max)))
(buffer-name) "region"))
(program-basename (file-name-nondirectory ispell-program-name))
- (dictionary (or ispell-current-dictionary "default")))
+ (dictionary (or ispell-current-dictionary "default"))
+ max-word)
(unwind-protect
(save-excursion
(message "Spell-checking %s using %s with %s dictionary..."
@@ -3152,10 +3165,14 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r
;; Reset `in-comment' (and indirectly `add-comment') for new line
in-comment nil))
(setq ispell-end (point)) ; "end" tracks region retrieved.
- (if string ; there is something to spell check!
- ;; (special start end)
- (setq shift (ispell-process-line string
- (and recheckp shift))))
+ ;; There is something to spell check!
+ (when string
+ ;; (special start end)
+ (let ((res (ispell-process-line string
+ (and recheckp shift))))
+ (setq shift (car res))
+ (when (cdr res)
+ (setq max-word (cdr res)))))
(goto-char ispell-end)))))
(if ispell-quit
nil
@@ -3166,6 +3183,9 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r
(kill-buffer ispell-choices-buffer))
(set-marker skip-region-start nil)
(set-marker rstart nil)
+ ;; Allow the user to pop back to the last position.
+ (when max-word
+ (push-mark max-word t))
(if ispell-quit
(progn
;; preserve or clear the region for ispell-continue.
@@ -3400,9 +3420,12 @@ Returns a string with the line data."
This will modify the buffer for spelling errors.
Requires variables ISPELL-START and ISPELL-END to be defined in its
dynamic scope.
-Returns the sum SHIFT due to changes in word replacements."
+
+Returns a cons cell where the `car' is sum SHIFT due to changes
+in word replacements, and the `cdr' is the location of the final
+word that was queried about."
;;(declare special ispell-start ispell-end)
- (let (poss accept-list)
+ (let (poss accept-list max-word)
(if (not (numberp shift))
(setq shift 0))
;; send string to spell process and get input.
@@ -3456,6 +3479,7 @@ Returns the sum SHIFT due to changes in word replacements."
(error (concat "Ispell misalignment: word "
"`%s' point %d; probably incompatible versions")
ispell-pipe-word actual-point)))
+ (setq max-word (marker-position word-start))
;; ispell-cmd-loop can go recursive & change buffer
(if ispell-keep-choices-win
(setq replace (ispell-command-loop
@@ -3552,7 +3576,7 @@ Returns the sum SHIFT due to changes in word replacements."
(set-marker line-end nil)))
;; Finished with misspelling!
(setq ispell-filter (cdr ispell-filter)))
- shift))
+ (cons shift max-word)))
;;;###autoload
@@ -3593,7 +3617,8 @@ to limit the check."
;;;###autoload
(defun ispell-buffer ()
- "Check the current buffer for spelling errors interactively."
+ "Check the current buffer for spelling errors interactively.
+Leave the mark at the last misspelled word that the user was queried about."
(interactive)
(ispell-region (point-min) (point-max)))
@@ -3883,8 +3908,8 @@ Don't check spelling of message headers except the Subject field.
Don't check included messages.
To abort spell checking of a message region and send the message anyway,
-use the `x' command. (Any subsequent regions will be checked.)
-The `X' command aborts sending the message so that you can edit the buffer.
+use the \\`x' command. (Any subsequent regions will be checked.)
+The \\`X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
in your init file:
@@ -3975,7 +4000,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to
(if (re-search-forward "^Subject: *" end-of-headers t)
(progn
(goto-char (match-end 0))
- (if (and (not (looking-at ".*Re\\>"))
+ (if (and (not (looking-at ".*\\<Re\\>"))
(not (looking-at "\\[")))
(progn
(setq case-fold-search old-case-fold-search)
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index 24149f9afb8..6b71f26e4f2 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -515,13 +515,12 @@ resets the page-delimiter to the original value."
(defvar pages-buffer-original-position)
(defvar pages-buffer-original-page)
-(defun pages-directory
- (pages-list-all-headers-p count-lines-p &optional regexp)
+(defun pages-directory (pages-list-all-headers-p count-lines-p &optional regexp)
"Display a directory of the page headers in a temporary buffer.
A header is the first non-blank line after the `page-delimiter'.
-\\[pages-directory-mode]
+\\<pages-directory-mode-map>
You may move point to one of the lines in the temporary buffer,
-then use \\<pages-directory-goto> to go to the same line in the pages buffer.
+then use \\[pages-directory-goto] to go to the same line in the pages buffer.
In interactive use:
@@ -587,7 +586,9 @@ directory for only the accessible portion of the buffer."
(pages-directory-mode)
(setq buffer-read-only nil)
(insert
- "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
+ (substitute-command-keys
+ "==== Pages Directory: use \\<pages-directory-mode-map>\
+\\[pages-directory-goto] to go to page under cursor. ====") "\n")
(setq pages-buffer pages-target-buffer)
(setq pages-pos-list nil))
@@ -772,7 +773,9 @@ directory."
(goto-char (point-min))
(delete-region (point) (line-end-position))
(insert
- "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
+ (substitute-command-keys
+ "=== Address List Directory: use \\<pages-directory-mode-map>\
+\\[pages-directory-goto] to go to page under cursor. ==="))
(set-buffer-modified-p nil)
))
(error "No addresses file found!")))
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index 3fc18323349..5d6f017eb99 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -35,11 +35,18 @@ A page boundary is any line whose beginning matches the regexp
(interactive "p")
(or count (setq count 1))
(while (and (> count 0) (not (eobp)))
- ;; In case the page-delimiter matches the null string,
- ;; don't find a match without moving.
- (if (bolp) (forward-char 1))
- (unless (re-search-forward page-delimiter nil t)
- (goto-char (point-max)))
+ (if (and (looking-at page-delimiter)
+ (> (match-end 0) (point)))
+ ;; If we're standing at the page delimiter, then just skip to
+ ;; the end of it. (But only if it's not a zero-length
+ ;; delimiter, because then we wouldn't have forward progress.)
+ (goto-char (match-end 0))
+ ;; In case the page-delimiter matches the null string,
+ ;; don't find a match without moving.
+ (when (bolp)
+ (forward-char 1))
+ (unless (re-search-forward page-delimiter nil t)
+ (goto-char (point-max))))
(setq count (1- count)))
(while (and (< count 0) (not (bobp)))
;; In case the page-delimiter matches the null string,
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 29804c3bfd2..cd726ad4776 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -96,8 +96,8 @@ lines that start paragraphs from lines that separate them.
If the variable `use-hard-newlines' is non-nil, then only lines following a
hard newline are considered to match."
- :type 'regexp)
-(put 'paragraph-start 'safe-local-variable #'stringp)
+ :type 'regexp
+ :safe #'stringp)
;; paragraph-start requires a hard newline, but paragraph-separate does not:
;; It is assumed that paragraph-separate is distinctive enough to be believed
@@ -113,8 +113,8 @@ This is matched against the text at the left margin, which is not necessarily
the beginning of the line, so it should not use \"^\" as an anchor. This
ensures that the paragraph functions will work equally within a region of
text indented by a margin setting."
- :type 'regexp)
-(put 'paragraph-separate 'safe-local-variable #'stringp)
+ :type 'regexp
+ :safe #'stringp)
(defcustom sentence-end-double-space t
"Non-nil means a single space does not end a sentence.
@@ -125,8 +125,8 @@ This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
:type 'boolean
+ :safe #'booleanp
:group 'fill)
-(put 'sentence-end-double-space 'safe-local-variable #'booleanp)
(defcustom sentence-end-without-period nil
"Non-nil means a sentence will end without a period.
@@ -137,8 +137,8 @@ This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
:type 'boolean
+ :safe #'booleanp
:group 'fill)
-(put 'sentence-end-without-period 'safe-local-variable #'booleanp)
(defcustom sentence-end-without-space
"。.?!"
@@ -147,8 +147,8 @@ regexp describing the end of a sentence, when the value of the variable
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
- :type 'string)
-(put 'sentence-end-without-space 'safe-local-variable #'stringp)
+ :type 'string
+ :safe #'stringp)
(defcustom sentence-end nil
"Regexp describing the end of a sentence.
@@ -158,14 +158,14 @@ All paragraph boundaries also end sentences, regardless.
The value nil means to use the default value defined by the
function `sentence-end'. You should always use this function
to obtain the value of this variable."
- :type '(choice regexp (const :tag "Use default value" nil)))
-(put 'sentence-end 'safe-local-variable #'string-or-null-p)
+ :type '(choice regexp (const :tag "Use default value" nil))
+ :safe #'string-or-null-p)
(defcustom sentence-end-base "[.?!…‽][]\"'”’)}»›]*"
"Regexp matching the basic end of a sentence, not including following space."
:type 'regexp
+ :safe #'stringp
:version "25.1")
-(put 'sentence-end-base 'safe-local-variable #'stringp)
(defun sentence-end ()
"Return the regexp describing the end of a sentence.
@@ -192,14 +192,14 @@ in between. See Info node `(elisp)Standard Regexps'."
(defcustom page-delimiter "^\014"
"Regexp describing line-beginnings that separate pages."
- :type 'regexp)
-(put 'page-delimiter 'safe-local-variable #'stringp)
+ :type 'regexp
+ :safe #'stringp)
(defcustom paragraph-ignore-fill-prefix nil
"Non-nil means the paragraph commands are not affected by `fill-prefix'.
This is desirable in modes where blank lines are the paragraph delimiters."
- :type 'boolean)
-(put 'paragraph-ignore-fill-prefix 'safe-local-variable #'booleanp)
+ :type 'boolean
+ :safe #'booleanp)
;; Silence the compiler.
(defun forward-paragraph (&optional arg)
@@ -477,20 +477,60 @@ sentences. Also, every paragraph boundary terminates sentences as well."
(skip-chars-backward " \t\n")
(goto-char par-end)))
(setq arg (1- arg)))
- (constrain-to-field nil opoint t)))
-
-(defun repunctuate-sentences (&optional no-query)
+ (let ((npoint (constrain-to-field nil opoint t)))
+ (not (= npoint opoint)))))
+
+(defun count-sentences (start end)
+ "Count sentences in current buffer from START to END."
+ (let ((sentences 0)
+ (inhibit-field-text-motion t))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (ignore-errors (forward-sentence))
+ (setq sentences (1+ sentences)))
+ ;; Remove last possibly empty sentence
+ (when (/= (skip-chars-backward " \t\n") 0)
+ (setq sentences (1- sentences)))
+ sentences))))
+
+(defun repunctuate-sentences-filter (_start _end)
+ "Search filter used by `repunctuate-sentences' to skip unneeded spaces.
+By default, it skips occurrences that already have two spaces."
+ (/= 2 (- (point) (save-excursion (skip-chars-backward " ") (point)))))
+
+(defvar repunctuate-sentences-filter #'repunctuate-sentences-filter
+ "The default filter used by `repunctuate-sentences'.
+It is advised to use `add-function' on this to add more filters,
+for example, `(looking-back (rx (or \"e.g.\" \"i.e.\") \" \") 5)'
+with a set of predefined abbreviations to skip from adding two spaces.")
+
+(defun repunctuate-sentences (&optional no-query start end)
"Put two spaces at the end of sentences from point to the end of buffer.
-It works using `query-replace-regexp'.
-If optional argument NO-QUERY is non-nil, make changes without
-asking for confirmation."
- (interactive)
+It works using `query-replace-regexp'. In Transient Mark mode,
+if the mark is active, operate on the contents of the region.
+Second and third arg START and END specify the region to operate on.
+If optional argument NO-QUERY is non-nil, make changes without asking
+for confirmation. You can use `repunctuate-sentences-filter' to add
+filters to skip occurrences of spaces that don't need to be replaced."
+ (interactive (list nil
+ (if (use-region-p) (region-beginning))
+ (if (use-region-p) (region-end))))
(let ((regexp "\\([]\"')]?\\)\\([.?!]\\)\\([]\"')]?\\) +")
(to-string "\\1\\2\\3 "))
(if no-query
- (while (re-search-forward regexp nil t)
- (replace-match to-string))
- (query-replace-regexp regexp to-string))))
+ (progn
+ (when start (goto-char start))
+ (while (re-search-forward regexp end t)
+ (replace-match to-string)))
+ (unwind-protect
+ (progn
+ (add-function :after-while isearch-filter-predicate
+ repunctuate-sentences-filter)
+ (query-replace-regexp regexp to-string nil start end))
+ (remove-function isearch-filter-predicate
+ repunctuate-sentences-filter)))))
(defun backward-sentence (&optional arg)
diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el
new file mode 100644
index 00000000000..e47653e734a
--- /dev/null
+++ b/lisp/textmodes/pixel-fill.el
@@ -0,0 +1,240 @@
+;;; pixel-fill.el --- variable pitch filling functions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: filling
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The main entry point is `pixel-fill-region', but
+;; `pixel-fill-find-fill-point' can also be useful by itself.
+
+;;; Code:
+
+(require 'kinsoku)
+
+(defgroup pixel-fill nil
+ "Filling based on pixel widths."
+ :group 'fill
+ :version "29.1")
+
+(defcustom pixel-fill-respect-kinsoku t
+ "If nil, fill even if we can't find a good kinsoku point.
+Kinsoku is a Japanese word meaning a rule that should not be violated.
+In Emacs, it is a term used for characters, e.g. punctuation marks,
+parentheses, and so on, that should not be placed in the beginning
+of a line or the end of a line."
+ :type 'boolean
+ :version "29.1")
+
+(defun pixel-fill-width (&optional columns window)
+ "Return the pixel width corresponding to COLUMNS in WINDOW.
+If COLUMNS is nil or omitted, use the entire window width.
+
+If WINDOW is nil or omitted, this defaults to the selected window."
+ (unless window
+ (setq window (selected-window)))
+ (let ((frame (window-frame window)))
+ (if columns
+ (* (frame-char-width frame) columns)
+ (- (window-body-width nil t)
+ (* 2 (frame-char-width frame))
+ ;; We need to adjust the available width for when the user
+ ;; disables the fringes, which will cause the display
+ ;; engine usurp one column for the continuation glyph.
+ (if (and (fboundp 'fringe-columns)
+ (or (not (zerop (fringe-columns 'right)))
+ (not (zerop (fringe-columns 'left)))))
+ 0
+ (* (frame-char-width frame) 2))
+ 1))))
+
+(defun pixel-fill-region (start end pixel-width)
+ "Fill the region between START and END.
+This will attempt to reformat the text in the region to have no
+lines that are visually wider than PIXEL-WIDTH.
+
+If START isn't at the start of a line, the horizontal position of
+START, converted to pixel units, will be used as the indentation
+prefix on subsequent lines."
+ (save-excursion
+ (goto-char start)
+ (let ((indentation
+ (car (window-text-pixel-size nil (line-beginning-position)
+ (point))))
+ (newline-end nil))
+ (when (> indentation pixel-width)
+ (error "The indentation (%s) is wider than the fill width (%s)"
+ indentation pixel-width))
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-max))
+ (when (looking-back "\n[ \t]*" (point-min))
+ (setq newline-end t))
+ (goto-char (point-min))
+ ;; First replace all whitespace with space.
+ (while (re-search-forward "[ \t\n]+" nil t)
+ (cond
+ ((or (= (match-beginning 0) start)
+ (= (match-end 0) end))
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; If there's just a single space here, don't replace.
+ ((not (and (= (- (match-end 0) (match-beginning 0)) 1)
+ (= (char-after (match-beginning 0)) ?\s)))
+ (replace-match
+ ;; We need to use a space that has an appropriate width.
+ (propertize " " 'face
+ (get-text-property (match-beginning 0) 'face))))))
+ (goto-char start)
+ (pixel-fill--fill-line pixel-width indentation)
+ (goto-char (point-max))
+ (when newline-end
+ (insert "\n"))))))
+
+(defun pixel-fill--goto-pixel (width)
+ (vertical-motion (cons (/ width (frame-char-width)) 0)))
+
+(defun pixel-fill--fill-line (width &optional indentation)
+ (let ((start (point)))
+ (pixel-fill--goto-pixel width)
+ (while (not (eolp))
+ ;; We have to do some folding. First find the first previous
+ ;; point suitable for folding.
+ (when (or (not (pixel-fill-find-fill-point (line-beginning-position)))
+ (= (point) start))
+ ;; We had unbreakable text (for this width), so just go to
+ ;; the first space and carry on.
+ (beginning-of-line)
+ (skip-chars-forward " ")
+ (search-forward " " (line-end-position) 'move))
+ (when (= (preceding-char) ?\s)
+ (delete-char -1))
+ (unless (eobp)
+ (insert ?\n)
+ (when (> indentation 0)
+ (insert (propertize " " 'display
+ (list 'space :align-to (list indentation))))))
+ (setq start (point))
+ (unless (eobp)
+ (pixel-fill--goto-pixel width)))))
+
+(define-inline pixel-fill--char-breakable-p (char)
+ "Return non-nil if a line can be broken before and after CHAR."
+ (inline-quote (aref fill-find-break-point-function-table ,char)))
+
+(define-inline pixel-fill--char-nospace-p (char)
+ "Return non-nil if no space is required before and after CHAR."
+ (inline-quote (aref fill-nospace-between-words-table ,char)))
+
+(define-inline pixel-fill--char-kinsoku-bol-p (char)
+ "Return non-nil if a line ought not to begin with CHAR."
+ (inline-letevals (char)
+ (inline-quote (and (not (eq ,char ?'))
+ (aref (char-category-set ,char) ?>)))))
+
+(define-inline pixel-fill--char-kinsoku-eol-p (char)
+ "Return non-nil if a line ought not to end with CHAR."
+ (inline-quote (aref (char-category-set ,char) ?<)))
+
+(defun pixel-fill-find-fill-point (start)
+ "Find a place suitable for breaking the current line.
+START should be the earliest buffer position that should be considered
+(typically the start of the line), and this function will search
+backward in the current buffer from the current position."
+ (let ((bp (point))
+ (end (point))
+ failed)
+ (while (not
+ (or (setq failed (<= (point) start))
+ (eq (preceding-char) ?\s)
+ (eq (following-char) ?\s)
+ (pixel-fill--char-breakable-p (preceding-char))
+ (pixel-fill--char-breakable-p (following-char))
+ (and (pixel-fill--char-kinsoku-bol-p (preceding-char))
+ (pixel-fill--char-breakable-p (following-char))
+ (not (pixel-fill--char-kinsoku-bol-p (following-char))))
+ (pixel-fill--char-kinsoku-eol-p (following-char))
+ (bolp)))
+ (backward-char 1))
+ (if failed
+ ;; There's no breakable point, so we give it up.
+ (let (found)
+ (goto-char bp)
+ ;; Don't overflow the window edge, even if
+ ;; `pixel-fill-respect-kinsoku' is t.
+ (when pixel-fill-respect-kinsoku
+ (while (setq found (re-search-forward
+ "\\(\\c>\\)\\| \\|\\c<\\|\\c|"
+ (line-end-position) 'move)))
+ (if (and found
+ (not (match-beginning 1)))
+ (goto-char (match-beginning 0)))))
+ (or
+ (eolp)
+ ;; Don't put kinsoku-bol characters at the beginning of a line,
+ ;; or kinsoku-eol characters at the end of a line.
+ (cond
+ ;; Don't overflow the window edge, even if `pixel-fill-respect-kinsoku'
+ ;; is t.
+ ((not pixel-fill-respect-kinsoku)
+ (while (and (not (eq (preceding-char) ?\s))
+ (or (pixel-fill--char-kinsoku-eol-p (preceding-char))
+ (pixel-fill--char-kinsoku-bol-p (following-char))))
+ (backward-char 1))
+ (when (setq failed (<= (point) start))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we look for the second best position.
+ (while (and (progn
+ (forward-char 1)
+ (<= (point) end))
+ (progn
+ (setq bp (point))
+ (pixel-fill--char-kinsoku-eol-p (following-char)))))
+ (goto-char bp)))
+ ((pixel-fill--char-kinsoku-eol-p (preceding-char))
+ ;; Find backward the point where kinsoku-eol characters begin.
+ (let ((count 4))
+ (while
+ (progn
+ (backward-char 1)
+ (and (> (setq count (1- count)) 0)
+ (not (eq (preceding-char) ?\s))
+ (or (pixel-fill--char-kinsoku-eol-p (preceding-char))
+ (pixel-fill--char-kinsoku-bol-p (following-char)))))))
+ (when (setq failed (<= (point) start))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we go to the second best position.
+ (if (looking-at "\\(\\c<+\\)\\c<")
+ (goto-char (match-end 1))
+ (forward-char 1))))
+ ((pixel-fill--char-kinsoku-bol-p (following-char))
+ ;; Find forward the point where kinsoku-bol characters end.
+ (let ((count 4))
+ (while (progn
+ (forward-char 1)
+ (and (>= (setq count (1- count)) 0)
+ (pixel-fill--char-kinsoku-bol-p (following-char))
+ (pixel-fill--char-breakable-p (following-char))))))))
+ (when (eq (following-char) ?\s)
+ (forward-char 1))))
+ (not failed)))
+
+(provide 'pixel-fill)
+
+;;; pixel-fill.el ends here
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 4e487d745c2..26b14ebc79e 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -360,7 +360,7 @@ The name of the first different author/editor is used."
;; Parse the bibliography environment
(defun reftex-extract-bib-entries-from-thebibliography (files)
- "Extract bib-entries from the \begin{thebibliography} environment.
+ "Extract bib-entries from the \\begin{thebibliography} environment.
Parsing is not as good as for the BibTeX database stuff.
The environment should be located in FILES."
(let* (start end buf entries re re-list file default)
@@ -580,7 +580,7 @@ If FORMAT is non-nil `format' entry accordingly."
(concat key "\n " authors " " year " " extra "\n " title "\n\n")))
(defun reftex-parse-bibitem (item)
- "Parse a \bibitem entry in ITEM."
+ "Parse a \\bibitem entry in ITEM."
(let ((key "") (text ""))
(when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item)
(setq key (match-string 1 item)
@@ -596,7 +596,7 @@ If FORMAT is non-nil `format' entry accordingly."
(cons "&entry" (concat key " " text)))))
(defun reftex-format-bibitem (item)
- "Format a \bibitem entry in ITEM so that it is (relatively) nice to look at."
+ "Format a \\bibitem entry in ITEM so that it is (relatively) nice to look at."
(let ((text (reftex-get-bib-field "&text" item))
(key (reftex-get-bib-field "&key" item))
(lines nil))
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index c7e34b4b90a..062cea9c505 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -154,8 +154,10 @@ No active TAGS table is required."
(erase-buffer)
(insert " MULTIPLE LABELS IN CURRENT DOCUMENT:\n")
(insert
- " Move point to label and type `r' to run a query-replace on the label\n"
- " and its references. Type `q' to exit this buffer.\n\n")
+ (substitute-command-keys
+ " Move point to label and type \\`r' to run a query-replace on the label\n")
+ (substitute-command-keys
+ " and its references. Type \\`q' to exit this buffer.\n\n"))
(insert " LABEL FILE\n")
(insert " -------------------------------------------------------------\n")
(use-local-map (make-sparse-keymap))
@@ -188,8 +190,8 @@ No active TAGS table is required."
default))))
(if (string= from "") (setq from default))
(unless to
- (setq to (read-string (format "Replace label %s with: "
- from))))
+ (setq to (read-string (format "Replace label %s with: " from)
+ nil nil from)))
(reftex-query-replace-document
(concat "{" (regexp-quote from) "}")
(format "{%s}" to))))
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index c28f31d5647..b517cc16634 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -29,9 +29,7 @@
(require 'reftex)
-;; START remove for XEmacs release
(defvar TeX-master)
-;; END remove for XEmacs release
;;;###autoload
(defun reftex-index-selection-or-word (&optional arg phrase)
@@ -271,8 +269,6 @@ will prompt for other arguments."
(and newtag (cdr cell) (not (member newtag (cdr cell)))
(push newtag (cdr cell)))))
-(define-obsolete-variable-alias
- 'reftex-index-map 'reftex-index-mode-map "24.1")
(defvar reftex-index-mode-map
(let ((map (make-sparse-keymap)))
;; Index map
@@ -1200,8 +1196,6 @@ This gets refreshed in every phrases command.")
'((reftex-index-phrases-font-lock-keywords)
nil t nil beginning-of-line)
"Font lock defaults for `reftex-index-phrases-mode'.")
-(define-obsolete-variable-alias
- 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1")
(defvar reftex-index-phrases-mode-map
(let ((map (make-sparse-keymap)))
;; Keybindings and Menu for phrases buffer
@@ -1274,10 +1268,11 @@ This gets refreshed in every phrases command.")
;;;###autoload
(defun reftex-index-phrase-selection-or-word (arg)
"Add current selection or word at point to the phrases buffer.
+\\<reftex-index-phrases-mode-map>
When you are in transient-mark-mode and the region is active, the
selection will be used - otherwise the word at point.
You get a chance to edit the entry in the phrases buffer - finish with
-`C-c C-c'."
+\\[reftex-index-phrases-save-and-return]."
(interactive "P")
(set-marker reftex-index-return-marker (point))
(reftex-index-selection-or-word arg 'phrase)
@@ -1375,7 +1370,7 @@ If the buffer is non-empty, delete the old header first."
;;;###autoload
(define-derived-mode reftex-index-phrases-mode fundamental-mode "Phrases"
"Major mode for managing the Index phrases of a LaTeX document.
-This buffer was created with RefTeX.
+This buffer was created with RefTeX. \\<reftex-index-phrases-mode-map>
To insert new phrases, use
- `C-c \\' in the LaTeX document to copy selection or word
@@ -1686,8 +1681,8 @@ this function repeatedly."
(defun reftex-index-phrases-set-macro-key ()
"Change the macro key for the current line.
Prompts for a macro key and insert is at the beginning of the line.
-If you reply with SPACE, the macro keyn will be removed, so that the
-default macro will be used. If you reply with `RET', just prints
+If you reply with \\`SPC', the macro key will be removed, so that the
+default macro will be used. If you reply with \\`RET', just prints
information about the currently selected macro."
(interactive)
(reftex-index-phrases-parse-header)
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index e34c45178b4..49cef297882 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -345,7 +345,17 @@ of master file."
;; Find external document specifications
(goto-char 1)
- (while (re-search-forward "[\n\r][ \t]*\\\\externaldocument\\(\\[\\([^]]*\\)\\]\\)?{\\([^}]+\\)}" nil t)
+ (while (re-search-forward
+ (concat "[\n\r][ \t]*"
+ ;; Support \externalcitedocument macro
+ "\\\\external\\(?:cite\\)?document"
+ ;; The optional prefix
+ "\\(\\[\\([^]]*\\)\\]\\)?"
+ ;; The 2nd opt. arg can only be nocite
+ "\\(?:\\[nocite\\]\\)?"
+ ;; Mandatory file argument
+ "{\\([^}]+\\)}")
+ nil t)
(push (list 'xr-doc (reftex-match-string 2)
(reftex-match-string 3))
docstruct))
@@ -360,13 +370,18 @@ of master file."
docstruct))
(defun reftex-using-biblatex-p ()
- "Return non-nil if we are using biblatex rather than bibtex."
+ "Return non-nil if we are using biblatex or other specific cite package.
+biblatex and other similar packages like multibib allow multiple macro
+calls to load a bibliography file. This function should be able to
+detect those packages."
(if (boundp 'TeX-active-styles)
;; the sophisticated AUCTeX way
- (member "biblatex" TeX-active-styles)
+ (or (member "biblatex" TeX-active-styles)
+ (member "multibib" TeX-active-styles))
;; poor-man's check...
(save-excursion
- (re-search-forward "^[^%\n]*?\\\\usepackage.*{biblatex}" nil t))))
+ (re-search-forward
+ "^[^%\n]*?\\\\usepackage\\(\\[[^]]*\\]\\)?{biblatex\\|multibib}" nil t))))
;;;###autoload
(defun reftex-locate-bibliography-files (master-dir &optional files)
@@ -374,7 +389,7 @@ of master file."
(unless files
(save-excursion
(goto-char (point-min))
- ;; when biblatex is used, multiple \bibliography or
+ ;; when biblatex or multibib are used, multiple \bibliography or
;; \addbibresource macros are allowed. With plain bibtex, only
;; the first is used.
(let ((using-biblatex (reftex-using-biblatex-p))
@@ -382,7 +397,7 @@ of master file."
(while (and again
(re-search-forward
(concat
- ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\("
+ ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\("
"\\(^\\)[^%\n\r]*\\\\\\("
(mapconcat #'identity reftex-bibliography-commands "\\|")
"\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)")
@@ -405,7 +420,7 @@ of master file."
;; find the file
(reftex-locate-file x "bib" master-dir)))
files))
- (delq nil files)))
+ (delq nil (delete-dups files))))
(defun reftex-replace-label-list-segment (old insert &optional entirely)
"Replace the segment in OLD which corresponds to INSERT.
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index d77411483f7..5942801a8a9 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -59,8 +59,6 @@
(define-key map [follow-link] 'mouse-face)
map))
-(define-obsolete-variable-alias
- 'reftex-select-label-map 'reftex-select-label-mode-map "24.1")
(defvar reftex-select-label-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
@@ -109,8 +107,6 @@ During a selection process, these are the local bindings.
;; We do not set a local map - reftex-select-item does this.
)
-(define-obsolete-variable-alias
- 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1")
(defvar reftex-select-bib-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 4ba3c2193ee..5599eaee024 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -28,7 +28,6 @@
(require 'reftex)
;;;
-(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1")
(defvar reftex-toc-mode-map
(let ((map (make-sparse-keymap)))
@@ -157,22 +156,22 @@ Here are all local bindings.
(defconst reftex-toc-help
" AVAILABLE KEYS IN TOC BUFFER
============================
-n / p next-line / previous-line
-SPC Show the corresponding location of the LaTeX document.
-TAB Goto the location and keep the TOC window.
-RET Goto the location and hide the TOC window (also on mouse-2).
-< / > Promote / Demote section, or all sections in region.
-C-c > Display Index. With prefix arg, restrict index to current section.
-q / k Hide/Kill *toc* buffer, return to position of reftex-toc command.
-l i c F Toggle display of [l]abels, [i]ndex, [c]ontext, [F]ile borders.
-t Change maximum toc depth (e.g. `3 t' hides levels greater than 3).
-f / g Toggle follow mode / Refresh *toc* buffer.
-a / d Toggle auto recenter / Toggle dedicated frame
-r / C-u r Reparse the LaTeX document / Reparse entire LaTeX document.
-. In other window, show position from where `reftex-toc' was called.
-M-% Global search and replace to rename label at point.
-x Switch to TOC of external document (with LaTeX package `xr').
-z Jump to a specific section (e.g. '3 z' goes to section 3).")
+\\`n' / \\`p' `next-line' / `previous-line'
+\\`SPC' Show the corresponding location of the LaTeX document.
+\\`TAB' Goto the location and keep the TOC window.
+\\`RET' Goto the location and hide the TOC window (also on `mouse-2').
+\\`<' / \\`>' Promote / Demote section, or all sections in region.
+\\`C-c >' Display Index. With prefix arg, restrict index to current section.
+\\`q' / \\`k' Hide/Kill *toc* buffer, return to position of reftex-toc command.
+\\`l' \\`i' \\`c' \\`F' Toggle display of [l]abels, [i]ndex, [c]ontext, [F]ile borders.
+\\`t' Change maximum toc depth (e.g. `3 t' hides levels greater than 3).
+\\`f' / \\`g' Toggle follow mode / Refresh *toc* buffer.
+\\`a' / \\`d' Toggle auto recenter / Toggle dedicated frame
+\\`r' / \\`C-u r' Reparse the LaTeX document / Reparse entire LaTeX document.
+\\`.' In other window, show position from where `reftex-toc' was called.
+\\`M-%' Global search and replace to rename label at point.
+\\`x' Switch to TOC of external document (with LaTeX package `xr').
+\\`z' Jump to a specific section (e.g. \\`3 z' goes to section 3).")
(defvar reftex--rebuilding-toc nil)
@@ -381,7 +380,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(- (or reftex-last-window-height (window-height))
(window-height)))))
(when (> count 0)
- (with-demoted-errors ;E.g. the window might be the root window!
+ (with-demoted-errors "Enlarge window error: %S"
(enlarge-window count reftex-toc-split-windows-horizontally)))))
(defun reftex-toc-dframe-p (&optional frame error)
@@ -394,7 +393,9 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(frame-parameter frame 'name))
"RefTeX TOC Frame")))
(if (and res error)
- (error "This frame is view-only. Use `C-c =' to create TOC window for commands"))
+ (error (substitute-command-keys
+ "This frame is view-only. Use \\[reftex-toc] \
+to create TOC window for commands")))
res))
(defun reftex-toc-show-help ()
@@ -402,7 +403,9 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(interactive)
(reftex-toc-dframe-p nil 'error)
(with-output-to-temp-buffer "*RefTeX Help*"
- (princ reftex-toc-help))
+ (let ((help (substitute-command-keys reftex-toc-help)))
+ (with-current-buffer standard-output
+ (insert help))))
(reftex-enlarge-to-fit "*RefTeX Help*" t)
;; If follow mode is active, arrange to delay it one command
(if reftex-toc-follow-mode
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 36dd36c95ea..f9f09825fa0 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -70,12 +70,16 @@
("tabwindow" ?f nil nil 1)))
(rotating "Sidewaysfigure and table"
- (("sidewaysfigure" ?f nil nil caption)
- ("sidewaystable" ?t nil nil caption)))
+ (("sidewaysfigure" ?f nil nil caption)
+ ("sidewaysfigure*" ?f nil nil caption)
+ ("sidewaystable" ?t nil nil caption)
+ ("sidewaystable*" ?t nil nil caption)))
- (sidecap "CSfigure and SCtable"
- (("SCfigure" ?f nil nil caption)
- ("SCtable" ?t nil nil caption)))
+ (sidecap "SCfigure and SCtable"
+ (("SCfigure" ?f nil nil caption)
+ ("SCfigure*" ?f nil nil caption)
+ ("SCtable" ?t nil nil caption)
+ ("SCtable*" ?t nil nil caption)))
(subfigure "Subfigure environments/macro"
(("subfigure" ?f nil nil caption)
@@ -392,19 +396,19 @@ that the *toc* window fills half the frame."
(defcustom reftex-toc-include-file-boundaries nil
"Non-nil means, include file boundaries in *toc* buffer.
-This flag can be toggled from within the *toc* buffer with the `F' key."
+This flag can be toggled from within the *toc* buffer with the \\`F' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-include-labels nil
"Non-nil means, include labels in *toc* buffer.
-This flag can be toggled from within the *toc* buffer with the `l' key."
+This flag can be toggled from within the *toc* buffer with the \\`l' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-include-index-entries nil
"Non-nil means, include index entries in *toc* buffer.
-This flag can be toggled from within the *toc* buffer with the `i' key."
+This flag can be toggled from within the *toc* buffer with the \\`i' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
@@ -422,14 +426,14 @@ changed."
(defcustom reftex-toc-include-context nil
"Non-nil means, include context with labels in the *toc* buffer.
Context will only be shown when labels are visible as well.
-This flag can be toggled from within the *toc* buffer with the `c' key."
+This flag can be toggled from within the *toc* buffer with the \\`c' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-follow-mode nil
"Non-nil means, point in *toc* buffer will cause other window to follow.
The other window will show the corresponding part of the document.
-This flag can be toggled from within the *toc* buffer with the `f' key."
+This flag can be toggled from within the *toc* buffer with the \\`f' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
@@ -1314,7 +1318,7 @@ macro before insertion. For example, it will change
\\cite[][]{Jones} -> \\cite{Jones}
\\cite[][Chapter 1]{Jones} -> \\cite[Chapter 1]{Jones}
\\cite[see][]{Jones} -> \\cite[see][]{Jones}
- \\cite[see][Chapter 1]{Jones} -> \\cite{Jones}
+ \\cite[see][Chapter 1]{Jones} -> \\cite[see][Chapter 1]{Jones}
It is possible that other packages have other conventions about which
optional argument is interpreted how - that is why this cleaning up
can be turned off."
@@ -1627,14 +1631,14 @@ to that section."
(defcustom reftex-index-include-context nil
"Non-nil means, display the index definition context in the index buffer.
-This flag may also be toggled from the index buffer with the `c' key."
+This flag may also be toggled from the index buffer with the \\`c' key."
:group 'reftex-index-support
:type 'boolean)
(defcustom reftex-index-follow-mode nil
"Non-nil means, point in *Index* buffer will cause other window to follow.
The other window will show the corresponding part of the document.
-This flag can be toggled from within the *Index* buffer with the `f' key."
+This flag can be toggled from within the *Index* buffer with the \\`f' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
@@ -1863,10 +1867,11 @@ of the regular expressions in this list, that file is not parsed by RefTeX."
(defcustom reftex-enable-partial-scans nil
"Non-nil means, re-parse only 1 file when asked to re-parse.
Re-parsing is normally requested with a \\[universal-argument] prefix to many RefTeX commands,
-or with the `r' key in menus. When this option is t in a multifile document,
+or with the \\`r' key in menus. When this option is t in a multifile document,
we will only parse the current buffer, or the file associated with the label
or section heading near point in a menu. Requesting re-parsing of an entire
-multifile document then requires a \\[universal-argument] \\[universal-argument] prefix or the capital `R' key
+multifile document then requires a \\[universal-argument] \
+\\[universal-argument] prefix or the capital \\`R' key
in menus."
:group 'reftex-optimizations-for-large-documents
:type 'boolean)
@@ -1912,7 +1917,7 @@ when new labels in its category are added. See the variable
When a new label is defined with `reftex-label', all selection buffers
associated with that label category are emptied, in order to force an
update upon next use. When nil, the buffers are left alone and have to be
-updated by hand, with the `g' key from the label selection process.
+updated by hand, with the \\`g' key from the label selection process.
The value of this variable will only have any effect when
`reftex-use-multiple-selection-buffers' is non-nil."
:group 'reftex-optimizations-for-large-documents
@@ -1964,7 +1969,7 @@ instead or as well. The variable may have one of these values:
both Both cursor and mouse trigger highlighting.
Changing this variable requires rebuilding the selection and *toc* buffers
-to become effective (keys `g' or `r')."
+to become effective (keys \\`g' or \\`r')."
:group 'reftex-fontification-configurations
:type '(choice
(const :tag "Never" nil)
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index 907d50889a1..e72576cdc74 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -2257,8 +2257,7 @@ IGNORE-WORDS List of words which should be removed from the string."
("Customize"
["Browse RefTeX Group" reftex-customize t]
"--"
- ["Build Full Customize Menu" reftex-create-customize-menu
- (fboundp 'customize-menu-create)])
+ ["Build Full Customize Menu" reftex-create-customize-menu])
("Documentation"
["Info" reftex-info t]
["Commentary" reftex-show-commentary t])))
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index d65aea62862..f7ebe04bcf5 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -296,7 +296,8 @@ With a prefix or a visible region, use the region as INITIAL."
(insert "\n\n" annotation))
(setq remember-initial-contents nil)
(goto-char (point-min)))
- (message "Use C-c C-c to remember the data.")))
+ (message (substitute-command-keys
+ "Use \\[remember-finalize] to remember the data"))))
;;;###autoload
(defun remember-other-frame (&optional initial)
@@ -653,7 +654,7 @@ to turn the *scratch* buffer into your notes buffer."
(remember-notes-mode 1)
(current-buffer)))))
(when switch-to
- (switch-to-buffer buf))
+ (pop-to-buffer-same-window buf))
buf))
(defun remember-notes--kill-buffer-query ()
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 104812f43cd..10313e99393 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -522,7 +522,7 @@ argument list for `rst-re'.")
(defvar rst-re-alist) ; Forward declare to use it in `rst-re'.
-;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel.
+;; FIXME: Use `rx' instead of re-inventing the wheel.
(rst-testcover-add-compose 'rst-re)
(defun rst-re (&rest args)
;; testcover: ok.
@@ -2351,7 +2351,7 @@ If user selects bullets or #, it's just added with position arranged by
`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
+input a starting item, for example `e' for `A)' style. The position is
also arranged by `rst-insert-list-new-tag'."
(let* ((itemstyle (completing-read
(format-prompt "Select preferred item style" "#.")
@@ -3569,8 +3569,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Font lock
-;; FIXME: The obsolete variables need to disappear.
-
;; The following versions have been done inside Emacs and should not be
;; replaced by `:package-version' attributes until a change.
@@ -3584,125 +3582,46 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-block-face 'rst-block
- "All syntax marking up a special block."
- :version "24.1"
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-block-face
- "customize the face `rst-block' instead."
- "24.1")
-
(defface rst-external '((t :inherit font-lock-type-face))
"Face used for field names and interpreted text."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-external-face 'rst-external
- "Field names and interpreted text."
- :version "24.1"
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-external-face
- "customize the face `rst-external' instead."
- "24.1")
-
(defface rst-definition '((t :inherit font-lock-function-name-face))
"Face used for all other defining constructs."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-definition-face 'rst-definition
- "All other defining constructs."
- :version "24.1"
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-definition-face
- "customize the face `rst-definition' instead."
- "24.1")
-
(defface rst-directive '((t :inherit font-lock-builtin-face))
"Face used for directives and roles."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-directive-face 'rst-directive
- "Directives and roles."
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-directive-face
- "customize the face `rst-directive' instead."
- "24.1")
-
(defface rst-comment '((t :inherit font-lock-comment-face))
"Face used for comments."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-comment-face 'rst-comment
- "Comments."
- :version "24.1"
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-comment-face
- "customize the face `rst-comment' instead."
- "24.1")
-
(defface rst-emphasis1 '((t :inherit italic))
"Face used for simple emphasis."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-emphasis1-face 'rst-emphasis1
- "Simple emphasis."
- :version "24.1"
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-emphasis1-face
- "customize the face `rst-emphasis1' instead."
- "24.1")
-
(defface rst-emphasis2 '((t :inherit bold))
"Face used for double emphasis."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-emphasis2-face 'rst-emphasis2
- "Double emphasis."
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-emphasis2-face
- "customize the face `rst-emphasis2' instead."
- "24.1")
-
(defface rst-literal '((t :inherit font-lock-string-face))
"Face used for literal text."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-literal-face 'rst-literal
- "Literal text."
- :version "24.1"
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-literal-face
- "customize the face `rst-literal' instead."
- "24.1")
-
(defface rst-reference '((t :inherit font-lock-variable-name-face))
"Face used for references to a definition."
:version "24.1"
:group 'rst-faces)
-(defcustom rst-reference-face 'rst-reference
- "References to a definition."
- :version "24.1"
- :group 'rst-faces
- :type '(face))
-(make-obsolete-variable 'rst-reference-face
- "customize the face `rst-reference' instead."
- "24.1")
-
(defface rst-transition '((t :inherit font-lock-keyword-face))
"Face used for a transition."
:package-version '(rst . "1.3.0")
@@ -3794,23 +3713,23 @@ of your own."
;; `Bullet Lists`_
;; FIXME: A bullet directly after a field name is not recognized.
(,(rst-re 'lin-beg '(:grp bul-sta))
- 1 rst-block-face)
+ 1 'rst-block)
;; `Enumerated Lists`_
(,(rst-re 'lin-beg '(:grp enmany-sta))
- 1 rst-block-face)
+ 1 'rst-block)
;; `Definition Lists`_
;; FIXME: missing.
;; `Field Lists`_
(,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx)
- 1 rst-external-face)
+ 1 'rst-external)
;; `Option Lists`_
(,(rst-re 'lin-beg '(:grp opt-tag (:shy optsep-tag opt-tag) "*")
'(:alt "$" (:seq hws-prt "\\{2\\}")))
- 1 rst-block-face)
+ 1 'rst-block)
;; `Line Blocks`_
;; Only for lines containing no more bar - to distinguish from tables.
(,(rst-re 'lin-beg '(:grp "|" bli-sfx) "[^|\n]*$")
- 1 rst-block-face)
+ 1 'rst-block)
;; `Tables`_
;; FIXME: missing
@@ -3818,22 +3737,22 @@ of your own."
;; All the `Explicit Markup Blocks`_
;; `Footnotes`_ / `Citations`_
(,(rst-re 'lin-beg 'fnc-sta-2)
- (1 rst-definition-face)
- (2 rst-definition-face))
+ (1 'rst-definition)
+ (2 'rst-definition))
;; `Directives`_ / `Substitution Definitions`_
(,(rst-re 'lin-beg 'dir-sta-3)
- (1 rst-directive-face)
- (2 rst-definition-face)
- (3 rst-directive-face))
+ (1 'rst-directive)
+ (2 'rst-definition)
+ (3 'rst-directive))
;; `Hyperlink Targets`_
(,(rst-re 'lin-beg
'(:grp exm-sta "_" (:alt
(:seq "`" ilcbkqdef-tag "`")
(:seq (:alt "[^:\\\n]" "\\\\.") "+")) ":")
'bli-sfx)
- 1 rst-definition-face)
+ 1 'rst-definition)
(,(rst-re 'lin-beg '(:grp "__") 'bli-sfx)
- 1 rst-definition-face)
+ 1 'rst-definition)
;; All `Inline Markup`_
;; Most of them may be multiline though this is uninteresting.
@@ -3841,16 +3760,16 @@ of your own."
;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
;; `Strong Emphasis`_.
(,(rst-re 'ilm-pfx '(:grp "\\*\\*" ilcast-tag "\\*\\*") 'ilm-sfx)
- 1 rst-emphasis2-face)
+ 1 'rst-emphasis2)
;; `Emphasis`_
(,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx)
- 1 rst-emphasis1-face)
+ 1 'rst-emphasis1)
;; `Inline Literals`_
(,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx)
- 1 rst-literal-face)
+ 1 'rst-literal)
;; `Inline Internal Targets`_
(,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx)
- 1 rst-definition-face)
+ 1 'rst-definition)
;; `Hyperlink References`_
;; FIXME: `Embedded URIs and Aliases`_ not considered.
;; FIXME: Directly adjacent marked up words are not fontified correctly
@@ -3858,28 +3777,28 @@ of your own."
(,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`")
(:seq "\\sw" (:alt "\\sw" "-") "+\\sw"))
"__?") 'ilm-sfx)
- 1 rst-reference-face)
+ 1 'rst-reference)
;; `Interpreted Text`_
(,(rst-re 'ilm-pfx '(:grp (:shy ":" sym-tag ":") "?")
'(:grp "`" ilcbkq-tag "`")
'(:grp (:shy ":" sym-tag ":") "?") 'ilm-sfx)
- (1 rst-directive-face)
- (2 rst-external-face)
- (3 rst-directive-face))
+ (1 'rst-directive)
+ (2 'rst-external)
+ (3 'rst-directive))
;; `Footnote References`_ / `Citation References`_
(,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx)
- 1 rst-reference-face)
+ 1 'rst-reference)
;; `Substitution References`_
;; FIXME: References substitutions like |this|_ or |this|__ are not
;; fontified correctly.
(,(rst-re 'ilm-pfx '(:grp sub-tag) 'ilm-sfx)
- 1 rst-reference-face)
+ 1 'rst-reference)
;; `Standalone Hyperlinks`_
;; FIXME: This takes it easy by using a whitespace as delimiter.
(,(rst-re 'ilm-pfx '(:grp uri-tag ":\\S +") 'ilm-sfx)
- 1 rst-definition-face)
+ 1 'rst-definition)
(,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx)
- 1 rst-definition-face)
+ 1 'rst-definition)
;; Do all block fontification as late as possible so 'append works.
@@ -3906,18 +3825,18 @@ of your own."
;; `Comments`_
;; This is multiline.
(,(rst-re 'lin-beg 'cmt-sta-1)
- (1 rst-comment-face)
+ (1 'rst-comment)
(rst-font-lock-find-unindented-line-match
(rst-font-lock-find-unindented-line-limit (match-end 1))
nil
- (0 rst-comment-face append)))
+ (0 'rst-comment append)))
(,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$")
- (1 rst-comment-face)
- (2 rst-comment-face)
+ (1'rst-comment)
+ (2'rst-comment)
(rst-font-lock-find-unindented-line-match
(rst-font-lock-find-unindented-line-limit 'next)
nil
- (0 rst-comment-face append)))
+ (0 'rst-comment append)))
;; FIXME: This is not rendered as comment::
;; .. .. list-table::
@@ -3941,11 +3860,11 @@ of your own."
;; `Indented Literal Blocks`_
;; This is multiline.
(,(rst-re 'lin-beg 'lit-sta-2)
- (2 rst-block-face)
+ (2 'rst-block)
(rst-font-lock-find-unindented-line-match
(rst-font-lock-find-unindented-line-limit t)
nil
- (0 rst-literal-face append)))
+ (0 'rst-literal append)))
;; FIXME: `Quoted Literal Blocks`_ missing.
;; This is multiline.
@@ -3972,8 +3891,8 @@ of your own."
;;
;; Indentation is not required for doctest blocks.
(,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+"))
- (1 rst-block-face)
- (2 rst-literal-face)))
+ (1 'rst-block)
+ (2 'rst-literal)))
"Keywords to highlight in rst mode.")
(defvar font-lock-beg)
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index efebee0521b..8f9b603ef5f 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -75,7 +75,8 @@ a DOCTYPE or an XML declaration."
:type 'boolean
:version "22.1")
-(defvaralias 'sgml-transformation 'sgml-transformation-function)
+(define-obsolete-variable-alias 'sgml-transformation
+ 'sgml-transformation-function "29.1")
(defcustom sgml-transformation-function 'identity
"Default value for `skeleton-transformation-function' in SGML mode."
@@ -418,11 +419,11 @@ These have to be run via `sgml-syntax-propertize'"))
(defun sgml-syntax-propertize (start end &optional rules-function)
"Syntactic keywords for `sgml-mode'."
(setq sgml--syntax-propertize-ppss (cons start (syntax-ppss start)))
- (cl-assert (>= (cadr sgml--syntax-propertize-ppss) 0))
- (sgml-syntax-propertize-inside end)
- (funcall (or rules-function sgml--syntax-propertize) (point) end)
- ;; Catch any '>' after the last quote.
- (sgml--syntax-propertize-ppss end))
+ (when (>= (cadr sgml--syntax-propertize-ppss) 0)
+ (sgml-syntax-propertize-inside end)
+ (funcall (or rules-function sgml--syntax-propertize) (point) end)
+ ;; Catch any '>' after the last quote.
+ (sgml--syntax-propertize-ppss end)))
(defun sgml-syntax-propertize-inside (end)
(let ((ppss (syntax-ppss)))
@@ -440,7 +441,8 @@ These have to be run via `sgml-syntax-propertize'"))
;; internal
(defvar sgml-face-tag-alist ()
- "Alist of face and tag name for facemenu.")
+ "Alist of face and tag name for facemenu.
+The tag name can be a string or a list of strings.")
(defvar sgml-tag-face-alist ()
"Tag names and face or list of faces to fontify with when invisible.
@@ -478,8 +480,8 @@ The attribute alist is made up as
ATTRIBUTERULE is a list of optionally t (no value when no input) followed by
an optional alist of possible values."
:type '(repeat (cons (string :tag "Tag Name")
- (repeat :tag "Tag Rule" sexp))))
-(put 'sgml-tag-alist 'risky-local-variable t)
+ (repeat :tag "Tag Rule" sexp)))
+ :risky t)
(defcustom sgml-tag-help
'(("!" . "Empty declaration for comment")
@@ -528,11 +530,13 @@ an optional alist of possible values."
(comment-indent-new-line soft)))
(defun sgml-mode-facemenu-add-face-function (face _end)
- (let ((tag-face (cdr (assq face sgml-face-tag-alist))))
+ "Add \"face\" tags with `facemenu-keymap' commands."
+ (let ((tag-face (ensure-list (cdr (assq face sgml-face-tag-alist)))))
(cond (tag-face
(setq tag-face (funcall skeleton-transformation-function tag-face))
- (setq facemenu-end-add-face (concat "</" tag-face ">"))
- (concat "<" tag-face ">"))
+ (setq facemenu-end-add-face
+ (mapconcat (lambda (f) (concat "</" f ">")) (reverse tag-face) ""))
+ (mapconcat (lambda (f) (concat "<" f ">")) tag-face ""))
((and (consp face)
(consp (car face))
(null (cdr face))
@@ -596,12 +600,11 @@ Do \\[describe-key] on the following bindings to discover what they do.
(setq-local tildify-foreach-region-function
(apply-partially
'tildify-foreach-ignore-environments
- `((,(eval-when-compile
- (concat
- "<\\("
- (regexp-opt '("pre" "dfn" "code" "samp" "kbd" "var"
- "PRE" "DFN" "CODE" "SAMP" "KBD" "VAR"))
- "\\)\\>[^>]*>"))
+ `((,(concat
+ "<\\("
+ (regexp-opt '("pre" "dfn" "code" "samp" "kbd" "var"
+ "PRE" "DFN" "CODE" "SAMP" "KBD" "VAR"))
+ "\\)\\>[^>]*>")
. ("</" 1 ">"))
("<! *--" . "-- *>")
("<" . ">"))))
@@ -620,6 +623,7 @@ Do \\[describe-key] on the following bindings to discover what they do.
(setq-local comment-indent-function 'sgml-comment-indent)
(setq-local comment-line-break-function 'sgml-comment-indent-new-line)
(setq-local skeleton-further-elements '((completion-ignore-case t)))
+ (setq-local skeleton-end-newline nil)
(setq-local skeleton-end-hook
(lambda ()
(or (eolp)
@@ -1868,6 +1872,7 @@ This takes effect when first loading the library.")
(defvar html-face-tag-alist
'((bold . "strong")
(italic . "em")
+ (bold-italic . ("strong" "em"))
(underline . "u")
(mode-line . "rev"))
"Value of `sgml-face-tag-alist' for HTML mode.")
@@ -2403,6 +2408,7 @@ To work around that, do:
(lambda () (char-before (match-end 0))))
(setq-local add-log-current-defun-function #'html-current-defun-name)
(setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*")
+ (add-hook 'completion-at-point-functions 'html-mode--complete-at-point nil t)
(when (fboundp 'libxml-parse-html-region)
(defvar css-class-list-function)
@@ -2411,6 +2417,8 @@ To work around that, do:
(setq-local css-id-list-function #'html-current-buffer-ids))
(setq imenu-create-index-function 'html-imenu-index)
+ (yank-media-handler 'text/html #'html-mode--html-yank-handler)
+ (yank-media-handler "image/.*" #'html-mode--image-yank-handler)
(setq-local sgml-empty-tags
;; From HTML-4.01's loose.dtd, parsed with
@@ -2426,6 +2434,60 @@ To work around that, do:
;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
)
+(defun html-mode--complete-at-point ()
+ ;; Complete a tag like <colg etc.
+ (or
+ (when-let ((tag (save-excursion
+ (and (looking-back "<\\([^ \t\n]*\\)"
+ (line-beginning-position))
+ (match-string 1)))))
+ (list (match-beginning 1) (point)
+ (mapcar #'car html-tag-alist)))
+ ;; Complete params like <colgroup ali etc.
+ (when-let ((tag (save-excursion (sgml-beginning-of-tag)))
+ (params (seq-filter #'consp (cdr (assoc tag html-tag-alist))))
+ (param (save-excursion
+ (and (looking-back "[ \t\n]\\([^= \t\n]*\\)"
+ (line-beginning-position))
+ (match-string 1)))))
+ (list (match-beginning 1) (point)
+ (mapcar #'car params)))
+ ;; Complete param values like <colgroup align=mi etc.
+ (when-let ((tag (save-excursion (sgml-beginning-of-tag)))
+ (params (seq-filter #'consp (cdr (assoc tag html-tag-alist))))
+ (param (save-excursion
+ (and (looking-back
+ "[ \t\n]\\([^= \t\n]+\\)=\\([^= \t\n]*\\)"
+ (line-beginning-position))
+ (match-string 1))))
+ (values (cdr (assoc param params))))
+ (list (match-beginning 2) (point)
+ (mapcar #'car values)))))
+
+(defun html-mode--html-yank-handler (_type html)
+ (save-restriction
+ (insert html)
+ (ignore-errors
+ (sgml-pretty-print (point-min) (point-max)))))
+
+(defun html-mode--image-yank-handler (type image)
+ (let ((file (read-file-name (format "Save %s image to: " type))))
+ (when (file-directory-p file)
+ (user-error "%s is a directory"))
+ (when (and (file-exists-p file)
+ (not (yes-or-no-p (format "%s exists; overwrite?" file))))
+ (user-error "%s exists"))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert image)
+ (write-region (point-min) (point-max) file))
+ (insert (format "<img src=%S>\n" (file-relative-name file)))
+ (insert-image
+ (create-image file (mailcap-mime-type-to-extension type) nil
+ :max-width 200
+ :max-height 200)
+ " ")))
+
(defvar html-imenu-regexp
"\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
"A regular expression matching a head line to be added to the menu.
diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el
new file mode 100644
index 00000000000..53850674ac0
--- /dev/null
+++ b/lisp/textmodes/string-edit.el
@@ -0,0 +1,136 @@
+;;; string-edit.el --- editing long strings -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defface string-edit-prompt
+ '((t (:inherit font-lock-comment-face)))
+ "Face used on `string-edit' help text."
+ :group 'text
+ :version "29.1")
+
+(defvar string-edit--success-callback)
+(defvar string-edit--abort-callback)
+
+;;;###autoload
+(cl-defun string-edit (prompt string success-callback
+ &key abort-callback)
+ "Switch to a new buffer to edit STRING.
+When the user finishes editing (with \\<string-edit-mode-map>\\[string-edit-done]), SUCCESS-CALLBACK
+is called with the resulting string.
+
+If the user aborts (with \\<string-edit-mode-map>\\[string-edit-abort]), ABORT-CALLBACK (if any) is
+called with no parameters.
+
+PROMPT will be inserted at the start of the buffer, but won't be
+included in the resulting string. If PROMPT is nil, no help text
+will be inserted."
+ (with-current-buffer (generate-new-buffer "*edit string*")
+ (when prompt
+ (let ((inhibit-read-only t))
+ (insert prompt)
+ (ensure-empty-lines 0)
+ (add-text-properties (point-min) (point)
+ (list 'intangible t
+ 'face 'string-edit-prompt
+ 'read-only t))
+ (insert (propertize (make-separator-line) 'rear-nonsticky t))
+ (add-text-properties (point-min) (point)
+ (list 'string-edit--prompt t))))
+ (let ((start (point)))
+ (insert string)
+ (goto-char start))
+
+ ;; Use `fit-window-to-buffer' after the buffer is filled with text.
+ (pop-to-buffer (current-buffer)
+ '(display-buffer-below-selected
+ (window-height . (lambda (window)
+ (fit-window-to-buffer window nil 10)))))
+
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list nil)
+ (string-edit-mode)
+ (setq-local string-edit--success-callback success-callback)
+ (when abort-callback
+ (setq-local string-edit--abort-callback abort-callback))
+ (setq-local header-line-format
+ (substitute-command-keys
+ "Type \\<string-edit-mode-map>\\[string-edit-done] when you've finished editing or \\[string-edit-abort] to abort"))
+ (message "%s" (substitute-command-keys
+ "Type \\<string-edit-mode-map>\\[string-edit-done] when you've finished editing"))))
+
+;;;###autoload
+(defun read-string-from-buffer (prompt string)
+ "Switch to a new buffer to edit STRING in a recursive edit.
+The user finishes editing with \\<string-edit-mode-map>\\[string-edit-done], or aborts with \\<string-edit-mode-map>\\[string-edit-abort]).
+
+PROMPT will be inserted at the start of the buffer, but won't be
+included in the resulting string. If nil, no prompt will be
+inserted in the buffer."
+ (string-edit
+ prompt
+ string
+ (lambda (edited)
+ (setq string edited)
+ (exit-recursive-edit))
+ :abort-callback (lambda ()
+ (exit-recursive-edit)
+ (error "Aborted edit")))
+ (recursive-edit)
+ string)
+
+(defvar-keymap string-edit-mode-map
+ "C-c C-c" #'string-edit-done
+ "C-c C-k" #'string-edit-abort)
+
+(define-derived-mode string-edit-mode text-mode "String"
+ "Mode for editing strings."
+ :interactive nil)
+
+(defun string-edit-done ()
+ "Finish editing the string and call the callback function.
+This will kill the current buffer."
+ (interactive)
+ (goto-char (point-min))
+ ;; Skip past the help text.
+ (when-let ((match (text-property-search-forward
+ 'string-edit--prompt nil t)))
+ (goto-char (prop-match-beginning match)))
+ (let ((string (buffer-substring (point) (point-max)))
+ (callback string-edit--success-callback))
+ (quit-window 'kill)
+ (funcall callback string)))
+
+(defun string-edit-abort ()
+ "Abort editing the current string."
+ (interactive)
+ (let ((callback string-edit--abort-callback))
+ (quit-window 'kill)
+ (when callback
+ (funcall callback))))
+
+(provide 'string-edit)
+
+;;; string-edit.el ends here
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 30a07cbefea..fc06c4c0da1 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -753,6 +753,18 @@ the cell contents dynamically."
:type 'string
:group 'table)
+(defcustom table-latex-environment "tabular"
+ "Tabular-compatible environment to use when generating latex.
+The value should be a string suitable for use as a LaTeX environment
+that's compatible with the \"tabular\" protocol, such as \"tabular\"
+and \"longtable\"."
+ :tag "Latex environment used to export tables"
+ :type '(choice
+ (const :tag "tabular" "tabular")
+ (const :tag "longtable" "longtable")
+ string)
+ :version "29.1")
+
(defcustom table-cals-thead-rows 1
"Number of top rows to become header rows in CALS table."
:tag "CALS Header Rows"
@@ -1195,6 +1207,21 @@ executing body forms.")
(easy-menu-add-item (current-global-map)
'("menu-bar" "tools") table-global-menu-map)
+;;;###autoload
+(define-minor-mode table-fixed-width-mode
+ "Cell width is fixed when this is non-nil.
+Normally it should be nil for allowing automatic cell width expansion
+that widens a cell when it is necessary. When non-nil, typing in a
+cell does not automatically expand the cell width. A word that is too
+long to fit in a cell is chopped into multiple lines. The chopped
+location is indicated by `table-word-continuation-char'. This
+variable's value can be toggled by \\[table-fixed-width-mode] at
+run-time."
+ :tag "Fix Cell Width"
+ :group 'table
+ (table--finish-delayed-tasks)
+ (table--update-cell-face))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Macros
@@ -1219,43 +1246,49 @@ original buffer's point is moved to the location that corresponds to
the last cache point coordinate."
(declare (debug (body)) (indent 0))
(let ((height-expansion (make-symbol "height-expansion-var-symbol"))
- (width-expansion (make-symbol "width-expansion-var-symbol")))
- `(let (,height-expansion ,width-expansion)
+ (width-expansion (make-symbol "width-expansion-var-symbol"))
+ (fixed-width (make-symbol "fixed-width")))
+ `(let ((,fixed-width table-fixed-width-mode)
+ ,height-expansion ,width-expansion)
;; make sure cache has valid data unless it is explicitly inhibited.
(unless table-inhibit-update
(table-recognize-cell))
(with-current-buffer (get-buffer-create table-cache-buffer-name)
- ;; goto the cell coordinate based on `table-cell-cache-point-coordinate'.
- (set-mark (table--goto-coordinate table-cell-cache-mark-coordinate))
- (table--goto-coordinate table-cell-cache-point-coordinate)
- (table--untabify-line)
- ;; always reset before executing body forms because auto-fill behavior is the default.
- (setq table-inhibit-auto-fill-paragraph nil)
- ;; do the body
- ,@body
- ;; fill paragraph unless the body does not want to by setting `table-inhibit-auto-fill-paragraph'.
- (unless table-inhibit-auto-fill-paragraph
- (if (and table-cell-info-justify
- (not (eq table-cell-info-justify 'left)))
- (table--fill-region (point-min) (point-max))
- (table--fill-region
- (save-excursion (forward-paragraph -1) (point))
- (save-excursion (forward-paragraph 1) (point)))))
- ;; keep the updated cell coordinate.
- (setq table-cell-cache-point-coordinate (table--get-coordinate))
- ;; determine the cell width expansion.
- (setq ,width-expansion (table--measure-max-width))
- (if (<= ,width-expansion table-cell-info-width) nil
- (table--fill-region (point-min) (point-max) ,width-expansion)
- ;; keep the updated cell coordinate.
- (setq table-cell-cache-point-coordinate (table--get-coordinate)))
- (setq ,width-expansion (- ,width-expansion table-cell-info-width))
- ;; determine the cell height expansion.
- (if (looking-at "\\s *\\'") nil
- (goto-char (point-min))
- (if (re-search-forward "\\(\\s *\\)\\'" nil t)
- (goto-char (match-beginning 1))))
- (setq ,height-expansion (- (cdr (table--get-coordinate)) (1- table-cell-info-height))))
+ (let ((table-fixed-width-mode ,fixed-width))
+ ;; Go to the cell coordinate based on
+ ;; `table-cell-cache-point-coordinate'.
+ (set-mark (table--goto-coordinate table-cell-cache-mark-coordinate))
+ (table--goto-coordinate table-cell-cache-point-coordinate)
+ (table--untabify-line)
+ ;; Always reset before executing body forms because
+ ;; auto-fill behavior is the default.
+ (setq table-inhibit-auto-fill-paragraph nil)
+ ;; Do the body
+ ,@body
+ ;; Fill paragraph unless the body does not want to by
+ ;; setting `table-inhibit-auto-fill-paragraph'.
+ (unless table-inhibit-auto-fill-paragraph
+ (if (and table-cell-info-justify
+ (not (eq table-cell-info-justify 'left)))
+ (table--fill-region (point-min) (point-max))
+ (table--fill-region
+ (save-excursion (forward-paragraph -1) (point))
+ (save-excursion (forward-paragraph 1) (point)))))
+ ;; Keep the updated cell coordinate.
+ (setq table-cell-cache-point-coordinate (table--get-coordinate))
+ ;; Determine the cell width expansion.
+ (setq ,width-expansion (table--measure-max-width))
+ (if (<= ,width-expansion table-cell-info-width) nil
+ (table--fill-region (point-min) (point-max) ,width-expansion)
+ ;; Keep the updated cell coordinate.
+ (setq table-cell-cache-point-coordinate (table--get-coordinate)))
+ (setq ,width-expansion (- ,width-expansion table-cell-info-width))
+ ;; Determine the cell height expansion.
+ (if (looking-at "\\s *\\'") nil
+ (goto-char (point-min))
+ (if (re-search-forward "\\(\\s *\\)\\'" nil t)
+ (goto-char (match-beginning 1))))
+ (setq ,height-expansion (- (cdr (table--get-coordinate)) (1- table-cell-info-height)))))
;; now back to the table buffer.
;; expand the cell width in the table buffer if necessary.
(if (> ,width-expansion 0)
@@ -2823,21 +2856,6 @@ or `top', `middle', `bottom' or `none' for vertical."
(table--justify-cell-contents justify))))))
;;;###autoload
-(define-minor-mode table-fixed-width-mode
- "Cell width is fixed when this is non-nil.
-Normally it should be nil for allowing automatic cell width expansion
-that widens a cell when it is necessary. When non-nil, typing in a
-cell does not automatically expand the cell width. A word that is too
-long to fit in a cell is chopped into multiple lines. The chopped
-location is indicated by `table-word-continuation-char'. This
-variable's value can be toggled by \\[table-fixed-width-mode] at
-run-time."
- :tag "Fix Cell Width"
- :group 'table
- (table--finish-delayed-tasks)
- (table--update-cell-face))
-
-;;;###autoload
(defun table-query-dimension (&optional where)
"Return the dimension of the current cell and the current table.
The result is a list (cw ch tw th c r cells) where cw is the cell
@@ -3019,7 +3037,8 @@ CALS (DocBook DTD):
"")))
((eq language 'latex)
(insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version)
- "\\begin{tabular}{|" (apply #'concat (make-list (length col-list) "l|")) "}\n"
+ "\\begin{" table-latex-environment "}{|"
+ (apply #'concat (make-list (length col-list) "l|")) "}\n"
"\\hline\n"))
((eq language 'cals)
(insert (format "<!-- This CALS table template is generated by emacs %s -->\n" emacs-version)
@@ -3045,7 +3064,7 @@ CALS (DocBook DTD):
((eq language 'html)
(insert "</table>\n"))
((eq language 'latex)
- (insert "\\end{tabular}\n"))
+ (insert "\\end{" table-latex-environment "}\n"))
((eq language 'cals)
(set-marker-insertion-type (table-get-source-info 'colspec-marker) t) ;; insert before
(save-excursion
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 64e38ad6973..d34133f8564 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -248,9 +248,9 @@ Normally set to either `plain-tex-mode' or `latex-mode'."
(defcustom tex-fontify-script t
"If non-nil, fontify subscript and superscript strings."
:type 'boolean
+ :safe #'booleanp
:group 'tex
:version "23.1")
-(put 'tex-fontify-script 'safe-local-variable #'booleanp)
(defcustom tex-font-script-display '(-0.2 0.2)
"How much to lower and raise subscript and superscript content.
@@ -505,7 +505,9 @@ An alternative value is \" . \", if you use a font with a narrow period."
"documentstyle" "documentclass" "verbatiminput"
"includegraphics" "includegraphics*")
t))
- (verbish (regexp-opt '("url" "nolinkurl" "path") t))
+ (verbish (regexp-opt '("url" "nolinkurl" "path"
+ "href" "ProvidesFile")
+ t))
;; Miscellany.
(slash "\\\\")
(opt " *\\(\\[[^]]*\\] *\\)*")
@@ -981,14 +983,13 @@ Inherits `shell-mode-map' with a few additions.")
(when (and slash (not comment))
(setq mode
(if (looking-at
- (eval-when-compile
- (concat
- (regexp-opt '("documentstyle" "documentclass"
- "begin" "subsection" "section"
- "part" "chapter" "newcommand"
- "renewcommand" "RequirePackage")
- 'words)
- "\\|NeedsTeXFormat{LaTeX")))
+ (concat
+ (regexp-opt '("documentstyle" "documentclass"
+ "begin" "subsection" "section"
+ "part" "chapter" "newcommand"
+ "renewcommand" "RequirePackage")
+ 'words)
+ "\\|NeedsTeXFormat{LaTeX"))
(if (and (looking-at
"document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
;; SliTeX is almost never used any more nowadays.
@@ -1176,12 +1177,7 @@ subshell is initiated, `tex-shell-hook' is run."
(setq-local outline-regexp latex-outline-regexp)
(setq-local outline-level #'latex-outline-level)
(setq-local forward-sexp-function #'latex-forward-sexp)
- (setq-local skeleton-end-hook nil)
- (setq-local comment-region-function #'latex--comment-region)
- (setq-local comment-style 'plain))
-
-(defun latex--comment-region (beg end &optional arg)
- (comment-region-default-1 beg end arg t))
+ (setq-local skeleton-end-hook nil))
;;;###autoload
(define-derived-mode slitex-mode latex-mode "SliTeX"
@@ -1245,11 +1241,10 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
(apply-partially
#'tildify-foreach-ignore-environments
`(("\\\\\\\\" . "") ; do not remove this
- (,(eval-when-compile
- (concat "\\\\begin{\\("
- (regexp-opt '("verbatim" "math" "displaymath"
- "equation" "eqnarray" "eqnarray*"))
- "\\)}"))
+ (,(concat "\\\\begin{\\("
+ (regexp-opt '("verbatim" "math" "displaymath"
+ "equation" "eqnarray" "eqnarray*"))
+ "\\)}")
. ("\\\\end{" 1 "}"))
("\\\\verb\\*?\\(.\\)" . (1))
("\\$\\$?" . (0))
@@ -2037,7 +2032,7 @@ In the tex shell buffer this command behaves like `comint-send-input'."
(defun tex-display-shell ()
"Make the TeX shell buffer visible in a window."
- (display-buffer (tex-shell-buf))
+ (display-buffer (tex-shell-buf) display-comint-buffer-action)
(tex-recenter-output-buffer nil))
(defun tex-shell-sentinel (proc _msg)
@@ -2129,11 +2124,10 @@ If NOT-ALL is non-nil, save the `.dvi' file."
(defvar tex-compile-history nil)
(defvar tex-input-files-re
- (eval-when-compile
- (concat "\\." (regexp-opt '("tex" "texi" "texinfo"
- "bbl" "ind" "sty" "cls") t)
- ;; Include files with no dots (for directories).
- "\\'\\|\\`[^.]+\\'")))
+ (concat "\\." (regexp-opt '("tex" "texi" "texinfo"
+ "bbl" "ind" "sty" "cls") t)
+ ;; Include files with no dots (for directories).
+ "\\'\\|\\`[^.]+\\'"))
(defcustom tex-use-reftex t
"If non-nil, use RefTeX's list of files to determine what command to use."
@@ -2441,7 +2435,7 @@ Only applies the FSPEC to the args part of FORMAT."
(if cmds (tex-format-cmd (caar cmds) fspec))))))
(defun tex-cmd-doc-view (file)
- (pop-to-buffer (find-file-noselect file)))
+ (pop-to-buffer (find-file-noselect file) display-comint-buffer-action))
(defun tex-compile (dir cmd)
"Run a command CMD on current TeX buffer's file in DIR."
@@ -2457,7 +2451,7 @@ Only applies the FSPEC to the args part of FORMAT."
(default (tex-compile-default fspec)))
(list default-directory
(completing-read
- (format "Command [%s]: " (tex-summarize-command default))
+ (format-prompt "Command" (tex-summarize-command default))
(mapcar (lambda (x)
(list (tex-format-cmd (eval (car x) t) fspec)))
tex-compile-commands)
@@ -2698,7 +2692,7 @@ line LINE of the window, or centered if LINE is nil."
(window))
(if (null tex-shell)
(message "No TeX output buffer")
- (setq window (display-buffer tex-shell))
+ (setq window (display-buffer tex-shell display-comint-buffer-action))
(with-selected-window window
(bury-buffer tex-shell)
(goto-char (point-max))
@@ -2987,13 +2981,7 @@ There might be text before point."
(put-text-property
(1- (match-beginning 1)) (match-beginning 1)
'syntax-table
- (if (= (1+ (line-beginning-position)) (match-beginning 1))
- ;; The `%' is a single-char comment, which Emacs
- ;; syntax-table can't deal with. We could turn it
- ;; into a non-comment, or use `\n%' or `%^' as the comment.
- ;; Instead, we include it in the ^^A comment.
- (string-to-syntax "< b")
- (string-to-syntax ">")))
+ (string-to-syntax ">"))
(let ((end (line-end-position)))
(if (< end (point-max))
(put-text-property
@@ -3016,8 +3004,9 @@ There might be text before point."
(defconst doctex-syntax-propertize-rules
(syntax-propertize-precompile-rules
latex-syntax-propertize-rules
- ;; For DocTeX comment-in-doc.
- ("\\(\\^\\)\\^A" (1 (doctex-font-lock-^^A))))))
+ ;; For DocTeX comment-in-doc (DocTeX ≥3 also allows ^^X).
+ ;; We make the comment start on the second char because of bug#35140.
+ ("\\^\\(\\^\\)[AX]" (1 (doctex-font-lock-^^A))))))
(defvar doctex-font-lock-keywords
(append tex-font-lock-keywords
@@ -3566,28 +3555,122 @@ There might be text before point."
("\\ordmasculine" . ?º)
("\\lambdabar" . ?ƛ)
("\\celsius" . ?℃)
+ ;; Text symbols formerly part of textcomp package:
+ ("\\textdollar" . ?$)
+ ("\\textborn" . ?*)
+ ("\\textless" . ?<)
+ ("\\textgreater" . ?>)
+ ("\\textbackslash" . ?\\)
+ ("\\textasciicircum" . ?^)
+ ("\\textunderscore" . ?_)
+ ("\\textbraceleft" . ?\{)
+ ("\\textbar" . ?|)
+ ("\\textbraceright" . ?\})
+ ("\\textasciitilde" . ?~)
+ ("\\textexclamdown" . ?¡)
+ ("\\textcent" . ?¢)
+ ("\\textsterling" . ?£)
+ ("\\textcurrency" . ?¤)
+ ("\\textyen" . ?¥)
+ ("\\textbrokenbar" . ?¦)
+ ("\\textsection" . ?§)
+ ("\\textasciidieresis" . ?¨)
+ ("\\textcopyright" . ?©)
+ ("\\textordfeminine" . ?ª)
+ ("\\guillemetleft" . ?«)
+ ("\\guillemotleft" . ?«)
+ ("\\textlnot" . ?¬)
+ ("\\textregistered" . ?®)
+ ("\\textasciimacron" . ?¯)
+ ("\\textdegree" . ?°)
+ ("\\textpm" . ?±)
+ ("\\texttwosuperior" . ?²)
+ ("\\textthreesuperior" . ?³)
+ ("\\textasciiacute" . ?´)
("\\textmu" . ?µ)
+ ("\\textparagraph" . ?¶)
+ ("\\textpilcrow" . ?¶)
+ ("\\textperiodcentered" . ?·)
+ ("\\textonesuperior" . ?¹)
+ ("\\textordmasculine" . ?º)
+ ("\\guillemetright" . ?»)
+ ("\\guillemotright" . ?»)
+ ("\\textonequarter" . ?¼)
+ ("\\textonehalf" . ?½)
+ ("\\textthreequarters" . ?¾)
+ ("\\textquestiondown" . ?¿)
+ ("\\texttimes" . ?×)
+ ("\\textdiv" . ?÷)
+ ("\\textflorin" . ?ƒ)
+ ("\\textasciicaron" . ?ˇ)
+ ("\\textasciibreve" . ?˘)
+ ("\\textacutedbl" . ?˝)
+ ("\\textgravedbl" . 757)
+ ("\\texttildelow" . 759)
+ ("\\textbaht" . ?฿)
+ ("\\textendash" . ?–)
+ ("\\textemdash" . ?—)
+ ("\\textbardbl" . ?‖)
+ ("\\textquoteleft" . 8216)
+ ("\\textquoteright" . 8217)
+ ("\\quotesinglbase" . 8218)
+ ("\\textquotedblleft" . 8220)
+ ("\\textquotedblright" . 8221)
+ ("\\quotedblbase" . 8222)
+ ;; \textdagger and \textdied are replaced with DAGGER (#x2020) and
+ ;; not with LATIN CROSS (#x271d)
+ ("\\textdagger" . ?†)
+ ("\\textdied" . ?†)
+ ("\\textdaggerdbl" . ?‡)
+ ("\\textbullet" . ?•)
+ ("\\textellipsis" . ?…)
+ ("\\textperthousand" . ?‰)
+ ("\\textpertenthousand" . ?‱)
+ ("\\guilsinglleft" . ?‹)
+ ("\\guilsinglright" . ?›)
+ ("\\textreferencemark" . ?※)
+ ("\\textinterrobang" . ?‽)
("\\textfractionsolidus" . ?⁄)
- ("\\textbigcircle" . ?⃝)
- ("\\textmusicalnote" . ?♪)
- ("\\textdied" . ?✝)
+ ("\\textlquill" . 8261) ; Literal ?⁅ breaks indentation
+ ("\\textrquill" . 8262) ; Literal ?⁆ breaks indentation
+ ("\\textdiscount" . ?⁒)
("\\textcolonmonetary" . ?₡)
- ("\\textwon" . ?₩)
+ ("\\textlira" . ?₤)
("\\textnaira" . ?₦)
+ ("\\textwon" . ?₩)
+ ("\\textdong" . ?₫)
+ ("\\texteuro" . ?€)
("\\textpeso" . ?₱)
- ("\\textlira" . ?₤)
- ("\\textrecipe" . ?℞)
- ("\\textinterrobang" . ?‽)
- ("\\textpertenthousand" . ?‱)
- ("\\textbaht" . ?฿)
+ ("\\textguarani" . ?₲)
+ ("\\textcelsius" . ?℃)
("\\textnumero" . ?№)
- ("\\textdiscount" . ?⁒)
+ ("\\textcircledP" . ?℗)
+ ("\\textrecipe" . ?℞)
+ ("\\textservicemark" . ?℠)
+ ("\\texttrademark" . ?™)
+ ("\\textohm" . ?Ω)
+ ("\\textmho" . ?℧)
("\\textestimated" . ?℮)
+ ("\\textleftarrow" . ?←)
+ ("\\textuparrow" . ?↑)
+ ("\\textrightarrow" . ?→)
+ ("\\textdownarrow" . ?↓)
+ ("\\textminus" . ?−)
+ ("\\textsurd" . ?√)
+ ("\\textlangle" . 9001) ; Literal ?〈 breaks indentation
+ ("\\textrangle" . 9002) ; Literal ?〉 breaks indentation
+ ("\\textblank" . ?␢)
+ ("\\textvisiblespace" . ?␣)
("\\textopenbullet" . ?◦)
- ("\\textlquill" . 8261) ; Literal ?⁅ breaks indentation.
- ("\\textrquill" . 8262) ; Literal ?⁆ breaks indentation.
- ("\\textcircledP" . ?℗)
- ("\\textreferencemark" . ?※))
+ ;; \textbigcircle is replaced with LARGE CIRCLE (#x25ef) and not
+ ;; with COMBINING ENCLOSING CIRCLE (#x20dd)
+ ("\\textbigcircle" . ?◯)
+ ("\\textmusicalnote" . ?♪)
+ ("\\textmarried" . ?⚭)
+ ("\\textdivorced" . ?⚮)
+ ("\\textlbrackdbl" . 10214) ; Literal ?⟦ breaks indentation
+ ("\\textrbrackdbl" . 10215) ; Literal ?⟧ breaks indentation
+ ("\\textinterrobangdown" . ?⸘))
"A `prettify-symbols-alist' usable for (La)TeX modes.")
(defun tex--prettify-symbols-compose-p (_start end _match)
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 81ac45eb6c4..5d6f5deae1b 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -4,7 +4,6 @@
;; Foundation, Inc.
;; Author: Robert J. Chassell
-;; Date: [See date below for texinfo-version]
;; Maintainer: emacs-devel@gnu.org
;; Keywords: maint, tex, docs
@@ -32,6 +31,16 @@
;;; Code:
+(eval-when-compile (require 'cl-lib)
+ (require 'flymake)
+ (require 'rx))
+(declare-function flymake-diag-region "flymake"
+ (buffer line &optional col))
+(declare-function flymake-make-diagnostic "flymake"
+ ( locus beg end type text
+ &optional data overlay-properties))
+(declare-function flymake--log-1 "flymake" (level sublog msg &rest args))
+
(eval-when-compile (require 'tex-mode))
(declare-function tex-buffer "tex-mode" ())
(declare-function tex-region "tex-mode" (beg end))
@@ -336,6 +345,69 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
(if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
(match-string-no-properties 1))))
+;;; Flymake support
+(defvar-local texinfo--flymake-proc nil)
+(defun texinfo-flymake (report-fn &rest _)
+ "Texinfo checking for Flymake.
+
+REPORT-FN is the callback function."
+ (let ((executable (or (executable-find "makeinfo")
+ (executable-find "texi2any")))
+ (source (current-buffer)))
+
+ (unless executable
+ (error "Flymake for Texinfo requires `makeinfo' or `texi2any'"))
+
+ (when (process-live-p texinfo--flymake-proc)
+ (kill-process texinfo--flymake-proc))
+
+ (save-restriction
+ (widen)
+ (setq texinfo--flymake-proc
+ (make-process
+ :name "texinfo-flymake"
+ :noquery t
+ :connection-type 'pipe
+ :buffer (generate-new-buffer " *texinfo-flymake*")
+ :command `(,executable "-o" ,null-device "-")
+ :sentinel
+ (lambda (proc _event)
+ (when (memq (process-status proc) '(exit signal))
+ (unwind-protect
+ (if (eq (buffer-local-value 'texinfo--flymake-proc
+ source)
+ proc)
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ (cl-loop
+ while (search-forward-regexp
+ (rx line-start
+ "-:"
+ (group-n 1 (0+ digit)) ; Line
+ (optional ":" (group-n 2 (0+ digit))) ; col
+ ": "
+ (optional (group-n 3 "warning: ")) ; warn
+ (group-n 4 (0+ nonl)) ; Message
+ line-end)
+ nil t)
+ for msg = (match-string 4)
+ for (beg . end) = (flymake-diag-region
+ source
+ (string-to-number (match-string 1)))
+ for type = (if (match-string 3)
+ :warning
+ :error)
+ collect (flymake-make-diagnostic
+ source beg end type msg)
+ into diags
+ finally (funcall report-fn diags)))
+ (flymake-log :warning "Cancelling obsolete check %s"
+ proc))
+ (kill-buffer (process-buffer proc)))))))
+ (process-send-region texinfo--flymake-proc (point-min) (point-max))
+ (process-send-eof texinfo--flymake-proc))))
+
+
;;; Texinfo mode
;;;###autoload
@@ -411,13 +483,13 @@ value of `texinfo-mode-hook'."
"\\)\\>"))
(setq-local require-final-newline mode-require-final-newline)
(setq-local indent-tabs-mode nil)
- (setq-local paragraph-separate
- (concat "@[a-zA-Z]*[ \n]\\|"
- paragraph-separate))
(setq-local paragraph-start (concat "@[a-zA-Z]*[ \n]\\|"
paragraph-start))
+ (setq-local fill-paragraph-function 'texinfo--fill-paragraph)
(setq-local sentence-end-base "\\(@\\(end\\)?dots{}\\|[.?!]\\)[]\"'”)}]*")
(setq-local fill-column 70)
+ (setq-local beginning-of-defun-function #'texinfo--beginning-of-defun)
+ (setq-local end-of-defun-function #'texinfo--end-of-defun)
(setq-local comment-start "@c ")
(setq-local comment-start-skip "@c +\\|@comment +")
(setq-local words-include-escapes t)
@@ -455,8 +527,63 @@ value of `texinfo-mode-hook'."
(let ((prevent-filling "^@\\(def\\|multitable\\)"))
(if (null auto-fill-inhibit-regexp)
prevent-filling
- (concat auto-fill-inhibit-regexp "\\|" prevent-filling)))))
-
+ (concat auto-fill-inhibit-regexp "\\|" prevent-filling))))
+
+ ;; Set up Flymake support.
+ (add-hook 'flymake-diagnostic-functions #'texinfo-flymake nil t))
+
+(defvar texinfo-fillable-commands '("@noindent")
+ "A list of commands that can be filled.")
+
+(defun texinfo--fill-paragraph (justify)
+ "Function to fill a paragraph in `texinfo-mode'."
+ (let ((command-re "\\(@[a-zA-Z]+\\)[ \t\n]"))
+ (catch 'no-fill
+ (save-restriction
+ ;; First check whether we're on a command line that can be
+ ;; filled by itself.
+ (or
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at command-re)
+ (let ((command (match-string 1)))
+ (if (member command texinfo-fillable-commands)
+ (progn
+ (narrow-to-region (point) (progn (forward-line 1) (point)))
+ t)
+ (throw 'no-fill nil)))))
+ ;; We're not on such a line, so fill the region.
+ (save-excursion
+ (let ((regexp (concat command-re "\\|^[ \t]*$\\|\f")))
+ (narrow-to-region
+ (if (re-search-backward regexp nil t)
+ (progn
+ (forward-line 1)
+ (point))
+ (point-min))
+ (if (re-search-forward regexp nil t)
+ (match-beginning 0)
+ (point-max)))
+ (goto-char (point-min)))))
+ ;; We've now narrowed to the region we want to fill.
+ (let ((fill-paragraph-function nil)
+ (adaptive-fill-mode nil))
+ (fill-paragraph justify))))
+ t))
+
+(defun texinfo--beginning-of-defun (&optional arg)
+ "Go to the previous @node line."
+ (while (and (> arg 0)
+ (re-search-backward "^@node " nil t))
+ (setq arg (1- arg))))
+
+(defun texinfo--end-of-defun ()
+ "Go to the start of the next @node line."
+ (when (looking-at-p "@node")
+ (forward-line))
+ (if (re-search-forward "^@node " nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))))
;;; Insert string commands
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index 5b468dc808b..e44aa06e3dd 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1367,7 +1367,7 @@ left at the end of the node line."
;; There may be an @chapter or other such command between
;; the top node line and the next node line, as a title
;; for an `ifinfo' section. This @chapter command must
- ;; must be skipped. So the procedure is to search for
+ ;; be skipped. So the procedure is to search for
;; the next `@node' line, and then copy its name.
(if (re-search-forward "^@node" nil t)
(progn
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 9dcfb10d6df..2a7ad295ab7 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -494,9 +494,8 @@ variable will be set to the representation."
(if (not (string-equal " " (or space tildify-space-string)))
(when space
(setq tildify-space-string space))
- (message (eval-when-compile
- (concat "Hard space is a single space character, tildify-"
- "mode won't have any effect, disabling.")))
+ (message (concat "Hard space is a single space character, tildify-"
+ "mode won't have any effect, disabling."))
(setq tildify-mode nil))))
(if tildify-mode
(add-hook 'post-self-insert-hook #'tildify-space nil t)
diff --git a/lisp/textmodes/word-wrap-mode.el b/lisp/textmodes/word-wrap-mode.el
new file mode 100644
index 00000000000..c354fc773a7
--- /dev/null
+++ b/lisp/textmodes/word-wrap-mode.el
@@ -0,0 +1,80 @@
+;;; word-wrap-mode.el --- minor mode for `word-wrap' tweaks -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+;; The list below lists all characters that have a general-category of
+;; Zs, but with the ones we don't want to add here commented out.
+(defcustom word-wrap-whitespace-characters
+ '(;;?\N{SPACE}
+ ;;?\N{NO-BREAK SPACE}
+ ?\N{OGHAM SPACE MARK}
+ ?\N{EN QUAD}
+ ?\N{EM QUAD}
+ ?\N{EN SPACE}
+ ?\N{EM SPACE}
+ ?\N{THREE-PER-EM SPACE}
+ ?\N{FOUR-PER-EM SPACE}
+ ?\N{SIX-PER-EM SPACE}
+ ?\N{FIGURE SPACE}
+ ?\N{PUNCTUATION SPACE}
+ ?\N{THIN SPACE}
+ ?\N{HAIR SPACE}
+ ;;?\N{NARROW NO-BREAK SPACE}
+ ?\N{MEDIUM MATHEMATICAL SPACE}
+ ?\N{IDEOGRAPHIC SPACE}
+ ;; Not in the Zs category:
+ ?\N{ZERO WIDTH SPACE})
+ "Characters that `word-wrap-whitespace-mode' should add to `word-wrap'."
+ :version "29.1"
+ :type '(repeat character)
+ :group 'display)
+
+(defvar word-wrap-mode--previous-state)
+
+;;;###autoload
+(define-minor-mode word-wrap-whitespace-mode
+ "Allow `word-wrap' to fold on all breaking whitespace characters.
+The characters to break on are defined by `word-wrap-whitespace-characters'."
+ :group 'display
+ (if word-wrap-whitespace-mode
+ (progn
+ (setq-local word-wrap-mode--previous-state
+ (cons (category-table)
+ (buffer-local-set-state
+ word-wrap-by-category t
+ word-wrap t)))
+ (set-category-table (copy-category-table))
+ (dolist (char word-wrap-whitespace-characters)
+ (modify-category-entry char ?|)))
+ (set-category-table (car word-wrap-mode--previous-state))
+ (buffer-local-restore-state (cdr word-wrap-mode--previous-state))))
+
+;;;###autoload
+(define-globalized-minor-mode global-word-wrap-whitespace-mode
+ word-wrap-whitespace-mode word-wrap-whitespace-mode
+ :group 'display)
+
+(provide 'word-wrap-mode)
+
+;;; word-wrap-mode.el ends here
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index b13b7b95cd0..b3dca5890f1 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -82,7 +82,7 @@ question.
(defun forward-thing (thing &optional n)
"Move forward to the end of the Nth next THING.
THING should be a symbol specifying a type of syntactic entity.
-Possibilities include `symbol', `list', `sexp', `defun',
+Possibilities include `symbol', `list', `sexp', `defun', `number',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'."
(let ((forward-op (or (get thing 'forward-op)
@@ -97,7 +97,7 @@ Possibilities include `symbol', `list', `sexp', `defun',
(defun bounds-of-thing-at-point (thing)
"Determine the start and end buffer locations for the THING at point.
THING should be a symbol specifying a type of syntactic entity.
-Possibilities include `symbol', `list', `sexp', `defun',
+Possibilities include `symbol', `list', `sexp', `defun', `number',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'.
@@ -106,8 +106,17 @@ valid THING.
Return a cons cell (START . END) giving the start and end
positions of the thing found."
- (if (get thing 'bounds-of-thing-at-point)
- (funcall (get thing 'bounds-of-thing-at-point))
+ (cond
+ ((get thing 'bounds-of-thing-at-point)
+ (funcall (get thing 'bounds-of-thing-at-point)))
+ ;; If the buffer is totally empty, give up.
+ ((and (not (eq thing 'whitespace))
+ (save-excursion
+ (goto-char (point-min))
+ (not (re-search-forward "[^\t\n ]" nil t))))
+ nil)
+ ;; Find the thing.
+ (t
(let ((orig (point)))
(ignore-errors
(save-excursion
@@ -149,7 +158,7 @@ positions of the thing found."
(lambda () (forward-thing thing -1))))
(point))))
(if (and (<= real-beg orig) (<= orig end) (< real-beg end))
- (cons real-beg end))))))))))
+ (cons real-beg end)))))))))))
;;;###autoload
(defun thing-at-point (thing &optional no-properties)
@@ -499,14 +508,14 @@ If no URL is found, return nil.
If optional argument LAX is non-nil, look for URLs that are not
well-formed, such as foo@bar or <nobody>.
-If optional arguments BOUNDS are non-nil, it should be a cons
+If optional argument BOUNDS is non-nil, it should be a cons
cell of the form (START . END), containing the beginning and end
positions of the URI. Otherwise, these positions are detected
automatically from the text around point.
If the scheme component is absent, either because a URI delimited
with <url:...> lacks one, or because an ill-formed URI was found
-with LAX or BEG and END, try to add a scheme in the returned URI.
+with LAX or BOUNDS, try to add a scheme in the returned URI.
The scheme is chosen heuristically: \"mailto:\" if the address
looks like an email address, \"ftp://\" if it starts with
\"ftp\", etc."
@@ -723,6 +732,7 @@ Signal an error if the entire string was not used."
"Return the symbol at point, or nil if none is found."
(let ((thing (thing-at-point 'symbol)))
(if thing (intern thing))))
+
;;;###autoload
(defun number-at-point ()
"Return the number at point, or nil if none is found.
@@ -737,7 +747,9 @@ like \"0xBEEF09\" or \"#xBEEF09\", are recognized."
(string-to-number
(buffer-substring (match-beginning 0) (match-end 0))))))
+(put 'number 'forward-op 'forward-word)
(put 'number 'thing-at-point 'number-at-point)
+
;;;###autoload
(defun list-at-point (&optional ignore-comment-or-string)
"Return the Lisp list at point, or nil if none is found.
diff --git a/lisp/thread.el b/lisp/thread.el
index fbbee26929e..1e6e9e75a72 100644
--- a/lisp/thread.el
+++ b/lisp/thread.el
@@ -30,6 +30,13 @@
(eval-when-compile (require 'pcase))
(eval-when-compile (require 'subr-x))
+(declare-function thread-name "thread.c")
+(declare-function thread-signal "thread.c")
+(declare-function thread--blocker "thread.c")
+(declare-function current-thread "thread.c")
+(declare-function thread-live-p "thread.c")
+(declare-function all-threads "thread.c")
+
;;;###autoload
(defun thread-handle-event (event)
"Handle thread events, propagated by `thread-signal'.
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index d54cb79622c..3b31f1d8090 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -73,16 +73,16 @@
(defcustom thumbs-per-line 4
"Number of thumbnails per line to show in directory."
- :type 'integer)
+ :type 'natnum)
(defcustom thumbs-max-image-number 16
- "Maximum number of images initially displayed in thumbs buffer."
- :type 'integer)
+ "Maximum number of images initially displayed in thumbs buffer."
+ :type 'natnum)
(defcustom thumbs-thumbsdir-max-size 50000000
"Maximum size for thumbnails directory.
-When it reaches that size (in bytes), a warning is sent."
- :type 'integer)
+When it reaches that size (in bytes), a warning is displayed."
+ :type 'natnum)
;; Unfortunately Windows XP has a program called CONVERT.EXE in
;; C:/WINDOWS/SYSTEM32/ for partitioning NTFS systems. So Emacs
@@ -91,7 +91,7 @@ When it reaches that size (in bytes), a warning is sent."
(defcustom thumbs-conversion-program
(if (eq system-type 'windows-nt)
;; FIXME is this necessary, or can a sane PATHEXE be assumed?
- ;; Eg find-program does not do this.
+ ;; E.g. find-program does not do this.
"convert.exe"
"convert")
"Name of conversion program for thumbnails generation.
@@ -106,12 +106,12 @@ This must be the ImageMagick \"convert\" utility."
(defcustom thumbs-relief 5
"Size of button-like border around thumbnails."
- :type 'integer)
+ :type 'natnum)
(defcustom thumbs-margin 2
"Size of the margin around thumbnails.
This is where you see the cursor."
- :type 'integer)
+ :type 'natnum)
(defcustom thumbs-thumbsdir-auto-clean t
"If set, delete older file in the thumbnails directory.
@@ -121,7 +121,7 @@ than `thumbs-thumbsdir-max-size'."
(defcustom thumbs-image-resizing-step 10
"Step by which to resize image as a percentage."
- :type 'integer)
+ :type 'natnum)
(defcustom thumbs-temp-dir temporary-file-directory
"Temporary directory to use.
@@ -215,16 +215,17 @@ FILEIN is the input file,
FILEOUT is the output file,
ACTION is the command to send to convert.
Optional arguments are:
-ARG any arguments to the ACTION command,
+ARG if non-nil, the argument of the ACTION command,
OUTPUT-FORMAT is the file format to output (default is jpeg),
ACTION-PREFIX is the symbol to place before the ACTION command
(defaults to `-' but can sometimes be `+')."
- (call-process thumbs-conversion-program nil nil nil
- (or action-prefix "-")
- action
- (or arg "")
- filein
- (format "%s:%s" (or output-format "jpeg") fileout)))
+ (let ((action-param (concat (or action-prefix "-") action))
+ (fileout-param (format "%s:%s" (or output-format "jpeg") fileout)))
+ (if arg
+ (call-process thumbs-conversion-program nil nil nil
+ action-param arg filein fileout-param)
+ (call-process thumbs-conversion-program nil nil nil
+ action-param filein fileout-param))))
(defun thumbs-new-image-size (s increment)
"New image (a cons of width x height)."
@@ -292,22 +293,12 @@ smaller according to whether INCREMENT is 1 or -1."
(thumbs-call-convert fn tn "sample" thumbs-geometry))
tn))
-(defun thumbs-image-type (img)
- "Return image type from filename IMG."
- (cond ((string-match ".*\\.jpe?g\\'" img) 'jpeg)
- ((string-match ".*\\.xpm\\'" img) 'xpm)
- ((string-match ".*\\.xbm\\'" img) 'xbm)
- ((string-match ".*\\.pbm\\'" img) 'pbm)
- ((string-match ".*\\.gif\\'" img) 'gif)
- ((string-match ".*\\.bmp\\'" img) 'bmp)
- ((string-match ".*\\.png\\'" img) 'png)
- ((string-match ".*\\.tiff?\\'" img) 'tiff)))
-
(declare-function image-size "image.c" (spec &optional pixels frame))
(defun thumbs-file-size (img)
(let ((i (image-size
- (find-image `((:type ,(thumbs-image-type img) :file ,img))) t)))
+ (find-image `((:type ,(image-supported-file-p img) :file ,img)))
+ t)))
(concat (number-to-string (round (car i))) "x"
(number-to-string (round (cdr i))))))
@@ -410,7 +401,7 @@ and SAME-WINDOW to show thumbs in the same window."
thumbs-image-num (or num 0))
(delete-region (point-min)(point-max))
(save-excursion
- (thumbs-insert-image img (thumbs-image-type img) 0)))))
+ (thumbs-insert-image img (image-supported-file-p img) 0)))))
(defun thumbs-find-image-at-point (&optional img otherwin)
"Display image IMG for thumbnail at point.
@@ -544,7 +535,7 @@ Open another window."
" - " (number-to-string num)))
(let ((inhibit-read-only t))
(erase-buffer)
- (thumbs-insert-image img (thumbs-image-type img) 0)
+ (thumbs-insert-image img (image-supported-file-p img) 0)
(goto-char (point-min))))
(setq thumbs-image-num num
thumbs-current-image-filename img))))
@@ -620,7 +611,7 @@ ACTION and ARG should be a valid convert command."
(thumbs-call-convert (or old thumbs-current-image-filename)
tmp
action
- (or arg ""))
+ arg)
(save-excursion
(thumbs-insert-image tmp 'jpeg 0))
(setq thumbs-current-tmp-filename tmp)))
@@ -713,27 +704,25 @@ ACTION and ARG should be a valid convert command."
;; thumbs-mode
-(defvar thumbs-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'thumbs-find-image-at-point)
- (define-key map [mouse-2] 'thumbs-mouse-find-image)
- (define-key map [(meta return)] 'thumbs-find-image-at-point-other-window)
- (define-key map [(control return)] 'thumbs-set-image-at-point-to-root-window)
- (define-key map [delete] 'thumbs-delete-images)
- (define-key map [right] 'thumbs-forward-char)
- (define-key map [left] 'thumbs-backward-char)
- (define-key map [up] 'thumbs-backward-line)
- (define-key map [down] 'thumbs-forward-line)
- (define-key map "+" 'thumbs-show-more-images)
- (define-key map "d" 'thumbs-dired)
- (define-key map "m" 'thumbs-mark)
- (define-key map "u" 'thumbs-unmark)
- (define-key map "R" 'thumbs-rename-images)
- (define-key map "x" 'thumbs-delete-images)
- (define-key map "s" 'thumbs-show-name)
- (define-key map "q" 'thumbs-kill-buffer)
- map)
- "Keymap for `thumbs-mode'.")
+(defvar-keymap thumbs-mode-map
+ :doc "Keymap for `thumbs-mode'."
+ "<return>" #'thumbs-find-image-at-point
+ "<mouse-2>" #'thumbs-mouse-find-image
+ "M-<return>" #'thumbs-find-image-at-point-other-window
+ "C-<return>" #'thumbs-set-image-at-point-to-root-window
+ "<delete>" #'thumbs-delete-images
+ "<right>" #'thumbs-forward-char
+ "<left>" #'thumbs-backward-char
+ "<up>" #'thumbs-backward-line
+ "<down>" #'thumbs-forward-line
+ "+" #'thumbs-show-more-images
+ "d" #'thumbs-dired
+ "m" #'thumbs-mark
+ "u" #'thumbs-unmark
+ "R" #'thumbs-rename-images
+ "x" #'thumbs-delete-images
+ "s" #'thumbs-show-name
+ "q" #'thumbs-kill-buffer)
(put 'thumbs-mode 'mode-class 'special)
(define-derived-mode thumbs-mode
@@ -741,22 +730,20 @@ ACTION and ARG should be a valid convert command."
"Preview images in a thumbnails buffer."
(setq buffer-read-only t))
-(defvar thumbs-view-image-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [prior] 'thumbs-previous-image)
- (define-key map [next] 'thumbs-next-image)
- (define-key map "^" 'thumbs-display-thumbs-buffer)
- (define-key map "-" 'thumbs-shrink-image)
- (define-key map "+" 'thumbs-enlarge-image)
- (define-key map "<" 'thumbs-rotate-left)
- (define-key map ">" 'thumbs-rotate-right)
- (define-key map "e" 'thumbs-emboss-image)
- (define-key map "r" 'thumbs-resize-image)
- (define-key map "s" 'thumbs-save-current-image)
- (define-key map "q" 'thumbs-kill-buffer)
- (define-key map "w" 'thumbs-set-root)
- map)
- "Keymap for `thumbs-view-image-mode'.")
+(defvar-keymap thumbs-view-image-mode-map
+ :doc "Keymap for `thumbs-view-image-mode'."
+ "<prior>" #'thumbs-previous-image
+ "<next>" #'thumbs-next-image
+ "^" #'thumbs-display-thumbs-buffer
+ "-" #'thumbs-shrink-image
+ "+" #'thumbs-enlarge-image
+ "<" #'thumbs-rotate-left
+ ">" #'thumbs-rotate-right
+ "e" #'thumbs-emboss-image
+ "r" #'thumbs-resize-image
+ "s" #'thumbs-save-current-image
+ "q" #'thumbs-kill-buffer
+ "w" #'thumbs-set-root)
;; thumbs-view-image-mode
(put 'thumbs-view-image-mode 'mode-class 'special)
@@ -775,6 +762,9 @@ ACTION and ARG should be a valid convert command."
(define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked)
(define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot)
+(define-obsolete-function-alias 'thumbs-image-type
+ #'image-supported-file-p "29.1")
+
(provide 'thumbs)
;;; thumbs.el ends here
diff --git a/lisp/time.el b/lisp/time.el
index 29216416d9d..e7066cae7a5 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -93,7 +93,7 @@ Non-nil means \\[display-time] should display day and date as well as time."
(defcustom display-time-interval 60
"Seconds between updates of time in the mode line."
- :type 'integer)
+ :type 'natnum)
(defcustom display-time-24hr-format nil
"Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
@@ -343,7 +343,7 @@ Switches from the 1 to 5 to 15 minute load average, and then back to 1."
"Update the `display-time' info for the mode line.
However, don't redisplay right now.
-This is used for things like Rmail `g' that want to force an
+This is used for things like Rmail \\`g' that want to force an
update which can wait for the next redisplay."
(let* ((now (current-time))
(time (current-time-string now))
@@ -355,7 +355,7 @@ update which can wait for the next redisplay."
(am-pm (if (>= hour 12) "pm" "am"))
(minutes (substring time 14 16))
(seconds (substring time 17 19))
- (time-zone (car (cdr (current-time-zone now))))
+ (time-zone (format-time-string "%Z" now))
(day (substring time 8 10))
(year (format-time-string "%Y" now))
(monthname (substring time 4 7))
@@ -519,18 +519,16 @@ If the value is t instead of an alist, use the value of
(defcustom world-clock-timer-second 60
"Interval in seconds for updating the `world-clock' buffer."
- :type 'integer
+ :type 'natnum
:version "28.1")
(defface world-clock-label
'((t :inherit font-lock-variable-name-face))
"Face for time zone label in `world-clock' buffer.")
-(defvar world-clock-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" #'next-line)
- (define-key map "p" #'previous-line)
- map))
+(defvar-keymap world-clock-mode-map
+ "n" #'next-line
+ "p" #'previous-line)
(define-derived-mode world-clock-mode special-mode "World clock"
"Major mode for buffer that displays times in various time zones.
diff --git a/lisp/timezone.el b/lisp/timezone.el
index 881af4dd74c..1e257c62d39 100644
--- a/lisp/timezone.el
+++ b/lisp/timezone.el
@@ -95,10 +95,7 @@ if nil, the local time zone is assumed."
Optional argument TIMEZONE specifies a time zone."
(let ((zone
(if (listp timezone)
- (let* ((m (timezone-zone-to-minute timezone))
- (absm (if (< m 0) (- m) m)))
- (format "%c%02d%02d"
- (if (< m 0) ?- ?+) (/ absm 60) (% absm 60)))
+ (format-time-string "%z" 0 (or timezone 0))
timezone)))
(format "%02d %s %04d %s %s"
day
@@ -302,11 +299,10 @@ Return a list in the same format as `current-time-zone's result,
or nil if the local time zone could not be computed.
DATE is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
- (and (fboundp 'current-time-zone)
- (let ((utc-time (timezone-time-from-absolute date seconds)))
- (and utc-time
- (let ((zone (current-time-zone utc-time)))
- (and (car zone) zone))))))
+ (let ((utc-time (timezone-time-from-absolute date seconds)))
+ (and utc-time
+ (let ((zone (current-time-zone utc-time)))
+ (and (car zone) zone)))))
(defun timezone-fix-time (date local timezone)
"Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 7ec5c0beccc..82b458e0107 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -89,15 +89,29 @@ functions.")
(declare-function image-mask-p "image.c" (spec &optional frame))
-(defconst tool-bar-keymap-cache (make-hash-table :weakness t :test 'equal))
+(defconst tool-bar-keymap-cache (make-hash-table :test #'equal))
+
+(defun tool-bar--cache-key ()
+ (cons (frame-terminal) (sxhash-eq tool-bar-map)))
+
+(defun tool-bar--flush-cache ()
+ "Remove all cached entries that refer to the current `tool-bar-map'."
+ (let ((id (sxhash-eq tool-bar-map))
+ (entries nil))
+ (maphash (lambda (k _)
+ (when (equal (cdr k) id)
+ (push k entries)))
+ tool-bar-keymap-cache)
+ (dolist (k entries)
+ (remhash k tool-bar-keymap-cache))))
(defun tool-bar-make-keymap (&optional _ignore)
"Generate an actual keymap from `tool-bar-map'.
Its main job is to figure out which images to use based on the display's
color capability and based on the available image libraries."
- (let ((key (cons (frame-terminal) tool-bar-map)))
- (or (gethash key tool-bar-keymap-cache)
- (puthash key (tool-bar-make-keymap-1) tool-bar-keymap-cache))))
+ (or (gethash (tool-bar--cache-key) tool-bar-keymap-cache)
+ (setf (gethash (tool-bar--cache-key) tool-bar-keymap-cache)
+ (tool-bar-make-keymap-1))))
(defun tool-bar-make-keymap-1 ()
"Generate an actual keymap from `tool-bar-map', without caching."
@@ -139,7 +153,8 @@ ICON.xbm, using `find-image'.
Use this function only to make bindings in the global value of `tool-bar-map'.
To define items in any other map, use `tool-bar-local-item'."
- (apply #'tool-bar-local-item icon def key tool-bar-map props))
+ (apply #'tool-bar-local-item icon def key tool-bar-map props)
+ (tool-bar--flush-cache))
(defun tool-bar--image-expression (icon)
"Return an expression that evaluates to an image spec for ICON."
@@ -177,6 +192,7 @@ ICON.xbm, using `find-image'."
(let* ((image-exp (tool-bar--image-expression icon)))
(define-key-after map (vector key)
`(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props))
+ (tool-bar--flush-cache)
(force-mode-line-update)))
;;;###autoload
@@ -243,6 +259,7 @@ holds a keymap."
(setq rest (cdr rest)))
(append `(menu-item ,(car defn) ,rest)
(list :image image-exp) props))))
+ (tool-bar--flush-cache)
(force-mode-line-update))))
;;; Set up some global items. Additions/deletions up for grabs.
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index d1628842307..95cb1cc62c0 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -58,9 +58,11 @@ echo area, instead of making a pop-up window."
(if (and tooltip-mode (fboundp 'x-show-tip))
(progn
(add-hook 'pre-command-hook 'tooltip-hide)
- (add-hook 'tooltip-functions 'tooltip-help-tips))
+ (add-hook 'tooltip-functions 'tooltip-help-tips)
+ (add-hook 'x-pre-popup-menu-hook 'tooltip-hide))
(unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode)
- (remove-hook 'pre-command-hook 'tooltip-hide))
+ (remove-hook 'pre-command-hook 'tooltip-hide)
+ (remove-hook 'x-pre-popup-menu-hook 'tooltip-hide))
(remove-hook 'tooltip-functions 'tooltip-help-tips))
(setq show-help-function
(if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode)))
@@ -138,15 +140,6 @@ When using the GTK toolkit, this face will only be used if
:group 'tooltip
:group 'basic-faces)
-(defcustom tooltip-use-echo-area nil
- "Use the echo area instead of tooltip frames for help and GUD tooltips.
-This variable is obsolete; instead of setting it to t, disable
-`tooltip-mode' (which has a similar effect)."
- :type 'boolean)
-
-(make-obsolete-variable 'tooltip-use-echo-area
- "disable Tooltip mode instead" "24.1" 'set)
-
(defcustom tooltip-resize-echo-area nil
"If non-nil, using the echo area for tooltips will resize the echo area.
By default, when the echo area is used for displaying tooltips,
@@ -228,25 +221,42 @@ change the existing association. Value is the resulting alist."
(declare-function x-show-tip "xfns.c"
(string &optional frame parms timeout dx dy))
-(defun tooltip-show (text &optional use-echo-area)
+(defun tooltip-show (text &optional use-echo-area text-face default-face)
"Show a tooltip window displaying TEXT.
Text larger than `x-max-tooltip-size' is clipped.
-If the alist in `tooltip-frame-parameters' includes `left' and `top'
-parameters, they determine the x and y position where the tooltip
-is displayed. Otherwise, the tooltip pops at offsets specified by
-`tooltip-x-offset' and `tooltip-y-offset' from the current mouse
-position.
+If the alist in `tooltip-frame-parameters' includes `left' and
+`top' parameters, they determine the x and y position where the
+tooltip is displayed. Otherwise, the tooltip pops at offsets
+specified by `tooltip-x-offset' and `tooltip-y-offset' from the
+current mouse position.
+
+The text properties of TEXT are also modified to add the
+appropriate faces before displaying the tooltip. If your code
+depends on them, you should copy the tooltip string before
+passing it to this function.
Optional second arg USE-ECHO-AREA non-nil means to show tooltip
-in echo area."
+in echo area.
+
+The third and fourth args TEXT-FACE and DEFAULT-FACE specify
+faces used to display the tooltip, and default to `tooltip' if
+not specified. TEXT-FACE specifies a face used to display text
+in the tooltip, while DEFAULT-FACE specifies a face that provides
+the background, foreground and border colors of the tooltip
+frame.
+
+Note that the last two arguments are not respected when
+`use-system-tooltips' is non-nil and Emacs is built with support
+for system tooltips, such as on NS, Haiku, and with the GTK
+toolkit."
(if use-echo-area
(tooltip-show-help-non-mode text)
(condition-case error
(let ((params (copy-sequence tooltip-frame-parameters))
- (fg (face-attribute 'tooltip :foreground))
- (bg (face-attribute 'tooltip :background)))
+ (fg (face-attribute (or default-face 'tooltip) :foreground))
+ (bg (face-attribute (or default-face 'tooltip) :background)))
(when (stringp fg)
(setf (alist-get 'foreground-color params) fg)
(setf (alist-get 'border-color params) fg))
@@ -256,7 +266,8 @@ in echo area."
;; faces used in our TEXT. Among other things, this allows
;; tooltips to use the `help-key-binding' face used in
;; `substitute-command-keys' substitutions.
- (add-face-text-property 0 (length text) 'tooltip t text)
+ (add-face-text-property 0 (length text)
+ (or text-face 'tooltip) t text)
(x-show-tip text
(selected-frame)
params
@@ -339,6 +350,8 @@ This is used by `tooltip-show-help' and
(defvar tooltip-previous-message nil
"The previous content of the echo area.")
+(defvar haiku-use-system-tooltips)
+
(defun tooltip-show-help-non-mode (help)
"Function installed as `show-help-function' when Tooltip mode is off.
It is also called if Tooltip mode is on, for text-only displays."
@@ -368,10 +381,16 @@ It is also called if Tooltip mode is on, for text-only displays."
((equal-including-properties tooltip-help-message (current-message))
(message nil)))))
+(declare-function menu-or-popup-active-p "xmenu.c" ())
+
(defun tooltip-show-help (msg)
"Function installed as `show-help-function'.
MSG is either a help string to display, or nil to cancel the display."
- (if (display-graphic-p)
+ (if (and (display-graphic-p)
+ ;; Tooltips can't be displayed on top of the global menu
+ ;; bar on NS.
+ (or (not (eq window-system 'ns))
+ (not (menu-or-popup-active-p))))
(let ((previous-help tooltip-help-message))
(setq tooltip-help-message msg)
(cond ((null msg)
@@ -399,7 +418,7 @@ This is installed on the hook `tooltip-functions', which
is run when the timer with id `tooltip-timeout-id' fires.
Value is non-nil if this function handled the tip."
(when (stringp tooltip-help-message)
- (tooltip-show tooltip-help-message tooltip-use-echo-area)
+ (tooltip-show tooltip-help-message (not tooltip-mode))
t))
(provide 'tooltip)
diff --git a/lisp/transient.el b/lisp/transient.el
index 0d7f9d0317b..41b69b1abac 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
-;; Homepage: https://github.com/magit/transient
+;; URL: https://github.com/magit/transient
;; Keywords: bindings
;; Package-Requires: ((emacs "25.1"))
@@ -61,10 +61,10 @@
(eval-when-compile
(require 'subr-x))
-(declare-function info 'info)
-(declare-function Man-find-section 'man)
-(declare-function Man-next-section 'man)
-(declare-function Man-getpage-in-background 'man)
+(declare-function info "info")
+(declare-function Man-find-section "man")
+(declare-function Man-next-section "man")
+(declare-function Man-getpage-in-background "man")
(defvar Man-notify-method)
@@ -246,7 +246,7 @@ for infix argument are highlighted when only a long argument
In the rare case that a short-hand is specified but does not
match the key binding, then it is highlighed differently.
-The highlighting is done using using `transient-mismatched-key'
+The highlighting is done using `transient-mismatched-key'
and `transient-nonstandard-key'."
:package-version '(transient . "0.1.0")
:group 'transient
@@ -1384,7 +1384,7 @@ The optional argument COMMAND is intended for internal use. If
you are contemplating using it in your own code, then you should
probably use this instead:
- (get COMMAND 'transient--suffix)"
+ (get COMMAND \\='transient--suffix)"
(when command
(cl-check-type command command))
(if (or transient--prefix
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el
index ec258888c8b..f91b36bfc28 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -214,8 +214,8 @@ Give the image the specified properties PROPS."
See also the option `widget-image-conversion'."
(delq nil
(mapcar
- #'(lambda (fmt)
- (and (image-type-available-p (car fmt)) fmt))
+ (lambda (fmt)
+ (and (image-type-available-p (car fmt)) fmt))
widget-image-conversion)))
;; Buffer local cache of theme data.
@@ -319,6 +319,7 @@ has been found accessible."
'(
("guide" . arrow)
("no-guide" . arrow)
+ ("nohandle-guide" . arrow)
("end-guide" . arrow)
("handle" . arrow)
("no-handle" . arrow)
@@ -440,6 +441,12 @@ Handle mouse button 1 click on buttons.")
:format "%t"
)
+(define-widget 'tree-widget-nohandle-guide 'item
+ "Vertical guide line, when there is no handle."
+ :tag " |"
+ ;;:tag-glyph (tree-widget-find-image "nohandle-guide")
+ :format "%t")
+
(define-widget 'tree-widget-end-guide 'item
"End of a vertical guide line."
:tag " \\=`"
@@ -483,6 +490,7 @@ Handle mouse button 1 click on buttons.")
:empty-icon 'tree-widget-empty-icon
:leaf-icon 'tree-widget-leaf-icon
:guide 'tree-widget-guide
+ :nohandle-guide 'tree-widget-nohandle-guide
:end-guide 'tree-widget-end-guide
:no-guide 'tree-widget-no-guide
:handle 'tree-widget-handle
@@ -612,11 +620,13 @@ This hook should be local in the buffer setup to display widgets.")
;;;; Expanded node.
(let ((args (widget-get tree :args))
(guide (widget-get tree :guide))
+ (nohandle-guide (widget-get tree :nohandle-guide))
(noguide (widget-get tree :no-guide))
(endguide (widget-get tree :end-guide))
(handle (widget-get tree :handle))
(nohandle (widget-get tree :no-handle))
(guidi (tree-widget-find-image "guide"))
+ (nohandle-guidi (tree-widget-find-image "nohandle-guide"))
(noguidi (tree-widget-find-image "no-guide"))
(endguidi (tree-widget-find-image "end-guide"))
(handli (tree-widget-find-image "handle"))
@@ -648,8 +658,8 @@ This hook should be local in the buffer setup to display widgets.")
;; Insert guide lines elements from previous levels.
(dolist (f (reverse flags))
(widget-create-child-and-convert
- tree (if f guide noguide)
- :tag-glyph (if f guidi noguidi))
+ tree (if f nohandle-guide noguide)
+ :tag-glyph (if f nohandle-guidi noguidi))
(widget-create-child-and-convert
tree nohandle :tag-glyph nohandli))
;; Insert guide line element for this level.
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 69540f35d8f..2c787ae5595 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -385,7 +385,7 @@ correspond to what the tutorial says.\n\n")
"Find the key bindings used in the tutorial that have changed.
Return a list with elements of the form
- '(KEY DEF-FUN DEF-FUN-TXT WHERE REMARK QUIET)
+ (KEY DEF-FUN DEF-FUN-TXT WHERE REMARK QUIET)
where
@@ -423,11 +423,9 @@ where
;; Handle prefix definitions specially
;; so that a mode that rebinds some subcommands
;; won't make it appear that the whole prefix is gone.
- (key-fun (if (eq def-fun 'ESC-prefix)
- (lookup-key global-map [27])
- (if (eq def-fun 'Control-X-prefix)
- (lookup-key global-map [24])
- (key-binding key))))
+ (key-fun (if (keymapp def-fun)
+ (lookup-key global-map key)
+ (key-binding key)))
(where (where-is-internal (if rem-fun rem-fun def-fun)))
cwhere)
@@ -651,13 +649,15 @@ with some explanatory links."
(unless (eq prop-val 'key-sequence)
(delete-region prop-start prop-end))))))
+(defvar tutorial--starting-point)
(defun tutorial--save-on-kill ()
"Query the user about saving the tutorial when killing Emacs."
(when (buffer-live-p tutorial--buffer)
(with-current-buffer tutorial--buffer
- (if (y-or-n-p "Save your position in the tutorial? ")
- (tutorial--save-tutorial-to (tutorial--saved-file))
- (message "Tutorial position not saved"))))
+ (unless (= (point) tutorial--starting-point)
+ (if (y-or-n-p "Save your position in the tutorial? ")
+ (tutorial--save-tutorial-to (tutorial--saved-file))
+ (message "Tutorial position not saved")))))
t)
(defun tutorial--save-tutorial ()
@@ -736,7 +736,6 @@ See `tutorial--save-tutorial' for more information."
(message "Can't save tutorial: %s is not a directory"
tutorial-dir)))))
-
;;;###autoload
(defun help-with-tutorial (&optional arg dont-ask-for-revert)
"Select the Emacs learn-by-doing tutorial.
@@ -916,6 +915,7 @@ Run the Viper tutorial? "))
(forward-line 1)
(newline (- n (/ n 2)))))
(goto-char (point-min)))
+ (setq-local tutorial--starting-point (point))
(setq buffer-undo-list nil)
(set-buffer-modified-p nil)))))
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 267facccc47..dca5a43b893 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -69,7 +69,7 @@
(defcustom type-break-interval (* 60 60)
"Number of seconds between scheduled typing breaks."
- :type 'integer
+ :type 'natnum
:group 'type-break)
(defcustom type-break-good-rest-interval (/ type-break-interval 6)
@@ -82,7 +82,7 @@ rest from typing, then the next typing break is simply rescheduled for later.
If a break is interrupted before this much time elapses, the user will be
asked whether or not really to interrupt the break."
:set-after '(type-break-interval)
- :type 'integer
+ :type 'natnum
:group 'type-break)
(defcustom type-break-good-break-interval nil
@@ -148,7 +148,7 @@ To avoid being queried at all, set `type-break-query-mode' to nil."
"Number of seconds between queries to take a break, if put off.
The user will continue to be prompted at this interval until he or she
finally submits to taking a typing break."
- :type 'integer
+ :type 'natnum
:group 'type-break)
(defcustom type-break-time-warning-intervals '(300 120 60 30)
@@ -171,7 +171,7 @@ will occur."
"Number of keystrokes for which warnings should be repeated.
That is, for each of this many keystrokes the warning is redisplayed
in the echo area to make sure it's really seen."
- :type 'integer
+ :type 'natnum
:group 'type-break)
(defcustom type-break-time-stamp-format "[%H:%M] "
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 6b48fe3df62..0b7db9b54fb 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -128,7 +128,6 @@ you can set, browse the `uniquify' custom group."
"If non-nil, rerationalize buffer names after a buffer has been killed."
:type 'boolean)
-;; The default value matches certain Gnus buffers.
(defcustom uniquify-ignore-buffers-re nil
"Regular expression matching buffer names that should not be uniquified.
For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename
@@ -476,34 +475,32 @@ For use on `kill-buffer-hook'."
;; rename-buffer and create-file-buffer. (Setting find-file-hook isn't
;; sufficient.)
-(advice-add 'rename-buffer :around #'uniquify--rename-buffer-advice)
-(defun uniquify--rename-buffer-advice (rb-fun newname &optional unique &rest args)
+;; (advice-add 'rename-buffer :around #'uniquify--rename-buffer-advice)
+(defun uniquify--rename-buffer-advice (newname &optional unique)
+ ;; BEWARE: This is called directly from `buffer.c'!
"Uniquify buffer names with parts of directory name."
- (let ((retval (apply rb-fun newname unique args)))
(uniquify-maybe-rerationalize-w/o-cb)
- (if (null unique)
+ (if (null unique)
;; Mark this buffer so it won't be renamed by uniquify.
(setq uniquify-managed nil)
(when uniquify-buffer-name-style
;; Rerationalize w.r.t the new name.
(uniquify-rationalize-file-buffer-names
- newname
+ newname
(uniquify-buffer-file-name (current-buffer))
- (current-buffer))
- (setq retval (buffer-name (current-buffer)))))
- retval))
+ (current-buffer)))))
-(advice-add 'create-file-buffer :around #'uniquify--create-file-buffer-advice)
-(defun uniquify--create-file-buffer-advice (cfb-fun filename &rest args)
+;; (advice-add 'create-file-buffer :around #'uniquify--create-file-buffer-advice)
+(defun uniquify--create-file-buffer-advice (buf filename)
+ ;; BEWARE: This is called directly from `files.el'!
"Uniquify buffer names with parts of directory name."
- (let ((retval (apply cfb-fun filename args)))
- (if uniquify-buffer-name-style
- (let ((filename (expand-file-name (directory-file-name filename))))
- (uniquify-rationalize-file-buffer-names
- (file-name-nondirectory filename)
- (file-name-directory filename) retval)))
- retval))
+ (when uniquify-buffer-name-style
+ (let ((filename (expand-file-name (directory-file-name filename))))
+ (uniquify-rationalize-file-buffer-names
+ (file-name-nondirectory filename)
+ (file-name-directory filename)
+ buf))))
(defun uniquify-unload-function ()
"Unload the uniquify library."
@@ -513,8 +510,6 @@ For use on `kill-buffer-hook'."
(set-buffer buf)
(when uniquify-managed
(push (cons buf (uniquify-item-base (car uniquify-managed))) buffers)))
- (advice-remove 'rename-buffer #'uniquify--rename-buffer-advice)
- (advice-remove 'create-file-buffer #'uniquify--create-file-buffer-advice)
(dolist (buf buffers)
(set-buffer (car buf))
(rename-buffer (cdr buf) t))))
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 585010d21c5..53cefb46e4b 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -87,11 +87,13 @@ instead of the filename inheritance method."
((and prompt (not byserv))
(setq user (or
(url-do-auth-source-search server type :user)
- (read-string (url-auth-user-prompt href realm)
- (or user (user-real-login-name))))
+ (and (url-interactive-p)
+ (read-string (url-auth-user-prompt href realm)
+ (or user (user-real-login-name)))))
pass (or
(url-do-auth-source-search server type :secret)
- (read-passwd "Password: " nil (or pass ""))))
+ (and (url-interactive-p)
+ (read-passwd "Password: " nil (or pass "")))))
(set url-basic-auth-storage
(cons (list server
(cons file
@@ -117,11 +119,13 @@ instead of the filename inheritance method."
(progn
(setq user (or
(url-do-auth-source-search server type :user)
- (read-string (url-auth-user-prompt href realm)
- (user-real-login-name)))
+ (and (url-interactive-p)
+ (read-string (url-auth-user-prompt href realm)
+ (user-real-login-name))))
pass (or
(url-do-auth-source-search server type :secret)
- (read-passwd "Password: "))
+ (and (url-interactive-p)
+ (read-passwd "Password: ")))
retval (base64-encode-string (format "%s:%s" user pass) t)
byserv (assoc server (symbol-value url-basic-auth-storage)))
(setcdr byserv
@@ -233,11 +237,13 @@ CREDS is a plist that may have properties `:user' and `:secret'."
;; plist-put modify the same plist.
(setq creds
(plist-put creds :user
- (read-string (url-auth-user-prompt url realm)
- (or (plist-get creds :user)
- (user-real-login-name)))))
+ (and (url-interactive-p)
+ (read-string (url-auth-user-prompt url realm)
+ (or (plist-get creds :user)
+ (user-real-login-name))))))
(plist-put creds :secret
- (read-passwd "Password: " nil (plist-get creds :secret))))
+ (and (url-interactive-p)
+ (read-passwd "Password: " nil (plist-get creds :secret)))))
(defun url-digest-auth-directory-id-assoc (dirkey keylist)
"Find the best match for DIRKEY in key alist KEYLIST.
@@ -301,8 +307,8 @@ object."
(defun url-digest-auth-build-response (key url realm attrs)
"Compute authorization string for the given challenge using KEY.
-The string looks like 'Digest username=\"John\", realm=\"The
-Realm\", ...'
+The string looks like \"Digest username=\"John\", realm=\"The
+Realm\", ...\"
Part of the challenge is already solved in a pre-computed KEY
which is list of a realm (or a directory), user name, and hash
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 3e69227124f..db8c121cf00 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -37,7 +37,7 @@
"Default maximum time in seconds before cache files expire.
Used by the function `url-cache-expired'."
:version "24.1"
- :type 'integer
+ :type 'natnum
:group 'url-cache)
;; Cache manager
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 6b9ce5da93e..0709cdd3fa1 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -26,6 +26,7 @@
(require 'url-util)
(require 'url-parse)
(require 'url-domsuf)
+(require 'generate-lisp-file)
(eval-when-compile (require 'cl-lib))
@@ -158,10 +159,7 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
(insert ")\n(setq url-cookie-secure-storage\n '")
(pp url-cookie-secure-storage (current-buffer)))
(insert ")\n")
- (insert " \n;; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-byte-compile: t\n"
- ";; End:\n")
+ (generate-lisp-file-trailer fname :inhibit-provide t :autoloads t)
(setq-local version-control 'never)
(write-file fname))
(setq url-cookies-changed-since-last-save nil))))
@@ -362,7 +360,7 @@ to run the `url-cookie-setup-save-timer' function manually."
(set-default var val)
(if (bound-and-true-p url-setup-done)
(url-cookie-setup-save-timer)))
- :type 'integer
+ :type 'natnum
:group 'url-cookie)
(defun url-cookie-setup-save-timer ()
@@ -494,12 +492,10 @@ Use \\<url-cookie-mode-map>\\[url-cookie-delete] to remove cookies."
(url-cookie--generate-buffer)
(goto-char point))))
-(defvar url-cookie-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [delete] 'url-cookie-delete)
- (define-key map [(control k)] 'url-cookie-delete)
- (define-key map [(control _)] 'url-cookie-undo)
- map))
+(defvar-keymap url-cookie-mode-map
+ "<delete>" #'url-cookie-delete
+ "C-k" #'url-cookie-delete
+ "C-_" #'url-cookie-undo)
(define-derived-mode url-cookie-mode special-mode "URL Cookie"
"Mode for listing cookies.
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index 1bbd741c1a7..e2c23a8b6d9 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -25,12 +25,10 @@
(autoload 'dired-get-filename "dired")
-(defvar url-dired-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-m" 'url-dired-find-file)
- (define-key map [mouse-2] 'url-dired-find-file-mouse)
- map)
- "Keymap used when browsing directories.")
+(defvar-keymap url-dired-minor-mode-map
+ :doc "Keymap used when browsing directories."
+ "C-m" #'url-dired-find-file
+ "<mouse-2>" #'url-dired-find-file-mouse)
(defun url-dired-find-file ()
"In dired, visit the file or directory named on this line."
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 31e5c07234c..3863ac99144 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -29,6 +29,12 @@
(require 'url-dired)
(declare-function mm-disable-multibyte "mm-util" ())
+(defvar url-allow-non-local-files nil
+ "If non-nil, allow URL to fetch non-local files.
+By default, this is not allowed, since that would allow rendering
+HTML to fetch files on other systems if given a <img
+src=\"/ssh:host...\"> element, which can be disturbing.")
+
(defconst url-file-default-port 21 "Default FTP port.")
(defconst url-file-asynchronous-p t "FTP transfers are asynchronous.")
(defalias 'url-file-expand-file-name 'url-default-expander)
@@ -70,18 +76,15 @@ to them."
buff func
func args
args efs))
- (let ((size (file-attribute-size (file-attributes name))))
- (with-current-buffer buff
- (goto-char (point-max))
- (if (/= -1 size)
- (insert (format "Content-length: %d\n" size)))
- (insert "\n")
- (insert-file-contents-literally name)
- (if (not (url-file-host-is-local-p (url-host url-current-object)))
- (condition-case ()
- (delete-file name)
- (error nil)))
- (apply func args))))
+ (with-current-buffer buff
+ (goto-char (point-max))
+ (insert-file-contents-literally name)
+ (insert (format "Content-length: %d\n\n" (buffer-size)))
+ (if (not (url-file-host-is-local-p (url-host url-current-object)))
+ (condition-case ()
+ (delete-file name)
+ (error nil)))
+ (apply func args)))
(declare-function ange-ftp-set-passwd "ange-ftp" (host user passwd))
(declare-function ange-ftp-copy-file-internal "ange-ftp"
@@ -111,7 +114,8 @@ to them."
(memq system-type '(ms-dos windows-nt)))
(substring file 1))
;; file: URL with a file:/bar:/foo-like spec.
- ((string-match "\\`/[^/]+:/" file)
+ ((and (not url-allow-non-local-files)
+ (string-match "\\`/[^/]+:/" file))
(concat "/:" file))
(t
file))))
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 2da24ff6042..74f77cd2383 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -396,7 +396,8 @@ if it had been inserted from a file named URL."
(url-handlers-create-wrapper file-writable-p (url))
(url-handlers-create-wrapper file-directory-p (url))
(url-handlers-create-wrapper file-executable-p (url))
-(url-handlers-create-wrapper directory-files (url &optional full match nosort))
+(url-handlers-create-wrapper
+ directory-files (url &optional full match nosort count))
(url-handlers-create-wrapper file-truename (url &optional counter prev-dirs))
(add-hook 'find-file-hook #'url-handlers-set-buffer-mode)
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index cb4814afcad..058e601301b 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -63,7 +63,7 @@ to run the `url-history-setup-save-timer' function manually."
(set-default var val)
(if (bound-and-true-p url-setup-done)
(url-history-setup-save-timer)))
- :type 'integer
+ :type 'natnum
:group 'url-history)
(defvar url-history-timer nil)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 16c3a6a1e62..4e5d017036c 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -36,6 +36,7 @@
(defvar url-current-object)
(defvar url-http-after-change-function)
(defvar url-http-chunked-counter)
+(defvar url-http-chunked-last-crlf-missing)
(defvar url-http-chunked-length)
(defvar url-http-chunked-start)
(defvar url-http-connection-opened)
@@ -332,7 +333,10 @@ Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')."
(if (and using-proxy
;; Bug#35969.
(not (equal "https" (url-type url-http-target-url))))
- (url-recreate-url url-http-target-url) real-fname))
+ (let ((url (copy-sequence url-http-target-url)))
+ (setf (url-host url) (puny-encode-domain (url-host url)))
+ (url-recreate-url url))
+ real-fname))
" HTTP/" url-http-version "\r\n"
;; Version of MIME we speak
"MIME-Version: 1.0\r\n"
@@ -585,6 +589,13 @@ should be shown to the user."
(url-http-debug "url-http-parse-headers called in (%s)" (buffer-name))
(url-http-parse-response)
(mail-narrow-to-head)
+ (when url-debug
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (url-http-debug "Response: %s"
+ (buffer-substring (point) (line-end-position)))
+ (forward-line 1))))
;;(narrow-to-region (point-min) url-http-end-of-headers)
(let ((connection (mail-fetch-field "Connection")))
;; In HTTP 1.0, keep the connection only if there is a
@@ -1068,90 +1079,105 @@ the callback to be triggered."
Cannot give a sophisticated percentage, but we need a different
function to look for the special 0-length chunk that signifies
the end of the document."
- (save-excursion
- (goto-char st)
- (let ((read-next-chunk t)
- (case-fold-search t)
- (regexp nil)
- (no-initial-crlf nil))
- ;; We need to loop thru looking for more chunks even within
- ;; one after-change-function call.
- (while read-next-chunk
- (setq no-initial-crlf (= 0 url-http-chunked-counter))
- (if url-http-content-type
+ (if url-http-chunked-last-crlf-missing
+ (progn
+ (goto-char url-http-chunked-last-crlf-missing)
+ (if (not (looking-at "\r\n"))
+ (url-http-debug
+ "Still spinning for the terminator of last chunk...")
+ (url-http-debug "Saw the last CRLF.")
+ (delete-region (match-beginning 0) (match-end 0))
+ (when (url-http-parse-headers)
+ (url-http-activate-callback))))
+ (save-excursion
+ (goto-char st)
+ (let ((read-next-chunk t)
+ (case-fold-search t)
+ (regexp nil)
+ (no-initial-crlf nil))
+ ;; We need to loop thru looking for more chunks even within
+ ;; one after-change-function call.
+ (while read-next-chunk
+ (setq no-initial-crlf (= 0 url-http-chunked-counter))
+ (if url-http-content-type
+ (url-display-percentage nil
+ "Reading [%s]... chunk #%d"
+ url-http-content-type url-http-chunked-counter)
(url-display-percentage nil
- "Reading [%s]... chunk #%d"
- url-http-content-type url-http-chunked-counter)
- (url-display-percentage nil
- "Reading... chunk #%d"
- url-http-chunked-counter))
- (url-http-debug "Reading chunk %d (%d %d %d)"
- url-http-chunked-counter st nd length)
- (setq regexp (if no-initial-crlf
- "\\([0-9a-z]+\\).*\r?\n"
- "\r?\n\\([0-9a-z]+\\).*\r?\n"))
-
- (if url-http-chunked-start
- ;; We know how long the chunk is supposed to be, skip over
- ;; leading crap if possible.
- (if (> nd (+ url-http-chunked-start url-http-chunked-length))
- (progn
- (url-http-debug "Got to the end of chunk #%d!"
- url-http-chunked-counter)
- (goto-char (+ url-http-chunked-start
- url-http-chunked-length)))
- (url-http-debug "Still need %d bytes to hit end of chunk"
- (- (+ url-http-chunked-start
- url-http-chunked-length)
- nd))
- (setq read-next-chunk nil)))
- (if (not read-next-chunk)
- (url-http-debug "Still spinning for next chunk...")
- (if no-initial-crlf (skip-chars-forward "\r\n"))
- (if (not (looking-at regexp))
- (progn
- ;; Must not have received the entirety of the chunk header,
- ;; need to spin some more.
- (url-http-debug "Did not see start of chunk @ %d!" (point))
- (setq read-next-chunk nil))
- ;; The data we got may have started in the middle of the
- ;; initial chunk header, so move back to the start of the
- ;; line and re-compute.
- (when (= url-http-chunked-counter 0)
- (beginning-of-line)
- (looking-at regexp))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'chunked-encoding t
- 'face 'cursor
- 'invisible t))
- (setq url-http-chunked-length (string-to-number (buffer-substring
- (match-beginning 1)
- (match-end 1))
- 16)
- url-http-chunked-counter (1+ url-http-chunked-counter)
- url-http-chunked-start (set-marker
- (or url-http-chunked-start
- (make-marker))
- (match-end 0)))
- (delete-region (match-beginning 0) (match-end 0))
- (url-http-debug "Saw start of chunk %d (length=%d, start=%d"
- url-http-chunked-counter url-http-chunked-length
- (marker-position url-http-chunked-start))
- (if (= 0 url-http-chunked-length)
- (progn
- ;; Found the end of the document! Wheee!
- (url-http-debug "Saw end of stream chunk!")
- (setq read-next-chunk nil)
- (url-display-percentage nil nil)
- ;; Every chunk, even the last 0-length one, is
- ;; terminated by CRLF. Skip it.
- (when (looking-at "\r?\n")
- (url-http-debug "Removing terminator of last chunk")
- (delete-region (match-beginning 0) (match-end 0)))
- (if (re-search-forward "^\r?\n" nil t)
- (url-http-debug "Saw end of trailers..."))
- (if (url-http-parse-headers)
- (url-http-activate-callback))))))))))
+ "Reading... chunk #%d"
+ url-http-chunked-counter))
+ (url-http-debug "Reading chunk %d (%d %d %d)"
+ url-http-chunked-counter st nd length)
+ (setq regexp (if no-initial-crlf
+ "\\([0-9a-z]+\\).*\r?\n"
+ "\r?\n\\([0-9a-z]+\\).*\r?\n"))
+
+ (if url-http-chunked-start
+ ;; We know how long the chunk is supposed to be, skip over
+ ;; leading crap if possible.
+ (if (> nd (+ url-http-chunked-start url-http-chunked-length))
+ (progn
+ (url-http-debug "Got to the end of chunk #%d!"
+ url-http-chunked-counter)
+ (goto-char (+ url-http-chunked-start
+ url-http-chunked-length)))
+ (url-http-debug "Still need %d bytes to hit end of chunk"
+ (- (+ url-http-chunked-start
+ url-http-chunked-length)
+ nd))
+ (setq read-next-chunk nil)))
+ (if (not read-next-chunk)
+ (url-http-debug "Still spinning for next chunk...")
+ (if no-initial-crlf (skip-chars-forward "\r\n"))
+ (if (not (looking-at regexp))
+ (progn
+ ;; Must not have received the entirety of the chunk header,
+ ;; need to spin some more.
+ (url-http-debug "Did not see start of chunk @ %d!" (point))
+ (setq read-next-chunk nil))
+ ;; The data we got may have started in the middle of the
+ ;; initial chunk header, so move back to the start of the
+ ;; line and re-compute.
+ (when (= url-http-chunked-counter 0)
+ (beginning-of-line)
+ (looking-at regexp))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'chunked-encoding t
+ 'face 'cursor
+ 'invisible t))
+ (setq url-http-chunked-length
+ (string-to-number (buffer-substring (match-beginning 1)
+ (match-end 1))
+ 16)
+ url-http-chunked-counter (1+ url-http-chunked-counter)
+ url-http-chunked-start (set-marker
+ (or url-http-chunked-start
+ (make-marker))
+ (match-end 0)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (url-http-debug "Saw start of chunk %d (length=%d, start=%d"
+ url-http-chunked-counter url-http-chunked-length
+ (marker-position url-http-chunked-start))
+ (if (= 0 url-http-chunked-length)
+ (progn
+ ;; Found the end of the document! Wheee!
+ (url-http-debug "Saw end of stream chunk!")
+ (setq read-next-chunk nil)
+ (url-display-percentage nil nil)
+ ;; Every chunk, even the last 0-length one, is
+ ;; terminated by CRLF. Skip it.
+ (if (not (looking-at "\r?\n"))
+ (progn
+ (url-http-debug
+ "Spinning for the terminator of last chunk...")
+ (setq url-http-chunked-last-crlf-missing
+ (point)))
+ (url-http-debug "Removing terminator of last chunk")
+ (delete-region (match-beginning 0) (match-end 0))
+ (when (re-search-forward "^\r?\n" nil t)
+ (url-http-debug "Saw end of trailers..."))
+ (when (url-http-parse-headers)
+ (url-http-activate-callback))))))))))))
(defun url-http-wait-for-headers-change-function (_st nd _length)
;; This will wait for the headers to arrive and then splice in the
@@ -1304,9 +1330,7 @@ The return value of this function is the retrieval buffer."
(cl-check-type url url "Need a pre-parsed URL.")
(let* (;; (host (url-host (or url-using-proxy url)))
;; (port (url-port (or url-using-proxy url)))
- (nsm-noninteractive (or url-request-noninteractive
- (and (boundp 'url-http-noninteractive)
- url-http-noninteractive)))
+ (nsm-noninteractive (not (url-interactive-p)))
;; The following binding is needed in url-open-stream, which
;; is called from url-http-find-free-connection.
(url-current-object url)
@@ -1337,6 +1361,7 @@ The return value of this function is the retrieval buffer."
url-http-after-change-function
url-http-response-version
url-http-response-status
+ url-http-chunked-last-crlf-missing
url-http-chunked-length
url-http-chunked-counter
url-http-chunked-start
@@ -1361,6 +1386,7 @@ The return value of this function is the retrieval buffer."
url-http-noninteractive url-request-noninteractive
url-http-data url-request-data
url-http-process connection
+ url-http-chunked-last-crlf-missing nil
url-http-chunked-length nil
url-http-chunked-start nil
url-http-chunked-counter 0
@@ -1407,10 +1433,10 @@ The return value of this function is the retrieval buffer."
(and proxy-auth
(concat "Proxy-Authorization: " proxy-auth "\r\n")))
"\r\n")
- (url-host url-current-object)
+ (puny-encode-domain (url-host url-current-object))
(or (url-port url-current-object)
url-https-default-port)
- (url-host url-current-object))))
+ (puny-encode-domain (url-host url-current-object)))))
(defun url-https-proxy-after-change-function (_st _nd _length)
(let* ((process-buffer (current-buffer))
@@ -1432,12 +1458,12 @@ The return value of this function is the retrieval buffer."
(condition-case e
(let ((tls-connection (gnutls-negotiate
:process proc
- :hostname (url-host url-current-object)
+ :hostname (puny-encode-domain (url-host url-current-object))
:verify-error nil)))
;; check certificate validity
(setq tls-connection
(nsm-verify-connection tls-connection
- (url-host url-current-object)
+ (puny-encode-domain (url-host url-current-object))
(url-port url-current-object)))
(with-current-buffer process-buffer (erase-buffer))
(set-process-buffer tls-connection process-buffer)
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index 78bb78b1ee2..f897248fe4c 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -48,6 +48,7 @@
(pcase (or window-system 'tty)
('x "X11")
('ns "OpenStep")
+ ('pgtk "PureGTK")
('tty "TTY")
(_ nil)))))
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 8741bca9423..cf45a7f681a 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -31,17 +31,18 @@
(eval-when-compile (require 'cl-lib))
(require 'browse-url)
(require 'url-parse)
+(require 'url-file)
(defcustom url-queue-parallel-processes 6
"The number of concurrent processes."
:version "24.1"
- :type 'integer
+ :type 'natnum
:group 'url)
(defcustom url-queue-timeout 5
"How long to let a job live once it's started (in seconds)."
:version "24.1"
- :type 'integer
+ :type 'natnum
:group 'url)
;;; Internal variables.
@@ -155,14 +156,16 @@ The variable `url-queue-timeout' sets a timeout."
(defun url-queue-start-retrieve (job)
(setf (url-queue-buffer job)
(ignore-errors
- (with-current-buffer (if (buffer-live-p (url-queue-context-buffer job))
+ (with-current-buffer (if (buffer-live-p
+ (url-queue-context-buffer job))
(url-queue-context-buffer job)
(current-buffer))
- (let ((url-request-noninteractive t))
- (url-retrieve (url-queue-url job)
- #'url-queue-callback-function (list job)
- (url-queue-silentp job)
- (url-queue-inhibit-cookiesp job)))))))
+ (let ((url-request-noninteractive t)
+ (url-allow-non-local-files t))
+ (url-retrieve (url-queue-url job)
+ #'url-queue-callback-function (list job)
+ (url-queue-silentp job)
+ (url-queue-inhibit-cookiesp job)))))))
(defun url-queue-prune-old-entries ()
(let (dead-jobs)
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
index 30c1961407e..c414a025a14 100644
--- a/lisp/url/url-tramp.el
+++ b/lisp/url/url-tramp.el
@@ -44,36 +44,40 @@ In case URL is not convertible, nil is returned."
(port
(and obj (natnump (url-portspec obj))
(number-to-string (url-portspec obj)))))
- (when (and obj (member (url-type obj) url-tramp-protocols))
- (when (url-password obj)
- (password-cache-add
- (tramp-make-tramp-file-name
- (make-tramp-file-name
- :method (url-type obj) :user (url-user obj)
- :host (url-host obj)))
- (url-password obj)))
- (tramp-make-tramp-file-name
- (make-tramp-file-name
- :method (url-type obj) :user (url-user obj)
- :host (url-host obj) :port port :localname (url-filename obj))))))
+ (if (and obj (member (url-type obj) url-tramp-protocols))
+ (progn
+ (when (url-password obj)
+ (password-cache-add
+ (tramp-make-tramp-file-name
+ (make-tramp-file-name
+ :method (url-type obj) :user (url-user obj)
+ :host (url-host obj)))
+ (url-password obj)))
+ (tramp-make-tramp-file-name
+ (make-tramp-file-name
+ :method (url-type obj) :user (url-user obj)
+ :host (url-host obj) :port port :localname (url-filename obj))))
+ url)))
(defun url-tramp-convert-tramp-to-url (file)
"Convert FILE, a Tramp file name, to a URL.
In case FILE is not convertible, nil is returned."
- (let* ((obj (ignore-errors (tramp-dissect-file-name file)))
+ (let* ((obj (and (tramp-tramp-file-p file)
+ (ignore-errors (tramp-dissect-file-name file))))
(port
(and obj (stringp (tramp-file-name-port obj))
(string-to-number (tramp-file-name-port obj)))))
- (when (and obj (member (tramp-file-name-method obj) url-tramp-protocols))
- (url-recreate-url
- (url-parse-make-urlobj
- (tramp-file-name-method obj)
- (tramp-file-name-user obj)
- nil ; password.
- (tramp-file-name-host obj)
- port
- (tramp-file-name-localname obj)
- nil nil t))))) ; target attributes fullness.
+ (if (and obj (member (tramp-file-name-method obj) url-tramp-protocols))
+ (url-recreate-url
+ (url-parse-make-urlobj
+ (tramp-file-name-method obj)
+ (tramp-file-name-user obj)
+ nil ; password.
+ (tramp-file-name-host obj)
+ port
+ (tramp-file-name-localname obj)
+ nil nil t)) ; target attributes fullness.
+ file)))
;;;###autoload
(defun url-tramp-file-handler (operation &rest args)
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index b8b7980e40b..fc84d451760 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -1,7 +1,6 @@
;;; url-util.el --- Miscellaneous helper routines for URL library -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2001, 2004-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -217,9 +216,7 @@ Will not do anything if `url-show-status' is nil."
;;;###autoload
(defun url-percentage (x y)
- (if (fboundp 'float)
- (round (* 100 (/ x (float y))))
- (/ (* x 100) y)))
+ (round (* 100 (/ x (float y)))))
;;;###autoload
(defalias 'url-basepath 'url-file-directory)
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 83c089a930a..de42599e0d4 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,7 +1,6 @@
;;; url-vars.el --- Variables for Uniform Resource Locator tool -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1999, 2001, 2004-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -131,7 +130,7 @@ Samples:
This variable controls several other variables and is _NOT_ automatically
updated. Call the function `url-setup-privacy-info' after modifying this
variable."
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (sym val) (set-default sym val) (url-setup-privacy-info))
:type '(radio (const :tag "None (you believe in the basic goodness of humanity)"
:value none)
@@ -204,10 +203,9 @@ from the ACCESS_proxy environment variables."
:type 'boolean
:group 'url-cache)
-(defvar url-mime-separator-chars (mapcar 'identity
- (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "abcdefghijklmnopqrstuvwxyz"
- "0123456789'()+_,-./=?"))
+(defvar url-mime-separator-chars (append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "abcdefghijklmnopqrstuvwxyz"
+ "0123456789'()+_,-./=?")
"Characters allowable in a MIME multipart separator.")
(defcustom url-bad-port-list
@@ -254,7 +252,7 @@ Generated according to current coding system priorities."
(push (car elt) accum)))
(nreverse accum)))))
(concat (format "%s;q=1, " (pop ordered))
- (mapconcat 'symbol-name ordered ";q=0.5, ")
+ (mapconcat #'symbol-name ordered ";q=0.5, ")
";q=0.5")))
(defvar url-mime-charset-string nil
@@ -299,7 +297,7 @@ get the first available language (as opposed to the default)."
(defcustom url-max-password-attempts 5
"Maximum number of times a password will be prompted for.
Applies when a protected document is denied by the server."
- :type 'integer
+ :type 'natnum
:group 'url)
(defcustom url-show-status t
@@ -332,7 +330,7 @@ undefined."
(defcustom url-max-redirections 30
"The maximum number of redirection requests to honor in a HTTP connection.
A negative number means to honor an unlimited number of redirection requests."
- :type 'integer
+ :type 'natnum
:group 'url)
(defcustom url-confirmation-func 'y-or-n-p
@@ -398,7 +396,7 @@ Should be one of:
(defvar url-lazy-message-time 0)
;; Fixme: We may not be able to run SSL.
-(defvar url-extensions-header "Security/Digest Security/SSL")
+(defvar url-extensions-header nil)
(defvar url-parse-syntax-table
(copy-syntax-table emacs-lisp-mode-syntax-table)
@@ -424,11 +422,15 @@ Should be one of:
This should be set, e.g. by mail user agents rendering HTML to avoid
`bugs' which call home.")
+(defun url-interactive-p ()
+ "Non-nil when the current request is from an interactive context."
+ (not (or url-request-noninteractive
+ (bound-and-true-p url-http-noninteractive))))
+
;; Obsolete
(defconst url-version "Emacs" "Version number of URL package.")
(make-obsolete-variable 'url-version 'emacs-version "28.1")
(provide 'url-vars)
-
;;; url-vars.el ends here
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 4592f0f2e72..d08ff04eda9 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -158,7 +158,7 @@ If URL is a multibyte string, it will be encoded as utf-8 and
URL-encoded before it's used."
;; XXX: There is code in Emacs that does dynamic binding
;; of the following variables around url-retrieve:
- ;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
+ ;; url-standalone-mode, url-gateway-unplugged,
;; url-confirmation-func, url-cookie-multiple-line,
;; url-cookie-{{,secure-}storage,confirmation}
;; url-standalone-mode and url-gateway-unplugged should work as
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 818353f366f..a8e699385c7 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -39,10 +39,6 @@
(define-error 'file-locked "File is locked" 'file-error)
-(defun userlock--fontify-key (key)
- "Add the `help-key-binding' face to string KEY."
- (propertize key 'face 'help-key-binding))
-
;;;###autoload
(defun ask-user-about-lock (file opponent)
"Ask user what to do when he wants to edit FILE but it is locked by OPPONENT.
@@ -68,12 +64,9 @@ in any way you like."
(match-string 0 opponent)))
opponent))
(while (null answer)
- (message "%s locked by %s: (%s, %s, %s, %s)? "
- short-file short-opponent
- (userlock--fontify-key "s")
- (userlock--fontify-key "q")
- (userlock--fontify-key "p")
- (userlock--fontify-key "?"))
+ (message (substitute-command-keys
+ "%s locked by %s: (\\`s', \\`q', \\`p', \\`?')? ")
+ short-file short-opponent)
(if noninteractive (error "Cannot resolve lock conflict in batch mode"))
(let ((tem (let ((inhibit-quit t)
(cursor-in-echo-area t))
@@ -88,12 +81,9 @@ in any way you like."
(?? . help))))
(cond ((null answer)
(beep)
- (message "Please type %s, %s, or %s; or %s for help"
- (userlock--fontify-key "q")
- (userlock--fontify-key "s")
- (userlock--fontify-key "p")
- ;; FIXME: Why do we use "?" here and "C-h" below?
- (userlock--fontify-key "?"))
+ ;; FIXME: Why do we use "?" here and "C-h" below?
+ (message (substitute-command-keys
+ "Please type \\`q', \\`s', or \\`p'; or \\`?' for help"))
(sit-for 3))
((eq (cdr answer) 'help)
(ask-user-about-lock-help)
@@ -106,17 +96,14 @@ in any way you like."
(with-output-to-temp-buffer "*Help*"
(with-current-buffer standard-output
(insert
- (format
+ (substitute-command-keys
"It has been detected that you want to modify a file that someone else has
already started modifying in Emacs.
-You can <%s>teal the file; the other user becomes the
+You can <\\`s'>teal the file; the other user becomes the
intruder if (s)he ever unmodifies the file and then changes it again.
-You can <%s>roceed; you edit at your own (and the other user's) risk.
-You can <%s>uit; don't modify this file."
- (userlock--fontify-key "s")
- (userlock--fontify-key "p")
- (userlock--fontify-key "q")))
+You can <\\`p'>roceed; you edit at your own (and the other user's) risk.
+You can <\\`q'>uit; don't modify this file."))
(help-mode))))
(define-error 'file-supersession nil 'file-error)
@@ -169,14 +156,11 @@ The buffer in question is current when this function is called."
(discard-input)
(save-window-excursion
(let ((prompt
- (format "%s changed on disk; \
-really edit the buffer? (%s, %s, %s or %s) "
- (file-name-nondirectory filename)
- (userlock--fontify-key "y")
- (userlock--fontify-key "n")
- (userlock--fontify-key "r")
- ;; FIXME: Why do we use "C-h" here and "?" above?
- (userlock--fontify-key "C-h")))
+ ;; FIXME: Why do we use "C-h" here and "?" above?
+ (format (substitute-command-keys
+ "%s changed on disk; \
+really edit the buffer? (\\`y', \\`n', \\`r' or \\`C-h') ")
+ (file-name-nondirectory filename)))
(choices '(?y ?n ?r ?? ?\C-h))
answer)
(when noninteractive
@@ -205,22 +189,18 @@ really edit the buffer? (%s, %s, %s or %s) "
(with-output-to-temp-buffer "*Help*"
(with-current-buffer standard-output
(insert
- (format
+ (substitute-command-keys
"You want to modify a buffer whose disk file has changed
since you last read it in or saved it with this buffer.
-If you say %s to go ahead and modify this buffer,
+If you say \\`y' to go ahead and modify this buffer,
you risk ruining the work of whoever rewrote the file.
-If you say %s to revert, the contents of the buffer are refreshed
+If you say \\`r' to revert, the contents of the buffer are refreshed
from the file on disk.
-If you say %s, the change you started to make will be aborted.
-
-Usually, you should type %s to get the latest version of the
-file, then make the change again."
- (userlock--fontify-key "y")
- (userlock--fontify-key "r")
- (userlock--fontify-key "n")
- (userlock--fontify-key "r")))
+If you say \\`n', the change you started to make will be aborted.
+
+Usually, you should type \\`r' to get the latest version of the
+file, then make the change again."))
(help-mode))))
;;;###autoload
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 8b55a78f84d..e02d84f1f56 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -590,9 +590,8 @@ Compatibility function for \\[next-error] invocations."
["Go To Source" change-log-goto-source
:help "Go to source location of ChangeLog tag near point"]))
-;; It used to be called change-log-time-zone-rule but really should be
-;; called add-log-time-zone-rule since it's only used from add-log-* code.
-(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule)
+(define-obsolete-variable-alias 'change-log-time-zone-rule
+ 'add-log-time-zone-rule "29.1")
(defvar add-log-time-zone-rule nil
"Time zone rule used for calculating change log time stamps.
If nil, use local time. If t, use Universal Time.
@@ -790,10 +789,9 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
If a ChangeLog file does not already exist, a non-nil value
means to put log entries in a suitably named buffer."
:type 'boolean
+ :safe #'booleanp
:version "27.1")
-(put 'add-log-dont-create-changelog-file 'safe-local-variable #'booleanp)
-
(defun add-log--pseudo-changelog-buffer-name (changelog-file-name)
"Compute a suitable name for a non-file visiting ChangeLog buffer.
CHANGELOG-FILE-NAME is the file name of the actual ChangeLog file
@@ -1069,8 +1067,23 @@ the change log file in another window."
(insert-before-markers "("))
(error nil)))))
+;; If we're filling a line that has a whole bunch of file names, and
+;; we're still in the file names, then transform this so that it'll
+;; still font-lock properly.
+(defun change-log-fill-file-list ()
+ (save-excursion
+ (unless (bobp)
+ (forward-line -1)
+ (when (looking-at change-log-file-names-re)
+ (goto-char (match-end 0))
+ (while (looking-at "\\=, \\([^ ,:([\n]+\\)")
+ (goto-char (match-end 0)))
+ (when (looking-at ", *\n")
+ (replace-match ":\n *" t t))))))
+
(defun change-log-indent ()
(change-log-fill-parenthesized-list)
+ (change-log-fill-file-list)
(let* ((indent
(save-excursion
(beginning-of-line)
diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el
index b56b4c0d83a..64d5d1081a3 100644
--- a/lisp/vc/compare-w.el
+++ b/lisp/vc/compare-w.el
@@ -1,7 +1,6 @@
;;; compare-w.el --- compare text between windows for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1986-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience files vc
@@ -99,7 +98,7 @@ may fail by finding the wrong match. The bigger number makes
difference regions more coarse-grained.
The default value 32 is good for the most cases."
- :type 'integer
+ :type 'natnum
:version "22.1")
(defcustom compare-windows-recenter nil
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index c368da88754..7f921a73398 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -29,23 +29,21 @@
;;; Code:
(require 'cl-lib)
-(require 'pcvs-util)
+(require 'pcvs)
;;;
-(easy-mmode-defmap cvs-status-mode-map
- '(("n" . next-line)
- ("p" . previous-line)
- ("N" . cvs-status-next)
- ("P" . cvs-status-prev)
- ("\M-n" . cvs-status-next)
- ("\M-p" . cvs-status-prev)
- ("t" . cvs-status-cvstrees)
- ("T" . cvs-status-trees)
- (">" . cvs-mode-checkout))
- "CVS-Status' keymap."
- :group 'cvs-status
- :inherit 'cvs-mode-map)
+(defvar-keymap cvs-status-mode-map
+ :parent cvs-mode-map
+ "n" #'next-line
+ "p" #'previous-line
+ "N" #'cvs-status-next
+ "P" #'cvs-status-prev
+ "M-n" #'cvs-status-next
+ "M-p" #'cvs-status-prev
+ "t" #'cvs-status-cvstrees
+ "T" #'cvs-status-trees
+ ">" #'cvs-mode-checkout)
;;(easy-menu-define cvs-status-menu cvs-status-mode-map
;; "Menu for `cvs-status-mode'."
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index f366261ae05..30ba4153a9e 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -55,6 +55,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'subr-x))
+(require 'easy-mmode)
(autoload 'vc-find-revision "vc")
(autoload 'vc-find-revision-no-save "vc")
@@ -162,57 +163,55 @@ and hunk-based syntax highlighting otherwise as a fallback."
;;;; keymap, menu, ...
;;;;
-(easy-mmode-defmap diff-mode-shared-map
- '(("n" . diff-hunk-next)
- ("N" . diff-file-next)
- ("p" . diff-hunk-prev)
- ("P" . diff-file-prev)
- ("\t" . diff-hunk-next)
- ([backtab] . diff-hunk-prev)
- ("k" . diff-hunk-kill)
- ("K" . diff-file-kill)
- ("}" . diff-file-next) ; From compilation-minor-mode.
- ("{" . diff-file-prev)
- ("\C-m" . diff-goto-source)
- ([mouse-2] . diff-goto-source)
- ("W" . widen)
- ("o" . diff-goto-source) ; other-window
- ("A" . diff-ediff-patch)
- ("r" . diff-restrict-view)
- ("R" . diff-reverse-direction)
- ([remap undo] . diff-undo))
- "Basic keymap for `diff-mode', bound to various prefix keys."
- :inherit special-mode-map)
-
-(easy-mmode-defmap diff-mode-map
- `(("\e" . ,(let ((map (make-sparse-keymap)))
- ;; We want to inherit most bindings from diff-mode-shared-map,
- ;; but not all since they may hide useful M-<foo> global
- ;; bindings when editing.
- (set-keymap-parent map diff-mode-shared-map)
- (dolist (key '("A" "r" "R" "g" "q" "W" "z"))
- (define-key map key nil))
- map))
- ;; From compilation-minor-mode.
- ("\C-c\C-c" . diff-goto-source)
- ;; By analogy with the global C-x 4 a binding.
- ("\C-x4A" . diff-add-change-log-entries-other-window)
- ;; Misc operations.
- ("\C-c\C-a" . diff-apply-hunk)
- ("\C-c\C-e" . diff-ediff-patch)
- ("\C-c\C-n" . diff-restrict-view)
- ("\C-c\C-s" . diff-split-hunk)
- ("\C-c\C-t" . diff-test-hunk)
- ("\C-c\C-r" . diff-reverse-direction)
- ("\C-c\C-u" . diff-context->unified)
- ;; `d' because it duplicates the context :-( --Stef
- ("\C-c\C-d" . diff-unified->context)
- ("\C-c\C-w" . diff-ignore-whitespace-hunk)
- ;; `l' because it "refreshes" the hunk like C-l refreshes the screen
- ("\C-c\C-l" . diff-refresh-hunk)
- ("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-(
- ("\C-c\C-f" . next-error-follow-minor-mode))
- "Keymap for `diff-mode'. See also `diff-mode-shared-map'.")
+(defvar-keymap diff-mode-shared-map
+ :parent special-mode-map
+ "n" #'diff-hunk-next
+ "N" #'diff-file-next
+ "p" #'diff-hunk-prev
+ "P" #'diff-file-prev
+ "TAB" #'diff-hunk-next
+ "<backtab>" #'diff-hunk-prev
+ "k" #'diff-hunk-kill
+ "K" #'diff-file-kill
+ "}" #'diff-file-next ; From compilation-minor-mode.
+ "{" #'diff-file-prev
+ "RET" #'diff-goto-source
+ "<mouse-2>" #'diff-goto-source
+ "W" #'widen
+ "o" #'diff-goto-source ; other-window
+ "A" #'diff-ediff-patch
+ "r" #'diff-restrict-view
+ "R" #'diff-reverse-direction
+ "<remap> <undo>" #'diff-undo)
+
+(defvar-keymap diff-mode-map
+ :doc "Keymap for `diff-mode'. See also `diff-mode-shared-map'."
+ "ESC" (let ((map (define-keymap :parent diff-mode-shared-map)))
+ ;; We want to inherit most bindings from
+ ;; `diff-mode-shared-map', but not all since they may hide
+ ;; useful `M-<foo>' global bindings when editing.
+ (dolist (key '("A" "r" "R" "g" "q" "W" "z"))
+ (keymap-set map key nil))
+ map)
+ ;; From compilation-minor-mode.
+ "C-c C-c" #'diff-goto-source
+ ;; By analogy with the global C-x 4 a binding.
+ "C-x 4 A" #'diff-add-change-log-entries-other-window
+ ;; Misc operations.
+ "C-c C-a" #'diff-apply-hunk
+ "C-c C-e" #'diff-ediff-patch
+ "C-c C-n" #'diff-restrict-view
+ "C-c C-s" #'diff-split-hunk
+ "C-c C-t" #'diff-test-hunk
+ "C-c C-r" #'diff-reverse-direction
+ "C-c C-u" #'diff-context->unified
+ ;; `d' because it duplicates the context :-( --Stef
+ "C-c C-d" #'diff-unified->context
+ "C-c C-w" #'diff-ignore-whitespace-hunk
+ ;; `l' because it "refreshes" the hunk like C-l refreshes the screen
+ "C-c C-l" #'diff-refresh-hunk
+ "C-c C-b" #'diff-refine-hunk ;No reason for `b' :-(
+ "C-c C-f" #'next-error-follow-minor-mode)
(easy-menu-define diff-mode-menu diff-mode-map
"Menu for `diff-mode'."
@@ -267,11 +266,12 @@ and hunk-based syntax highlighting otherwise as a fallback."
(defcustom diff-minor-mode-prefix "\C-c="
"Prefix key for `diff-minor-mode' commands."
- :type '(choice (string "\e") (string "C-c=") string))
+ :type '(choice (string "ESC")
+ (string "\C-c=") string))
-(easy-mmode-defmap diff-minor-mode-map
- `((,diff-minor-mode-prefix . ,diff-mode-shared-map))
- "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'.")
+(defvar-keymap diff-minor-mode-map
+ :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'."
+ (key-description diff-minor-mode-prefix) diff-mode-shared-map)
(define-minor-mode diff-auto-refine-mode
"Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode).
@@ -894,6 +894,9 @@ data such as \"Index: ...\" and such."
;; Fix the original hunk-header.
(diff-fixup-modifs start pos))))
+(defun diff--outline-level ()
+ (if (string-match-p diff-hunk-header-re (match-string 0))
+ 2 1))
;;;;
;;;; jump to other buffers
@@ -1476,6 +1479,14 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
(defvar whitespace-style)
(defvar whitespace-trailing-regexp)
+(defvar-local diff-mode-read-only nil
+ "Non-nil when read-only diff buffer uses short keys.")
+
+;; It should be lower than `outline-minor-mode' and `view-mode'.
+(or (assq 'diff-mode-read-only minor-mode-map-alist)
+ (nconc minor-mode-map-alist
+ (list (cons 'diff-mode-read-only diff-mode-shared-map))))
+
;;;###autoload
(define-derived-mode diff-mode fundamental-mode "Diff"
"Major mode for viewing/editing context diffs.
@@ -1494,7 +1505,6 @@ a diff with \\[diff-reverse-direction].
(setq-local font-lock-defaults diff-font-lock-defaults)
(add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local)
- (setq-local outline-regexp diff-outline-regexp)
(setq-local imenu-generic-expression
diff-imenu-generic-expression)
;; These are not perfect. They would be better done separately for
@@ -1514,23 +1524,23 @@ a diff with \\[diff-reverse-direction].
(diff-setup-whitespace)
- (if diff-default-read-only
- (setq buffer-read-only t))
+ ;; read-only setup
+ (when diff-default-read-only
+ (setq buffer-read-only t))
+ (when buffer-read-only
+ (setq diff-mode-read-only t))
+ (add-hook 'read-only-mode-hook
+ (lambda ()
+ (setq diff-mode-read-only buffer-read-only))
+ nil t)
+
;; setup change hooks
(if (not diff-update-on-the-fly)
(add-hook 'write-contents-functions #'diff-write-contents-hooks nil t)
(make-local-variable 'diff-unhandled-changes)
(add-hook 'after-change-functions #'diff-after-change-function nil t)
(add-hook 'post-command-hook #'diff-post-command-hook nil t))
- ;; Neat trick from Dave Love to add more bindings in read-only mode:
- (let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map)))
- (add-to-list 'minor-mode-overriding-map-alist ro-bind)
- ;; Turn off this little trick in case the buffer is put in view-mode.
- (add-hook 'view-mode-hook
- (lambda ()
- (setq minor-mode-overriding-map-alist
- (delq ro-bind minor-mode-overriding-map-alist)))
- nil t))
+
;; add-log support
(setq-local add-log-current-defun-function #'diff-current-defun)
(setq-local add-log-buffer-file-name-function
@@ -1539,11 +1549,7 @@ a diff with \\[diff-reverse-direction].
#'diff--filter-substring)
(unless buffer-file-name
(hack-dir-local-variables-non-file-buffer))
- (save-excursion
- (setq-local diff-buffer-type
- (if (re-search-forward "^diff --git" nil t)
- 'git
- nil))))
+ (diff-setup-buffer-type))
;;;###autoload
(define-minor-mode diff-minor-mode
@@ -1579,6 +1585,21 @@ modified lines of the diff."
"^[-+!] .*?\\([\t ]+\\)$"
"^[-+!<>].*?\\([\t ]+\\)$"))))
+(defun diff-setup-buffer-type ()
+ "Try to guess the `diff-buffer-type' from content of current Diff mode buffer.
+`outline-regexp' is updated accordingly."
+ (save-excursion
+ (goto-char (point-min))
+ (setq-local diff-buffer-type
+ (if (re-search-forward "^diff --git" nil t)
+ 'git
+ nil)))
+ (when (eq diff-buffer-type 'git)
+ (setq diff-outline-regexp
+ (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)")))
+ (setq-local outline-level #'diff--outline-level)
+ (setq-local outline-regexp diff-outline-regexp))
+
(defun diff-delete-if-empty ()
;; An empty diff file means there's no more diffs to integrate, so we
;; can just remove the file altogether. Very handy for .rej files if we
@@ -2251,21 +2272,24 @@ Return new point, if it was moved."
"Iterate over all hunks between point and MAX.
Call FUN with two args (BEG and END) for each hunk."
(save-excursion
- (let* ((beg (or (ignore-errors (diff-beginning-of-hunk))
- (ignore-errors (diff-hunk-next) (point))
- max)))
- (while (< beg max)
- (goto-char beg)
- (cl-assert (looking-at diff-hunk-header-re))
- (let ((end
- (save-excursion (diff-end-of-hunk) (point))))
- (cl-assert (< beg end))
- (funcall fun beg end)
- (goto-char end)
- (setq beg (if (looking-at diff-hunk-header-re)
- end
- (or (ignore-errors (diff-hunk-next) (point))
- max))))))))
+ (catch 'malformed
+ (let* ((beg (or (ignore-errors (diff-beginning-of-hunk))
+ (ignore-errors (diff-hunk-next) (point))
+ max)))
+ (while (< beg max)
+ (goto-char beg)
+ (unless (looking-at diff-hunk-header-re)
+ (throw 'malformed nil))
+ (let ((end
+ (save-excursion (diff-end-of-hunk) (point))))
+ (unless (< beg end)
+ (throw 'malformed nil))
+ (funcall fun beg end)
+ (goto-char end)
+ (setq beg (if (looking-at diff-hunk-header-re)
+ end
+ (or (ignore-errors (diff-hunk-next) (point))
+ max)))))))))
(defun diff--font-lock-refined (max)
"Apply hunk refinement from font-lock."
@@ -2576,40 +2600,103 @@ fixed, visit it in a buffer."
(defun diff--font-lock-prettify (limit)
(when diff-font-lock-prettify
- (save-excursion
- ;; FIXME: Include the first space for context-style hunks!
- (while (re-search-forward "^[-+! ]" limit t)
- (let ((spec (alist-get (char-before)
- '((?+ . (left-fringe diff-fringe-add diff-indicator-added))
- (?- . (left-fringe diff-fringe-del diff-indicator-removed))
- (?! . (left-fringe diff-fringe-rep diff-indicator-changed))
- (?\s . (left-fringe diff-fringe-nul fringe))))))
- (put-text-property (match-beginning 0) (match-end 0) 'display spec))))
+ (when (> (frame-parameter nil 'left-fringe) 0)
+ (save-excursion
+ ;; FIXME: Include the first space for context-style hunks!
+ (while (re-search-forward "^[-+! ]" limit t)
+ (unless (eq (get-text-property (match-beginning 0) 'face)
+ 'diff-header)
+ (put-text-property
+ (match-beginning 0) (match-end 0)
+ 'display
+ (alist-get
+ (char-before)
+ '((?+ . (left-fringe diff-fringe-add diff-indicator-added))
+ (?- . (left-fringe diff-fringe-del diff-indicator-removed))
+ (?! . (left-fringe diff-fringe-rep diff-indicator-changed))
+ (?\s . (left-fringe diff-fringe-nul fringe)))))))))
;; Mimicks the output of Magit's diff.
;; FIXME: This has only been tested with Git's diff output.
+ ;; FIXME: Add support for Git's "rename from/to"?
(while (re-search-forward "^diff " limit t)
- ;; FIXME: Switching between context<->unified leads to messed up
- ;; file headers by cutting the `display' property in chunks!
+ ;; We split the regexp match into a search plus a looking-at because
+ ;; we want to use LIMIT for the search but we still want to match
+ ;; all the header's lines even if LIMIT falls in the middle of it.
(when (save-excursion
(forward-line 0)
(looking-at
(eval-when-compile
- (concat "diff.*\n"
- "\\(?:\\(?:new file\\|deleted\\).*\n\\)?"
- "\\(?:index.*\n\\)?"
- "--- \\(?:" null-device "\\|a/\\(.*\\)\\)\n"
- "\\+\\+\\+ \\(?:" null-device "\\|b/\\(.*\\)\\)\n"))))
- (put-text-property (match-beginning 0)
- (or (match-beginning 2) (match-beginning 1))
- 'display (propertize
- (cond
- ((null (match-beginning 1)) "new file ")
- ((null (match-beginning 2)) "deleted ")
- (t "modified "))
- 'face '(diff-file-header diff-header)))
- (unless (match-beginning 2)
- (put-text-property (match-end 1) (1- (match-end 0))
- 'display "")))))
+ (let* ((index "\\(?:index.*\n\\)?")
+ (file4 (concat
+ "\\(?:" null-device "\\|[ab]/\\(?4:.*\\)\\)"))
+ (file5 (concat
+ "\\(?:" null-device "\\|[ab]/\\(?5:.*\\)\\)"))
+ (header (concat "--- " file4 "\n"
+ "\\+\\+\\+ " file5 "\n"))
+ (binary (concat
+ "Binary files " file4
+ " and " file5 " \\(?7:differ\\)\n"))
+ (horb (concat "\\(?:" header "\\|" binary "\\)?")))
+ (concat "diff.*?\\(?: a/\\(.*?\\) b/\\(.*\\)\\)?\n"
+ "\\(?:"
+ ;; For new/deleted files, there might be no
+ ;; header (and no hunk) if the file is/was empty.
+ "\\(?3:new\\(?6:\\)\\|deleted\\) file mode \\(?10:[0-7]\\{6\\}\\)\n"
+ index horb
+ ;; Normal case. There might be no header
+ ;; (and no hunk) if only the file mode
+ ;; changed.
+ "\\|"
+ "\\(?:old mode \\(?8:[0-7]\\{6\\}\\)\n\\)?"
+ "\\(?:new mode \\(?9:[0-7]\\{6\\}\\)\n\\)?"
+ index horb "\\)")))))
+ ;; The file names can be extracted either from the `diff' line
+ ;; or from the two header lines. Prefer the header line info if
+ ;; available since the `diff' line is ambiguous in case the
+ ;; file names include " b/" or " a/".
+ ;; FIXME: This prettification throws away all the information
+ ;; about the index hashes.
+ (let ((oldfile (or (match-string 4) (match-string 1)))
+ (newfile (or (match-string 5) (match-string 2)))
+ (kind (if (match-beginning 7) " BINARY"
+ (unless (or (match-beginning 4)
+ (match-beginning 5)
+ (not (match-beginning 3)))
+ " empty")))
+ (filemode
+ (cond
+ ((match-beginning 10)
+ (concat " file with mode " (match-string 10) " "))
+ ((and (match-beginning 8) (match-beginning 9))
+ (concat " file (mode changed from "
+ (match-string 8) " to " (match-string 9) ") "))
+ (t " file "))))
+ (add-text-properties
+ (match-beginning 0) (1- (match-end 0))
+ (list 'display
+ (propertize
+ (cond
+ ((match-beginning 3)
+ (concat (capitalize (match-string 3)) kind filemode
+ (if (match-beginning 6) newfile oldfile)))
+ ((and (null (match-string 4)) (match-string 5))
+ (concat "New " kind filemode newfile))
+ ((null (match-string 2))
+ ;; We used to use
+ ;; (concat "Deleted" kind filemode oldfile)
+ ;; here but that misfires for `diff-buffers'
+ ;; (see 24 Jun 2022 message in bug#54034).
+ ;; AFAIK if (match-string 2) is nil then so is
+ ;; (match-string 1), so "Deleted" doesn't sound right,
+ ;; so better just let the header in plain sight for now.
+ ;; FIXME: `diff-buffers' should maybe try to better
+ ;; mimic Git's format with "a/" and "b/" so prettification
+ ;; can "just work!"
+ nil)
+ (t
+ (concat "Modified" kind filemode oldfile)))
+ 'face '(diff-file-header diff-header))
+ 'font-lock-multiline t))))))
nil)
;;; Syntax highlighting from font-lock
@@ -2654,7 +2741,8 @@ When OLD is non-nil, highlight the hunk from the old source."
;; Trim a trailing newline to find hunk in diff-syntax-fontify-props
;; in diffs that have no newline at end of diff file.
(text (string-trim-right
- (or (with-demoted-errors (diff-hunk-text hunk (not old) nil))
+ (or (with-demoted-errors "Error getting hunk text: %S"
+ (diff-hunk-text hunk (not old) nil))
"")))
(line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?")
(if old (match-string 1)
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 341a2891265..3e35a3329b1 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -52,6 +52,12 @@ set (`vc-git-diff-switches' for git, for instance), and
"The command to use to run diff."
:type 'string)
+(defcustom diff-entire-buffers t
+ "If non-nil, diff the entire buffers, not just the visible part.
+If nil, only use the narrowed-to parts of the buffers."
+ :type 'boolean
+ :version "29.1")
+
;; prompt if prefix arg present
(defun diff-switches ()
(if current-prefix-arg
@@ -96,15 +102,15 @@ Non-interactively, OLD and NEW may each be a file or a buffer."
(interactive
(let* ((newf (if (and buffer-file-name (file-exists-p buffer-file-name))
(read-file-name
- (concat "Diff new file (default "
- (file-name-nondirectory buffer-file-name) "): ")
+ (format-prompt "Diff new file"
+ (file-name-nondirectory buffer-file-name))
nil buffer-file-name t)
(read-file-name "Diff new file: " nil nil t)))
(oldf (file-newest-backup newf)))
(setq oldf (if (and oldf (file-exists-p oldf))
(read-file-name
- (concat "Diff original file (default "
- (file-name-nondirectory oldf) "): ")
+ (format-prompt "Diff original file"
+ (file-name-nondirectory oldf))
(file-name-directory oldf) oldf t)
(read-file-name "Diff original file: "
(file-name-directory newf) nil t)))
@@ -119,7 +125,9 @@ temporary file with the buffer's contents."
(if (bufferp file-or-buf)
(with-current-buffer file-or-buf
(let ((tempfile (make-temp-file "buffer-content-")))
- (write-region nil nil tempfile nil 'nomessage)
+ (if diff-entire-buffers
+ (write-region nil nil tempfile nil 'nomessage)
+ (write-region (point-min) (point-max) tempfile nil 'nomessage))
tempfile))
(file-local-copy file-or-buf)))
@@ -145,7 +153,7 @@ Possible values are:
;; Noninteractive helper for creating and reverting diff buffers
"Compare the OLD and NEW file/buffer.
If the optional SWITCHES is nil, the switches specified in the
-variable ‘diff-switches’ are passed to the diff command,
+variable `diff-switches' are passed to the diff command,
otherwise SWITCHES is used. SWITCHES can be a string or a list
of strings.
@@ -274,7 +282,9 @@ interactively for diff switches. Otherwise, the switches
specified in the variable `diff-switches' are passed to the
diff command.
-OLD and NEW may each be a buffer or a buffer name."
+OLD and NEW may each be a buffer or a buffer name.
+
+Also see the `diff-entire-buffers' variable."
(interactive
(let ((newb (read-buffer "Diff new buffer" (current-buffer) t))
(oldb (read-buffer "Diff original buffer"
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index ca56a2851db..07b853817d1 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -85,7 +85,10 @@ options after the default ones.
This variable is not for customizing the look of the differences produced by
the command \\[ediff-show-diff-output]. Use the variable
-`ediff-custom-diff-options' for that."
+`ediff-custom-diff-options' for that.
+
+Setting this variable directly may not yield the expected
+results. It should be set via the Customize interface instead."
:set #'ediff-set-diff-options
:type 'string)
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index 1a970f344e5..4e412041691 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -227,7 +227,9 @@ the value of this variable and the variables `ediff-help-message-*' in
((string= cmd "s") (re-search-forward "^['`‘]s['’]"))
((string= cmd "+") (re-search-forward "^['`‘]\\+['’]"))
((string= cmd "=") (re-search-forward "^['`‘]=['’]"))
- (t (user-error "Undocumented command! Type `G' in Ediff Control Panel to drop a note to the Ediff maintainer")))
+ (t (user-error (substitute-command-keys
+ "Undocumented command! Type \\`G' in Ediff Control \
+Panel to drop a note to the Ediff maintainer"))))
) ; let case-fold-search
))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 896773067b7..273bad5d353 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -615,8 +615,8 @@ Actually, Ediff restores the scope of visibility that existed at startup.")
(defcustom ediff-keep-variants t
"Nil means prompt to remove unmodified buffers A/B/C at session end.
-Supplying a prefix argument to the quit command `q' temporarily reverses the
-meaning of this variable."
+Supplying a prefix argument to the quit command \\`q' temporarily
+reverses the meaning of this variable."
:type 'boolean
:group 'ediff)
@@ -955,9 +955,9 @@ this variable represents.")
(((class color))
(:foreground "red3" :background "green"))
(t (:underline t :stipple "gray3")))
- "Face for highlighting the refinement of the selected diff in the ancestor buffer.
-At present, this face is not used and no fine differences are computed for the
-ancestor buffer."
+ "Face for highlighting refinement of the selected diff in the ancestor buffer.
+At present, this face is not used and no fine differences are
+computed for the ancestor buffer."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
@@ -1055,7 +1055,7 @@ this variable represents.")
(:foreground "cyan3" :background "light grey"
:weight bold :extend t))
(t (:italic t :stipple ,stipple-pixmap :extend t)))
- "Face for highlighting even-numbered non-current differences in the ancestor buffer."
+ "Face for highlighting even-numbered non-current differences in ancestor buffer."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
@@ -1146,7 +1146,7 @@ this variable represents.")
(((class color))
(:foreground "green3" :background "black" :weight bold :extend t))
(t (:italic t :stipple "gray1" :extend t)))
- "Face for highlighting odd-numbered non-current differences in the ancestor buffer."
+ "Face for highlighting odd-numbered non-current differences in ancestor buffer."
:group 'ediff-highlighting)
;; An internal variable. Ediff takes the face from here. When unhighlighting,
;; this variable is set to nil, then again to the appropriate face.
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index de8c587b1ca..aae6ad549ea 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -54,7 +54,7 @@ Valid values are the symbols `default-A', `default-B', and `combined'."
The value must be a list of the form
\(STRING1 bufspec1 STRING2 bufspec2 STRING3 bufspec3 STRING4)
where bufspec is the symbol A, B, or Ancestor. For instance, if the value is
-'(STRING1 A STRING2 Ancestor STRING3 B STRING4) then the
+`(STRING1 A STRING2 Ancestor STRING3 B STRING4)' then the
combined text will look like this:
STRING1
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index 48716901116..b7c349fc1cd 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -128,7 +128,7 @@
(defconst ediff-meta-buffer-verbose-message "Ediff Session Group Panel: %s
Useful commands (type ? to hide them and free up screen):
- button2, v, or RET over session record: start that Ediff session
+ mouse-2, v, or RET over session record: start that Ediff session
M:\tin sessions invoked from here, brings back this group panel
R:\tdisplay the registry of active Ediff sessions
h:\tmark session for hiding (toggle)
@@ -1236,7 +1236,7 @@ behavior."
(insert "\t\t*** Directory Differences ***\n")
(insert "
Useful commands:
- C,button2: over file name -- copy this file to directory that doesn't have it
+ C,mouse-2: over file name -- copy this file to directory that doesn't have it
q: hide this buffer
n,SPC: next line
p,DEL: previous line\n\n")
@@ -1429,7 +1429,7 @@ Useful commands:
This is a registry of all active Ediff sessions.
Useful commands:
- button2, `v', RET over a session record: switch to that session
+ mouse-2, `v', RET over a session record: switch to that session
M over a session record: display the associated session group
R in any Ediff session: display session registry
n,SPC: next session
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 8a6785e2c58..17654f80ec7 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -415,7 +415,9 @@ other files, enter `/dev/null'.
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
- (princ (format-message "
+ (with-current-buffer standard-output
+ (insert (format-message
+ (substitute-command-keys "
Ediff has inferred that
%s
%s
@@ -423,10 +425,10 @@ are two possible targets for applying the patch.
Both files seem to be plausible alternatives.
Please advise:
- Type `y' to use %s as the target;
- Type `n' to use %s as the target.
-"
- file1 file2 file1 file2)))
+ Type \\`y' to use %s as the target;
+ Type \\`n' to use %s as the target.
+")
+ file1 file2 file1 file2))))
(setcar session-file-object
(if (y-or-n-p (format "Use %s ? " file1))
(progn
@@ -503,15 +505,11 @@ are two possible targets for this %spatch. However, these files do not exist."
patch-file-name)
(setq patch-file-name
(read-file-name
- (format "Patch is in file%s: "
- (cond ((and buffer-file-name
- (equal (expand-file-name dir)
- (file-name-directory buffer-file-name)))
- (concat
- " (default "
- (file-name-nondirectory buffer-file-name)
- ")"))
- (t "")))
+ (format-prompt "Patch is in file"
+ (and buffer-file-name
+ (equal (expand-file-name dir)
+ (file-name-directory buffer-file-name))
+ (file-name-nondirectory buffer-file-name)))
dir buffer-file-name 'must-match))
(if (file-directory-p patch-file-name)
(error "Patch file cannot be a directory: %s" patch-file-name)
@@ -827,7 +825,8 @@ you can still examine the changes via M-x ediff-files"
ediff-patch-diagnostics patch-diagnostics))
(bury-buffer patch-diagnostics)
- (message "Type `P', if you need to see patch diagnostics")
+ (message (substitute-command-keys
+ "Type \\`P', if you need to see patch diagnostics"))
ctl-buf))
(defun ediff-multi-patch-internal (patch-buf &optional startup-hooks)
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index c757f71818b..040a9a63c5a 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -3121,11 +3121,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(lambda () (when defaults
(setq minibuffer-default defaults)))
(read-file-name
- (format "%s%s "
- prompt
- (cond (default-file
- (concat " (default " default-file "):"))
- (t (concat " (default " default-dir "):"))))
+ (format-prompt prompt (or default-file default-dir))
default-dir
(or default-file default-dir)
t ; must match, no-confirm
@@ -3435,6 +3431,9 @@ Without an argument, it saves customized diff argument, if available
))
(defun ediff-show-diff-output (arg)
+ "With prefix argument ARG, show plain diff output.
+Without an argument, save the customized diff argument, if available
+(and plain output, if customized output was not generated)."
(interactive "P")
(ediff-barf-if-not-control-buffer)
(ediff-compute-custom-diffs-maybe)
@@ -3442,7 +3441,10 @@ Without an argument, it saves customized diff argument, if available
(ediff-skip-unsuitable-frames ' ok-unsplittable))
(let ((buf (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer))
ediff-diff-buffer)
- ((ediff-buffer-live-p ediff-custom-diff-buffer)
+ ((and (ediff-buffer-live-p ediff-custom-diff-buffer)
+ ;; We may not have gotten a custom output if
+ ;; we're working on unsaved buffers.
+ (> (buffer-size ediff-custom-diff-buffer) 0))
ediff-custom-diff-buffer)
((ediff-buffer-live-p ediff-diff-buffer)
ediff-diff-buffer)
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 1e702edb419..6db3667545e 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -1135,7 +1135,8 @@ It assumes that it is called from within the control buffer."
(setq mode-line-format
(if (ediff-narrow-control-frame-p)
(list " " mode-line-buffer-identification)
- (list "-- " mode-line-buffer-identification " Quick Help")))
+ (list "-- " mode-line-buffer-identification
+ (list 'ediff-use-long-help-message " Quick Help"))))
;; control buffer id
(setq mode-line-buffer-identification
(if (ediff-narrow-control-frame-p)
@@ -1213,18 +1214,20 @@ It assumes that it is called from within the control buffer."
ediff-control-buffer-suffix))
(defun ediff-make-wide-control-buffer-id ()
- (cond ((< ediff-current-difference 0)
- (list (format "%%b At start of %d diffs"
- ediff-number-of-differences)))
- ((>= ediff-current-difference ediff-number-of-differences)
- (list (format "%%b At end of %d diffs"
- ediff-number-of-differences)))
- (t
- (list (format "%%b diff %d of %d"
- (1+ ediff-current-difference)
- ediff-number-of-differences)))))
-
-
+ (list
+ (concat "%b "
+ (propertize
+ (cond ((< ediff-current-difference 0)
+ (format "At start of %d diffs"
+ ediff-number-of-differences))
+ ((>= ediff-current-difference ediff-number-of-differences)
+ (format "At end of %d diffs"
+ ediff-number-of-differences))
+ (t
+ (format "diff %d of %d"
+ (1+ ediff-current-difference)
+ ediff-number-of-differences)))
+ 'face 'mode-line-buffer-id))))
;; If buff is not live, return nil
(defun ediff-get-visible-buffer-window (buff)
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 7841c256034..840ab8cf51c 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -1558,7 +1558,9 @@ With optional NODE, goes to that node."
(info "ediff")
(if node
(Info-goto-node node)
- (message "Type `i' to search for a specific topic"))
+ (message (substitute-command-keys
+ (concat "Type \\<Info-mode-map>\\[Info-index] to"
+ " search for a specific topic"))))
(raise-frame))
(error (beep 1)
(with-output-to-temp-buffer ediff-msg-buffer
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index b2fdb07d5fb..422ed5c0a4d 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -221,7 +221,7 @@ depend on the flags."
(defcustom emerge-min-visible-lines 3
"Number of lines to show above and below the flags when displaying a difference."
- :type 'integer)
+ :type 'natnum)
(defcustom emerge-temp-file-prefix
(expand-file-name "emerge" temporary-file-directory)
@@ -1647,7 +1647,7 @@ the height of the merge window.
(defun emerge-scroll-left (&optional arg)
"Scroll left all three merge buffers, if they are in windows.
If an argument is given, that is how many columns are scrolled, else nearly
-the width of the A and B windows. `C-u -' alone as argument scrolls half the
+the width of the A and B windows. \\`C-u -' alone as argument scrolls half the
width of the A and B windows."
(interactive "P")
(emerge-operate-on-windows
@@ -1675,7 +1675,7 @@ width of the A and B windows."
(defun emerge-scroll-right (&optional arg)
"Scroll right all three merge buffers, if they are in windows.
If an argument is given, that is how many columns are scrolled, else nearly
-the width of the A and B windows. `C-u -' alone as argument scrolls half the
+the width of the A and B windows. \\`C-u -' alone as argument scrolls half the
width of the A and B windows."
(interactive "P")
(emerge-operate-on-windows
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index c2000c7eec3..e958673fea8 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -54,21 +54,19 @@
(define-obsolete-variable-alias 'vc-log-mode-map 'log-edit-mode-map "28.1")
(define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1")
-(easy-mmode-defmap log-edit-mode-map
- '(("\C-c\C-c" . log-edit-done)
- ("\C-c\C-a" . log-edit-insert-changelog)
- ("\C-c\C-w" . log-edit-generate-changelog-from-diff)
- ("\C-c\C-d" . log-edit-show-diff)
- ("\C-c\C-f" . log-edit-show-files)
- ("\C-c\C-k" . log-edit-kill-buffer)
- ("\C-a" . log-edit-beginning-of-line)
- ("\M-n" . log-edit-next-comment)
- ("\M-p" . log-edit-previous-comment)
- ("\M-r" . log-edit-comment-search-backward)
- ("\M-s" . log-edit-comment-search-forward)
- ("\C-c?" . log-edit-mode-help))
- "Keymap for the `log-edit-mode' (to edit version control log messages)."
- :group 'log-edit)
+(defvar-keymap log-edit-mode-map
+ "C-c C-c" #'log-edit-done
+ "C-c C-a" #'log-edit-insert-changelog
+ "C-c C-w" #'log-edit-generate-changelog-from-diff
+ "C-c C-d" #'log-edit-show-diff
+ "C-c C-f" #'log-edit-show-files
+ "C-c C-k" #'log-edit-kill-buffer
+ "C-a" #'log-edit-beginning-of-line
+ "M-n" #'log-edit-next-comment
+ "M-p" #'log-edit-previous-comment
+ "M-r" #'log-edit-comment-search-backward
+ "M-s" #'log-edit-comment-search-forward
+ "C-c ?" #'log-edit-mode-help)
(easy-menu-define log-edit-menu log-edit-mode-map
"Menu used for `log-edit-mode'."
@@ -712,10 +710,14 @@ different header separator appropriate for `log-edit-mode'."
(interactive)
(when (or (called-interactively-p 'interactive)
(log-edit-empty-buffer-p))
- (insert "Summary: ")
- (when log-edit-setup-add-author
- (insert "\nAuthor: "))
- (insert "\n\n")
+ (dolist (header (append '("Summary") (and log-edit-setup-add-author
+ '("Author"))))
+ ;; Make `C-a' work like in other buffers with header names.
+ (insert (propertize (concat header ": ")
+ 'field 'header
+ 'rear-nonsticky t)
+ "\n"))
+ (insert "\n")
(message-position-point)))
(defun log-edit-insert-cvs-template ()
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index bb2f49a7b65..415b1564eda 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -110,6 +110,7 @@
;;; Code:
(require 'pcvs-util)
+(require 'easy-mmode)
(autoload 'vc-find-revision "vc")
(autoload 'vc-diff-internal "vc")
@@ -121,39 +122,19 @@
:group 'pcl-cvs
:prefix "log-view-")
-(easy-mmode-defmap log-view-mode-map
- '(
- ("-" . negative-argument)
- ("0" . digit-argument)
- ("1" . digit-argument)
- ("2" . digit-argument)
- ("3" . digit-argument)
- ("4" . digit-argument)
- ("5" . digit-argument)
- ("6" . digit-argument)
- ("7" . digit-argument)
- ("8" . digit-argument)
- ("9" . digit-argument)
-
- ("\C-m" . log-view-toggle-entry-display)
- ("m" . log-view-toggle-mark-entry)
- ("e" . log-view-modify-change-comment)
- ("d" . log-view-diff)
- ("=" . log-view-diff)
- ("D" . log-view-diff-changeset)
- ("a" . log-view-annotate-version)
- ("f" . log-view-find-revision)
- ("n" . log-view-msg-next)
- ("p" . log-view-msg-prev)
- ("\t" . log-view-msg-next)
- ([backtab] . log-view-msg-prev)
- ("N" . log-view-file-next)
- ("P" . log-view-file-prev)
- ("\M-n" . log-view-file-next)
- ("\M-p" . log-view-file-prev))
- "Log-View's keymap."
- :inherit special-mode-map
- :group 'log-view)
+(defvar-keymap log-view-mode-map
+ "RET" #'log-view-toggle-entry-display
+ "m" #'log-view-toggle-mark-entry
+ "e" #'log-view-modify-change-comment
+ "d" #'log-view-diff
+ "=" #'log-view-diff
+ "D" #'log-view-diff-changeset
+ "a" #'log-view-annotate-version
+ "f" #'log-view-find-revision
+ "n" #'log-view-msg-next
+ "p" #'log-view-msg-prev
+ "TAB" #'log-view-msg-next
+ "<backtab>" #'log-view-msg-prev)
(easy-menu-define log-view-mode-menu log-view-mode-map
"Log-View Display Menu."
@@ -181,9 +162,15 @@
["Previous Log Entry" log-view-msg-prev
:help "Go to the previous count'th log message"]
["Next File" log-view-file-next
- :help "Go to the next count'th file"]
+ :help "Go to the next count'th file"
+ :active (derived-mode-p vc-cvs-log-view-mode
+ vc-rcs-log-view-mode
+ vc-sccs-log-view-mode)]
["Previous File" log-view-file-prev
- :help "Go to the previous count'th file"]))
+ :help "Go to the previous count'th file"
+ :active (derived-mode-p vc-cvs-log-view-mode
+ vc-rcs-log-view-mode
+ vc-sccs-log-view-mode)]))
(defvar log-view-mode-hook nil
"Hook run at the end of `log-view-mode'.")
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index f6b1895a5ca..2f11716bde9 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -264,160 +264,6 @@ This variable is buffer local and only used in the *cvs* buffer.")
(defconst cvs-vendor-branch "1.1.1"
"The default branch used by CVS for vendor code.")
-(easy-mmode-defmap cvs-mode-diff-map
- '(("E" "imerge" . cvs-mode-imerge)
- ("=" . cvs-mode-diff)
- ("e" "idiff" . cvs-mode-idiff)
- ("2" "other" . cvs-mode-idiff-other)
- ("d" "diff" . cvs-mode-diff)
- ("b" "backup" . cvs-mode-diff-backup)
- ("h" "head" . cvs-mode-diff-head)
- ("r" "repository" . cvs-mode-diff-repository)
- ("y" "yesterday" . cvs-mode-diff-yesterday)
- ("v" "vendor" . cvs-mode-diff-vendor))
- "Keymap for diff-related operations in `cvs-mode'."
- :name "Diff")
-;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
-;; in substitute-command-keys.
-(fset 'cvs-mode-diff-map cvs-mode-diff-map)
-
-(easy-mmode-defmap cvs-mode-map
- ;;(define-prefix-command 'cvs-mode-map-diff-prefix)
- ;;(define-prefix-command 'cvs-mode-map-control-c-prefix)
- '(;; various
- ;; (undo . cvs-mode-undo)
- ("?" . cvs-help)
- ("h" . cvs-help)
- ("q" . cvs-bury-buffer)
- ("z" . kill-this-buffer)
- ("F" . cvs-mode-set-flags)
- ;; ("\M-f" . cvs-mode-force-command)
- ("!" . cvs-mode-force-command)
- ("\C-c\C-c" . cvs-mode-kill-process)
- ;; marking
- ("m" . cvs-mode-mark)
- ("M" . cvs-mode-mark-all-files)
- ("S" . cvs-mode-mark-on-state)
- ("u" . cvs-mode-unmark)
- ("\C-?". cvs-mode-unmark-up)
- ("%" . cvs-mode-mark-matching-files)
- ("T" . cvs-mode-toggle-marks)
- ("\M-\C-?" . cvs-mode-unmark-all-files)
- ;; navigation keys
- (" " . cvs-mode-next-line)
- ("n" . cvs-mode-next-line)
- ("p" . cvs-mode-previous-line)
- ("\t" . cvs-mode-next-line)
- ([backtab] . cvs-mode-previous-line)
- ;; M- keys are usually those that operate on modules
- ;;("\M-C". cvs-mode-rcs2log) ; i.e. "Create a ChangeLog"
- ;;("\M-t". cvs-rtag)
- ;;("\M-l". cvs-rlog)
- ("\M-c". cvs-checkout)
- ("\M-e". cvs-examine)
- ("g" . cvs-mode-revert-buffer)
- ("\M-u". cvs-update)
- ("\M-s". cvs-status)
- ;; diff commands
- ("=" . cvs-mode-diff)
- ("d" . cvs-mode-diff-map)
- ;; keys that operate on individual files
- ("\C-k" . cvs-mode-acknowledge)
- ("A" . cvs-mode-add-change-log-entry-other-window)
- ;;("B" . cvs-mode-byte-compile-files)
- ("C" . cvs-mode-commit-setup)
- ("O" . cvs-mode-update)
- ("U" . cvs-mode-undo)
- ("I" . cvs-mode-insert)
- ("a" . cvs-mode-add)
- ("b" . cvs-set-branch-prefix)
- ("B" . cvs-set-secondary-branch-prefix)
- ("c" . cvs-mode-commit)
- ("e" . cvs-mode-examine)
- ("f" . cvs-mode-find-file)
- ("\C-m" . cvs-mode-find-file)
- ("i" . cvs-mode-ignore)
- ("l" . cvs-mode-log)
- ("o" . cvs-mode-find-file-other-window)
- ("r" . cvs-mode-remove)
- ("s" . cvs-mode-status)
- ("t" . cvs-mode-tag)
- ("v" . cvs-mode-view-file)
- ("x" . cvs-mode-remove-handled)
- ;; cvstree bindings
- ("+" . cvs-mode-tree)
- ;; mouse bindings
- ([mouse-2] . cvs-mode-find-file)
- ([follow-link] . (lambda (pos)
- (if (eq (get-char-property pos 'face) 'cvs-filename) t)))
- ([(down-mouse-3)] . cvs-menu)
- ;; dired-like bindings
- ("\C-o" . cvs-mode-display-file)
- ;; Emacs-21 toolbar
- ;;([tool-bar item1] . (menu-item "Examine" cvs-examine :image (image :file "/usr/share/icons/xpaint.xpm" :type xpm)))
- ;;([tool-bar item2] . (menu-item "Update" cvs-update :image (image :file "/usr/share/icons/mail1.xpm" :type xpm)))
- )
- "Keymap for `cvs-mode'."
- :dense t
- :suppress t)
-
-(fset 'cvs-mode-map cvs-mode-map)
-
-(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'."
- '("CVS"
- ["Open file" cvs-mode-find-file t]
- ["Open in other window" cvs-mode-find-file-other-window t]
- ["Display in other window" cvs-mode-display-file t]
- ["Interactive merge" cvs-mode-imerge t]
- ("View diff"
- ["Interactive diff" cvs-mode-idiff t]
- ["Current diff" cvs-mode-diff t]
- ["Diff with head" cvs-mode-diff-head t]
- ["Diff with vendor" cvs-mode-diff-vendor t]
- ["Diff against yesterday" cvs-mode-diff-yesterday t]
- ["Diff with backup" cvs-mode-diff-backup t])
- ["View log" cvs-mode-log t]
- ["View status" cvs-mode-status t]
- ["View tag tree" cvs-mode-tree t]
- "----"
- ["Insert" cvs-mode-insert]
- ["Update" cvs-mode-update (cvs-enabledp 'update)]
- ["Re-examine" cvs-mode-examine t]
- ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)]
- ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))]
- ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)]
- ["Add" cvs-mode-add (cvs-enabledp 'add)]
- ["Remove" cvs-mode-remove (cvs-enabledp 'remove)]
- ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)]
- ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t]
- "----"
- ["Mark" cvs-mode-mark t]
- ["Mark all" cvs-mode-mark-all-files t]
- ["Mark by regexp..." cvs-mode-mark-matching-files t]
- ["Mark by state..." cvs-mode-mark-on-state t]
- ["Unmark" cvs-mode-unmark t]
- ["Unmark all" cvs-mode-unmark-all-files t]
- ["Hide handled" cvs-mode-remove-handled t]
- "----"
- ["PCL-CVS Manual" (lambda () (interactive)
- (info "(pcl-cvs)Top")) t]
- "----"
- ["Quit" cvs-mode-quit t]))
-
-;;;;
-;;;; CVS-Minor mode
-;;;;
-
-(defcustom cvs-minor-mode-prefix "\C-xc"
- "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'."
- :type 'string)
-
-(easy-mmode-defmap cvs-minor-mode-map
- `((,cvs-minor-mode-prefix . cvs-mode-map)
- ("e" . (menu-item nil cvs-mode-edit-log
- :filter (lambda (x) (if (derived-mode-p 'log-view-mode) x)))))
- "Keymap for `cvs-minor-mode', used in buffers related to PCL-CVS.")
-
(defvar cvs-buffer nil
"(Buffer local) The *cvs* buffer associated with this buffer.")
(put 'cvs-buffer 'permanent-local t)
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 11d14f95766..b48a4a1cbf1 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -130,9 +130,11 @@ to confuse some users sometimes."
(defvar cvs-bakprefix ".#"
"The prefix that CVS prepends to files when rcsmerge'ing.")
-(easy-mmode-defmap cvs-status-map
- '(([(mouse-2)] . cvs-mode-toggle-mark))
- "Local keymap for text properties of status.")
+(declare-function cvs-mode-toggle-mark "pcvs" (e))
+
+(defvar-keymap cvs-status-map
+ :doc "Local keymap for text properties of status."
+ "<mouse-2>" #'cvs-mode-toggle-mark)
;; Constructor:
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 59b3d63c64a..c19fe9bd2ad 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -117,11 +117,11 @@
(require 'cl-lib)
(require 'ewoc) ;Ewoc was once cookie
-(require 'pcvs-defs)
(require 'pcvs-util)
(require 'pcvs-parse)
(require 'pcvs-info)
(require 'vc-cvs)
+(require 'easy-mmode)
;;;;
@@ -138,6 +138,147 @@
(defvar cvs-from-vc nil "Bound to t inside VC advice.")
+(defvar-keymap cvs-mode-diff-map
+ :name "Diff"
+ "E" (cons "imerge" #'cvs-mode-imerge)
+ "=" #'cvs-mode-diff
+ "e" (cons "idiff" #'cvs-mode-idiff)
+ "2" (cons "other" #'cvs-mode-idiff-other)
+ "d" (cons "diff" #'cvs-mode-diff)
+ "b" (cons "backup" #'cvs-mode-diff-backup)
+ "h" (cons "head" #'cvs-mode-diff-head)
+ "r" (cons "repository" #'cvs-mode-diff-repository)
+ "y" (cons "yesterday" #'cvs-mode-diff-yesterday)
+ "v" (cons "vendor" #'cvs-mode-diff-vendor))
+;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
+;; in substitute-command-keys.
+(fset 'cvs-mode-diff-map cvs-mode-diff-map)
+
+(defvar-keymap cvs-mode-map
+ :full t
+ :suppress t
+ ;; various
+ "?" #'cvs-help
+ "h" #'cvs-help
+ "q" #'cvs-bury-buffer
+ "z" #'kill-this-buffer
+ "F" #'cvs-mode-set-flags
+ "!" #'cvs-mode-force-command
+ "C-c C-c" #'cvs-mode-kill-process
+ ;; marking
+ "m" #'cvs-mode-mark
+ "M" #'cvs-mode-mark-all-files
+ "S" #'cvs-mode-mark-on-state
+ "u" #'cvs-mode-unmark
+ "DEL" #'cvs-mode-unmark-up
+ "%" #'cvs-mode-mark-matching-files
+ "T" #'cvs-mode-toggle-marks
+ "M-DEL" #'cvs-mode-unmark-all-files
+ ;; navigation keys
+ "SPC" #'cvs-mode-next-line
+ "n" #'cvs-mode-next-line
+ "p" #'cvs-mode-previous-line
+ "TAB" #'cvs-mode-next-line
+ "<backtab>" #'cvs-mode-previous-line
+ ;; M- keys are usually those that operate on modules
+ "M-c" #'cvs-checkout
+ "M-e" #'cvs-examine
+ "g" #'cvs-mode-revert-buffer
+ "M-u" #'cvs-update
+ "M-s" #'cvs-status
+ ;; diff commands
+ "=" #'cvs-mode-diff
+ "d" cvs-mode-diff-map
+ ;; keys that operate on individual files
+ "C-k" #'cvs-mode-acknowledge
+ "A" #'cvs-mode-add-change-log-entry-other-window
+ "C" #'cvs-mode-commit-setup
+ "O" #'cvs-mode-update
+ "U" #'cvs-mode-undo
+ "I" #'cvs-mode-insert
+ "a" #'cvs-mode-add
+ "b" #'cvs-set-branch-prefix
+ "B" #'cvs-set-secondary-branch-prefix
+ "c" #'cvs-mode-commit
+ "e" #'cvs-mode-examine
+ "f" #'cvs-mode-find-file
+ "RET" #'cvs-mode-find-file
+ "i" #'cvs-mode-ignore
+ "l" #'cvs-mode-log
+ "o" #'cvs-mode-find-file-other-window
+ "r" #'cvs-mode-remove
+ "s" #'cvs-mode-status
+ "t" #'cvs-mode-tag
+ "v" #'cvs-mode-view-file
+ "x" #'cvs-mode-remove-handled
+ ;; cvstree bindings
+ "+" #'cvs-mode-tree
+ ;; mouse bindings
+ "<mouse-2>" #'cvs-mode-find-file
+ "<follow-link>" (lambda (pos)
+ (eq (get-char-property pos 'face) 'cvs-filename))
+ "<down-mouse-3>" #'cvs-menu
+ ;; dired-like bindings
+ "C-o" #'cvs-mode-display-file)
+
+(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'."
+ '("CVS"
+ ["Open file" cvs-mode-find-file t]
+ ["Open in other window" cvs-mode-find-file-other-window t]
+ ["Display in other window" cvs-mode-display-file t]
+ ["Interactive merge" cvs-mode-imerge t]
+ ("View diff"
+ ["Interactive diff" cvs-mode-idiff t]
+ ["Current diff" cvs-mode-diff t]
+ ["Diff with head" cvs-mode-diff-head t]
+ ["Diff with vendor" cvs-mode-diff-vendor t]
+ ["Diff against yesterday" cvs-mode-diff-yesterday t]
+ ["Diff with backup" cvs-mode-diff-backup t])
+ ["View log" cvs-mode-log t]
+ ["View status" cvs-mode-status t]
+ ["View tag tree" cvs-mode-tree t]
+ "----"
+ ["Insert" cvs-mode-insert]
+ ["Update" cvs-mode-update (cvs-enabledp 'update)]
+ ["Re-examine" cvs-mode-examine t]
+ ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)]
+ ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))]
+ ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)]
+ ["Add" cvs-mode-add (cvs-enabledp 'add)]
+ ["Remove" cvs-mode-remove (cvs-enabledp 'remove)]
+ ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)]
+ ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t]
+ "----"
+ ["Mark" cvs-mode-mark t]
+ ["Mark all" cvs-mode-mark-all-files t]
+ ["Mark by regexp..." cvs-mode-mark-matching-files t]
+ ["Mark by state..." cvs-mode-mark-on-state t]
+ ["Unmark" cvs-mode-unmark t]
+ ["Unmark all" cvs-mode-unmark-all-files t]
+ ["Hide handled" cvs-mode-remove-handled t]
+ "----"
+ ["PCL-CVS Manual" (lambda () (interactive)
+ (info "(pcl-cvs)Top")) t]
+ "----"
+ ["Quit" cvs-mode-quit t]))
+
+;;;;
+;;;; CVS-Minor mode
+;;;;
+
+(defcustom cvs-minor-mode-prefix "\C-xc"
+ "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'."
+ :type 'string
+ :group 'pcl-cvs)
+
+(defvar-keymap cvs-minor-mode-map
+ (key-description cvs-minor-mode-prefix) 'cvs-mode-map
+ "e" '(menu-item nil cvs-mode-edit-log
+ :filter (lambda (x)
+ (and (derived-mode-p 'log-view-mode) x))))
+
+(require 'pcvs-defs)
+
;;;;
;;;; flags variables
;;;;
@@ -758,6 +899,7 @@ clear what alternative to use.
- `DOUBLE' is the generic case."
(declare (debug (&define sexp lambda-list stringp
("interactive" interactive) def-body))
+ (indent defun)
(doc-string 3))
(let ((style (cvs-cdr fun))
(fun (cvs-car fun)))
@@ -1284,8 +1426,7 @@ marked instead. A directory can never be marked."
(intern
(upcase
(completing-read
- (concat
- "Mark files in state" (if default (concat " [" default "]")) ": ")
+ (format-prompt "Mark files in state" default)
(mapcar (lambda (x)
(list (downcase (symbol-name (car x)))))
cvs-states)
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 51ad8293f65..003b26eca41 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -47,6 +47,7 @@
(require 'diff) ;For diff-check-labels.
(require 'diff-mode) ;For diff-refine.
(require 'newcomment)
+(require 'easy-mmode)
;;; The real definition comes later.
(defvar smerge-mode)
@@ -142,36 +143,34 @@ Used in `smerge-diff-base-upper' and related functions."
"Face used for added characters shown by `smerge-refine'."
:version "24.3")
-(easy-mmode-defmap smerge-basic-map
- `(("n" . smerge-next)
- ("p" . smerge-prev)
- ("r" . smerge-resolve)
- ("a" . smerge-keep-all)
- ("b" . smerge-keep-base)
- ("o" . smerge-keep-lower) ; for the obsolete keep-other
- ("l" . smerge-keep-lower)
- ("m" . smerge-keep-upper) ; for the obsolete keep-mine
- ("u" . smerge-keep-upper)
- ("E" . smerge-ediff)
- ("C" . smerge-combine-with-next)
- ("R" . smerge-refine)
- ("\C-m" . smerge-keep-current)
- ("=" . ,(make-sparse-keymap "Diff"))
- ("=<" "base-upper" . smerge-diff-base-upper)
- ("=>" "base-lower" . smerge-diff-base-lower)
- ("==" "upper-lower" . smerge-diff-upper-lower))
- "The base keymap for `smerge-mode'.")
+(defvar-keymap smerge-basic-map
+ "n" #'smerge-next
+ "p" #'smerge-prev
+ "r" #'smerge-resolve
+ "a" #'smerge-keep-all
+ "b" #'smerge-keep-base
+ "o" #'smerge-keep-lower ; for the obsolete keep-other
+ "l" #'smerge-keep-lower
+ "m" #'smerge-keep-upper ; for the obsolete keep-mine
+ "u" #'smerge-keep-upper
+ "E" #'smerge-ediff
+ "C" #'smerge-combine-with-next
+ "R" #'smerge-refine
+ "C-m" #'smerge-keep-current
+ "=" (define-keymap :name "Diff"
+ "<" (cons "base-upper" #'smerge-diff-base-upper)
+ ">" (cons "base-lower" #'smerge-diff-base-lower)
+ "=" (cons "upper-lower" #'smerge-diff-upper-lower)))
(defcustom smerge-command-prefix "\C-c^"
"Prefix for `smerge-mode' commands."
:type '(choice (const :tag "ESC" "\e")
- (const :tag "C-c ^" "\C-c^" )
+ (const :tag "C-c ^" "\C-c^")
(const :tag "none" "")
string))
-(easy-mmode-defmap smerge-mode-map
- `((,smerge-command-prefix . ,smerge-basic-map))
- "Keymap for `smerge-mode'.")
+(defvar-keymap smerge-mode-map
+ (key-description smerge-command-prefix) smerge-basic-map)
(defvar-local smerge-check-cache nil)
(defun smerge-check (n)
@@ -926,8 +925,11 @@ Its behavior has mainly two restrictions:
to `smerge-refine-regions'.
This only matters if `smerge-refine-weight-hack' is nil.")
-(defvar smerge-refine-ignore-whitespace t
- "If non-nil, `smerge-refine' should try to ignore change in whitespace.")
+(defcustom smerge-refine-ignore-whitespace t
+ "If non-nil, `smerge-refine' should try to ignore change in whitespace."
+ :type 'boolean
+ :version "29.1"
+ :group 'diff)
(defvar smerge-refine-weight-hack t
"If non-nil, pass to diff as many lines as there are chars in the region.
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index bd4ff3e015a..1f19c4cfe26 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -57,7 +57,7 @@ is applied to the background."
:set (lambda (symbol value)
(set-default symbol value)
(when (boundp 'vc-annotate-color-map)
- (with-demoted-errors
+ (with-demoted-errors "VC color map error: %S"
;; Update the value of the dependent variable.
(custom-reevaluate-setting 'vc-annotate-color-map))))
:version "25.1"
@@ -451,7 +451,8 @@ should be applied to the background or to the foreground."
(setq-local vc-annotate-backend backend)
(setq-local vc-annotate-parent-file file)
(setq-local vc-annotate-parent-rev rev)
- (setq-local vc-annotate-parent-display-mode display-mode))))
+ (setq-local vc-annotate-parent-display-mode display-mode)
+ (kill-local-variable 'revert-buffer-function))))
(with-current-buffer temp-buffer-name
(vc-run-delayed
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 8f06d5a847a..1f81ff2e0fe 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -26,6 +26,7 @@
(require 'vc-rcs)
(eval-when-compile (require 'vc))
+(require 'log-view)
(declare-function vc-checkout "vc" (file &optional rev))
(declare-function vc-expand-dirs "vc" (file-or-dir-list backend))
@@ -1257,6 +1258,14 @@ ignore file."
(if sort (sort-lines nil (point-min) (point-max)))
(save-buffer)))))
+(defvar-keymap vc-cvs-log-view-mode-map
+ "N" #'log-view-file-next
+ "P" #'log-view-file-prev
+ "M-n" #'log-view-file-next
+ "M-p" #'log-view-file-prev)
+
+(define-derived-mode vc-cvs-log-view-mode log-view-mode "CVS-Log-View")
+
(provide 'vc-cvs)
;;; vc-cvs.el ends here
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 9cf6422de00..9335da10065 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -325,6 +325,7 @@ See `run-hooks'."
(define-key map "U" #'vc-dir-unmark-all-files)
(define-key map "\C-?" #'vc-dir-unmark-file-up)
(define-key map "\M-\C-?" #'vc-dir-unmark-all-files)
+ (define-key map "%" #'vc-dir-mark-by-regexp)
;; Movement.
(define-key map "n" #'vc-dir-next-line)
(define-key map " " #'vc-dir-next-line)
@@ -750,6 +751,23 @@ share the same state."
(vc-dir-mark-file crt)))
(setq crt (ewoc-next vc-ewoc crt))))))))
+(defun vc-dir-mark-by-regexp (regexp &optional unmark)
+ "Mark all files that match REGEXP.
+If UNMARK (interactively, the prefix), unmark instead."
+ (interactive "sMark files matching: \nP")
+ (ewoc-map
+ (lambda (filearg)
+ (when (and (not (vc-dir-fileinfo->directory filearg))
+ (eq (not unmark)
+ (not (vc-dir-fileinfo->marked filearg)))
+ ;; We don't want to match on the part of the file
+ ;; that's above the current directory.
+ (string-match-p regexp (file-relative-name
+ (vc-dir-fileinfo->name filearg))))
+ (setf (vc-dir-fileinfo->marked filearg) (not unmark))
+ t))
+ vc-ewoc))
+
(defun vc-dir-mark-files (mark-files)
"Mark files specified by file names in the argument MARK-FILES.
MARK-FILES should be a list of absolute filenames."
@@ -1433,7 +1451,12 @@ These are the commands available for use in the file status buffer:
(vc-dir-refresh)
;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
(let ((use-vc-backend backend))
- (vc-dir-mode))))
+ (vc-dir-mode)
+ ;; Activate the backend-specific minor mode, if any.
+ (when-let ((minor-mode
+ (intern-soft (format "vc-dir-%s-mode"
+ (downcase (symbol-name backend))))))
+ (funcall minor-mode 1)))))
(defun vc-default-dir-extra-headers (_backend _dir)
;; Be loud by default to remind people to add code to display
@@ -1539,9 +1562,8 @@ These are the commands available for use in the file status buffer:
This implements the `bookmark-make-record-function' type for
`vc-dir' buffers."
(let* ((bookmark-name
- (concat "(" (symbol-name vc-dir-backend) ") "
- (file-name-nondirectory
- (directory-file-name default-directory))))
+ (file-name-nondirectory
+ (directory-file-name default-directory)))
(defaults (list bookmark-name default-directory)))
`(,bookmark-name
,@(bookmark-make-record-default 'no-file)
@@ -1561,6 +1583,8 @@ type returned by `vc-dir-bookmark-make-record'."
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+(put 'vc-dir-bookmark-jump 'bookmark-handler-type "VC")
+
(provide 'vc-dir)
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index a55954467e0..5c664d58f1a 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -127,8 +127,12 @@ preserve the setting."
:group 'vc)
(defcustom vc-command-messages nil
- "If non-nil, display run messages from back-end commands."
- :type 'boolean
+ "If non-nil, display and log messages about running back-end commands.
+If the value is `log', messages about running VC back-end commands are
+logged in the *Messages* buffer, but not displayed."
+ :type '(choice (const :tag "No messages" nil)
+ (const :tag "Display and log messages" t)
+ (const :tag "Log messages, but don't display" log))
:group 'vc)
(defcustom vc-suppress-confirm nil
@@ -311,7 +315,10 @@ case, and the process object in the asynchronous case."
(substring command 0 -1)
command)
" " (vc-delistify flags)
- " " (vc-delistify files))))
+ " " (vc-delistify files)))
+ (vc-inhibit-message
+ (or (eq vc-command-messages 'log)
+ (eq (selected-window) (active-minibuffer-window)))))
(save-current-buffer
(unless (or (eq buffer t)
(and (stringp buffer)
@@ -335,7 +342,7 @@ case, and the process object in the asynchronous case."
(apply #'start-file-process command (current-buffer)
command squeezed))))
(when vc-command-messages
- (let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (let ((inhibit-message vc-inhibit-message))
(message "Running in background: %s" full-command)))
;; Get rid of the default message insertion, in case we don't
;; set a sentinel explicitly.
@@ -345,11 +352,11 @@ case, and the process object in the asynchronous case."
(when vc-command-messages
(vc-run-delayed
(let ((message-truncate-lines t)
- (inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (inhibit-message vc-inhibit-message))
(message "Done in background: %s" full-command)))))
;; Run synchronously
(when vc-command-messages
- (let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (let ((inhibit-message vc-inhibit-message))
(message "Running in foreground: %s" full-command)))
(let ((buffer-undo-list t))
(setq status (apply #'process-file command nil t nil squeezed)))
@@ -364,7 +371,7 @@ case, and the process object in the asynchronous case."
(if (integerp status) (format "status %d" status) status)
full-command))
(when vc-command-messages
- (let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (let ((inhibit-message vc-inhibit-message))
(message "Done (status=%d): %s" status full-command)))))
(vc-run-delayed
(run-hook-with-args 'vc-post-command-functions
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 7072b8e483b..8937454d111 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -290,12 +290,14 @@ Good example of file name that needs this: \"test[56].xx\".")
(vc-git--run-command-string nil "version")))
(setq vc-git--program-version
(if (and version-string
- ;; Git for Windows appends ".windows.N" to the
- ;; numerical version reported by Git.
- (string-match
- "git version \\([0-9.]+\\)\\(\\.windows\\.[0-9]+\\)?$"
- version-string))
- (match-string 1 version-string)
+ ;; Some Git versions append additional strings
+ ;; to the numerical version string. E.g., Git
+ ;; for Windows appends ".windows.N", while Git
+ ;; for Mac appends " (Apple Git-N)". Capture
+ ;; numerical version and ignore the rest.
+ (string-match "git version \\([0-9][0-9.]+\\)"
+ version-string))
+ (string-trim-right (match-string 1 version-string) "\\.")
"0")))))
(defun vc-git--git-status-to-vc-state (code-list)
@@ -1597,7 +1599,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(declare-function grep-read-regexp "grep" ())
(declare-function grep-read-files "grep" (regexp))
(declare-function grep-expand-template "grep"
- (template &optional regexp files dir excl))
+ (template &optional regexp files dir excl more-opts))
(defvar compilation-environment)
;; Derived from `lgrep'.
@@ -1680,7 +1682,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(let ((stash (completing-read
prompt
(split-string
- (or (vc-git--run-command-string nil "stash" "list") "") "\n")
+ (or (vc-git--run-command-string nil "stash" "list") "") "\n" t)
nil :require-match nil 'vc-git-stash-read-history)))
(if (string-equal stash "")
(user-error "Not a stash")
@@ -1693,8 +1695,8 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(vc-setup-buffer "*vc-git-stash*")
(vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
(set-buffer "*vc-git-stash*")
- (diff-mode)
(setq buffer-read-only t)
+ (diff-mode)
(pop-to-buffer (current-buffer)))
(defun vc-git-stash-apply (name)
@@ -1725,12 +1727,11 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(defun vc-git-stash-list ()
(when-let ((out (vc-git--run-command-string nil "stash" "list")))
- (delete
- ""
- (split-string
- (replace-regexp-in-string
- "^stash@" " " out)
- "\n"))))
+ (split-string
+ (replace-regexp-in-string
+ "^stash@" " " out)
+ "\n"
+ t)))
(defun vc-git-stash-get-at-point (point)
(save-excursion
@@ -1867,6 +1868,17 @@ Returns nil if not possible."
(1- (point-max)))))))
(and name (not (string= name "undefined")) name))))
+(defvar-keymap vc-dir-git-mode-map
+ "z c" #'vc-git-stash
+ "z s" #'vc-git-stash-snapshot
+ "z p" #'vc-git-stash-pop)
+
+(define-minor-mode vc-dir-git-mode
+ "A minor mode for git-specific commands in `vc-dir-mode' buffers.
+Also note that there are git stash commands available in the
+\"Stash\" section at the head of the buffer."
+ :lighter " Git")
+
(provide 'vc-git)
;;; vc-git.el ends here
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 1b94311a817..026f125396e 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -672,7 +672,6 @@ Return the byte's value as an integer."
(let* ((result nil)
(flen (length fname))
(case-fold-search nil)
- (inhibit-changing-match-data t)
;; Find a conservative bound for the loop below by using
;; Boyer-Moore on the raw dirstate without parsing it; we
;; know we can't possibly find fname _after_ the last place
@@ -976,10 +975,9 @@ REPO must be the directory name of an hg repository."
"Test whether the ignore pattern set HGIP says to ignore FILENAME.
FILENAME must be the file's true absolute name."
(let ((patterns (vc-hg--ignore-patterns-ignore-patterns hgip))
- (inhibit-changing-match-data t)
(ignored nil))
(while (and patterns (not ignored))
- (setf ignored (string-match (pop patterns) filename)))
+ (setf ignored (string-match-p (pop patterns) filename)))
ignored))
(defvar vc-hg--cached-ignore-patterns nil
@@ -1043,7 +1041,8 @@ Avoids the need to repeatedly scan dirstate on repeated calls to
(equal size (pop cache))
(equal ascii-fname (pop cache)))
(pop cache)
- (let ((result (vc-hg--raw-dirstate-search dirstate ascii-fname)))
+ (let ((result (save-match-data
+ (vc-hg--raw-dirstate-search dirstate ascii-fname))))
(setf vc-hg--dirstate-scan-cache
(list dirstate mtime size ascii-fname result))
result))))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index ee295b17c73..80508570f32 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -99,7 +99,7 @@ interpreted as hostnames."
:type 'regexp
:group 'vc)
-(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg Mtn)
+(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg)
;; RCS, CVS, SVN, SCCS, and SRC come first because they are per-dir
;; rather than per-tree. RCS comes first because of the multibackend
;; support intended to use RCS for local commits (with a remote CVS server).
@@ -141,7 +141,8 @@ confirmation whether it should follow the link. If nil, the link is
visited and a warning displayed."
:type '(choice (const :tag "Ask for confirmation" ask)
(const :tag "Visit link and warn" nil)
- (const :tag "Follow link" t))
+ (const :tag "Follow link" t))
+ :safe #'null
:group 'vc)
(defcustom vc-display-status t
@@ -555,15 +556,6 @@ this function."
templates))))
-;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made
-;; obsolete earlier, it is ok for the latter to be an alias to the former,
-;; since the latter will be removed first. We can't just make it
-;; an alias for read-only-mode, since that is not 100% the same.
-(defalias 'vc-toggle-read-only 'toggle-read-only)
-(make-obsolete 'vc-toggle-read-only
- "use `read-only-mode' instead (or `toggle-read-only' in older versions of Emacs)."
- "24.1")
-
(defun vc-default-make-version-backups-p (_backend _file)
"Return non-nil if unmodified versions should be backed up locally.
The default is to switch off this feature."
@@ -798,9 +790,10 @@ In the latter case, VC mode is deactivated for this buffer."
(add-hook 'vc-mode-line-hook #'vc-mode-line nil t)
(let (backend)
(cond
- ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
- ;; Let the backend setup any buffer-local things he needs.
- (vc-call-backend backend 'find-file-hook)
+ ((setq backend (with-demoted-errors "VC refresh error: %S"
+ (vc-backend buffer-file-name)))
+ ;; Let the backend setup any buffer-local things he needs.
+ (vc-call-backend backend 'find-file-hook)
;; Compute the state and put it in the mode line.
(vc-mode-line buffer-file-name backend)
(unless vc-make-backup-files
@@ -864,7 +857,8 @@ In the latter case, VC mode is deactivated for this buffer."
(defvar vc-prefix-map
(let ((map (make-sparse-keymap)))
(define-key map "a" #'vc-update-change-log)
- (define-key map "b" #'vc-switch-backend)
+ (with-suppressed-warnings ((obsolete vc-switch-backend))
+ (define-key map "b" #'vc-switch-backend))
(define-key map "d" #'vc-dir)
(define-key map "g" #'vc-annotate)
(define-key map "G" #'vc-ignore)
@@ -963,7 +957,7 @@ In the latter case, VC mode is deactivated for this buffer."
(defalias 'vc-menu-map vc-menu-map)
-(declare-function vc-responsible-backend "vc" (file))
+(declare-function vc-responsible-backend "vc" (file &optional no-error))
(defun vc-menu-map-filter (orig-binding)
(if (and (symbolp orig-binding) (fboundp orig-binding))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index fb57b2bbc6e..a4345c7d7e2 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -40,6 +40,7 @@
(eval-when-compile
(require 'cl-lib)
(require 'vc))
+(require 'log-view)
(declare-function vc-read-revision "vc"
(prompt &optional files backend default initial-input))
@@ -99,7 +100,7 @@ to use --brief and sets this variable to remember whether it worked."
"Where to look for RCS master files.
For a description of possible values, see `vc-check-master-templates'."
:type '(choice (const :tag "Use standard RCS file names"
- '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s"))
+ ("%sRCS/%s,v" "%s%s,v" "%sRCS/%s"))
(repeat :tag "User-specified"
(choice string
function)))
@@ -1062,9 +1063,9 @@ file."
(defun vc-rcs-consult-headers (file)
"Search for RCS headers in FILE, and set properties accordingly.
-Returns: nil if no headers were found
- 'rev if a workfile revision was found
- 'rev-and-lock if revision and lock info was found"
+Returns: nil if no headers were found
+ `rev' if a workfile revision was found
+ `rev-and-lock' if revision and lock info was found"
(cond
((not (get-file-buffer file)) nil)
((let (status version)
@@ -1456,6 +1457,14 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
`((headers ,desc ,@headers)
(revisions ,@revs)))))
+(defvar-keymap vc-rcs-log-view-mode-map
+ "N" #'log-view-file-next
+ "P" #'log-view-file-prev
+ "M-n" #'log-view-file-next
+ "M-p" #'log-view-file-prev)
+
+(define-derived-mode vc-rcs-log-view-mode log-view-mode "RCS-Log-View")
+
(provide 'vc-rcs)
;;; vc-rcs.el ends here
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 0df70c8f232..9622bf5e097 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -27,6 +27,7 @@
(eval-when-compile
(require 'vc))
+(require 'log-view)
;;;
;;; Customization options
@@ -216,7 +217,7 @@ to the SCCS command."
;; TODO: check for all the patterns in vc-sccs-master-templates
(or (and (file-directory-p
(expand-file-name "SCCS" (file-name-directory file)))
- file)
+ (file-name-directory file))
(let ((dir (vc-sccs-search-project-dir (or (file-name-directory file) "")
(file-name-nondirectory file))))
(and (stringp dir)
@@ -518,6 +519,14 @@ If NAME is nil or a revision number string it's just passed through."
(file-name-directory (vc-master-name file))))
(vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1))))
+(defvar-keymap vc-sccs-log-view-mode-map
+ "N" #'log-view-file-next
+ "P" #'log-view-file-prev
+ "M-n" #'log-view-file-next
+ "M-p" #'log-view-file-prev)
+
+(define-derived-mode vc-sccs-log-view-mode log-view-mode "SCCS-Log-View")
+
(provide 'vc-sccs)
;;; vc-sccs.el ends here
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index 5a252c55cb2..432448bde58 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -120,7 +120,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
"Where to look for SRC master files.
For a description of possible values, see `vc-check-master-templates'."
:type '(choice (const :tag "Use standard SRC file names"
- '("%s.src/%s,v"))
+ ("%s.src/%s,v"))
(repeat :tag "User-specified"
(choice string
function))))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index b38a676acbd..270877041aa 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -201,8 +201,8 @@ switches."
;; FIXME are there other possible combinations?
(cond ((eq state 'edited) (setq state 'needs-merge))
((not state) (setq state 'needs-update))))
- (when (and state (not (string= "." filename)))
- (setq result (cons (list filename state) result)))))
+ (when state
+ (setq result (cons (list filename state) result)))))
(funcall callback result)))
;; dir-status-files called from vc-dir, which loads vc,
@@ -212,7 +212,7 @@ switches."
(autoload 'vc-expand-dirs "vc")
(defun vc-svn-dir-status-files (_dir files callback)
- "Run 'svn status' for DIR and update BUFFER via CALLBACK.
+ "Run \"svn status\" for DIR and update BUFFER via CALLBACK.
CALLBACK is called as (CALLBACK RESULT BUFFER), where
RESULT is a list of conses (FILE . STATE) for directory DIR."
;; FIXME shouldn't this rather default to all the files in dir?
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index bebd0946dee..d3e53858c16 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -739,6 +739,7 @@
(require 'cl-lib)
(declare-function diff-setup-whitespace "diff-mode" ())
+(declare-function diff-setup-buffer-type "diff-mode" ())
(eval-when-compile
(require 'dired))
@@ -823,7 +824,7 @@ for the backend you use."
"Limit the number of items shown by the VC log commands.
Zero means unlimited.
Not all VC backends are able to support this feature."
- :type 'integer)
+ :type 'natnum)
(defcustom vc-allow-async-revert nil
"Specifies whether the diff during \\[vc-revert] may be asynchronous.
@@ -937,11 +938,20 @@ repository, prompting for the directory and the VC backend to
use."
(catch 'found
;; First try: find a responsible backend, it must be a backend
- ;; under which FILE is not yet registered.
- (dolist (backend vc-handled-backends)
- (and (not (vc-call-backend backend 'registered file))
- (vc-call-backend backend 'responsible-p file)
- (throw 'found backend)))
+ ;; under which FILE is not yet registered and with the most
+ ;; specific path to FILE.
+ (let ((max 0)
+ bk)
+ (dolist (backend vc-handled-backends)
+ (when (not (vc-call-backend backend 'registered file))
+ (let* ((dir-name (vc-call-backend backend 'responsible-p file))
+ (len (and dir-name
+ (length (file-name-split
+ (expand-file-name dir-name))))))
+ (when (and len (> len max))
+ (setq max len bk backend)))))
+ (when bk
+ (throw 'found bk)))
;; no responsible backend
(let* ((possible-backends
(let (pos)
@@ -969,7 +979,7 @@ use."
(message "arg %s" arg)
(and (file-directory-p arg)
(string-prefix-p (expand-file-name arg) def-dir)))))))
- (let ((default-directory repo-dir))
+ (let ((default-directory repo-dir))
(vc-call-backend bk 'create-repo))
(throw 'found bk))))
@@ -994,13 +1004,14 @@ responsible for the given file."
;;
;; First try: find a responsible backend. If this is for registration,
;; it must be a backend under which FILE is not yet registered.
- (let ((dirs (delq nil
- (mapcar
- (lambda (backend)
- (when-let ((dir (vc-call-backend
- backend 'responsible-p file)))
- (cons backend dir)))
- vc-handled-backends))))
+ (let* ((file (expand-file-name file))
+ (dirs (delq nil
+ (mapcar
+ (lambda (backend)
+ (when-let ((dir (vc-call-backend
+ backend 'responsible-p file)))
+ (cons backend dir)))
+ vc-handled-backends))))
;; Just a single response (or none); use it.
(if (< (length dirs) 2)
(caar dirs)
@@ -1188,7 +1199,11 @@ For old-style locking-based version control systems, like RCS:
*vc-log* buffer to check in the changes. Leave a
read-only copy of each changed file after checking in.
If every file is locked by you and unchanged, unlock them.
- If every file is locked by someone else, offer to steal the lock."
+ If every file is locked by someone else, offer to steal the lock.
+
+When using this command to register a new file (or files), it
+will automatically deduce which VC repository to register it
+with, using the most specific one."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
@@ -1716,21 +1731,48 @@ to override the value of `vc-diff-switches' and `diff-switches'."
;; any switches in diff-switches.
(when (listp switches) switches))))
-(defun vc-diff-finish (buffer messages)
+(defun vc-shrink-buffer-window (&optional buffer)
+ "Call `shrink-window-if-larger-than-buffer' only when BUFFER is visible.
+BUFFER defaults to the current buffer."
+ (let ((window (get-buffer-window buffer t)))
+ (when window
+ (shrink-window-if-larger-than-buffer window))))
+
+(defvar vc-diff-finish-functions '(vc-shrink-buffer-window)
+ "Functions run at the end of the diff command.
+Each function runs in the diff output buffer without args.")
+
+(defun vc-diff-restore-buffer (original new)
+ "Restore point in buffer NEW to where it was in ORIGINAL.
+
+This function works by updating buffer ORIGINAL with the contents
+of NEW (without destroying existing markers), swapping their text
+objects, and finally killing buffer ORIGINAL."
+ (with-current-buffer original
+ (let ((inhibit-read-only t))
+ (replace-buffer-contents new)))
+ (with-current-buffer new
+ (buffer-swap-text original))
+ (kill-buffer original))
+
+(defun vc-diff-finish (buffer messages &optional oldbuf)
;; The empty sync output case has already been handled, so the only
;; possibility of an empty output is for an async process.
(when (buffer-live-p buffer)
- (let ((window (get-buffer-window buffer t))
- (emptyp (zerop (buffer-size buffer))))
+ (let ((emptyp (zerop (buffer-size buffer))))
(with-current-buffer buffer
(and messages emptyp
(let ((inhibit-read-only t))
(insert (cdr messages) ".\n")
(message "%s" (cdr messages))))
(diff-setup-whitespace)
- (goto-char (point-min))
- (when window
- (shrink-window-if-larger-than-buffer window)))
+ (diff-setup-buffer-type)
+ ;; `oldbuf' is the buffer that used to show this diff. Make
+ ;; sure that we restore point in it if it's given.
+ (if oldbuf
+ (vc-diff-restore-buffer oldbuf buffer)
+ (goto-char (point-min)))
+ (run-hooks 'vc-diff-finish-functions))
(when (and messages (not emptyp))
(message "%sdone" (car messages))))))
@@ -1754,7 +1796,11 @@ Return t if the buffer had changes, nil otherwise."
;; but the only way to set it for each file included would
;; be to call the back end separately for each file.
(coding-system-for-read
- (if files (vc-coding-system-for-diff (car files)) 'undecided)))
+ (if files (vc-coding-system-for-diff (car files)) 'undecided))
+ (orig-diff-buffer-clone
+ (if revert-buffer-in-progress-p
+ (clone-buffer
+ (generate-new-buffer-name " *vc-diff-clone*") nil))))
;; On MS-Windows and MS-DOS, Diff is likely to produce DOS-style
;; EOLs, which will look ugly if (car files) happens to have Unix
;; EOLs.
@@ -1793,16 +1839,16 @@ Return t if the buffer had changes, nil otherwise."
(setq files (nreverse filtered))))
(vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async)
(set-buffer buffer)
+ ;; Make the *vc-diff* buffer read only, the diff-mode key
+ ;; bindings are nicer for read only buffers. pcl-cvs does the
+ ;; same thing.
+ (setq buffer-read-only t)
(diff-mode)
(setq-local diff-vc-backend (car vc-fileset))
(setq-local diff-vc-revisions (list rev1 rev2))
(setq-local revert-buffer-function
(lambda (_ignore-auto _noconfirm)
(vc-diff-internal async vc-fileset rev1 rev2 verbose)))
- ;; Make the *vc-diff* buffer read only, the diff-mode key
- ;; bindings are nicer for read only buffers. pcl-cvs does the
- ;; same thing.
- (setq buffer-read-only t)
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
;; Treat this case specially so as not to pop the buffer.
@@ -1815,7 +1861,8 @@ Return t if the buffer had changes, nil otherwise."
;; after `pop-to-buffer'; the former assumes the diff buffer is
;; shown in some window.
(let ((buf (current-buffer)))
- (vc-run-delayed (vc-diff-finish buf (when verbose messages))))
+ (vc-run-delayed (vc-diff-finish buf (when verbose messages)
+ orig-diff-buffer-clone)))
;; In the async case, we return t even if there are no differences
;; because we don't know that yet.
t)))
@@ -1863,13 +1910,10 @@ Return t if the buffer had changes, nil otherwise."
(vc-working-revision first))))
(when (string= rev1-default "") (setq rev1-default nil))))
;; construct argument list
- (let* ((rev1-prompt (if rev1-default
- (concat "Older revision (default "
- rev1-default "): ")
- "Older revision: "))
- (rev2-prompt (concat "Newer revision (default "
- ;; (or rev2-default
- "current source): "))
+ (let* ((rev1-prompt (format-prompt "Older revision" rev1-default))
+ (rev2-prompt (format-prompt "Newer revision"
+ ;; (or rev2-default
+ "current source"))
(rev1 (vc-read-revision rev1-prompt files backend rev1-default))
(rev2 (vc-read-revision rev2-prompt files backend nil))) ;; rev2-default
(when (string= rev1 "") (setq rev1 nil))
@@ -2082,7 +2126,7 @@ If `F.~REV~' already exists, use it instead of checking it out again."
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(vc-ensure-vc-buffer)
(list
- (vc-read-revision "Revision to visit (default is working revision): "
+ (vc-read-revision (format-prompt "Revision to visit" "working revision")
(list buffer-file-name)))))
(set-buffer (or (buffer-base-buffer) (current-buffer)))
(vc-ensure-vc-buffer)
@@ -2378,7 +2422,7 @@ This function runs the hook `vc-retrieve-tag-hook' when finished."
(read-directory-name "Directory: " default-directory nil t))))
(list
dir
- (vc-read-revision "Tag name to retrieve (default latest revisions): "
+ (vc-read-revision (format-prompt "Tag name to retrieve" "latest revisions")
(list dir)
(vc-responsible-backend dir)))))
(let* ((backend (vc-responsible-backend dir))
@@ -2486,6 +2530,10 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(put 'vc-log-view-type 'permanent-local t)
(defvar vc-sentinel-movepoint)
+(defvar vc-log-finish-functions '(vc-shrink-buffer-window)
+ "Functions run at the end of the log command.
+Each function runs in the log output buffer without args.")
+
(defun vc-log-internal-common (backend
buffer-name
files
@@ -2517,11 +2565,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(vc-run-delayed
(let ((inhibit-read-only t))
(funcall setup-buttons-func backend files retval)
- (shrink-window-if-larger-than-buffer)
(when goto-location-func
(funcall goto-location-func backend)
(setq vc-sentinel-movepoint (point)))
- (set-buffer-modified-p nil)))))
+ (set-buffer-modified-p nil)
+ (run-hooks 'vc-log-finish-functions)))))
(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
(vc-log-internal-common
@@ -2606,7 +2654,10 @@ with its diffs (if the underlying VCS supports that)."
(error "Directory is not version controlled")))
(setq default-directory rootdir)
(vc-print-log-internal backend (list rootdir) revision revision limit
- (when with-diff 'with-diff))))
+ (when with-diff 'with-diff))
+ ;; We're looking at the root, so displaying " from <some-file>" in
+ ;; the mode line isn't helpful.
+ (setq vc-parent-buffer-name nil)))
;;;###autoload
(defun vc-print-branch-log (branch)
@@ -2743,7 +2794,7 @@ to the working revision (except for keyword expansion)."
(unwind-protect
(when (if vc-revert-show-diff
(progn
- (setq diff-buffer (generate-new-buffer-name "*vc-diff*"))
+ (setq diff-buffer (generate-new-buffer "*vc-diff*"))
(vc-diff-internal vc-allow-async-revert vc-fileset
nil nil nil diff-buffer))
;; Avoid querying the user again.
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index 819a051b514..a54227c1bce 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -216,23 +216,17 @@
;; Key bindings
;; ============
;;
-;; There is an alternative set of key bindings which will be used
-;; automatically for a PC if Oemacs is detected. This set uses separate
-;; control, shift and meta keys with function keys 1 to 10. In
-;; particular, movement keys are concentrated on f5 to f8 with (in
-;; increasing order of distance traveled) C-, M- and S- as prefixes.
-;; See the actual bindings below (search for C-f1). This is because the
-;; C-S- prefix is represented by weird key sequences and the set is
-;; incomplete; if you don't mind that, some hints are given in comments
-;; below.
+;; There is an alternative set of key bindings named "Oemacs" (for
+;; historical reasons). This set uses separate control, shift and
+;; meta keys with function keys 1 to 10. In particular, movement keys
+;; are concentrated on f5 to f8 with (in increasing order of distance
+;; traveled) C-, M- and S- as prefixes. See the actual bindings below
+;; (search for C-f1). This is because the C-S- prefix is represented
+;; by weird key sequences and the set is incomplete; if you don't mind
+;; that, some hints are given in comments below.
;;
-;; You can specify the usual or the Oemacs bindings by setting the
-;; variable vcursor-key-bindings to `xterm' or `oemacs'. You can also set
-;; it to nil, in which case vcursor will not make any key bindings
-;; and you can define your own. The default is t, which makes vcursor
-;; guess (it will use xterm unless it thinks Oemacs is running). The
-;; oemacs set will work on an X terminal with function keys, but the
-;; xterm set will not work under Oemacs.
+;; You can specify which set of key bindings to use by customizing the
+;; user option `vcursor-key-bindings'.
;;
;; Usage on dumb terminals
;; =======================
@@ -355,8 +349,7 @@ on loading vcursor and from the customize package."
(set var value)
(cond
((not value)) ;; Don't set any key bindings.
- ((or (eq value 'oemacs)
- (and (eq value t) (fboundp 'oemacs-version)))
+ ((eq value 'oemacs)
(global-set-key [C-f1] #'vcursor-toggle-copy)
(global-set-key [C-f2] #'vcursor-copy)
(global-set-key [C-f3] #'vcursor-copy-word)
@@ -386,33 +379,6 @@ on loading vcursor and from the customize package."
(global-set-key [S-f9] #'vcursor-execute-key)
(global-set-key [S-f10] #'vcursor-execute-command)
-
- ;; Partial dictionary of Oemacs key sequences for you to roll your own,
- ;; e.g C-S-up: (global-set-key "\M-[\C-f\M-\C-m" 'vcursor-previous-line)
- ;; Sequence: Sends:
- ;; "\M-[\C-f\M-\C-m" C-S-up
- ;; "\M-[\C-f\M-\C-q" C-S-down
- ;; "\M-[\C-fs" C-S-left
- ;; "\M-[\C-ft" C-S-right
- ;;
- ;; "\M-[\C-fw" C-S-home
- ;; "\M-[\C-b\C-o" S-tab
- ;; "\M-[\C-f\M-\C-r" C-S-insert
- ;; "\M-[\C-fu" C-S-end
- ;; "\M-[\C-f\M-\C-s" C-S-delete
- ;; "\M-[\C-f\M-\C-d" C-S-prior
- ;; "\M-[\C-fv" C-S-next
- ;;
- ;; "\M-[\C-f^" C-S-f1
- ;; "\M-[\C-f_" C-S-f2
- ;; "\M-[\C-f`" C-S-f3
- ;; "\M-[\C-fa" C-S-f4
- ;; "\M-[\C-fb" C-S-f5
- ;; "\M-[\C-fc" C-S-f6
- ;; "\M-[\C-fd" C-S-f7
- ;; "\M-[\C-fe" C-S-f8
- ;; "\M-[\C-ff" C-S-f9
- ;; "\M-[\C-fg" C-S-f10
)
(t
(global-set-key (vcursor-cs-binding "up") #'vcursor-previous-line)
@@ -456,11 +422,12 @@ on loading vcursor and from the customize package."
(global-set-key (vcursor-cs-binding "f10") #'vcursor-execute-command)
)))
+;; TODO: Get rid of references to "oemacs", which was an ancient
+;; MS-DOS compatible release of Emacs 19.
(defcustom vcursor-key-bindings nil
"How to bind keys when vcursor is loaded.
-If t, guess; if `xterm', use bindings suitable for an X terminal; if
-`oemacs', use bindings which work on a PC with Oemacs. If nil, don't
-define any key bindings.
+If t or `xterm', use the default bindings; if `oemacs', use
+alternative key bindings. If nil, don't define any key bindings.
Default is nil."
:type '(choice (const t) (const nil) (const xterm) (const oemacs))
@@ -788,9 +755,9 @@ out how much to copy."
(vcursor-check)
(with-current-buffer (overlay-buffer vcursor-overlay)
- (let ((start (goto-char (overlay-start vcursor-overlay))))
- (- (progn (apply func args) (point)) start)))
- )
+ (save-excursion
+ (let ((start (goto-char (overlay-start vcursor-overlay))))
+ (- (progn (apply func args) (point)) start)))))
;; Make sure the virtual cursor is active. Unless arg is non-nil,
;; report an error if it is not.
@@ -854,9 +821,7 @@ Arguments N and optional ALL-FRAMES are the same as with `other-window'.
ALL-FRAMES is also used to decide whether to split the window."
(interactive "p")
- (if (if (fboundp 'oemacs-version)
- (one-window-p nil)
- (one-window-p nil all-frames))
+ (if (one-window-p nil all-frames)
(display-buffer (current-buffer) t))
(save-excursion
(save-window-excursion
diff --git a/lisp/version.el b/lisp/version.el
index fa755c78676..7e360209d85 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -53,6 +53,8 @@ developing Emacs.")
(defvar ns-version-string)
(defvar cairo-version-string)
+(declare-function haiku-get-version-string "haikufns.c")
+
(defun emacs-version (&optional here)
"Display the version of Emacs that is running in this session.
With a prefix argument, insert the Emacs version string at point
@@ -76,6 +78,8 @@ to the system configuration; look at `system-configuration' instead."
((featurep 'x-toolkit) ", X toolkit")
((featurep 'ns)
(format ", NS %s" ns-version-string))
+ ((featurep 'haiku)
+ (format ", Haiku %s" (haiku-get-version-string)))
(t ""))
(if (featurep 'cairo)
(format ", cairo version %s" cairo-version-string)
diff --git a/lisp/view.el b/lisp/view.el
index a90a7631f04..287112f2d44 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -1,7 +1,6 @@
;;; view.el --- peruse file or buffer without editing -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
@@ -26,9 +25,11 @@
;; This package provides the `view' minor mode documented in the Emacs
;; user's manual.
+;;
;; View mode entry and exit is done through the functions `view-mode-enter'
;; and `view-mode-exit'. Use these functions to enter or exit `view-mode' from
;; Emacs Lisp programs.
+;;
;; We use both view- and View- as prefix for symbols. View- is used as
;; prefix for commands that have a key binding. view- is used for commands
;; without key binding. The purpose of this is to make it easier for a
@@ -36,8 +37,8 @@
;;; Suggested key bindings:
;;
-;; (define-key ctl-x-4-map "v" #'view-file-other-window) ; ^x4v
-;; (define-key ctl-x-5-map "v" #'view-file-other-frame) ; ^x5v
+;; (keymap-set ctl-x-4-map "v" #'view-file-other-window) ; C-x 4 v
+;; (keymap-set ctl-x-5-map "v" #'view-file-other-frame) ; C-x 5 v
;;
;; You could also bind `view-file', `view-buffer', `view-buffer-other-window' and
;; `view-buffer-other-frame' to keys.
@@ -101,8 +102,6 @@ functions that enable or disable view mode.")
(defvar-local view-old-buffer-read-only nil)
-(defvar-local view-old-Helper-return-blurb nil)
-
(defvar-local view-page-size nil
"Default number of lines to scroll by View page commands.
If nil that means use the window size.")
@@ -113,18 +112,6 @@ If nil that means use half the window size.")
(defvar-local view-last-regexp nil) ; Global is better???
-(defvar-local view-return-to-alist nil
- "What to do with used windows and where to go when finished viewing buffer.
-This is local in each buffer being viewed.
-It is added to by `view-mode-enter' when starting to view a buffer and
-subtracted from by `view-mode-exit' when finished viewing the buffer.
-
-See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of
-`view-return-to-alist'.")
-(make-obsolete-variable
- 'view-return-to-alist "this variable is no longer used." "24.1")
-(put 'view-return-to-alist 'permanent-local t)
-
(defvar-local view-exit-action nil
"If non-nil, a function called when finished viewing.
The function should take one argument (a buffer).
@@ -142,68 +129,68 @@ that use View mode automatically.")
(defvar-local view-overlay nil
"Overlay used to display where a search operation found its match.
This is local in each buffer, once it is used.")
+
-;; Define keymap inside defvar to make it easier to load changes.
;; Some redundant "less"-like key bindings below have been commented out.
-(defvar view-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "C" #'View-kill-and-leave)
- (define-key map "c" #'View-leave)
- (define-key map "Q" #'View-quit-all)
- (define-key map "E" #'View-exit-and-edit)
- ;; (define-key map "v" #'View-exit)
- (define-key map "e" #'View-exit)
- (define-key map "q" #'View-quit)
- ;; (define-key map "N" #'View-search-last-regexp-backward)
- (define-key map "p" #'View-search-last-regexp-backward)
- (define-key map "n" #'View-search-last-regexp-forward)
- ;; (define-key map "?" #'View-search-regexp-backward) ; Less does this.
- (define-key map "\\" #'View-search-regexp-backward)
- (define-key map "/" #'View-search-regexp-forward)
- (define-key map "r" #'isearch-backward)
- (define-key map "s" #'isearch-forward)
- (define-key map "m" #'point-to-register)
- (define-key map "'" #'register-to-point)
- (define-key map "x" #'exchange-point-and-mark)
- (define-key map "@" #'View-back-to-mark)
- (define-key map "." #'set-mark-command)
- (define-key map "%" #'View-goto-percent)
- ;; (define-key map "G" #'View-goto-line-last)
- (define-key map "g" #'View-goto-line)
- (define-key map "=" #'what-line)
- (define-key map "F" #'View-revert-buffer-scroll-page-forward)
- ;; (define-key map "k" #'View-scroll-line-backward)
- (define-key map "y" #'View-scroll-line-backward)
- ;; (define-key map "j" #'View-scroll-line-forward)
- (define-key map "\n" #'View-scroll-line-forward)
- (define-key map "\r" #'View-scroll-line-forward)
- (define-key map "u" #'View-scroll-half-page-backward)
- (define-key map "d" #'View-scroll-half-page-forward)
- (define-key map "z" #'View-scroll-page-forward-set-page-size)
- (define-key map "w" #'View-scroll-page-backward-set-page-size)
- ;; (define-key map "b" #'View-scroll-page-backward)
- (define-key map "\C-?" #'View-scroll-page-backward)
- ;; (define-key map "f" #'View-scroll-page-forward)
- (define-key map " " #'View-scroll-page-forward)
- (define-key map [?\S-\ ] #'View-scroll-page-backward)
- (define-key map "o" #'View-scroll-to-buffer-end)
- (define-key map ">" #'end-of-buffer)
- (define-key map "<" #'beginning-of-buffer)
- (define-key map "-" #'negative-argument)
- (define-key map "9" #'digit-argument)
- (define-key map "8" #'digit-argument)
- (define-key map "7" #'digit-argument)
- (define-key map "6" #'digit-argument)
- (define-key map "5" #'digit-argument)
- (define-key map "4" #'digit-argument)
- (define-key map "3" #'digit-argument)
- (define-key map "2" #'digit-argument)
- (define-key map "1" #'digit-argument)
- (define-key map "0" #'digit-argument)
- (define-key map "H" #'describe-mode)
- (define-key map "?" #'describe-mode) ; Maybe do as less instead? See above.
- (define-key map "h" #'describe-mode)
- map))
+(defvar-keymap view-mode-map
+ :doc "Keymap for `view-mode'."
+ "C" #'View-kill-and-leave
+ "c" #'View-leave
+ "Q" #'View-quit-all
+ "E" #'View-exit-and-edit
+ ;; "v" #'View-exit
+ "e" #'View-exit
+ "q" #'View-quit
+ ;; "N" #'View-search-last-regexp-backward
+ "p" #'View-search-last-regexp-backward
+ "n" #'View-search-last-regexp-forward
+ ;; "?" #'View-search-regexp-backward ; Less does this.
+ "\\" #'View-search-regexp-backward
+ "/" #'View-search-regexp-forward
+ "r" #'isearch-backward
+ "s" #'isearch-forward
+ "m" #'point-to-register
+ "'" #'register-to-point
+ "x" #'exchange-point-and-mark
+ "@" #'View-back-to-mark
+ "." #'set-mark-command
+ "%" #'View-goto-percent
+ ;; "G" #'View-goto-line-last
+ "g" #'View-goto-line
+ "=" #'what-line
+ "F" #'View-revert-buffer-scroll-page-forward
+ ;; "k" #'View-scroll-line-backward
+ "y" #'View-scroll-line-backward
+ ;; "j" #'View-scroll-line-forward
+ "C-j" #'View-scroll-line-forward
+ "RET" #'View-scroll-line-forward
+ "u" #'View-scroll-half-page-backward
+ "d" #'View-scroll-half-page-forward
+ "z" #'View-scroll-page-forward-set-page-size
+ "w" #'View-scroll-page-backward-set-page-size
+ ;; "b" #'View-scroll-page-backward
+ "DEL" #'View-scroll-page-backward
+ ;; "f" #'View-scroll-page-forward
+ "SPC" #'View-scroll-page-forward
+ "S-SPC" #'View-scroll-page-backward
+ "o" #'View-scroll-to-buffer-end
+ ">" #'end-of-buffer
+ "<" #'beginning-of-buffer
+ "-" #'negative-argument
+ "9" #'digit-argument
+ "8" #'digit-argument
+ "7" #'digit-argument
+ "6" #'digit-argument
+ "5" #'digit-argument
+ "4" #'digit-argument
+ "3" #'digit-argument
+ "2" #'digit-argument
+ "1" #'digit-argument
+ "0" #'digit-argument
+ "H" #'describe-mode
+ "?" #'describe-mode ; Maybe do as less instead? See above.
+ "h" #'describe-mode)
+
;;; Commands that enter or exit view mode.
@@ -454,15 +441,7 @@ Entry to view-mode runs the normal hook `view-mode-hook'."
(setq view-page-size nil
view-half-page-size nil
view-old-buffer-read-only buffer-read-only
- buffer-read-only t)
- (if (boundp 'Helper-return-blurb)
- (setq view-old-Helper-return-blurb (and (boundp 'Helper-return-blurb)
- Helper-return-blurb)
- Helper-return-blurb
- (format "continue viewing %s"
- (if (buffer-file-name)
- (file-name-nondirectory (buffer-file-name))
- (buffer-name))))))
+ buffer-read-only t))
(define-obsolete-function-alias 'view-mode-enable 'view-mode "24.4")
@@ -482,46 +461,10 @@ Entry to view-mode runs the normal hook `view-mode-hook'."
;; so that View mode stays off if read-only-mode is called.
(if (local-variable-p 'view-read-only)
(kill-local-variable 'view-read-only))
- (if (boundp 'Helper-return-blurb)
- (setq Helper-return-blurb view-old-Helper-return-blurb))
(if buffer-read-only
(setq buffer-read-only view-old-buffer-read-only)))
;;;###autoload
-(defun view-return-to-alist-update (buffer &optional item)
- "Update `view-return-to-alist' of buffer BUFFER.
-Remove from `view-return-to-alist' all entries referencing dead
-windows. Optional argument ITEM non-nil means add ITEM to
-`view-return-to-alist' after purging. For a description of items
-that can be added see the RETURN-TO-ALIST argument of the
-function `view-mode-exit'. If `view-return-to-alist' contains an
-entry for the selected window, purge that entry from
-`view-return-to-alist' before adding ITEM."
- (declare (obsolete "this function has no effect." "24.1"))
- (with-current-buffer buffer
- (when view-return-to-alist
- (let* ((list view-return-to-alist)
- entry entry-window last)
- (while list
- (setq entry (car list))
- (setq entry-window (car entry))
- (if (and (windowp entry-window)
- (or (and item (eq entry-window (selected-window)))
- (not (window-live-p entry-window))))
- ;; Remove that entry.
- (if last
- (setcdr last (cdr list))
- (setq view-return-to-alist
- (cdr view-return-to-alist)))
- ;; Leave entry alone.
- (setq last entry))
- (setq list (cdr list)))))
- ;; Add ITEM.
- (when item
- (setq view-return-to-alist
- (cons item view-return-to-alist)))))
-
-;;;###autoload
(defun view-mode-enter (&optional quit-restore exit-action)
"Enter View mode and set up exit from view mode depending on optional arguments.
Optional argument QUIT-RESTORE if non-nil must specify a valid
@@ -988,6 +931,9 @@ If TIMES is negative, search backwards."
(and (zerop times)
(looking-at ".*")))
+(defvar-local view-old-Helper-return-blurb nil)
+(make-obsolete 'view-old-Helper-return-blurb nil "29.1")
+
(provide 'view)
;;; view.el ends here
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index f353566b060..85e37ec609a 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -312,8 +312,8 @@ names."
;;;; System name and version for emacsbug.el
-(declare-function w32-version "w32-win" ())
-(declare-function w32-read-registry "w32fns" (root key name))
+(declare-function w32-version "term/w32-win" ())
+(declare-function w32-read-registry "w32fns.c" (root key name))
(defun w32--os-description ()
"Return a string describing the underlying OS and its version."
@@ -359,23 +359,6 @@ names."
;;;; Support for build process
-;; From autoload.el
-(defvar autoload-make-program)
-(defvar generated-autoload-file)
-
-(defun w32-batch-update-autoloads ()
- "Like `batch-update-autoloads', but takes the name of the autoloads file
-from the command line.
-
-This is required because some Windows build environments, such as MSYS,
-munge command-line arguments that include file names to a horrible mess
-that Emacs is unable to cope with."
- (let ((generated-autoload-file
- (expand-file-name (pop command-line-args-left)))
- ;; I can only assume the same considerations may apply here...
- (autoload-make-program (pop command-line-args-left)))
- (batch-update-autoloads)))
-
(defun w32-append-code-lines (orig extra)
"Append non-empty non-comment lines in the file EXTRA to the file ORIG.
diff --git a/lisp/wdired.el b/lisp/wdired.el
index f6d2b37904a..a5858ed190e 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -155,26 +155,30 @@ nonexistent directory will fail."
:version "26.1"
:type 'boolean)
-(defvar wdired-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-s" #'wdired-finish-edit)
- (define-key map "\C-c\C-c" #'wdired-finish-edit)
- (define-key map "\C-c\C-k" #'wdired-abort-changes)
- (define-key map "\C-c\C-[" #'wdired-abort-changes)
- (define-key map "\C-x\C-q" #'wdired-exit)
- (define-key map "\C-m" #'undefined)
- (define-key map "\C-j" #'undefined)
- (define-key map "\C-o" #'undefined)
- (define-key map [up] #'wdired-previous-line)
- (define-key map "\C-p" #'wdired-previous-line)
- (define-key map [down] #'wdired-next-line)
- (define-key map "\C-n" #'wdired-next-line)
- (define-key map [remap upcase-word] #'wdired-upcase-word)
- (define-key map [remap capitalize-word] #'wdired-capitalize-word)
- (define-key map [remap downcase-word] #'wdired-downcase-word)
- (define-key map [remap self-insert-command] #'wdired--self-insert)
- map)
- "Keymap used in `wdired-mode'.")
+(defcustom wdired-search-replace-filenames t
+ "Non-nil to search and replace in file names only."
+ :version "29.1"
+ :type 'boolean)
+
+(defvar-keymap wdired-mode-map
+ :doc "Keymap used in `wdired-mode'."
+ "C-x C-s" #'wdired-finish-edit
+ "C-c C-c" #'wdired-finish-edit
+ "C-c C-k" #'wdired-abort-changes
+ "C-c C-[" #'wdired-abort-changes
+ "C-x C-q" #'wdired-exit
+ "RET" #'undefined
+ "C-j" #'undefined
+ "C-o" #'undefined
+ "<up>" #'wdired-previous-line
+ "C-p" #'wdired-previous-line
+ "<down>" #'wdired-next-line
+ "C-n" #'wdired-next-line
+ "C-(" #'dired-hide-details-mode
+ "<remap> <upcase-word>" #'wdired-upcase-word
+ "<remap> <capitalize-word>" #'wdired-capitalize-word
+ "<remap> <downcase-word>" #'wdired-downcase-word
+ "<remap> <self-insert-command>" #'wdired--self-insert)
(easy-menu-define wdired-mode-menu wdired-mode-map
"Menu for `wdired-mode'."
@@ -218,6 +222,7 @@ symbolic link targets, and filenames permission."
(error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
(put 'wdired-mode 'mode-class 'special)
+(declare-function dired-isearch-search-filenames "dired-aux")
;;;###autoload
(defun wdired-change-to-wdired-mode ()
@@ -238,9 +243,16 @@ See `wdired-mode'."
(dired-remember-marks (point-min) (point-max)))
(setq-local wdired--old-point (point))
(wdired--set-permission-bounds)
- (setq-local query-replace-skip-read-only t)
- (add-function :after-while (local 'isearch-filter-predicate)
- #'wdired-isearch-filter-read-only)
+ (when wdired-search-replace-filenames
+ (add-function :around (local 'isearch-search-fun-function)
+ #'dired-isearch-search-filenames
+ '((isearch-message-prefix . "filename ")))
+ (setq-local replace-search-function
+ (setq-local replace-re-search-function
+ (funcall isearch-search-fun-function)))
+ ;; Original dired hook removes dired-isearch-search-filenames that
+ ;; is needed outside isearch for lazy-highlighting in query-replace.
+ (remove-hook 'isearch-mode-hook #'dired-isearch-filenames-setup t))
(use-local-map wdired-mode-map)
(force-mode-line-update)
(setq buffer-read-only nil)
@@ -320,11 +332,6 @@ or \\[wdired-abort-changes] to abort changes")))
;; Is this good enough? Assumes no extra white lines from dired.
(put-text-property (1- (point-max)) (point-max) 'read-only t)))))))
-(defun wdired-isearch-filter-read-only (beg end)
- "Skip matches that have a read-only property."
- (not (text-property-not-all (min beg end) (max beg end)
- 'read-only nil)))
-
;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
(defun wdired--preprocess-files ()
@@ -439,8 +446,13 @@ non-nil means return old filename."
(remove-text-properties
(point-min) (point-max)
'(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
- (remove-function (local 'isearch-filter-predicate)
- #'wdired-isearch-filter-read-only)
+ (when wdired-search-replace-filenames
+ (remove-function (local 'isearch-search-fun-function)
+ #'dired-isearch-search-filenames)
+ (kill-local-variable 'replace-search-function)
+ (kill-local-variable 'replace-re-search-function)
+ ;; Restore dired hook
+ (add-hook 'isearch-mode-hook #'dired-isearch-filenames-setup nil t))
(use-local-map dired-mode-map)
(force-mode-line-update)
(setq buffer-read-only t)
@@ -509,7 +521,15 @@ non-nil means return old filename."
files-renamed))))
(forward-line -1)))
(when files-renamed
- (setq errors (+ errors (wdired-do-renames files-renamed))))
+ (pcase-let ((`(,errs . ,successful-renames)
+ (wdired-do-renames files-renamed)))
+ (cl-incf errors errs)
+ ;; Some of the renames may fail -- in that case, don't mark an
+ ;; already-existing file with the same name as renamed.
+ (pcase-dolist (`(,file . _) wdired--old-marks)
+ (unless (member file successful-renames)
+ (setq wdired--old-marks
+ (assoc-delete-all file wdired--old-marks #'equal))))))
;; We have to be in wdired-mode when wdired-do-renames is executed
;; so that wdired--restore-properties runs, but we have to change
;; back to dired-mode before reverting the buffer to avoid using
@@ -554,7 +574,8 @@ non-nil means return old filename."
(errors 0)
(total (1- (length renames)))
(prep (make-progress-reporter "Renaming" 0 total))
- (overwrite (or (not wdired-confirm-overwrite) 1)))
+ (overwrite (or (not wdired-confirm-overwrite) 1))
+ (successful-renames nil))
(while (or renames
;; We've done one round through the renames, we have found
;; some residue, but we also made some progress, so maybe
@@ -605,13 +626,15 @@ non-nil means return old filename."
(wdired-create-parentdirs file-new))
(dired-rename-file file-ori file-new
overwrite))
+ (:success
+ (push file-new successful-renames))
(error
(setq errors (1+ errors))
(dired-log "Rename `%s' to `%s' failed:\n%s\n"
file-ori file-new
err)))))))))
(progress-reporter-done prep)
- errors))
+ (cons errors successful-renames)))
(defun wdired-create-parentdirs (file-new)
"Create parent directories for FILE-NEW if they don't exist."
@@ -872,21 +895,19 @@ Like original function but it skips read-only words."
;; The following code deals with changing the access bits (or
;; permissions) of the files.
-(defvar wdired-perm-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map " " #'wdired-toggle-bit)
- (define-key map "r" #'wdired-set-bit)
- (define-key map "w" #'wdired-set-bit)
- (define-key map "x" #'wdired-set-bit)
- (define-key map "-" #'wdired-set-bit)
- (define-key map "S" #'wdired-set-bit)
- (define-key map "s" #'wdired-set-bit)
- (define-key map "T" #'wdired-set-bit)
- (define-key map "t" #'wdired-set-bit)
- (define-key map "s" #'wdired-set-bit)
- (define-key map "l" #'wdired-set-bit)
- (define-key map [mouse-1] #'wdired-mouse-toggle-bit)
- map))
+(defvar-keymap wdired-perm-mode-map
+ "SPC" #'wdired-toggle-bit
+ "r" #'wdired-set-bit
+ "w" #'wdired-set-bit
+ "x" #'wdired-set-bit
+ "-" #'wdired-set-bit
+ "S" #'wdired-set-bit
+ "s" #'wdired-set-bit
+ "T" #'wdired-set-bit
+ "t" #'wdired-set-bit
+ "s" #'wdired-set-bit
+ "l" #'wdired-set-bit
+ "<mouse-1>" #'wdired-mouse-toggle-bit)
;; Put a keymap property to the permission bits of the files, and store the
;; original name and permissions as a property
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index e2c8eecf897..240f99effc2 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -295,8 +295,8 @@ It's a list containing some or all of the following values:
`whitespace-line-column' are highlighted via
faces.
Whole line is highlighted.
- It has precedence over `lines-tail' (see
- below).
+ It has precedence over `lines-tail' and
+ `lines-char' (see below).
It has effect only if `face' (see above)
is present in `whitespace-style'.
@@ -310,6 +310,15 @@ It's a list containing some or all of the following values:
and if `face' (see above) is present in
`whitespace-style'.
+ lines-char lines which have columns beyond
+ `whitespace-line-column' are highlighted via
+ putting a face on the first character that goes
+ beyond the `whitespace-line-column' column.
+ It has effect only if `lines' or
+ `lines-tail' (see above) is not present
+ in `whitespace-style' and if `face' (see
+ above) is present in `whitespace-style'.
+
newline NEWLINEs are visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
@@ -431,6 +440,7 @@ See also `whitespace-display-mappings' for documentation."
(const :tag "(Face) SPACEs and HARD SPACEs" spaces)
(const :tag "(Face) Lines" lines)
(const :tag "(Face) Lines, only overlong part" lines-tail)
+ (const :tag "(Face) Lines, only first character" lines-char)
(const :tag "(Face) NEWLINEs" newline)
(const :tag "(Face) Missing newlines at EOB"
missing-newline-at-eof)
@@ -772,7 +782,8 @@ Used when `whitespace-style' includes `big-indent'."
It must be an integer or nil. If nil, the `fill-column' variable value is
used.
-Used when `whitespace-style' includes `lines' or `lines-tail'."
+Used when `whitespace-style' includes `lines', `lines-tail' or
+`lines-char'."
:type '(choice :tag "Line Length Limit"
(integer :tag "Line Length")
(const :tag "Use fill-column" nil))
@@ -1058,6 +1069,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
trailing
lines
lines-tail
+ lines-char
newline
empty
indentation
@@ -1085,6 +1097,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
(?r . trailing)
(?l . lines)
(?L . lines-tail)
+ (?\C-l . lines-char)
(?n . newline)
(?e . empty)
(?\C-i . indentation)
@@ -1244,6 +1257,7 @@ Interactively, it accepts one of the following chars:
r toggle trailing blanks visualization
l toggle \"long lines\" visualization
L toggle \"long lines\" tail visualization
+ C-l toggle \"long lines\" one character visualization
n toggle NEWLINE visualization
e toggle empty line at bob and/or eob visualization
C-i toggle indentation SPACEs visualization (via `indent-tabs-mode')
@@ -1274,6 +1288,7 @@ The valid symbols are:
trailing toggle trailing blanks visualization
lines toggle \"long lines\" visualization
lines-tail toggle \"long lines\" tail visualization
+ lines-char toggle \"long lines\" one character visualization
newline toggle NEWLINE visualization
empty toggle empty line at bob and/or eob visualization
indentation toggle indentation SPACEs visualization
@@ -1682,37 +1697,37 @@ cleaning up these problems."
(rstart (min start end))
(rend (max start end))
;; Fall back to whitespace-style so we can run before
- ;; before the mode is active.
+ ;; the mode is active.
(style (copy-sequence
(or whitespace-active-style whitespace-style)))
(bogus-list
(mapcar
- #'(lambda (option)
- (when force
- (push (car option) style))
- (goto-char rstart)
- (let ((regexp
- (cond
- ((eq (car option) 'indentation)
- (whitespace-indentation-regexp))
- ((eq (car option) 'indentation::tab)
- (whitespace-indentation-regexp 'tab))
- ((eq (car option) 'indentation::space)
- (whitespace-indentation-regexp 'space))
- ((eq (car option) 'space-after-tab)
- (whitespace-space-after-tab-regexp))
- ((eq (car option) 'space-after-tab::tab)
- (whitespace-space-after-tab-regexp 'tab))
- ((eq (car option) 'space-after-tab::space)
- (whitespace-space-after-tab-regexp 'space))
- ((eq (car option) 'missing-newline-at-eof)
- "[^\n]\\'")
- (t
- (cdr option)))))
- (when (re-search-forward regexp rend t)
- (unless has-bogus
- (setq has-bogus (memq (car option) style)))
- t)))
+ (lambda (option)
+ (when force
+ (push (car option) style))
+ (goto-char rstart)
+ (let ((regexp
+ (cond
+ ((eq (car option) 'indentation)
+ (whitespace-indentation-regexp))
+ ((eq (car option) 'indentation::tab)
+ (whitespace-indentation-regexp 'tab))
+ ((eq (car option) 'indentation::space)
+ (whitespace-indentation-regexp 'space))
+ ((eq (car option) 'space-after-tab)
+ (whitespace-space-after-tab-regexp))
+ ((eq (car option) 'space-after-tab::tab)
+ (whitespace-space-after-tab-regexp 'tab))
+ ((eq (car option) 'space-after-tab::space)
+ (whitespace-space-after-tab-regexp 'space))
+ ((eq (car option) 'missing-newline-at-eof)
+ "[^\n]\\'")
+ (t
+ (cdr option)))))
+ (when (re-search-forward regexp rend t)
+ (unless has-bogus
+ (setq has-bogus (memq (car option) style)))
+ t)))
whitespace-report-list)))
(when (pcase report-if-bogus ('nil t) ('never nil) (_ has-bogus))
(whitespace-kill-buffer whitespace-report-buffer-name)
@@ -1770,6 +1785,7 @@ cleaning up these problems."
[] r - toggle trailing blanks visualization
[] l - toggle \"long lines\" visualization
[] L - toggle \"long lines\" tail visualization
+ [] C-l - toggle \"long lines\" one character visualization
[] n - toggle NEWLINE visualization
[] e - toggle empty line at bob and/or eob visualization
[] C-i - toggle indentation SPACEs visualization (via `indent-tabs-mode')
@@ -1892,6 +1908,7 @@ It accepts one of the following chars:
r toggle trailing blanks visualization
l toggle \"long lines\" visualization
L toggle \"long lines\" tail visualization
+ C-l toggle \"long lines\" one character visualization
n toggle NEWLINE visualization
e toggle empty line at bob and/or eob visualization
C-i toggle indentation SPACEs visualization (via `indent-tabs-mode')
@@ -2020,6 +2037,7 @@ resultant list will be returned."
(memq 'trailing whitespace-active-style)
(memq 'lines whitespace-active-style)
(memq 'lines-tail whitespace-active-style)
+ (memq 'lines-char whitespace-active-style)
(memq 'newline whitespace-active-style)
(memq 'empty whitespace-active-style)
(memq 'indentation whitespace-active-style)
@@ -2066,12 +2084,17 @@ resultant list will be returned."
;; Show trailing blanks.
`((,#'whitespace-trailing-regexp 1 whitespace-trailing t)))
,@(when (or (memq 'lines whitespace-active-style)
- (memq 'lines-tail whitespace-active-style))
+ (memq 'lines-tail whitespace-active-style)
+ (memq 'lines-char whitespace-active-style))
;; Show "long" lines.
`((,#'whitespace-lines-regexp
- ,(if (memq 'lines whitespace-active-style)
- 0 ; whole line
- 2) ; line tail
+ ,(cond
+ ;; whole line
+ ((memq 'lines whitespace-active-style) 0)
+ ;; line tail
+ ((memq 'lines-tail whitespace-active-style) 2)
+ ;; first overflowing character
+ ((memq 'lines-char whitespace-active-style) 3))
whitespace-line prepend)))
,@(when (or (memq 'space-before-tab whitespace-active-style)
(memq 'space-before-tab::tab whitespace-active-style)
@@ -2089,16 +2112,7 @@ resultant list will be returned."
,@(when (or (memq 'indentation whitespace-active-style)
(memq 'indentation::tab whitespace-active-style)
(memq 'indentation::space whitespace-active-style))
- `((,(cond
- ((memq 'indentation whitespace-active-style)
- ;; Show indentation SPACEs (indent-tabs-mode).
- (whitespace-indentation-regexp))
- ((memq 'indentation::tab whitespace-active-style)
- ;; Show indentation SPACEs (SPACEs).
- (whitespace-indentation-regexp 'tab))
- ((memq 'indentation::space whitespace-active-style)
- ;; Show indentation SPACEs (TABs).
- (whitespace-indentation-regexp 'space)))
+ `((,#'whitespace--indentation-matcher
1 whitespace-indentation t)))
,@(when (memq 'big-indent whitespace-active-style)
;; Show big indentation.
@@ -2182,7 +2196,7 @@ resultant list will be returned."
(re-search-forward
(let ((line-column (or whitespace-line-column fill-column)))
(format
- "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
+ "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(?2:\\(?3:.\\).*\\)$"
tab-width
(1- tab-width)
(/ line-column tab-width)
@@ -2333,6 +2347,26 @@ Also refontify when necessary."
(font-lock-flush ostart (overlay-end whitespace-point--used))
(delete-overlay whitespace-point--used))))))
+(defun whitespace--indentation-matcher (limit)
+ "Indentation matcher for `font-lock-keywords'.
+This matcher is a function instead of a static regular expression
+so that the next call to `font-lock-flush' picks up any changes
+to `indent-tabs-mode' and `tab-width'."
+ (re-search-forward
+ (whitespace-indentation-regexp
+ (cond
+ ((memq 'indentation whitespace-active-style) nil)
+ ((memq 'indentation::tab whitespace-active-style) 'tab)
+ ((memq 'indentation::space whitespace-active-style) 'space)))
+ limit t))
+
+(defun whitespace--variable-watcher (_symbol _newval _op buffer)
+ "Variable watcher that calls `font-lock-flush' for BUFFER."
+ (when buffer
+ (with-current-buffer buffer
+ (when whitespace-mode
+ (font-lock-flush)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>)
@@ -2445,9 +2479,16 @@ It should be added buffer-locally to `write-file-functions'."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar whitespace--watched-vars
+ '(fill-column indent-tabs-mode tab-width whitespace-line-column))
+
+(dolist (var whitespace--watched-vars)
+ (add-variable-watcher var #'whitespace--variable-watcher))
(defun whitespace-unload-function ()
"Unload the whitespace library."
+ (dolist (var whitespace--watched-vars)
+ (remove-variable-watcher var #'whitespace--variable-watcher))
(global-whitespace-mode -1)
;; be sure all local whitespace mode is turned off
(save-current-buffer
@@ -2463,5 +2504,4 @@ It should be added buffer-locally to `write-file-functions'."
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'whitespace-load-hook)
-
;;; whitespace.el ends here
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index ae2a43654e0..53626182470 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -131,16 +131,21 @@ This exists as a variable so it can be set locally in certain buffers.")
(((class grayscale color)
(background light))
:background "gray85"
+ ;; We use negative thickness of the horizontal box border line to
+ ;; avoid making lines taller when fields become visible.
+ :box (:line-width (1 . -1) :color "gray80")
:extend t)
(((class grayscale color)
(background dark))
:background "dim gray"
+ :box (:line-width (1 . -1) :color "gray46")
:extend t)
(t
:slant italic
:extend t))
"Face used for editable fields."
- :group 'widget-faces)
+ :group 'widget-faces
+ :version "28.1")
(defface widget-single-line-field '((((type tty))
:background "green3"
@@ -432,8 +437,9 @@ the :notify function can't know the new value.")
(follow-link (widget-get widget :follow-link))
(help-echo (widget-get widget :help-echo)))
(widget-put widget :button-overlay overlay)
- (if (functionp help-echo)
+ (when (functionp help-echo)
(setq help-echo 'widget-mouse-help))
+ (overlay-put overlay 'before-string #(" " 0 1 (invisible t)))
(overlay-put overlay 'button widget)
(overlay-put overlay 'keymap (widget-get widget :keymap))
(overlay-put overlay 'evaporate t)
@@ -874,6 +880,7 @@ The child is converted, using the keyword arguments ARGS."
"Make a deep copy of WIDGET."
(widget-apply (copy-sequence widget) :copy))
+;;;###autoload
(defun widget-convert (type &rest args)
"Convert TYPE to a widget without inserting it in the buffer.
The optional ARGS are additional keyword arguments."
@@ -2963,7 +2970,8 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
"A widget which groups other widgets inside."
:convert-widget 'widget-types-convert-widget
:copy 'widget-types-copy
- :format ":\n%v"
+ :format (concat (propertize ":" 'display "")
+ "\n%v")
:value-create 'widget-group-value-create
:value-get 'widget-editable-list-value-get
:default-get 'widget-group-default-get
@@ -3320,7 +3328,7 @@ It reads a file name from an editable text field."
;;; (file (file-name-nondirectory value))
;;; (menu-tag (widget-apply widget :menu-tag-get))
;;; (must-match (widget-get widget :must-match))
-;;; (answer (read-file-name (concat menu-tag " (default " value "): ")
+;;; (answer (read-file-name (format-prompt menu-tag value)
;;; dir nil must-match file)))
;;; (widget-value-set widget (abbreviate-file-name answer))
;;; (widget-setup)
@@ -3453,7 +3461,7 @@ It reads a directory name from an editable text field."
map))
(define-widget 'key-sequence 'restricted-sexp
- "A key sequence."
+ "A key sequence. This is obsolete; use the `key' type instead."
:prompt-value 'widget-field-prompt-value
:prompt-internal 'widget-symbol-prompt-internal
; :prompt-match 'fboundp ;; What was this good for? KFS
@@ -3519,6 +3527,31 @@ It reads a directory name from an editable text field."
value))
+(defvar widget-key-prompt-value-history nil
+ "History of input to `widget-key-prompt-value'.")
+
+(define-widget 'key 'editable-field
+ "A key sequence."
+ :prompt-value 'widget-field-prompt-value
+ :match #'widget-key-valid-p
+ :format "%{%t%}: %v"
+ :validate 'widget-key-validate
+ :keymap widget-key-sequence-map
+ :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value"
+ :tag "Key")
+
+(defun widget-key-valid-p (_widget value)
+ "Non-nil if VALUE is a valid value for the key widget WIDGET."
+ (key-valid-p value))
+
+(defun widget-key-validate (widget)
+ (unless (and (stringp (widget-value widget))
+ (key-valid-p (widget-value widget)))
+ (widget-put widget :error (format "Invalid key: %S"
+ (widget-value widget)))
+ widget))
+
+
(define-widget 'sexp 'editable-field
"An arbitrary Lisp expression."
:tag "Lisp expression"
diff --git a/lisp/widget.el b/lisp/widget.el
index 34885f7d1f0..e6a856b2927 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -44,7 +44,7 @@
;; (list 'or (list 'boundp (list 'car 'keywords))
;; (list 'set (list 'car 'keywords) (list 'car 'keywords)))
;; (list 'setq 'keywords (list 'cdr 'keywords)))))
- (declare (obsolete nil "27.1"))
+ (declare (obsolete nil "27.1") (indent defun))
nil)
;;(define-widget-keywords :documentation-indent
@@ -83,7 +83,7 @@ create identical widgets:
* (apply #\\='widget-create CLASS ARGS)
The third argument DOC is a documentation string for the widget."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
;;
(unless (or (null doc) (stringp doc))
(error "Widget documentation must be nil or a string"))
@@ -91,7 +91,6 @@ The third argument DOC is a documentation string for the widget."
(put name 'widget-documentation (purecopy doc))
name)
-;; This is used by external widget code (in W3, at least).
(define-obsolete-function-alias 'widget-plist-member #'plist-member "26.1")
(provide 'widget)
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 6c239dcd1ba..958a9585dc3 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -448,6 +448,7 @@ unless `windmove-create-window' is non-nil and a new window is created."
(defvar windmove-mode-map (make-sparse-keymap)
"Map used by `windmove-install-defaults'.")
+;;;###autoload
(define-minor-mode windmove-mode
"Global minor mode for default windmove commands."
:keymap windmove-mode-map
@@ -643,7 +644,7 @@ Default value of MODIFIERS is `shift-meta'."
(defun windmove-delete-in-direction (dir &optional arg)
"Delete the window at direction DIR.
If prefix ARG is `\\[universal-argument]', also kill the buffer in that window.
-With `M-0' prefix, delete the selected window and
+With \\`M-0' prefix, delete the selected window and
select the window at direction DIR.
When `windmove-wrap-around' is non-nil, takes the window
from the opposite side of the frame."
@@ -700,7 +701,7 @@ where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or
a single modifier.
If PREFIX is `none', no prefix is used. If MODIFIERS is `none',
the keybindings are directly bound to the arrow keys.
-Default value of PREFIX is `C-x' and MODIFIERS is `shift'."
+Default value of PREFIX is \\`C-x' and MODIFIERS is `shift'."
(interactive)
(unless prefix (setq prefix '(?\C-x)))
(when (eq prefix 'none) (setq prefix nil))
diff --git a/lisp/window.el b/lisp/window.el
index a47a1216d10..4d88ffa9039 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -108,11 +108,14 @@ Return the buffer."
;; Return the buffer.
buffer)))
+;; Defined in help.el.
+(defvar resize-temp-buffer-window-inhibit)
+
(defun temp-buffer-window-show (buffer &optional action)
"Show temporary buffer BUFFER in a window.
Return the window showing BUFFER. Pass ACTION as action argument
to `display-buffer'."
- (let (window frame)
+ (let (resize-temp-buffer-window-inhibit window)
(with-current-buffer buffer
(set-buffer-modified-p nil)
(setq buffer-read-only t)
@@ -130,9 +133,9 @@ to `display-buffer'."
t
window-combination-limit)))
(setq window (display-buffer buffer action)))
- (setq frame (window-frame window))
- (unless (eq frame (selected-frame))
- (raise-frame frame))
+ ;; We used to raise the window's frame here. Do not do that
+ ;; since it would override an `inhibit-switch-frame' entry
+ ;; specified for the action alist used by `display-buffer'.
(setq minibuffer-scroll-window window)
(set-window-hscroll window 0)
(with-selected-window window
@@ -448,7 +451,7 @@ window to a height less than the one specified here, an
application should instead call `window-resize' with a non-nil
IGNORE argument. In order to have `split-window' make a window
shorter, explicitly specify the SIZE argument of that function."
- :type 'integer
+ :type 'natnum
:version "24.1"
:group 'windows)
@@ -480,7 +483,7 @@ window to a width less than the one specified here, an
application should instead call `window-resize' with a non-nil
IGNORE argument. In order to have `split-window' make a window
narrower, explicitly specify the SIZE argument of that function."
- :type 'integer
+ :type 'natnum
:version "24.1"
:group 'windows)
@@ -1514,21 +1517,11 @@ Emacs won't change the size of any window displaying that buffer,
unless it has no other choice (like when deleting a neighboring
window).")
-(defun window--preservable-size (window &optional horizontal)
- "Return height of WINDOW as `window-preserve-size' would preserve it.
-Optional argument HORIZONTAL non-nil means to return the width of
-WINDOW as `window-preserve-size' would preserve it."
- (if horizontal
- (window-body-width window t)
- (+ (window-body-height window t)
- (window-header-line-height window)
- (window-mode-line-height window))))
-
(defun window-preserve-size (&optional window horizontal preserve)
- "Preserve height of window WINDOW.
+ "Preserve height of specified WINDOW's body.
WINDOW must be a live window and defaults to the selected one.
-Optional argument HORIZONTAL non-nil means preserve the width of
-WINDOW.
+Optional argument HORIZONTAL non-nil means to preserve the width
+of WINDOW's body.
PRESERVE t means to preserve the current height/width of WINDOW's
body in frame and window resizing operations whenever possible.
@@ -1545,21 +1538,15 @@ WINDOW as argument also removes the respective restraint.
Other values of PRESERVE are reserved for future use."
(setq window (window-normalize-window window t))
(let* ((parameter (window-parameter window 'window-preserved-size))
- (width (nth 1 parameter))
- (height (nth 2 parameter)))
- (if horizontal
- (set-window-parameter
- window 'window-preserved-size
- (list
- (window-buffer window)
- (and preserve (window--preservable-size window t))
- height))
- (set-window-parameter
- window 'window-preserved-size
- (list
- (window-buffer window)
- width
- (and preserve (window--preservable-size window)))))))
+ (width (if horizontal
+ (and preserve (window-body-width window t))
+ (nth 1 parameter)))
+ (height (if horizontal
+ (nth 2 parameter)
+ (and preserve (window-body-height window t)))))
+ (set-window-parameter
+ window 'window-preserved-size
+ (list (window-buffer window) width height))))
(defun window-preserved-size (&optional window horizontal)
"Return preserved height of window WINDOW.
@@ -1567,12 +1554,9 @@ WINDOW must be a live window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means to return preserved
width of WINDOW."
(setq window (window-normalize-window window t))
- (let* ((parameter (window-parameter window 'window-preserved-size))
- (buffer (nth 0 parameter))
- (width (nth 1 parameter))
- (height (nth 2 parameter)))
- (when (eq buffer (window-buffer window))
- (if horizontal width height))))
+ (let ((parameter (window-parameter window 'window-preserved-size)))
+ (when (eq (nth 0 parameter) (window-buffer window))
+ (nth (if horizontal 1 2) parameter))))
(defun window--preserve-size (window horizontal)
"Return non-nil when the height of WINDOW shall be preserved.
@@ -1580,7 +1564,7 @@ Optional argument HORIZONTAL non-nil means to return non-nil when
the width of WINDOW shall be preserved."
(let ((size (window-preserved-size window horizontal)))
(and (numberp size)
- (= size (window--preservable-size window horizontal)))))
+ (= size (window-body-size window horizontal t)))))
(defun window-safe-min-size (&optional window horizontal pixelwise)
"Return safe minimum size of WINDOW.
@@ -2504,15 +2488,23 @@ and no others."
(defalias 'some-window 'get-window-with-predicate)
+(defcustom display-buffer-avoid-small-windows nil
+ "If non-nil, windows that have fewer lines than this are avoided.
+This is used by `get-lru-window'. The value is interpreted in units
+of the frame's canonical line height, like `window-total-height' does."
+ :type '(choice (const nil) number)
+ :version "29.1"
+ :group 'windows)
+
(defun get-lru-window (&optional all-frames dedicated not-selected no-other)
- "Return the least recently used window on frames specified by ALL-FRAMES.
+ "Return the least recently used window on frames specified by ALL-FRAMES.
Return a full-width window if possible. A minibuffer window is
never a candidate. A dedicated window is never a candidate
unless DEDICATED is non-nil, so if all windows are dedicated, the
value is nil. Avoid returning the selected window if possible.
Optional argument NOT-SELECTED non-nil means never return the
selected window. Optional argument NO-OTHER non-nil means to
-never return a window whose 'no-other-window' parameter is
+never return a window whose `no-other-window' parameter is
non-nil.
The following non-nil values of the optional argument ALL-FRAMES
@@ -2529,15 +2521,23 @@ have special meanings:
- A frame means consider all windows on that frame only.
Any other value of ALL-FRAMES means consider all windows on the
-selected frame and no others."
- (let (best-window best-time second-best-window second-best-time time)
- (dolist (window (window-list-1 nil 'nomini all-frames))
+selected frame and no others.
+
+`display-buffer-avoid-small-windows', if non-nil, is also taken into
+consideration. Windows whose height is smaller that the value of that
+variable will be avoided if larger windows are available."
+ (let ((windows (window-list-1 nil 'nomini all-frames))
+ best-window best-time second-best-window second-best-time time)
+ (dolist (window windows)
(when (and (or dedicated (not (window-dedicated-p window)))
(or (not not-selected) (not (eq window (selected-window))))
(or (not no-other)
(not (window-parameter window 'no-other-window))))
(setq time (window-use-time window))
(if (or (eq window (selected-window))
+ (and display-buffer-avoid-small-windows
+ (< (window-height window)
+ display-buffer-avoid-small-windows))
(not (window-full-width-p window)))
(when (or (not second-best-time) (< time second-best-time))
(setq second-best-time time)
@@ -2554,7 +2554,7 @@ never a candidate unless DEDICATED is non-nil, so if all windows
are dedicated, the value is nil. Optional argument NOT-SELECTED
non-nil means never return the selected window. Optional
argument NO-OTHER non-nil means to never return a window whose
-'no-other-window' parameter is non-nil.
+`no-other-window' parameter is non-nil.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -2590,7 +2590,7 @@ never a candidate unless DEDICATED is non-nil, so if all windows
are dedicated, the value is nil. Optional argument NOT-SELECTED
non-nil means never return the selected window. Optional
argument NO-OTHER non-nil means to never return a window whose
-'no-other-window' parameter is non-nil.
+`no-other-window' parameter is non-nil.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -4181,8 +4181,8 @@ another live window on that frame to serve as its selected
window. This option allows to control which window gets selected
instead.
-The possible choices are 'mru' (the default) to select the most
-recently used window on that frame, and 'pos' to choose the
+The possible choices are `mru' (the default) to select the most
+recently used window on that frame, and `pos' to choose the
window at the frame coordinates of point of the previously
selected window. If this is nil, choose the frame's first window
instead. A window with a non-nil `no-other-window' parameter is
@@ -4594,7 +4594,9 @@ as well. In that case, if this option specifies a function, it
will be called with the third argument nil.
Under certain circumstances `switch-to-prev-buffer' may ignore
-this option, for example, when there is only one buffer left."
+this option, for example, when there is only one buffer left.
+
+Also see `switch-to-prev-buffer-skip-regexp'."
:type
'(choice (const :tag "Never" nil)
(const :tag "This frame" this)
@@ -4605,16 +4607,37 @@ this option, for example, when there is only one buffer left."
:version "27.1"
:group 'windows)
+(defcustom switch-to-prev-buffer-skip-regexp nil
+ "Buffers that `switch-to-prev-buffer' and `switch-to-next-buffer' should skip.
+The value can either be a regexp or a list of regexps. Buffers whose
+names match these regexps are skipped by `switch-to-prev-buffer'
+and `switch-to-next-buffer'.
+
+Also see `switch-to-prev-buffer-skip'."
+ :type '(choice regexp
+ (repeat regexp))
+ :version "29.1"
+ :group 'windows)
+
(defun switch-to-prev-buffer-skip-p (skip window buffer &optional bury-or-kill)
"Return non-nil if `switch-to-prev-buffer' should skip BUFFER.
SKIP is a value derived from `switch-to-prev-buffer-skip', WINDOW
the window `switch-to-prev-buffer' acts upon. Optional argument
BURY-OR-KILL is passed unchanged by `switch-to-prev-buffer' and
omitted in calls from `switch-to-next-buffer'."
- (when skip
- (if (functionp skip)
- (funcall skip window buffer bury-or-kill)
- (get-buffer-window buffer skip))))
+ (or (and skip
+ (if (functionp skip)
+ (funcall skip window buffer bury-or-kill)
+ (get-buffer-window buffer skip)))
+ (and switch-to-prev-buffer-skip-regexp
+ (or (and (stringp switch-to-prev-buffer-skip-regexp)
+ (string-match-p switch-to-prev-buffer-skip-regexp
+ (buffer-name buffer)))
+ (and (consp switch-to-prev-buffer-skip-regexp)
+ (catch 'found
+ (dolist (regexp switch-to-prev-buffer-skip-regexp)
+ (when (string-match-p regexp (buffer-name buffer))
+ (throw 'tag t)))))))))
(defun switch-to-prev-buffer (&optional window bury-or-kill)
"In WINDOW switch to previous buffer.
@@ -4902,10 +4925,7 @@ the buffer `*scratch*', creating it if necessary."
(setq frame (or frame (selected-frame)))
(or (get-next-valid-buffer (nreverse (buffer-list frame))
buffer visible-ok frame)
- (get-buffer "*scratch*")
- (let ((scratch (get-buffer-create "*scratch*")))
- (set-buffer-major-mode scratch)
- scratch)))
+ (get-scratch-buffer-create)))
(defcustom frame-auto-hide-function #'iconify-frame
"Function called to automatically hide frames.
@@ -5023,7 +5043,11 @@ minibuffer window or is dedicated to its buffer."
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
and defaults to the current buffer.
-Interactively, prompt for the buffer.
+Interactively, this command will prompt for the buffer name. A
+prefix argument of 0 (zero) means that only windows in the
+current terminal's frames will be deleted. Any other prefix
+argument means that only windows in the current frame will be
+deleted.
The following non-nil values of the optional argument FRAME
have special meanings:
@@ -5060,7 +5084,21 @@ If the buffer specified by BUFFER-OR-NAME is shown in a
minibuffer window, do nothing for that window. For any window
that does not show that buffer, remove the buffer from that
window's lists of previous and next buffers."
- (interactive "bDelete windows on (buffer):\nP")
+ (interactive
+ (let ((frame (cond
+ ((and (numberp current-prefix-arg)
+ (zerop current-prefix-arg))
+ 0)
+ (current-prefix-arg t))))
+ (list (read-buffer "Delete windows on (buffer): "
+ nil nil
+ (lambda (buf)
+ (get-buffer-window
+ (if (consp buf) (car buf) buf)
+ (cond
+ ((null frame) t)
+ ((numberp frame) frame)))))
+ frame)))
(let ((buffer (window-normalize-buffer buffer-or-name))
;; Handle the "inverted" meaning of the FRAME argument wrt other
;; `window-list-1' based function.
@@ -5120,6 +5158,14 @@ all window-local buffer lists."
:version "27.1"
:group 'windows)
+(defun window--quit-restore-select-window (window)
+ "Select WINDOW after having quit another one.
+Do not select an inactive minibuffer window."
+ (when (and (window-live-p window)
+ (or (not (window-minibuffer-p window))
+ (minibuffer-window-active-p window)))
+ (select-window window)))
+
(defun quit-restore-window (&optional window bury-or-kill)
"Quit WINDOW and deal with its buffer.
WINDOW must be a live window and defaults to the selected one.
@@ -5133,7 +5179,7 @@ parameter to nil. See Info node `(elisp) Quitting Windows' for
more details.
If WINDOW's dedicated flag is t, try to delete WINDOW. If it
-equals the value 'side', restore that value when WINDOW is not
+equals the value `side', restore that value when WINDOW is not
deleted.
Optional second argument BURY-OR-KILL tells how to proceed with
@@ -5158,6 +5204,7 @@ nil means to not handle the buffer in a particular way. This
(setq window (window-normalize-window window t))
(let* ((buffer (window-buffer window))
(quit-restore (window-parameter window 'quit-restore))
+ (quit-restore-2 (nth 2 quit-restore))
(prev-buffer (catch 'prev-buffer
(dolist (buf (window-prev-buffers window))
(unless (eq (car buf) buffer)
@@ -5169,15 +5216,13 @@ nil means to not handle the buffer in a particular way. This
((and dedicated (not (eq dedicated 'side))
(window--delete window 'dedicated (eq bury-or-kill 'kill)))
;; If the previously selected window is still alive, select it.
- (when (window-live-p (nth 2 quit-restore))
- (select-window (nth 2 quit-restore))))
+ (window--quit-restore-select-window quit-restore-2))
((and (not prev-buffer)
(eq (nth 1 quit-restore) 'tab)
(eq (nth 3 quit-restore) buffer))
(tab-bar-close-tab)
;; If the previously selected window is still alive, select it.
- (when (window-live-p (nth 2 quit-restore))
- (select-window (nth 2 quit-restore))))
+ (window--quit-restore-select-window quit-restore-2))
((and (not prev-buffer)
(or (eq (nth 1 quit-restore) 'frame)
(and (eq (nth 1 quit-restore) 'window)
@@ -5189,8 +5234,7 @@ nil means to not handle the buffer in a particular way. This
;; Delete WINDOW if possible.
(window--delete window nil (eq bury-or-kill 'kill)))
;; If the previously selected window is still alive, select it.
- (when (window-live-p (nth 2 quit-restore))
- (select-window (nth 2 quit-restore))))
+ (window--quit-restore-select-window quit-restore-2))
((and (listp (setq quad (nth 1 quit-restore)))
(buffer-live-p (car quad))
(eq (nth 3 quit-restore) buffer))
@@ -5234,8 +5278,8 @@ nil means to not handle the buffer in a particular way. This
;; Reset the quit-restore parameter.
(set-window-parameter window 'quit-restore nil)
;; Select old window.
- (when (window-live-p (nth 2 quit-restore))
- (select-window (nth 2 quit-restore))))
+ ;; If the previously selected window is still alive, select it.
+ (window--quit-restore-select-window quit-restore-2))
(t
;; Show some other buffer in WINDOW and reset the quit-restore
;; parameter.
@@ -5248,8 +5292,8 @@ nil means to not handle the buffer in a particular way. This
(when (eq dedicated 'side)
(set-window-dedicated-p window 'side))
(window--delete window nil (eq bury-or-kill 'kill))
- (when (window-live-p (nth 2 quit-restore))
- (select-window (nth 2 quit-restore))))))
+ ;; If the previously selected window is still alive, select it.
+ (window--quit-restore-select-window quit-restore-2))))
;; Deal with the buffer.
(cond
@@ -5714,12 +5758,12 @@ right, if any."
;;; Balancing windows.
;; The following routine uses the recycled code from an old version of
-;; `window--resize-child-windows'. It's not very pretty, but coding it the way the
-;; new `window--resize-child-windows' code does would hardly make it any shorter or
-;; more readable (FWIW we'd need three loops - one to calculate the
-;; minimum sizes per window, one to enlarge or shrink windows until the
-;; new parent-size matches, and one where we shrink the largest/enlarge
-;; the smallest window).
+;; `window--resize-child-windows'. It's not very pretty, but coding it
+;; the way the new `window--resize-child-windows' code does would hardly
+;; make it any shorter or more readable (FWIW we'd need three loops -
+;; one to calculate the minimum sizes per window, one to enlarge or
+;; shrink windows until the new parent-size matches, and one where we
+;; shrink the largest/enlarge the smallest window).
(defun balance-windows-2 (window horizontal)
"Subroutine of `balance-windows-1'.
WINDOW must be a vertical combination (horizontal if HORIZONTAL
@@ -5730,9 +5774,10 @@ is non-nil)."
(first (window-child window))
(sub first)
(number-of-children 0)
+ (rest 0)
(parent-size (window-new-pixel window))
(total-sum parent-size)
- failed size sub-total sub-delta sub-amount rest)
+ failed size sub-total sub-delta sub-amount)
(while sub
(if (window-size-fixed-p sub horizontal)
(progn
@@ -7257,11 +7302,15 @@ Return WINDOW if BUFFER and WINDOW are live."
(inhibit-modification-hooks t))
(funcall (cdr (assq 'body-function alist)) window)))
- (let ((quit-restore (window-parameter window 'quit-restore))
- (height (cdr (assq 'window-height alist)))
- (width (cdr (assq 'window-width alist)))
- (size (cdr (assq 'window-size alist)))
- (preserve-size (cdr (assq 'preserve-size alist))))
+ (let* ((frame (window-frame window))
+ (quit-restore (window-parameter window 'quit-restore))
+ (window-height (assq 'window-height alist))
+ (height (cdr window-height))
+ (window-width (assq 'window-width alist))
+ (width (cdr window-width))
+ (window-size (assq 'window-size alist))
+ (size (cdr window-size))
+ (preserve-size (cdr (assq 'preserve-size alist))))
(cond
((or (eq type 'frame)
(and (eq (car quit-restore) 'same)
@@ -7272,29 +7321,43 @@ Return WINDOW if BUFFER and WINDOW are live."
;; Adjust size of frame if asked for. We probably should do
;; that only for a single window frame.
(cond
- ((not size))
+ ((not size)
+ (when window-size
+ (setq resize-temp-buffer-window-inhibit t)))
((consp size)
- (let ((width (car size))
- (height (cdr size))
- (frame (window-frame window)))
- (when (and (numberp width) (numberp height))
- (set-frame-height
- frame (+ (frame-height frame)
- (- height (window-total-height window))))
- (set-frame-width
- frame (+ (frame-width frame)
- (- width (window-total-width window)))))))
- ((functionp size)
- (ignore-errors (funcall size window)))))
+ ;; Modifying the parameters of a newly created frame might
+ ;; not work everywhere, but then `temp-buffer-resize-mode'
+ ;; will certainly fail in a similar fashion.
+ (if (eq (car size) 'body-chars)
+ (let ((width (+ (frame-text-width frame)
+ (* (frame-char-width frame) (cadr size))
+ (- (window-body-width window t))))
+ (height (+ (frame-text-height frame)
+ (* (frame-char-height frame) (cddr size))
+ (- (window-body-height window t)))))
+ (modify-frame-parameters
+ frame `((height . (text-pixels . ,height))
+ (width . (text-pixels . ,width)))))
+ (let ((width (- (+ (frame-width frame) (car size))
+ (window-total-width window)))
+ (height (- (+ (frame-height frame) (cdr size))
+ (window-total-height window))))
+ (modify-frame-parameters
+ frame `((height . ,height) (width . ,width)))))
+ (setq resize-temp-buffer-window-inhibit t))
+ ((functionp size)
+ (ignore-errors (funcall size window))
+ (setq resize-temp-buffer-window-inhibit t))))
((or (eq type 'window)
(and (eq (car quit-restore) 'same)
(eq (nth 1 quit-restore) 'window)))
;; A window that never showed another buffer but BUFFER ever
- ;; since it was created on an existing frame.
- ;;
- ;; Adjust width and/or height of window if asked for.
+ ;; since it was created on an existing frame. Adjust its width
+ ;; and/or height if asked for.
(cond
- ((not height))
+ ((not height)
+ (when window-height
+ (setq resize-temp-buffer-window-inhibit 'vertical)))
((numberp height)
(let* ((new-height
(if (integerp height)
@@ -7305,12 +7368,23 @@ Return WINDOW if BUFFER and WINDOW are live."
(delta (- new-height (window-total-height window))))
(when (and (window--resizable-p window delta nil 'safe)
(window-combined-p window))
- (window-resize window delta nil 'safe))))
- ((functionp height)
- (ignore-errors (funcall height window))))
+ (window-resize window delta nil 'safe)))
+ (setq resize-temp-buffer-window-inhibit 'vertical))
+ ((and (consp height) (eq (car height) 'body-lines))
+ (let* ((delta (- (* (frame-char-height frame) (cdr height))
+ (window-body-height window t))))
+ (and (window--resizable-p window delta nil 'safe nil nil nil t)
+ (window-combined-p window)
+ (window-resize window delta nil 'safe t)))
+ (setq resize-temp-buffer-window-inhibit 'vertical))
+ ((functionp height)
+ (ignore-errors (funcall height window))
+ (setq resize-temp-buffer-window-inhibit 'vertical)))
;; Adjust width of window if asked for.
(cond
- ((not width))
+ ((not width)
+ (when window-width
+ (setq resize-temp-buffer-window-inhibit 'horizontal)))
((numberp width)
(let* ((new-width
(if (integerp width)
@@ -7321,13 +7395,24 @@ Return WINDOW if BUFFER and WINDOW are live."
(delta (- new-width (window-total-width window))))
(when (and (window--resizable-p window delta t 'safe)
(window-combined-p window t))
- (window-resize window delta t 'safe))))
+ (window-resize window delta t 'safe)))
+ (setq resize-temp-buffer-window-inhibit 'horizontal))
+ ((and (consp width) (eq (car width) 'body-columns))
+ (let* ((delta (- (* (frame-char-width frame) (cdr width))
+ (window-body-width window t))))
+ (and (window--resizable-p window delta t 'safe nil nil nil t)
+ (window-combined-p window t)
+ (window-resize window delta t 'safe t)))
+ (setq resize-temp-buffer-window-inhibit 'horizontal))
((functionp width)
- (ignore-errors (funcall width window))))
+ (ignore-errors (funcall width window))
+ (setq resize-temp-buffer-window-inhibit 'horizontal)))
+
;; Preserve window size if asked for.
(when (consp preserve-size)
(window-preserve-size window t (car preserve-size))
(window-preserve-size window nil (cdr preserve-size)))))
+
;; Assign any window parameters specified.
(let ((parameters (cdr (assq 'window-parameters alist))))
(dolist (parameter parameters)
@@ -7366,6 +7451,7 @@ The actual non-nil value of this variable will be copied to the
(const display-buffer-pop-up-window)
(const display-buffer-same-window)
(const display-buffer-pop-up-frame)
+ (const display-buffer-full-frame)
(const display-buffer-in-child-frame)
(const display-buffer-below-selected)
(const display-buffer-at-bottom)
@@ -7415,9 +7501,9 @@ Its value takes effect before processing the ACTION argument of
If non-nil, this is an alist of elements (CONDITION . ACTION),
where:
- CONDITION is either a regexp matching buffer names, or a
- function that takes two arguments - a buffer name and the
- ACTION argument of `display-buffer' - and returns a boolean.
+ CONDITION is passed to `buffer-match-p', along with the buffer
+ that is to be displayed and the ACTION argument of
+ `display-buffer', to check if ACTION should be used.
ACTION is a cons cell (FUNCTIONS . ALIST), where FUNCTIONS is an
action function or a list of action functions and ALIST is an
@@ -7470,22 +7556,16 @@ all fail. It should never be set by programs or users. See
`display-buffer'.")
(put 'display-buffer-fallback-action 'risky-local-variable t)
-(defun display-buffer-assq-regexp (buffer-name alist action)
- "Retrieve ALIST entry corresponding to BUFFER-NAME.
-This returns the cdr of the alist entry ALIST if either its key
-is a string that matches BUFFER-NAME, as reported by
-`string-match-p'; or if the key is a function that returns
-non-nil when called with three arguments: the ALIST key,
-BUFFER-NAME and ACTION. ACTION should have the form of the
-action argument passed to `display-buffer'."
+(defun display-buffer-assq-regexp (buffer-or-name alist action)
+ "Retrieve ALIST entry corresponding to buffer specified by BUFFER-OR-NAME.
+This returns the cdr of the alist entry ALIST if the entry's
+key (its car) and BUFFER-OR-NAME satisfy `buffer-match-p', using
+the key as CONDITION argument of `buffer-match-p'. ACTION should
+have the form of the action argument passed to `display-buffer'."
(catch 'match
(dolist (entry alist)
- (let ((key (car entry)))
- (when (or (and (stringp key)
- (string-match-p key buffer-name))
- (and (functionp key)
- (funcall key buffer-name action)))
- (throw 'match (cdr entry)))))))
+ (when (buffer-match-p (car entry) buffer-or-name action)
+ (throw 'match (cdr entry))))))
(defvar display-buffer--same-window-action
'(display-buffer-same-window
@@ -7518,6 +7598,7 @@ to an expression containing one of these \"action\" functions:
`display-buffer-use-least-recent-window' -- Try to avoid re-using
windows that have recently been switched to.
`display-buffer-pop-up-window' -- Pop up a new window.
+ `display-buffer-full-frame' -- Delete other windows and use the full frame.
`display-buffer-below-selected' -- Use or pop up a window below
the selected one.
`display-buffer-at-bottom' -- Use or pop up a window at the
@@ -7530,7 +7611,7 @@ to an expression containing one of these \"action\" functions:
For instance:
- (setq display-buffer-alist '((\".*\" display-buffer-at-bottom)))
+ (setq display-buffer-alist \\='((\".*\" display-buffer-at-bottom)))
Buffer display can be further customized to a very high degree;
the rest of this docstring explains some of the many
@@ -7570,6 +7651,9 @@ Action alist entries are:
window from being used for display.
`inhibit-switch-frame' -- A non-nil value prevents any frame
used for showing the buffer from being raised or selected.
+ Note that a window manager may still raise a new frame and
+ give it focus, effectively overriding the value specified
+ here.
`reusable-frames' -- The value specifies the set of frames to
search for a window that already displays the buffer.
Possible values are nil (the selected frame), t (any live
@@ -7579,20 +7663,33 @@ Action alist entries are:
frame parameters to give a new frame, if one is created.
`window-height' -- The value specifies the desired height of the
window chosen and is either an integer (the total height of
- the window), a floating point number (the fraction of its
- total height with respect to the total height of the frame's
- root window) or a function to be called with one argument -
- the chosen window. The function is supposed to adjust the
- height of the window; its return value is ignored. Suitable
- functions are `shrink-window-if-larger-than-buffer' and
- `fit-window-to-buffer'.
+ the window specified in frame lines), a floating point
+ number (the fraction of its total height with respect to the
+ total height of the frame's root window), a cons cell whose
+ car is `body-lines' and whose cdr is an integer that
+ specifies the height of the window's body in frame lines, or
+ a function to be called with one argument - the chosen
+ window. That function is supposed to adjust the height of
+ the window. Suitable functions are `fit-window-to-buffer'
+ and `shrink-window-if-larger-than-buffer'.
`window-width' -- The value specifies the desired width of the
window chosen and is either an integer (the total width of
- the window), a floating point number (the fraction of its
- total width with respect to the width of the frame's root
- window) or a function to be called with one argument - the
- chosen window. The function is supposed to adjust the width
- of the window; its return value is ignored.
+ the window specified in frame lines), a floating point
+ number (the fraction of its total width with respect to the
+ width of the frame's root window), a cons cell whose car is
+ `body-columns' and whose cdr is an integer that specifies the
+ width of the window's body in frame columns, or a function to
+ be called with one argument - the chosen window. That
+ function is supposed to adjust the width of the window.
+ `window-size' -- This entry is only useful for windows appearing
+ alone on their frame and specifies the desired size of that
+ window either as a cons of integers (the total width and
+ height of the window on that frame), a cons cell whose car is
+ `body-chars' and whose cdr is a cons of integers (the desired
+ width and height of the window's body in columns and lines of
+ its frame), or a function to be called with one argument -
+ the chosen window. That function is supposed to adjust the
+ size of the frame.
`preserve-size' -- The value should be either (t . nil) to
preserve the width of the chosen window, (nil . t) to
preserve its height or (t . t) to preserve its height and
@@ -7608,9 +7705,9 @@ Action alist entries are:
to fill the window body with some contents that might depend
on dimensions of the displayed window.
-The entries `window-height', `window-width' and `preserve-size'
-are applied only when the window used for displaying the buffer
-never showed another buffer before.
+The entries `window-height', `window-width', `window-size' and
+`preserve-size' are applied only when the window used for
+displaying the buffer never showed another buffer before.
The ACTION argument can also have a non-nil and non-list value.
This means to display the buffer in a window other than the
@@ -7638,7 +7735,7 @@ specified by the ACTION argument."
;; Otherwise, use the defined actions.
(let* ((user-action
(display-buffer-assq-regexp
- (buffer-name buffer) display-buffer-alist action))
+ buffer display-buffer-alist action))
(special-action (display-buffer--special-action buffer))
;; Extra actions from the arguments to this function:
(extra-action
@@ -7735,6 +7832,23 @@ indirectly called by the latter."
(window-dedicated-p))
(window--display-buffer buffer (selected-window) 'reuse alist)))
+(defun display-buffer-full-frame (buffer alist)
+ "Display BUFFER in the current frame, taking the entire frame.
+ALIST is an association list of action symbols and values. See
+Info node `(elisp) Buffer Display Action Alists' for details of
+such alists.
+
+This is an action function for buffer display, see Info
+node `(elisp) Buffer Display Action Functions'. It should be
+called only by `display-buffer' or a function directly or
+indirectly called by the latter."
+ (when-let ((window (or (display-buffer-reuse-window buffer alist)
+ (display-buffer-same-window buffer alist)
+ (display-buffer-pop-up-window buffer alist)
+ (display-buffer-use-some-window buffer alist))))
+ (delete-other-windows window)
+ window))
+
(defun display-buffer--maybe-same-window (buffer alist)
"Conditionally display BUFFER in the selected window.
ALIST is an association list of action symbols and values. See
@@ -8531,6 +8645,14 @@ currently selected window; otherwise it will be displayed in
another window."
(pop-to-buffer buffer display-buffer--same-window-action norecord))
+(defcustom display-comint-buffer-action display-buffer--same-window-action
+ "`display-buffer' action for displaying comint buffers."
+ :type display-buffer--action-custom-type
+ :risky t
+ :version "29.1"
+ :group 'windows
+ :group 'comint)
+
(defun read-buffer-to-switch (prompt)
"Read the name of a buffer to switch to, prompting with PROMPT.
Return the name of the buffer as a string.
@@ -8541,7 +8663,7 @@ from the list of completions and default values."
(let ((rbts-completion-table (internal-complete-buffer-except)))
(minibuffer-with-setup-hook
(lambda ()
- (setq minibuffer-completion-table rbts-completion-table)
+ (setq-local minibuffer-completion-table rbts-completion-table)
;; Since rbts-completion-table is built dynamically, we
;; can't just add it to the default value of
;; icomplete-with-completion-tables, so we add it
@@ -8560,12 +8682,13 @@ If BUFFER-OR-NAME is nil, return the buffer returned by
`other-buffer'. Else, if a buffer specified by BUFFER-OR-NAME
exists, return that buffer. If no such buffer exists, create a
buffer with the name BUFFER-OR-NAME and return that buffer."
- (if buffer-or-name
- (or (get-buffer buffer-or-name)
- (let ((buffer (get-buffer-create buffer-or-name)))
- (set-buffer-major-mode buffer)
- buffer))
- (other-buffer)))
+ (pcase buffer-or-name
+ ('nil (other-buffer))
+ ("*scratch*" (get-scratch-buffer-create))
+ (_ (or (get-buffer buffer-or-name)
+ (let ((buffer (get-buffer-create buffer-or-name)))
+ (set-buffer-major-mode buffer)
+ buffer)))))
(defcustom switch-to-buffer-preserve-window-point t
"If non-nil, `switch-to-buffer' tries to preserve `window-point'.
@@ -8808,6 +8931,7 @@ to deactivate this overriding action."
(let* ((old-window (or (minibuffer-selected-window) (selected-window)))
(new-window nil)
(minibuffer-depth (minibuffer-depth))
+ (obey-display switch-to-buffer-obey-display-actions)
(clearfun (make-symbol "clear-display-buffer-overriding-action"))
(postfun (make-symbol "post-display-buffer-override-next-command"))
(action (lambda (buffer alist)
@@ -8832,6 +8956,7 @@ to deactivate this overriding action."
(funcall post-function old-window new-window)))))
(fset clearfun
(lambda ()
+ (setq switch-to-buffer-obey-display-actions obey-display)
(setcar display-buffer-overriding-action
(delq action (car display-buffer-overriding-action)))))
(fset postfun
@@ -8848,6 +8973,7 @@ to deactivate this overriding action."
(add-hook 'post-command-hook postfun)
(when echofun
(add-hook 'prefix-command-echo-keystrokes-functions echofun))
+ (setq switch-to-buffer-obey-display-actions t)
(push action (car display-buffer-overriding-action))
exitfun))
@@ -9053,10 +9179,11 @@ present. See also `fit-frame-to-buffer-sizes'."
(defcustom fit-frame-to-buffer-sizes '(nil nil nil nil)
"Size boundaries of frame for `fit-frame-to-buffer'.
-This list specifies the total maximum and minimum lines and
-maximum and minimum columns of the root window of any frame that
-shall be fit to its buffer. If any of these values is non-nil,
-it overrides the corresponding argument of `fit-frame-to-buffer'.
+This list specifies the total maximum and minimum numbers of
+lines and the maximum and minimum numbers of columns of the body
+of the root window of any frame that shall be fit to its buffer.
+Any value specified by ths variable will be overridden by the
+corresponding argument of `fit-frame-to-buffer', if non-nil.
On window systems where the menubar can wrap, fitting a frame to
its buffer may swallow the last line(s). Specifying an
@@ -9252,30 +9379,30 @@ for `fit-frame-to-buffer'."
(t parent-or-display-height))
;; The following is the maximum height that fits into the
;; top and bottom margins.
- (max (- bottom-margin top-margin outer-minus-body-height))))
+ (max (- bottom-margin top-margin outer-minus-body-height) 0)))
(min-height
(cond
((numberp min-height) (* min-height line-height))
((numberp (nth 1 sizes)) (* (nth 1 sizes) line-height))
- (t (window-min-size window nil nil t))))
+ (t (window-safe-min-size window nil t))))
(max-width
- (min
- (cond
- ((numberp max-width) (* max-width char-width))
- ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width))
- (t parent-or-display-width))
- ;; The following is the maximum width that fits into the
- ;; left and right margins.
- (max (- right-margin left-margin outer-minus-body-width))))
+ (unless (eq only 'vertically)
+ (min
+ (cond
+ ((numberp max-width) (* max-width char-width))
+ ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width))
+ (t parent-or-display-width))
+ ;; The following is the maximum width that fits into the
+ ;; left and right margins.
+ (max (- right-margin left-margin outer-minus-body-width) 0))))
(min-width
(cond
((numberp min-width) (* min-width char-width))
- ((numberp (nth 3 sizes)) (nth 3 sizes))
- (t (window-min-size window t nil t))))
+ ((numberp (nth 3 sizes)) (* (nth 3 sizes) char-width))
+ (t (window-safe-min-size window t t))))
;; Note: Currently, for a new frame the sizes of the header
;; and mode line may be estimated incorrectly
- (size
- (window-text-pixel-size window from to max-width max-height))
+ (size (window-text-pixel-size window from to max-width max-height))
(width (max (car size) min-width))
(height (max (cdr size) min-height)))
;; Don't change height or width when the window's size is fixed
@@ -9970,68 +10097,119 @@ When point is already on that position, then signal an error."
(defun scroll-up-command (&optional arg)
"Scroll text of selected window upward ARG lines; or near full screen if no ARG.
+Interactively, giving this command a numerical prefix will scroll
+up by that many lines (and down by that many lines if the number
+is negative). Without a prefix, scroll up by a full screen.
+If given a `C-u -' prefix, scroll a full page down instead.
+
If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot
scroll window further, move cursor to the bottom line.
When point is already on that position, then signal an error.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
-If ARG is the atom `-', scroll downward by nearly full screen."
+
+If ARG is the atom `-', scroll downward by nearly full screen.
+
+The command \\[set-goal-column] can be used to create a
+semipermanent goal column for this command."
(interactive "^P")
- (cond
- ((null scroll-error-top-bottom)
- (scroll-up arg))
- ((eq arg '-)
- (scroll-down-command nil))
- ((< (prefix-numeric-value arg) 0)
- (scroll-down-command (- (prefix-numeric-value arg))))
- ((eobp)
- (scroll-up arg)) ; signal error
- (t
- (condition-case nil
- (scroll-up arg)
- (end-of-buffer
- (if arg
- ;; When scrolling by ARG lines can't be done,
- ;; move by ARG lines instead.
- (forward-line arg)
- ;; When ARG is nil for full-screen scrolling,
- ;; move to the bottom of the buffer.
- (goto-char (point-max))))))))
+ (prog1
+ (cond
+ ((null scroll-error-top-bottom)
+ (scroll-up arg))
+ ((eq arg '-)
+ (scroll-down-command nil))
+ ((< (prefix-numeric-value arg) 0)
+ (scroll-down-command (- (prefix-numeric-value arg))))
+ ((eobp)
+ (scroll-up arg)) ; signal error
+ (t
+ (condition-case nil
+ (scroll-up arg)
+ (end-of-buffer
+ (if arg
+ ;; When scrolling by ARG lines can't be done,
+ ;; move by ARG lines instead.
+ (forward-line arg)
+ ;; When ARG is nil for full-screen scrolling,
+ ;; move to the bottom of the buffer.
+ (goto-char (point-max)))))))
+ (scroll-command--goto-goal-column)))
+
+(defun scroll-command--goto-goal-column ()
+ (when goal-column
+ ;; Move to the desired column.
+ (if (and line-move-visual
+ (not (or truncate-lines truncate-partial-width-windows)))
+ ;; Under line-move-visual, goal-column should be
+ ;; interpreted in units of the frame's canonical character
+ ;; width, which is exactly what vertical-motion does.
+ (vertical-motion (cons goal-column 0))
+ (line-move-to-column (truncate goal-column)))))
(put 'scroll-up-command 'scroll-command t)
(defun scroll-down-command (&optional arg)
"Scroll text of selected window down ARG lines; or near full screen if no ARG.
+Interactively, giving this command a numerical prefix will scroll
+down by that many lines (and up by that many lines if the number
+is negative). Without a prefix, scroll down by a full screen.
+If given a `C-u -' prefix, scroll a full page up instead.
+
If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot
scroll window further, move cursor to the top line.
When point is already on that position, then signal an error.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
-If ARG is the atom `-', scroll upward by nearly full screen."
+
+If ARG is the atom `-', scroll upward by nearly full screen.
+
+The command \\[set-goal-column] can be used to create a
+semipermanent goal column for this command."
(interactive "^P")
- (cond
- ((null scroll-error-top-bottom)
- (scroll-down arg))
- ((eq arg '-)
- (scroll-up-command nil))
- ((< (prefix-numeric-value arg) 0)
- (scroll-up-command (- (prefix-numeric-value arg))))
- ((bobp)
- (scroll-down arg)) ; signal error
- (t
- (condition-case nil
- (scroll-down arg)
- (beginning-of-buffer
- (if arg
- ;; When scrolling by ARG lines can't be done,
- ;; move by ARG lines instead.
- (forward-line (- arg))
- ;; When ARG is nil for full-screen scrolling,
- ;; move to the top of the buffer.
- (goto-char (point-min))))))))
+ (prog1
+ (cond
+ ((null scroll-error-top-bottom)
+ (scroll-down arg))
+ ((eq arg '-)
+ (scroll-up-command nil))
+ ((< (prefix-numeric-value arg) 0)
+ (scroll-up-command (- (prefix-numeric-value arg))))
+ ((bobp)
+ (scroll-down arg)) ; signal error
+ (t
+ (condition-case nil
+ (scroll-down arg)
+ (beginning-of-buffer
+ (if arg
+ ;; When scrolling by ARG lines can't be done,
+ ;; move by ARG lines instead.
+ (forward-line (- arg))
+ ;; When ARG is nil for full-screen scrolling,
+ ;; move to the top of the buffer.
+ (goto-char (point-min)))))))
+ (scroll-command--goto-goal-column)))
(put 'scroll-down-command 'scroll-command t)
+(defun scroll-other-window (&optional lines)
+ "Scroll next window upward LINES lines; or near full screen if no ARG.
+See `scroll-up-command' for details."
+ (interactive "P")
+ (with-selected-window (other-window-for-scrolling)
+ (funcall (or (command-remapping #'scroll-up-command)
+ #'scroll-up-command)
+ lines)))
+
+(defun scroll-other-window-down (&optional lines)
+ "Scroll next window downward LINES lines; or near full screen if no ARG.
+See `scroll-down-command' for details."
+ (interactive "P")
+ (with-selected-window (other-window-for-scrolling)
+ (funcall (or (command-remapping #'scroll-down-command)
+ #'scroll-down-command)
+ lines)))
+
;;; Scrolling commands which scroll a line instead of full screen.
(defun scroll-up-line (&optional arg)
diff --git a/lisp/winner.el b/lisp/winner.el
index e671b83880a..38ab5f51016 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -50,7 +50,7 @@
(defcustom winner-ring-size 200
"Maximum number of stored window configurations per frame."
- :type 'integer)
+ :type 'natnum)
(defcustom winner-boring-buffers '("*Completions*")
"List of buffer names whose windows `winner-undo' will not restore.
@@ -343,8 +343,8 @@ Winner mode is a global minor mode that records the changes in
the window configuration (i.e. how the frames are partitioned
into windows) so that the changes can be \"undone\" using the
command `winner-undo'. By default this one is bound to the key
-sequence `C-c <left>'. If you change your mind (while undoing),
-you can press `C-c <right>' (calling `winner-redo')."
+sequence \\`C-c <left>'. If you change your mind (while undoing),
+you can press \\`C-c <right>' (calling `winner-redo')."
:global t
(if winner-mode
(progn
diff --git a/lisp/woman.el b/lisp/woman.el
index 2e0d9a9090d..c74faa8af48 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -841,10 +841,12 @@ Only useful when run on a graphic display such as X or MS-Windows."
:tag "WoMan Formatting"
:group 'woman)
-(defcustom woman-fill-column 65
- "Right margin for formatted text -- default is 65."
- :type 'integer
- :group 'woman-formatting)
+;; This could probably be 80 to match 'Man-width'.
+(defcustom woman-fill-column 70
+ "Right margin for formatted text -- default is 70."
+ :type 'natnum
+ :group 'woman-formatting
+ :version "29.1")
(defcustom woman-fill-frame nil
;; Based loosely on a suggestion by Theodore Jump:
@@ -1151,7 +1153,7 @@ updated (e.g. to re-interpret the current directory).
Used non-interactively, arguments are optional: if given then TOPIC
should be a topic string and non-nil RE-CACHE forces re-caching."
(interactive (list nil current-prefix-arg))
- ;; The following test is for non-interactive calls via gnudoit etc.
+ ;; The following test is for non-interactive calls via emacsclient, etc.
(if (or (not (stringp topic)) (string-match-p "\\S " topic))
(let ((file-name (woman-file-name topic re-cache)))
(if file-name
@@ -1813,8 +1815,7 @@ Argument EVENT is the invoking mouse event."
"--"
["Describe (Wo)Man Mode" describe-mode t]
["Mini Help" woman-mini-help t]
- ,@(if (fboundp 'customize-group)
- '(["Customize..." (customize-group 'woman) t]))
+ ["Customize..." (customize-group 'woman) t]
"--"
("Advanced"
["View Source" (view-file woman-last-file-name) woman-last-file-name]
@@ -2280,9 +2281,9 @@ Currently set only from \\='\\\" t in the first line of the source file.")
(replace-match woman-unpadded-space-string t t))
;; Discard optional hyphen \%; concealed newlines \<newline>;
- ;; point-size change function \sN,\s+N, \s-N:
+ ;; kerning \/, \,; point-size change function \sN,\s+N, \s-N:
(goto-char from)
- (while (re-search-forward "\\\\\\([%\n]\\|s[-+]?[0-9]+\\)" nil t)
+ (while (re-search-forward "\\\\\\([%\n/,]\\|s[-+]?[0-9]+\\)" nil t)
(woman-delete-match 0))
;; BEWARE: THIS SHOULD PROBABLY ALL BE DONE MUCH LATER!!!!!
@@ -4579,6 +4580,8 @@ logging the message."
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))
+(put 'woman-bookmark-jump 'bookmark-handler-type "WoMan")
+
;; Obsolete.
(defvar woman-version "0.551 (beta)" "WoMan version information.")
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 559679131bd..92899e7a0c6 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -24,8 +24,9 @@
;;; Commentary:
-;; This file provides the drop part only. Currently supported protocols
-;; are XDND, Motif and the old KDE 1.x protocol.
+;; This file provides the receiving side of the XDND and Motif
+;; protocols, and both the receiving and initiating ends of the old
+;; KDE (OffiX) and new OffiX protocols.
;;; Code:
@@ -35,25 +36,26 @@
(defcustom x-dnd-test-function #'x-dnd-default-test-function
"The function drag and drop uses to determine if to accept or reject a drop.
The function takes three arguments, WINDOW, ACTION and TYPES.
-WINDOW is where the mouse is when the function is called. WINDOW may be a
-frame if the mouse isn't over a real window (i.e. menu bar, tool bar or
-scroll bar). ACTION is the suggested action from the drag and drop source,
-one of the symbols move, copy, link or ask. TYPES is a list of available
-types for the drop.
-
-The function shall return nil to reject the drop or a cons with two values,
-the wanted action as car and the wanted type as cdr. The wanted action
-can be copy, move, link, ask or private.
+WINDOW is where the mouse is when the function is called. WINDOW
+may be a frame if the mouse isn't over a real window (i.e. menu
+bar, tool bar or scroll bar). ACTION is the suggested action
+from the drag and drop source, one of the symbols move, copy,
+link or ask. TYPES is a vector of available types for the drop.
+
+Each element of TYPE should either be a string (containing the
+name of the type's X atom), or a symbol, whose name will be used.
+
+The function shall return nil to reject the drop or a cons with
+two values, the wanted action as car and the wanted type as cdr.
+The wanted action can be copy, move, link, ask or private.
+
The default value for this variable is `x-dnd-default-test-function'."
:version "22.1"
:type 'symbol
:group 'x)
-
-
(defcustom x-dnd-types-alist
- `(
- (,(purecopy "text/uri-list") . x-dnd-handle-uri-list)
+ `((,(purecopy "text/uri-list") . x-dnd-handle-uri-list)
(,(purecopy "text/x-moz-url") . x-dnd-handle-moz-url)
(,(purecopy "_NETSCAPE_URL") . x-dnd-handle-uri-list)
(,(purecopy "FILE_NAME") . x-dnd-handle-file-name)
@@ -65,7 +67,9 @@ The default value for this variable is `x-dnd-default-test-function'."
(,(purecopy "COMPOUND_TEXT") . x-dnd-insert-ctext)
(,(purecopy "STRING") . dnd-insert-text)
(,(purecopy "TEXT") . dnd-insert-text)
- )
+ (,(purecopy "DndTypeFile") . x-dnd-handle-offix-file)
+ (,(purecopy "DndTypeFiles") . x-dnd-handle-offix-files)
+ (,(purecopy "DndTypeText") . dnd-insert-text))
"Which function to call to handle a drop of that type.
If the type for the drop is not present, or the function is nil,
the drop is rejected. The function takes three arguments, WINDOW, ACTION
@@ -80,28 +84,82 @@ if drop is successful, nil if not."
(defcustom x-dnd-known-types
(mapcar 'purecopy
- '("text/uri-list"
- "text/x-moz-url"
- "_NETSCAPE_URL"
- "FILE_NAME"
- "UTF8_STRING"
- "text/plain;charset=UTF-8"
- "text/plain;charset=utf-8"
- "text/unicode"
- "text/plain"
- "COMPOUND_TEXT"
- "STRING"
- "TEXT"
- ))
+ '("XdndDirectSave0"
+ "text/uri-list"
+ "text/x-moz-url"
+ "_NETSCAPE_URL"
+ "FILE_NAME"
+ "UTF8_STRING"
+ "text/plain;charset=UTF-8"
+ "text/plain;charset=utf-8"
+ "text/unicode"
+ "text/plain"
+ "COMPOUND_TEXT"
+ "STRING"
+ "TEXT"
+ "DndTypeFile"
+ "DndTypeText"))
"The types accepted by default for dropped data.
The types are chosen in the order they appear in the list."
:version "22.1"
:type '(repeat string)
- :group 'x
-)
+ :group 'x)
+
+(defcustom x-dnd-use-offix-drop 'files
+ "If non-nil, use the OffiX protocol to drop files and text.
+This allows dropping (via `dired-mouse-drag-files' or
+`mouse-drag-and-drop-region-cross-program') on some old Java
+applets and old KDE programs. Turning this off allows dropping
+only text on some other programs such as xterm and urxvt.
+
+If the symbol `files', use the OffiX protocol when dropping
+files, and the fallback drop method (which is used with programs
+like xterm) for text."
+ :version "29.1"
+ :type '(choice (const :tag "Don't use the OffiX protocol for drag-and-drop" nil)
+ (const :tag "Only use the OffiX protocol to drop files" files)
+ (const :tag "Use the OffiX protocol for both files and text" t))
+ :group 'x)
+
+(defcustom x-dnd-direct-save-function #'x-dnd-save-direct
+ "Function called when a file is dropped that Emacs must save.
+It is called with two arguments: the first is either nil or t,
+and the second is a string.
+
+If the first argument is t, the second argument is the name the
+dropped file should be saved under. The function should return a
+complete file name describing where the file should be saved.
+
+It can also return nil, which means to cancel the drop.
+
+If the first argument is nil, the second is the name of the file
+that was dropped."
+ :version "29.1"
+ :type '(choice (const :tag "Prompt for name before saving"
+ x-dnd-save-direct)
+ (const :tag "Save and open immediately without prompting"
+ x-dnd-save-direct-immediately)
+ (function :tag "Other function"))
+ :group 'x)
+
+(defcustom x-dnd-copy-types '("chromium/x-renderer-taint")
+ "List of data types offered by programs that don't support `private'.
+Some programs (such as Chromium) do not support
+`XdndActionPrivate'. The default `x-dnd-test-function' will
+always return `copy' instead, for programs offering one of the
+data types in this list."
+ :version "29.1"
+ :type '(repeat string)
+ :group 'x)
;; Internal variables
+(defvar x-dnd-debug-errors nil
+ "Whether or not to signal protocol errors during drag-and-drop.
+This is useful for debugging errors in the DND code, but makes
+drag-and-drop much slower over network connections with high
+latency.")
+
(defvar x-dnd-current-state nil
"The current state for a drop.
This is an alist with one entry for each display. The value for each display
@@ -115,21 +173,38 @@ the type we want for the drop,
the action we want for the drop,
any protocol specific data.")
+(declare-function x-get-selection-internal "xselect.c"
+ (selection-symbol target-type &optional time-stamp terminal))
+(declare-function x-display-set-last-user-time "xfns.c")
+
+(defconst x-dnd-xdnd-to-action
+ '(("XdndActionPrivate" . private)
+ ("XdndActionCopy" . copy)
+ ("XdndActionMove" . move)
+ ("XdndActionLink" . link)
+ ("XdndActionAsk" . ask)
+ ("XdndActionDirectSave" . direct-save))
+ "Mapping from XDND action types to Lisp symbols.")
+
(defvar x-dnd-empty-state [nil nil nil nil nil nil nil])
(declare-function x-register-dnd-atom "xselect.c")
+(defvar x-fast-protocol-requests)
+
(defun x-dnd-init-frame (&optional frame)
"Setup drag and drop for FRAME (i.e. create appropriate properties)."
(when (eq 'x (window-system frame))
- (x-register-dnd-atom "DndProtocol" frame)
- (x-register-dnd-atom "_MOTIF_DRAG_AND_DROP_MESSAGE" frame)
- (x-register-dnd-atom "XdndEnter" frame)
- (x-register-dnd-atom "XdndPosition" frame)
- (x-register-dnd-atom "XdndLeave" frame)
- (x-register-dnd-atom "XdndDrop" frame)
- (x-dnd-init-xdnd-for-frame frame)
- (x-dnd-init-motif-for-frame frame)))
+ (let ((x-fast-protocol-requests (not x-dnd-debug-errors)))
+ (x-register-dnd-atom "DndProtocol" frame)
+ (x-register-dnd-atom "_MOTIF_DRAG_AND_DROP_MESSAGE" frame)
+ (x-register-dnd-atom "XdndEnter" frame)
+ (x-register-dnd-atom "XdndPosition" frame)
+ (x-register-dnd-atom "XdndLeave" frame)
+ (x-register-dnd-atom "XdndDrop" frame)
+ (x-register-dnd-atom "_DND_PROTOCOL" frame)
+ (x-dnd-init-xdnd-for-frame frame)
+ (x-dnd-init-motif-for-frame frame))))
(defun x-dnd-get-state-cons-for-frame (frame-or-window)
"Return the entry in `x-dnd-current-state' for a frame or window."
@@ -147,14 +222,22 @@ any protocol specific data.")
(defun x-dnd-default-test-function (_window _action types)
"The default test function for drag and drop.
-WINDOW is where the mouse is when this function is called. It may be
-a frame if the mouse is over the menu bar, scroll bar or tool bar.
-ACTION is the suggested action from the source, and TYPES are the
-types the drop data can have. This function only accepts drops with
-types in `x-dnd-known-types'. It always returns the action private."
+WINDOW is where the mouse is when this function is called. It
+may be a frame if the mouse is over the menu bar, scroll bar or
+tool bar. ACTION is the suggested action from the source, and
+TYPES are the types the drop data can have. This function only
+accepts drops with types in `x-dnd-known-types'. It always
+returns the action `private', unless `types' contains a value
+inside `x-dnd-copy-types'."
(let ((type (x-dnd-choose-type types)))
- (when type (cons 'private type))))
-
+ (when type (let ((list x-dnd-copy-types))
+ (catch 'out
+ (while t
+ (if (not list)
+ (throw 'out (cons 'private type))
+ (if (x-dnd-find-type (car list) types)
+ (throw 'out (cons 'copy type))
+ (setq list (cdr list))))))))))
(defun x-dnd-current-type (frame-or-window)
"Return the type we want the DND data to be in for the current drop.
@@ -167,29 +250,49 @@ FRAME-OR-WINDOW is the frame or window that the mouse is over."
(setcdr (x-dnd-get-state-cons-for-frame frame-or-window)
(copy-sequence x-dnd-empty-state)))
-(defun x-dnd-maybe-call-test-function (window action)
+(defun x-dnd-find-type (target types)
+ "Find the type TARGET in an array of types TYPES.
+TARGET must be a string, but TYPES can contain either symbols or
+strings."
+ (catch 'done
+ (dotimes (i (length types))
+ (let* ((type (aref types i))
+ (typename (if (symbolp type)
+ (symbol-name type) type)))
+ (when (equal target typename)
+ (throw 'done t))))
+ nil))
+
+(defun x-dnd-maybe-call-test-function (window action &optional xdnd)
"Call `x-dnd-test-function' if something has changed.
WINDOW is the window the mouse is over. ACTION is the suggested
action from the source. If nothing has changed, return the last
-action and type we got from `x-dnd-test-function'."
+action and type we got from `x-dnd-test-function'.
+
+XDND means the XDND protocol is being used."
(let ((buffer (when (window-live-p window)
(window-buffer window)))
(current-state (x-dnd-get-state-for-frame window)))
- (unless (and (equal buffer (aref current-state 0))
- (equal window (aref current-state 1))
- (equal action (aref current-state 3)))
- (save-current-buffer
- (when buffer (set-buffer buffer))
- (let* ((action-type (funcall x-dnd-test-function
- window
- action
- (aref current-state 2)))
- (handler (cdr (assoc (cdr action-type) x-dnd-types-alist))))
- ;; Ignore action-type if we have no handler.
- (setq current-state
- (x-dnd-save-state window
- action
- (when handler action-type)))))))
+ (if (and xdnd (x-dnd-find-type "XdndDirectSave0"
+ (aref current-state 2)))
+ (setq current-state
+ (x-dnd-save-state window 'direct-save
+ '(direct-save . "XdndDirectSave0")))
+ (unless (and (equal buffer (aref current-state 0))
+ (equal window (aref current-state 1))
+ (equal action (aref current-state 3)))
+ (save-current-buffer
+ (when buffer (set-buffer buffer))
+ (let* ((action-type (funcall x-dnd-test-function
+ window
+ action
+ (aref current-state 2)))
+ (handler (cdr (assoc (cdr action-type) x-dnd-types-alist))))
+ ;; Ignore action-type if we have no handler.
+ (setq current-state
+ (x-dnd-save-state window
+ action
+ (when handler action-type))))))))
(let ((current-state (x-dnd-get-state-for-frame window)))
(cons (aref current-state 5)
(aref current-state 4))))
@@ -322,7 +425,10 @@ nil if not."
;; If dropping in an ordinary window which we could use,
;; let dnd-open-file-other-window specify what to do.
(progn
- (when (not mouse-yank-at-point)
+ (when (and (not mouse-yank-at-point)
+ ;; If dropping on top of the mode line, insert
+ ;; the text at point instead.
+ (posn-point (event-start event)))
(goto-char (posn-point (event-start event))))
(funcall handler window action data))
;; If we can't display the file here,
@@ -336,51 +442,152 @@ nil if not."
Currently XDND, Motif and old KDE 1.x protocols are recognized."
(interactive "e")
(let* ((client-message (car (cdr (cdr event))))
- (window (posn-window (event-start event)))
- (message-atom (aref client-message 0))
- (frame (aref client-message 1))
- (format (aref client-message 2))
- (data (aref client-message 3)))
-
- (cond ((equal "DndProtocol" message-atom) ; Old KDE 1.x.
- (x-dnd-handle-old-kde event frame window message-atom format data))
-
- ((equal "_MOTIF_DRAG_AND_DROP_MESSAGE" message-atom) ; Motif
- (x-dnd-handle-motif event frame window message-atom format data))
-
- ((and (> (length message-atom) 4) ; XDND protocol.
- (equal "Xdnd" (substring message-atom 0 4)))
- (x-dnd-handle-xdnd event frame window message-atom format data)))))
+ (x-fast-protocol-requests (not x-dnd-debug-errors))
+ (window (posn-window (event-start event))))
+ (if (eq (and (consp client-message)
+ (car client-message))
+ 'XdndSelection)
+ ;; This is an internal Emacs message caused by something being
+ ;; dropped on top of a frame.
+ (progn
+ (let ((action (cdr (assoc (symbol-name (cadr client-message))
+ x-dnd-xdnd-to-action)))
+ (targets (cddr client-message))
+ (local-value (nth 2 client-message)))
+ (when (windowp window)
+ (select-window window))
+ (x-dnd-save-state window nil nil
+ (apply #'vector targets))
+ (x-dnd-maybe-call-test-function window action)
+ (unwind-protect
+ (x-dnd-drop-data event (if (framep window) window
+ (window-frame window))
+ window
+ (x-get-local-selection
+ local-value
+ (intern (x-dnd-current-type window)))
+ (x-dnd-current-type window))
+ (x-dnd-forget-drop window))))
+ (let ((message-atom (aref client-message 0))
+ (frame (aref client-message 1))
+ (format (aref client-message 2))
+ (data (aref client-message 3)))
+ (cond ((equal "DndProtocol" message-atom) ; Old KDE 1.x.
+ (x-dnd-handle-old-kde event frame window message-atom format data))
+ ((equal "_DND_PROTOCOL" message-atom) ; OffiX protocol.
+ (x-dnd-handle-offix event frame window message-atom format data))
+ ((equal "_MOTIF_DRAG_AND_DROP_MESSAGE" message-atom) ; Motif
+ (x-dnd-handle-motif event frame window message-atom format data))
+
+ ((and (> (length message-atom) 4) ; XDND protocol.
+ (equal "Xdnd" (substring message-atom 0 4)))
+ (x-dnd-handle-xdnd event frame window message-atom format data)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Old KDE protocol. Only dropping of files.
+;;; Old KDE protocol.
(declare-function x-window-property "xfns.c"
(prop &optional frame type source delete-p vector-ret-p))
-(defun x-dnd-handle-old-kde (_event frame window _message _format _data)
- "Open the files in a KDE 1.x drop."
- (let ((values (x-window-property "DndSelection" frame nil 0 t)))
- (x-dnd-handle-uri-list window 'private
- (replace-regexp-in-string "\0$" "" values))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
+(defvar x-dnd-offix-old-kde-to-name '((-1 . DndTypeInvalid)
+ (0 . DndTypeUnknown)
+ (1 . DndTypeRawData)
+ (2 . DndTypeFile)
+ (3 . DndTypeFiles)
+ (4 . DndTypeText)
+ (5 . DndTypeDir)
+ (6 . DndTypeLink)
+ (7 . DndTypeExe)
+ (8 . DndTypeUrl))
+ "Alist of old KDE data types to their names.")
+
+(defun x-dnd-handle-old-kde (event frame window _message _format data)
+ "Handle an old KDE (OffiX) drop.
+EVENT, FRAME, WINDOW and DATA mean the same thing they do in
+`x-dnd-handle-offix.'"
+ (let ((proto (aref data 4)))
+ ;; If PROTO > 0, this is an old KDE drop emulated by a program
+ ;; supporting a newer version of the OffiX protocol, so we should
+ ;; wait for the corresponding modern event instead.
+ (when (zerop proto)
+ (let ((type (cdr (assq (aref data 0) x-dnd-offix-old-kde-to-name)))
+ (data (x-window-property "DndSelection" frame nil 0 t)))
+ ;; First save state.
+ (x-dnd-save-state window nil nil (vector type) nil)
+ ;; Now call the test function to decide what action to perform.
+ (x-dnd-maybe-call-test-function window 'private)
+ (unwind-protect
+ (when (windowp window)
+ (select-window window))
+ (x-dnd-drop-data event frame window data
+ (symbol-name type))
+ (x-dnd-forget-drop window))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; New OffiX protocol.
+
+(defvar x-dnd-offix-id-to-name '((-1 . DndTypeInvalid)
+ (0 . DndTypeUnknown)
+ (1 . DndTypeRawData)
+ (2 . DndTypeFile)
+ (3 . DndTypeFiles)
+ (4 . DndTypeText)
+ (5 . DndTypeDir)
+ (6 . DndTypeLink)
+ (7 . DndTypeExe)
+ (8 . DndTypeUrl)
+ (9 . DndTypeMime)
+ (10 . DndTypePixmap))
+ "Alist of OffiX data types to their names.")
+
+(defun x-dnd-handle-offix-file (window action string)
+ "Convert OffiX file name to a regular file name.
+Then, call `x-dnd-handle-file-name'.
+
+WINDOW and ACTION mean the same as in `x-dnd-handle-file-name'.
+STRING is the raw OffiX file name data."
+ (x-dnd-handle-file-name window action
+ (replace-regexp-in-string "\0$" "" string)))
+
+(defun x-dnd-handle-offix-files (window action string)
+ "Convert OffiX file name list to a URI list.
+Then, call `x-dnd-handle-file-name'.
+
+WINDOW and ACTION mean the same as in `x-dnd-handle-file-name'.
+STRING is the raw OffiX file name data."
+ (x-dnd-handle-file-name window action
+ ;; OffiX file name lists contain one extra
+ ;; NULL byte at the end.
+ (if (string-suffix-p "\0\0" string)
+ (substring string 0 (1- (length string)))
+ string)))
+
+(defun x-dnd-handle-offix (event frame window _message-atom _format data)
+ "Handle OffiX drop event EVENT.
+FRAME is the frame where the drop happened.
+WINDOW is the window where the drop happened.
+_MESSAGE-ATOM and _FORMAT are unused.
+DATA is the vector containing the contents of the client
+message (format 32) that caused EVENT to be generated."
+ (let ((type (cdr (assq (aref data 0) x-dnd-offix-id-to-name)))
+ (data (x-window-property "_DND_SELECTION" frame nil 0 t)))
+ ;; First save state.
+ (x-dnd-save-state window nil nil (vector type) nil)
+ ;; Now call the test function to decide what action to perform.
+ (x-dnd-maybe-call-test-function window 'private)
+ (unwind-protect
+ (when (windowp window)
+ (select-window window))
+ (x-dnd-drop-data event frame window data
+ (symbol-name type))
+ (x-dnd-forget-drop window))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; XDND protocol.
-(defconst x-dnd-xdnd-to-action
- '(("XdndActionPrivate" . private)
- ("XdndActionCopy" . copy)
- ("XdndActionMove" . move)
- ("XdndActionLink" . link)
- ("XdndActionAsk" . ask))
- "Mapping from XDND action types to Lisp symbols.")
-
(declare-function x-change-window-property "xfns.c"
- (prop value &optional frame type format outer-P))
+ (prop value &optional frame type format outer-P window-id))
(defun x-dnd-init-xdnd-for-frame (frame)
"Set the XdndAware property for FRAME to indicate that we do XDND."
@@ -389,7 +596,7 @@ Currently XDND, Motif and old KDE 1.x protocols are recognized."
frame "ATOM" 32 t))
(defun x-dnd-get-drop-width-height (frame w accept)
- "Return the width/height to be sent in a XDndStatus message.
+ "Return the width/height to be sent in a XdndStatus message.
FRAME is the frame and W is the window where the drop happened.
If ACCEPT is nil return 0 (empty rectangle),
otherwise if W is a window, return its width/height,
@@ -406,7 +613,7 @@ otherwise return the frame width/height."
0))
(defun x-dnd-get-drop-x-y (frame w)
- "Return the x/y coordinates to be sent in a XDndStatus message.
+ "Return the x/y coordinates to be sent in a XdndStatus message.
Coordinates are required to be absolute.
FRAME is the frame and W is the window where the drop happened.
If W is a window, return its absolute coordinates,
@@ -425,8 +632,6 @@ otherwise return the frame coordinates."
(declare-function x-get-atom-name "xselect.c" (value &optional frame))
(declare-function x-send-client-message "xselect.c"
(display dest from message-type format values))
-(declare-function x-get-selection-internal "xselect.c"
- (selection-symbol target-type &optional time-stamp terminal))
(defun x-dnd-version-from-flags (flags)
"Return the version byte from the 32 bit FLAGS in an XDndEnter message."
@@ -446,72 +651,111 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(version (x-dnd-version-from-flags flags))
(more-than-3 (x-dnd-more-than-3-from-flags flags))
(dnd-source (aref data 0)))
- (message "%s %s" version more-than-3)
- (if version ;; If flags is bad, version will be nil.
- (x-dnd-save-state
- window nil nil
- (if (> more-than-3 0)
- (x-window-property "XdndTypeList"
- frame "AnyPropertyType"
- dnd-source nil t)
- (vector (x-get-atom-name (aref data 2))
- (x-get-atom-name (aref data 3))
- (x-get-atom-name (aref data 4))))))))
+ (when version ;; If flags is bad, version will be nil.
+ (x-dnd-save-state
+ window nil nil
+ (if (> more-than-3 0)
+ (x-window-property "XdndTypeList"
+ frame "AnyPropertyType"
+ dnd-source nil t)
+ (vector (x-get-atom-name (aref data 2))
+ (x-get-atom-name (aref data 3))
+ (x-get-atom-name (aref data 4))))
+ version))))
((equal "XdndPosition" message)
- (let* ((action (x-get-atom-name (aref data 4)))
+ (let* ((state (x-dnd-get-state-for-frame window))
+ (version (aref state 6))
+ (action (if (< version 2) 'copy ; `copy' is the default action.
+ (x-get-atom-name (aref data 4))))
(dnd-source (aref data 0))
(action-type (x-dnd-maybe-call-test-function
window
- (cdr (assoc action x-dnd-xdnd-to-action))))
- (reply-action (car (rassoc (car action-type)
- x-dnd-xdnd-to-action)))
+ (cdr (assoc action x-dnd-xdnd-to-action)) t))
+ (reply-action (car (rassoc
+ ;; Mozilla and some other programs
+ ;; support XDS, but only if we
+ ;; reply with `copy'. We can
+ ;; recognize these broken programs
+ ;; by checking to see if
+ ;; `XdndActionDirectSave' was
+ ;; originally specified.
+ (if (and (eq (car action-type)
+ 'direct-save)
+ (not (eq action 'direct-save)))
+ 'copy
+ (car action-type))
+ x-dnd-xdnd-to-action)))
(accept ;; 1 = accept, 0 = reject
- (if (and reply-action action-type) 1 0))
+ (if (and reply-action action-type
+ ;; Only allow drops on the text area of a
+ ;; window.
+ (not (posn-area (event-start event))))
+ 1 0))
(list-to-send
(list (string-to-number
(frame-parameter frame 'outer-window-id))
- accept ;; 1 = Accept, 0 = reject.
+ ;; 1 = accept, 0 = reject. 2 = "want position
+ ;; updates even for movement inside the given
+ ;; widget bounds".
+ (+ (if dnd-indicate-insertion-point 2 0) accept)
(x-dnd-get-drop-x-y frame window)
(x-dnd-get-drop-width-height
frame window (eq accept 1))
- (or reply-action 0)
- )))
+ ;; The no-toolkit Emacs build can actually
+ ;; receive drops from programs that speak
+ ;; versions of XDND earlier than 3 (such as
+ ;; GNUstep), since the toplevel window is the
+ ;; innermost window.
+ (if (>= version 2)
+ (or reply-action 0)
+ 0))))
(x-send-client-message
frame dnd-source frame "XdndStatus" 32 list-to-send)
- ))
+ (dnd-handle-movement (event-start event))))
((equal "XdndLeave" message)
(x-dnd-forget-drop window))
((equal "XdndDrop" message)
(if (windowp window) (select-window window))
- (let* ((dnd-source (aref data 0))
+ (let* ((state (x-dnd-get-state-for-frame frame))
+ (version (aref state 6))
+ (dnd-source (aref data 0))
(timestamp (aref data 2))
- (value (and (x-dnd-current-type window)
- (x-get-selection-internal
- 'XdndSelection
- (intern (x-dnd-current-type window))
- timestamp)))
- success action)
-
- (setq action (if value
- (condition-case info
- (x-dnd-drop-data event frame window value
- (x-dnd-current-type window))
- (error
- (message "Error: %s" info)
- nil))))
-
- (setq success (if action 1 0))
-
- (x-send-client-message
- frame dnd-source frame "XdndFinished" 32
- (list (string-to-number (frame-parameter frame 'outer-window-id))
- success ;; 1 = Success, 0 = Error
- (if success "XdndActionPrivate" 0)
- ))
- (x-dnd-forget-drop window)))
+ (current-action (aref state 5))
+ (current-type (aref state 4))
+ success action value)
+ (x-display-set-last-user-time timestamp)
+ (if (and (eq current-action 'direct-save)
+ (equal current-type "XdndDirectSave0"))
+ (x-dnd-handle-xds-drop event window dnd-source version)
+ (setq value (and (x-dnd-current-type window)
+ (x-get-selection-internal
+ 'XdndSelection
+ (intern (x-dnd-current-type window))
+ timestamp)))
+ (unwind-protect
+ (setq action (if value
+ (condition-case info
+ (x-dnd-drop-data
+ event frame window value
+ (x-dnd-current-type window))
+ (error
+ (message "Error: %s" info)
+ nil))))
+ (setq success (if action 1 0))
+ (when (>= version 2)
+ (x-send-client-message
+ frame dnd-source frame "XdndFinished" 32
+ (list (string-to-number
+ (frame-parameter frame 'outer-window-id))
+ (if (>= version 5) success 0) ;; 1 = Success, 0 = Error
+ (if (or (not action) (< version 5)) 0
+ (or (car (rassoc action
+ x-dnd-xdnd-to-action))
+ 0)))))
+ (x-dnd-forget-drop window)))))
(t (error "Unknown XDND message %s %s" message data))))
@@ -562,6 +806,88 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(reverse bytes)
bytes)))
+(defun x-dnd-xm-unpack-targets-table-header (data)
+ "Decode the header of DATA, a Motif targets table.
+Return a list of the following fields with the given types:
+
+ Field name Type
+ - BYTE_ORDER BYTE
+ - PROTOCOL BYTE
+ - TARGET_LIST_COUNT CARD16
+ - TOTAL_DATA_SIZE CARD32"
+ (let* ((byte-order (aref data 0))
+ (protocol (aref data 1))
+ (target-list-count (x-dnd-get-motif-value
+ data 2 2 byte-order))
+ (total-data-size (x-dnd-get-motif-value
+ data 4 4 byte-order)))
+ (list byte-order protocol target-list-count
+ total-data-size)))
+
+(defun x-dnd-xm-read-single-rec (data i)
+ "Read a single rec from DATA, a Motif targets table.
+I is the offset into DATA to begin reading at. Return a list
+of (CONSUMED NTARGETS TARGETS), where CONSUMED is the number of
+bytes read from DATA, NTARGETS is the total number of targets
+inside the current rec, and TARGETS is a vector of atoms
+describing the selection targets in the current rec."
+ (let* ((byte-order (aref data 0))
+ (n-targets (x-dnd-get-motif-value
+ data i 2 byte-order))
+ (targets (make-vector n-targets nil))
+ (consumed 0))
+ (while (< consumed n-targets)
+ (aset targets consumed (x-dnd-get-motif-value
+ data (+ i 2 (* consumed 4))
+ 4 byte-order))
+ (setq consumed (1+ consumed)))
+ (list (+ 2 (* consumed 4)) n-targets targets)))
+
+(defun x-dnd-xm-read-targets-table (frame)
+ "Read the Motif targets table on FRAME.
+Return a vector of vectors of numbers, which are the atoms of the
+available selection targets for each index into the selection
+table."
+ (let* ((drag-window (x-window-property "_MOTIF_DRAG_WINDOW"
+ frame "WINDOW" 0 nil t))
+ (targets-data (x-window-property "_MOTIF_DRAG_TARGETS"
+ frame "_MOTIF_DRAG_TARGETS"
+ drag-window nil t))
+ (header (x-dnd-xm-unpack-targets-table-header targets-data))
+ (vec (make-vector (nth 2 header) nil))
+ (current-byte 8)
+ (i 0))
+ (unless (stringp targets-data)
+ (error "Expected format 8, got %s" (type-of targets-data)))
+ (prog1 vec
+ (while (< i (nth 2 header))
+ (let ((rec (x-dnd-xm-read-single-rec targets-data
+ current-byte)))
+ (aset vec i (nth 2 rec))
+ (setq current-byte (+ current-byte (car rec)))
+ (setq i (1+ i))))
+ (unless (eq current-byte (nth 3 header))
+ (error "Targets table header says size is %d, but it is actually %d"
+ (nth 3 header) current-byte)))))
+
+(defun x-dnd-xm-read-targets (frame window selection)
+ "Read targets of SELECTION on FRAME from the targets table.
+WINDOW should be the drag-and-drop operation's initiator.
+Return a vector of atoms containing the selection targets."
+ (let* ((targets-table (x-dnd-xm-read-targets-table frame))
+ (initiator-info (x-window-property selection frame
+ "_MOTIF_DRAG_INITIATOR_INFO"
+ window nil nil))
+ (byte-order (aref initiator-info 0))
+ (idx (x-dnd-get-motif-value initiator-info
+ 2 2 byte-order))
+ (vector (aref targets-table idx))
+ (i 0))
+ (prog1 vector
+ (while (< i (length vector))
+ (aset vector i
+ (intern (x-get-atom-name (aref vector i))))
+ (setq i (1+ i))))))
(defvar x-dnd-motif-message-types
'((0 . XmTOP_LEVEL_ENTER)
@@ -583,178 +909,571 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(2 . private)) ; Motif does not have private, so use copy for private.
"Mapping from number to operation for Motif DND.")
-(defun x-dnd-handle-motif (event frame window message-atom _format data)
- (let* ((message-type (cdr (assoc (aref data 0) x-dnd-motif-message-types)))
+(defun x-dnd-handle-motif (event frame window _message-atom _format data)
+ (let* ((message-type (cdr (assoc (logand (aref data 0) #x3f)
+ x-dnd-motif-message-types)))
+ (initiator-p (eq (lsh (aref data 0) -7) 0))
(source-byteorder (aref data 1))
(my-byteorder (byteorder))
(source-flags (x-dnd-get-motif-value data 2 2 source-byteorder))
(source-action (cdr (assoc (logand ?\xF source-flags)
x-dnd-motif-to-action))))
- (cond ((eq message-type 'XmTOP_LEVEL_ENTER)
- (let* ((dnd-source (x-dnd-get-motif-value
- data 8 4 source-byteorder))
- (selection-atom (x-dnd-get-motif-value
- data 12 4 source-byteorder))
- (atom-name (x-get-atom-name selection-atom))
- (types (when atom-name
- (x-get-selection-internal (intern atom-name)
- 'TARGETS))))
- (x-dnd-forget-drop frame)
- (when types (x-dnd-save-state window nil nil
- types
- dnd-source))))
-
- ;; Can not forget drop here, LEAVE comes before DROP_START and
- ;; we need the state in DROP_START.
- ((eq message-type 'XmTOP_LEVEL_LEAVE)
- nil)
-
- ((eq message-type 'XmDRAG_MOTION)
- (let* ((state (x-dnd-get-state-for-frame frame))
- (timestamp (x-dnd-motif-value-to-list
- (x-dnd-get-motif-value data 4 4
- source-byteorder)
- 4 my-byteorder))
- (x (x-dnd-motif-value-to-list
- (x-dnd-get-motif-value data 8 2 source-byteorder)
- 2 my-byteorder))
- (y (x-dnd-motif-value-to-list
- (x-dnd-get-motif-value data 10 2 source-byteorder)
- 2 my-byteorder))
- (dnd-source (aref state 6))
- (first-move (not (aref state 3)))
- (action-type (x-dnd-maybe-call-test-function
- window
- source-action))
- (reply-action (car (rassoc (car action-type)
- x-dnd-motif-to-action)))
- (reply-flags
- (x-dnd-motif-value-to-list
- (if reply-action
- (+ reply-action
- ?\x30 ; 30: valid drop site
- ?\x700) ; 700: can do copy, move or link
- ?\x30) ; 30: drop site, but noop.
- 2 my-byteorder))
- (reply (append
- (list
- (+ ?\x80 ; 0x80 indicates a reply.
- (if first-move
- 3 ; First time, reply is SITE_ENTER.
- 2)) ; Not first time, reply is DRAG_MOTION.
- my-byteorder)
- reply-flags
- timestamp
- x
- y)))
- (x-send-client-message frame
- dnd-source
- frame
- "_MOTIF_DRAG_AND_DROP_MESSAGE"
- 8
- reply)))
-
- ((eq message-type 'XmOPERATION_CHANGED)
- (let* ((state (x-dnd-get-state-for-frame frame))
- (timestamp (x-dnd-motif-value-to-list
- (x-dnd-get-motif-value data 4 4 source-byteorder)
- 4 my-byteorder))
- (dnd-source (aref state 6))
- (action-type (x-dnd-maybe-call-test-function
- window
- source-action))
- (reply-action (car (rassoc (car action-type)
- x-dnd-motif-to-action)))
- (reply-flags
- (x-dnd-motif-value-to-list
- (if reply-action
- (+ reply-action
- ?\x30 ; 30: valid drop site
- ?\x700) ; 700: can do copy, move or link
- ?\x30) ; 30: drop site, but noop
- 2 my-byteorder))
- (reply (append
- (list
- (+ ?\x80 ; 0x80 indicates a reply.
- 8) ; 8 is OPERATION_CHANGED
- my-byteorder)
- reply-flags
- timestamp)))
- (x-send-client-message frame
- dnd-source
- frame
- "_MOTIF_DRAG_AND_DROP_MESSAGE"
- 8
- reply)))
-
- ((eq message-type 'XmDROP_START)
- (let* ((x (x-dnd-motif-value-to-list
- (x-dnd-get-motif-value data 8 2 source-byteorder)
- 2 my-byteorder))
- (y (x-dnd-motif-value-to-list
- (x-dnd-get-motif-value data 10 2 source-byteorder)
- 2 my-byteorder))
- (selection-atom (x-dnd-get-motif-value
- data 12 4 source-byteorder))
- (atom-name (x-get-atom-name selection-atom))
- (dnd-source (x-dnd-get-motif-value
- data 16 4 source-byteorder))
- (action-type (x-dnd-maybe-call-test-function
- window
- source-action))
- (reply-action (car (rassoc (car action-type)
- x-dnd-motif-to-action)))
- (reply-flags
- (x-dnd-motif-value-to-list
- (if reply-action
- (+ reply-action
- ?\x30 ; 30: valid drop site
- ?\x700) ; 700: can do copy, move or link
- (+ ?\x30 ; 30: drop site, but noop.
- ?\x200)) ; 200: drop cancel.
- 2 my-byteorder))
- (reply (append
- (list
- (+ ?\x80 ; 0x80 indicates a reply.
- 5) ; DROP_START.
- my-byteorder)
- reply-flags
- x
- y))
- (timestamp (x-dnd-get-motif-value
- data 4 4 source-byteorder))
- action)
-
- (x-send-client-message frame
- dnd-source
- frame
- "_MOTIF_DRAG_AND_DROP_MESSAGE"
- 8
- reply)
- (setq action
- (when (and reply-action atom-name)
- (let* ((value (x-get-selection-internal
- (intern atom-name)
- (intern (x-dnd-current-type window)))))
- (when value
- (condition-case info
- (x-dnd-drop-data event frame window value
- (x-dnd-current-type window))
- (error
- (message "Error: %s" info)
- nil))))))
- (x-get-selection-internal
- (intern atom-name)
- (if action 'XmTRANSFER_SUCCESS 'XmTRANSFER_FAILURE)
- timestamp)
- (x-dnd-forget-drop frame)))
-
- (t (error "Unknown Motif DND message %s %s" message-atom data)))))
+ (when initiator-p
+ (cond ((eq message-type 'XmTOP_LEVEL_ENTER)
+ (let* ((dnd-source (x-dnd-get-motif-value
+ data 8 4 source-byteorder))
+ (selection-atom (x-dnd-get-motif-value
+ data 12 4 source-byteorder))
+ (atom-name (x-get-atom-name selection-atom))
+ (types (x-dnd-xm-read-targets frame dnd-source
+ atom-name)))
+ (x-dnd-forget-drop frame)
+ (when types (x-dnd-save-state window nil nil
+ types dnd-source))))
+
+ ;; Can not forget drop here, LEAVE comes before DROP_START and
+ ;; we need the state in DROP_START.
+ ((eq message-type 'XmTOP_LEVEL_LEAVE)
+ nil)
+
+ ((eq message-type 'XmDRAG_MOTION)
+ (let* ((state (x-dnd-get-state-for-frame frame))
+ (timestamp (x-dnd-motif-value-to-list
+ (x-dnd-get-motif-value data 4 4
+ source-byteorder)
+ 4 my-byteorder))
+ (x (x-dnd-motif-value-to-list
+ (x-dnd-get-motif-value data 8 2 source-byteorder)
+ 2 my-byteorder))
+ (y (x-dnd-motif-value-to-list
+ (x-dnd-get-motif-value data 10 2 source-byteorder)
+ 2 my-byteorder))
+ (dnd-source (aref state 6))
+ (first-move (not (aref state 3)))
+ (action-type (x-dnd-maybe-call-test-function
+ window
+ source-action))
+ (reply-action (car (rassoc (car action-type)
+ x-dnd-motif-to-action)))
+ (reply-flags
+ (if (posn-area (event-start event))
+ (x-dnd-motif-value-to-list ?\x20 ; 20: invalid drop site
+ 2 my-byteorder)
+ (x-dnd-motif-value-to-list
+ (if reply-action
+ (+ reply-action
+ ?\x30 ; 30: valid drop site
+ ?\x700) ; 700: can do copy, move or link
+ ?\x30) ; 30: drop site, but noop.
+ 2 my-byteorder)))
+ (reply (append
+ (list
+ (+ ?\x80 ; 0x80 indicates a reply.
+ (if first-move
+ 3 ; First time, reply is SITE_ENTER.
+ 2)) ; Not first time, reply is DRAG_MOTION.
+ my-byteorder)
+ reply-flags
+ timestamp
+ x
+ y)))
+ (x-display-set-last-user-time timestamp)
+ (x-send-client-message frame
+ dnd-source
+ frame
+ "_MOTIF_DRAG_AND_DROP_MESSAGE"
+ 8
+ reply)
+ (dnd-handle-movement (event-start event))))
+
+ ((eq message-type 'XmOPERATION_CHANGED)
+ (let* ((state (x-dnd-get-state-for-frame frame))
+ (timestamp (x-dnd-motif-value-to-list
+ (x-dnd-get-motif-value data 4 4 source-byteorder)
+ 4 my-byteorder))
+ (dnd-source (aref state 6))
+ (action-type (x-dnd-maybe-call-test-function
+ window
+ source-action))
+ (reply-action (car (rassoc (car action-type)
+ x-dnd-motif-to-action)))
+ (reply-flags
+ (if (posn-area (event-start event))
+ (x-dnd-motif-value-to-list ?\x20 ; 20: invalid drop site
+ 2 my-byteorder)
+ (x-dnd-motif-value-to-list
+ (if reply-action
+ (+ reply-action
+ ?\x30 ; 30: valid drop site
+ ?\x700) ; 700: can do copy, move or link
+ ?\x30) ; 30: drop site, but noop.
+ 2 my-byteorder)))
+ (reply (append
+ (list
+ (+ ?\x80 ; 0x80 indicates a reply.
+ 8) ; 8 is OPERATION_CHANGED
+ my-byteorder)
+ reply-flags
+ timestamp)))
+ (x-display-set-last-user-time timestamp)
+ (x-send-client-message frame
+ dnd-source
+ frame
+ "_MOTIF_DRAG_AND_DROP_MESSAGE"
+ 8
+ reply)))
+
+ ((eq message-type 'XmDROP_START)
+ (when (windowp window)
+ (select-window window))
+ (let* ((x (x-dnd-motif-value-to-list
+ (x-dnd-get-motif-value data 8 2 source-byteorder)
+ 2 my-byteorder))
+ (y (x-dnd-motif-value-to-list
+ (x-dnd-get-motif-value data 10 2 source-byteorder)
+ 2 my-byteorder))
+ (selection-atom (x-dnd-get-motif-value
+ data 12 4 source-byteorder))
+ (atom-name (x-get-atom-name selection-atom))
+ (dnd-source (x-dnd-get-motif-value
+ data 16 4 source-byteorder)))
+
+ ;; This might be a drop from a program that doesn't use
+ ;; the Motif drag protocol. Compute all the necessary
+ ;; state here if that is true.
+ (unless (and (x-dnd-get-state-for-frame frame)
+ (aref (x-dnd-get-state-for-frame frame) 2))
+ (x-dnd-forget-drop frame)
+ (let ((types (x-dnd-xm-read-targets frame dnd-source
+ atom-name)))
+ (x-dnd-save-state window nil nil types dnd-source)))
+
+ (let* ((action-type (x-dnd-maybe-call-test-function
+ window
+ source-action))
+ (reply-action (and (not (posn-area (event-start event)))
+ (car (rassoc (car action-type)
+ x-dnd-motif-to-action))))
+ (reply-flags
+ (x-dnd-motif-value-to-list
+ (if (posn-area (event-start event))
+ (+ ?\x20 ; 20: invalid drop site
+ ?\x200) ; 200: drop cancel
+ (if reply-action
+ (+ reply-action
+ ?\x30 ; 30: valid drop site
+ ?\x700) ; 700: can do copy, move or link
+ (+ ?\x30 ; 30: drop site, but noop.
+ ?\x200))) ; 200: drop cancel.
+ 2 my-byteorder))
+ (reply (append
+ (list
+ (+ ?\x80 ; 0x80 indicates a reply.
+ 5) ; DROP_START.
+ my-byteorder)
+ reply-flags
+ x y))
+ (timestamp (x-dnd-get-motif-value
+ data 4 4 source-byteorder))
+ action)
+ (x-display-set-last-user-time timestamp)
+ (x-send-client-message frame
+ dnd-source
+ frame
+ "_MOTIF_DRAG_AND_DROP_MESSAGE"
+ 8
+ reply)
+ (unwind-protect
+ (setq action
+ (when (and reply-action atom-name)
+ (let* ((value (x-get-selection-internal
+ (intern atom-name)
+ (intern (x-dnd-current-type window))
+ timestamp)))
+ (when value
+ (condition-case info
+ (x-dnd-drop-data event frame window value
+ (x-dnd-current-type window))
+ (error
+ (message "Error: %s" info)
+ nil))))))
+ (x-get-selection-internal
+ (intern atom-name)
+ (if action 'XmTRANSFER_SUCCESS 'XmTRANSFER_FAILURE)
+ timestamp)
+ (x-dnd-forget-drop frame)))))
+
+ (t (message "Unknown Motif drag-and-drop message: %s"
+ (logand (aref data 0) #x3f)))))))
;;;
+
+
+;;; Handling drops.
+
+(defvar x-treat-local-requests-remotely)
+(declare-function x-get-local-selection "xfns.c")
+
+(defun x-dnd-convert-to-offix (targets local-selection)
+ "Convert local selection data to OffiX data.
+TARGETS should be the list of targets currently available in
+`XdndSelection'. Return a list of an OffiX type, and data
+suitable for passing to `x-change-window-property', or nil if the
+data could not be converted.
+LOCAL-SELECTION should be the local selection data describing the
+selection data to convert."
+ (let ((x-treat-local-requests-remotely t)
+ file-name-data string-data)
+ (cond
+ ((and (member "FILE_NAME" targets)
+ (setq file-name-data
+ (x-get-local-selection local-selection 'FILE_NAME)))
+ (if (string-match-p "\0" file-name-data)
+ ;; This means there are multiple file names in
+ ;; XdndSelection. Convert the file name data to a format
+ ;; that OffiX understands.
+ (cons 'DndTypeFiles (concat file-name-data "\0\0"))
+ (cons 'DndTypeFile (concat file-name-data "\0"))))
+ ((and (member "STRING" targets)
+ (setq string-data
+ (x-get-local-selection local-selection 'STRING)))
+ (cons 'DndTypeText (encode-coding-string string-data
+ 'latin-1))))))
+
+(defun x-dnd-do-offix-drop (targets x y frame window-id contents)
+ "Perform an OffiX drop on WINDOW-ID with the given selection contents.
+Return non-nil if the drop succeeded, or nil if it did not
+happen, which can happen if TARGETS didn't contain anything that
+the OffiX protocol can represent.
+
+X and Y are the root window coordinates of the drop. TARGETS is
+the list of targets CONTENTS can be converted to, and CONTENTS is
+the local selection data to drop onto the target window.
+
+FRAME is the frame that will act as a source window for the
+drop."
+ (if-let* ((data (x-dnd-convert-to-offix targets contents))
+ (type-id (car (rassq (car data)
+ x-dnd-offix-id-to-name)))
+ (source-id (string-to-number
+ (frame-parameter frame 'window-id)))
+ (message-data (list type-id ; l[0] = DataType
+ 0 ; l[1] = event->xbutton.state
+ source-id ; l[2] = window
+ (+ x (* 65536 y)) ; l[3] = drop_x + 65536 * drop_y
+ 1))) ; l[4] = protocol version
+ (prog1 t
+ ;; Send a legacy (old KDE) message first. Newer clients will
+ ;; ignore it, since the protocol version is 1.
+ (x-change-window-property "DndSelection"
+ (cdr data) frame
+ "STRING" 8 nil 0)
+ (x-send-client-message frame window-id
+ frame "DndProtocol"
+ 32 message-data)
+ ;; Now send a modern _DND_PROTOCOL message.
+ (x-change-window-property "_DND_SELECTION"
+ (cdr data) frame
+ "STRING" 8 nil 0)
+ (x-send-client-message frame window-id
+ frame "_DND_PROTOCOL"
+ 32 message-data))))
+
+(defun x-dnd-handle-unsupported-drop (targets x y action window-id frame _time local-selection-data)
+ "Return non-nil if the drop described by TARGETS and ACTION should not proceed.
+X and Y are the root window coordinates of the drop.
+FRAME is the frame the drop originated on.
+WINDOW-ID is the X window the drop should happen to.
+LOCAL-SELECTION-DATA is the local selection data of the drop."
+ (let ((chosen-action nil))
+ (not (and (or (eq action 'XdndActionCopy)
+ (eq action 'XdndActionMove))
+ (not (and x-dnd-use-offix-drop local-selection-data
+ (or (not (eq x-dnd-use-offix-drop 'files))
+ (member "FILE_NAME" targets))
+ (when (x-dnd-do-offix-drop targets x
+ y frame window-id
+ local-selection-data)
+ (setq chosen-action 'XdndActionCopy))))
+ (let ((delegate-p (or (member "STRING" targets)
+ (member "UTF8_STRING" targets)
+ (member "COMPOUND_TEXT" targets)
+ (member "TEXT" targets))))
+ (prog1 delegate-p
+ ;; A string will avoid the drop emulation done in C
+ ;; code, but won't be returned from `x-begin-drag'.
+ (setq chosen-action (unless delegate-p ""))))))
+ chosen-action))
+
+(defvar x-dnd-targets-list)
+(defvar x-dnd-native-test-function)
+
+(defun x-dnd-handle-native-drop (pos action)
+ "Compute the action for a drop at POS.
+Return the appropriate drag-and-drop action for a local drop at POS.
+ACTION is the action given to `x-begin-drag'."
+ (let ((state (funcall x-dnd-test-function
+ (posn-window pos)
+ (cdr (assoc (symbol-name action)
+ x-dnd-xdnd-to-action))
+ (apply #'vector x-dnd-targets-list))))
+ (when state
+ (intern (car (rassq (car state) x-dnd-xdnd-to-action))))))
+
+(setq x-dnd-native-test-function #'x-dnd-handle-native-drop)
+
+;;; XDS protocol support.
+
+(declare-function x-begin-drag "xfns.c")
+(declare-function x-delete-window-property "xfns.c")
+(defvar selection-converter-alist)
+
+(defvar x-dnd-xds-current-file nil
+ "The file name for which a direct save is currently being performed.")
+
+(defvar x-dnd-xds-source-frame nil
+ "The frame from which a direct save is currently being performed.")
+
+(defvar x-dnd-xds-performed nil
+ "Whether or not the drop target made a request for `XdndDirectSave0'.")
+
+(defvar x-dnd-disable-motif-protocol)
+(defvar x-dnd-use-unsupported-drop)
+
+(defun x-dnd-handle-direct-save (_selection _type _value)
+ "Handle a selection request for `XdndDirectSave'."
+ (setq x-dnd-xds-performed t)
+ (let* ((uri (x-window-property "XdndDirectSave0"
+ x-dnd-xds-source-frame
+ "AnyPropertyType" nil t))
+ (local-file-uri (if (and (string-match "^file://\\([^/]*\\)" uri)
+ (not (equal (match-string 1 uri) "")))
+ (dnd-get-local-file-uri uri)
+ uri))
+ (local-name (and local-file-uri
+ (dnd-get-local-file-name local-file-uri))))
+ (if (not local-name)
+ '(STRING . "F")
+ (condition-case nil
+ (progn
+ (copy-file x-dnd-xds-current-file
+ local-name t)
+ (when (equal x-dnd-xds-current-file
+ dnd-last-dragged-remote-file)
+ (dnd-remove-last-dragged-remote-file)))
+ (:success '(STRING . "S"))
+ (error '(STRING . "E"))))))
+
+(defun x-dnd-handle-octet-stream (_selection _type _value)
+ "Handle a selecton request for `application/octet-stream'.
+Return the contents of the XDS file."
+ (cons 'application/octet-stream
+ (ignore-errors
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (setq buffer-file-coding-system 'binary)
+ (insert-file-contents-literally x-dnd-xds-current-file)
+ (buffer-substring-no-properties (point-min)
+ (point-max))))))
+
+(defun x-dnd-do-direct-save (file name frame allow-same-frame)
+ "Perform a direct save operation on FILE, from FRAME.
+FILE is the file containing the contents to drop.
+NAME is the name that should be given to the file after dropping.
+FRAME is the frame from which the drop will originate.
+ALLOW-SAME-FRAME means whether or not dropping will be allowed
+on FRAME.
+
+Return the action taken by the drop target, or nil if no action
+was taken, or the direct save failed."
+ (dnd-remove-last-dragged-remote-file)
+ (let ((file-name file)
+ (original-file-name file)
+ (selection-converter-alist
+ (append '((XdndDirectSave0 . x-dnd-handle-direct-save)
+ (application/octet-stream . x-dnd-handle-octet-stream))
+ selection-converter-alist))
+ (x-dnd-xds-current-file nil)
+ (x-dnd-xds-source-frame frame)
+ (x-dnd-xds-performed nil)
+ ;; The XDS protocol is built on top of XDND, and cannot
+ ;; possibly work with Motif or OffiX programs.
+ (x-dnd-disable-motif-protocol t)
+ (x-dnd-use-offix-drop nil)
+ (x-dnd-use-unsupported-drop nil)
+ (prop-deleted nil)
+ encoded-name)
+ (unwind-protect
+ (progn
+ (when (file-remote-p file)
+ (setq file-name (file-local-copy file))
+ (setq dnd-last-dragged-remote-file file-name)
+ (add-hook 'kill-emacs-hook
+ #'dnd-remove-last-dragged-remote-file))
+ (setq encoded-name
+ (encode-coding-string name
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ (setq x-dnd-xds-current-file file-name)
+ (x-change-window-property "XdndDirectSave0" encoded-name
+ frame "text/plain" 8 nil)
+ (gui-set-selection 'XdndSelection (concat "file://" file-name))
+ ;; FIXME: this does not work with GTK file managers, since
+ ;; they always reach for `text/uri-list' first, contrary to
+ ;; the spec.
+ (let ((action (x-begin-drag '("XdndDirectSave0" "text/uri-list"
+ "application/octet-stream")
+ 'XdndActionDirectSave
+ frame nil allow-same-frame)))
+ (if (not x-dnd-xds-performed)
+ action
+ (let ((property (x-window-property "XdndDirectSave0" frame
+ "AnyPropertyType" nil t)))
+ (setq prop-deleted t)
+ ;; "System-G" deletes the property upon success.
+ (and (or (null property)
+ (and (stringp property)
+ (not (equal property ""))))
+ action)))))
+ (unless prop-deleted
+ (x-delete-window-property "XdndDirectSave0" frame))
+ ;; Delete any remote copy that was made.
+ (when (not (equal file-name original-file-name))
+ (delete-file file-name)))))
+
+(defun x-dnd-save-direct (need-name name)
+ "Handle dropping a file that should be saved immediately.
+NEED-NAME tells whether or not the file was not yet saved. NAME
+is either the name of the file, or the name the drop source wants
+us to save under.
+
+Prompt the user for a file name, then open it."
+ (if need-name
+ (let ((file-name (read-file-name "Write file: "
+ default-directory
+ nil nil name)))
+ (when (file-exists-p file-name)
+ (unless (y-or-n-p (format-message
+ "File `%s' exists; overwrite? " file-name))
+ (setq file-name nil)))
+ file-name)
+ ;; TODO: move this to dired.el once a platform-agonistic
+ ;; interface can be found.
+ (if (derived-mode-p 'dired-mode)
+ (revert-buffer)
+ (find-file name))))
+
+(defun x-dnd-save-direct-immediately (need-name name)
+ "Save and open a dropped file, like `x-dnd-save-direct'.
+NEED-NAME tells whether or not the file was not yet saved. NAME
+is either the name of the file, or the name the drop source wants
+us to save under.
+
+Unlike `x-dnd-save-direct', do not prompt for the name by which
+to save the file. Simply save it in the current directory."
+ (if need-name
+ (let ((file-name (expand-file-name name)))
+ (when (file-exists-p file-name)
+ (unless (y-or-n-p (format-message
+ "File `%s' exists; overwrite? " file-name))
+ (setq file-name nil)))
+ file-name)
+ ;; TODO: move this to dired.el once a platform-agonistic
+ ;; interface can be found.
+ (if (derived-mode-p 'dired-mode)
+ (revert-buffer)
+ (find-file name))))
+
+(defun x-dnd-handle-octet-stream-for-drop (save-to)
+ "Save the contents of the XDS selection to SAVE-TO.
+Return non-nil if successful, nil otherwise."
+ (ignore-errors
+ (let ((coding-system-for-write 'raw-text)
+ (data (x-get-selection-internal 'XdndSelection
+ 'application/octet-stream)))
+ (when data
+ (write-region data nil save-to)
+ t))))
+
+(defun x-dnd-handle-xds-drop (event window source version)
+ "Handle an XDS (X Direct Save) protocol drop.
+EVENT is the drag-n-drop event containing the drop.
+WINDOW is the window on top of which the drop is supposed to happen.
+SOURCE is the X window that sent the drop.
+VERSION is the version of the XDND protocol understood by SOURCE."
+ (if (not (windowp window))
+ ;; We can't perform an XDS drop if there's no window from which
+ ;; to determine the current directory.
+ (let* ((start (event-start event))
+ (frame (posn-window start)))
+ (x-send-client-message frame source frame
+ "XdndFinished" 32
+ (list (string-to-number
+ (frame-parameter frame
+ 'outer-window-id)))))
+ (let ((desired-name (x-window-property "XdndDirectSave0"
+ (window-frame window)
+ ;; We currently don't handle
+ ;; any alternative character
+ ;; encodings.
+ "text/plain" source))
+ (frame (window-frame window))
+ (success nil) save-to save-to-remote hostname)
+ (unwind-protect
+ (when (stringp desired-name)
+ (setq desired-name (decode-coding-string
+ desired-name
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ (let ((name (funcall x-dnd-direct-save-function
+ t desired-name)))
+ (setq save-to name save-to-remote name))
+ (when save-to
+ (if (file-remote-p save-to)
+ (setq hostname (file-remote-p save-to 'host)
+ save-to (file-local-name save-to))
+ (setq hostname (system-name)))
+ (with-selected-window window
+ (let ((uri (format "file://%s%s" hostname save-to)))
+ (x-change-window-property "XdndDirectSave0"
+ (encode-coding-string
+ (url-encode-url uri) 'ascii)
+ frame "text/plain" 8 nil source)
+ (let ((result (x-get-selection-internal 'XdndSelection
+ 'XdndDirectSave0)))
+ (cond ((equal result "F")
+ (setq success
+ (x-dnd-handle-octet-stream-for-drop save-to-remote))
+ (unless success
+ (x-change-window-property "XdndDirectSave0" ""
+ frame "text/plain" 8
+ nil source)))
+ ((equal result "S")
+ (setq success t))
+ ((equal result "E")
+ (setq success nil))
+ (t (error "Broken implementation of XDS: got %s in reply"
+ result)))
+ (when success
+ (funcall x-dnd-direct-save-function nil save-to-remote)))))))
+ ;; We assume XDS always comes from a client supporting version 2
+ ;; or later, since custom actions aren't present before.
+ (x-send-client-message frame source frame
+ "XdndFinished" 32
+ (list (string-to-number
+ (frame-parameter frame
+ 'outer-window-id))
+ (if (>= version 5)
+ (if success 1 0)
+ 0)
+ (if (or (not success)
+ (< version 5))
+ 0
+ "XdndDirectSave0")))))))
+
(provide 'x-dnd)
;;; x-dnd.el ends here
diff --git a/lisp/xdg.el b/lisp/xdg.el
index 60e643964e8..c7d9c0e785e 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -41,13 +41,11 @@
;; XDG Base Directory Specification
;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
-(defmacro xdg--dir-home (environ default-path)
- (declare (debug (stringp stringp)))
- (let ((env (make-symbol "env")))
- `(let ((,env (getenv ,environ)))
- (if (or (null ,env) (not (file-name-absolute-p ,env)))
- (expand-file-name ,default-path)
- ,env))))
+(defun xdg--dir-home (environ default-path)
+ (let ((env (getenv environ)))
+ (if (or (null env) (not (file-name-absolute-p env)))
+ (expand-file-name default-path)
+ env)))
(defun xdg-config-home ()
"Return the base directory for user specific configuration files.
@@ -85,6 +83,23 @@ According to the XDG Base Directory Specification version
should be used.\""
(xdg--dir-home "XDG_DATA_HOME" "~/.local/share"))
+(defun xdg-state-home ()
+ "Return the base directory for user-specific state data.
+
+According to the XDG Base Directory Specification version
+0.8 (8th May 2021):
+
+ \"The $XDG_STATE_HOME contains state data that should persist
+ between (application) restarts, but that is not important or
+ portable enough to the user that it should be stored in
+ $XDG_DATA_HOME. It may contain:
+
+ * actions history (logs, history, recently used files, …)
+
+ * current state of the application that can be reused on a
+ restart (view, layout, open files, undo history, …)\""
+ (xdg--dir-home "XDG_STATE_HOME" "~/.local/state"))
+
(defun xdg-runtime-dir ()
"Return the value of $XDG_RUNTIME_DIR.
@@ -156,13 +171,12 @@ file:///foo/bar.jpg"
;; https://www.freedesktop.org/wiki/Software/xdg-user-dirs/
(defconst xdg-line-regexp
- (eval-when-compile
- (rx "XDG_"
- (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
- "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
- "_DIR=\""
- (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
- "\""))
+ (rx "XDG_"
+ (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
+ "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
+ "_DIR=\""
+ (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
+ "\"")
"Regexp matching non-comment lines in `xdg-user-dirs' config files.")
(defvar xdg-user-dirs nil
diff --git a/lisp/xml.el b/lisp/xml.el
index 94c4f91ce04..9c9f1d9b172 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -612,8 +612,8 @@ references."
(if (setq ref (match-string 2))
(progn ; Numeric char reference
(setq val (save-match-data
- (decode-char 'ucs (string-to-number
- ref (if (match-string 1) 16)))))
+ (string-to-number
+ ref (if (match-string 1) 16))))
(and (null val)
xml-validating-parser
(error "XML: (Validity) Invalid character reference `%s'"
@@ -898,11 +898,11 @@ references and parameter-entity references."
ref val)
(cond ((setq ref (match-string 1 string))
;; Decimal character reference
- (setq val (decode-char 'ucs (string-to-number ref)))
+ (setq val (string-to-number ref))
(if val (push (string val) children)))
;; Hexadecimal character reference
((setq ref (match-string 2 string))
- (setq val (decode-char 'ucs (string-to-number ref 16)))
+ (setq val (string-to-number ref 16))
(if val (push (string val) children)))
;; Parameter entity reference
((setq ref (match-string 3 string))
@@ -962,7 +962,7 @@ STRING is assumed to occur in an XML attribute value."
(if ref
;; [4.6] Character references are included as
;; character data.
- (let ((val (decode-char 'ucs (string-to-number ref (if is-hex 16)))))
+ (let ((val (string-to-number ref (if is-hex 16))))
(push (cond (val (string val))
(xml-validating-parser
(error "XML: (Validity) Undefined character `x%s'" ref))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 5662f0a3ea6..88bc8ff6c5e 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -33,10 +33,12 @@
(require 'cl-lib)
(require 'bookmark)
+(require 'format-spec)
(declare-function make-xwidget "xwidget.c"
- (type title width height arguments &optional buffer))
+ (type title width height &optional arguments buffer related))
(declare-function xwidget-buffer "xwidget.c" (xwidget))
+(declare-function set-xwidget-buffer "xwidget.c" (xwidget buffer))
(declare-function xwidget-size-request "xwidget.c" (xwidget))
(declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
(declare-function xwidget-webkit-execute-script "xwidget.c"
@@ -53,31 +55,34 @@
(declare-function delete-xwidget-view "xwidget.c" (xwidget-view))
(declare-function get-buffer-xwidgets "xwidget.c" (buffer))
(declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget))
+(declare-function xwidget-webkit-back-forward-list "xwidget.c" (xwidget &optional limit))
+(declare-function xwidget-webkit-estimated-load-progress "xwidget.c" (xwidget))
+(declare-function xwidget-webkit-set-cookie-storage-file "xwidget.c" (xwidget file))
+(declare-function xwidget-live-p "xwidget.c" (xwidget))
+(declare-function xwidget-webkit-stop-loading "xwidget.c" (xwidget))
+(declare-function xwidget-info "xwidget.c" (xwidget))
(defgroup xwidget nil
"Displaying native widgets in Emacs buffers."
:group 'widgets)
-(defun xwidget-insert (pos type title width height &optional args)
+(defun xwidget-insert (pos type title width height &optional args related)
"Insert an xwidget at position POS.
-Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT.
+Supply the xwidget's TYPE, TITLE, WIDTH, HEIGHT, and RELATED.
See `make-xwidget' for the possible TYPE values.
The usage of optional argument ARGS depends on the xwidget.
This returns the result of `make-xwidget'."
(goto-char pos)
- (let ((id (make-xwidget type title width height args)))
+ (let ((id (make-xwidget type title width height args nil related)))
(put-text-property (point) (+ 1 (point))
'display (list 'xwidget ':xwidget id))
id))
(defun xwidget-at (pos)
"Return xwidget at POS."
- ;; TODO this function is a bit tedious because the C layer isn't well
- ;; protected yet and xwidgetp apparently doesn't work yet.
(let* ((disp (get-text-property pos 'display))
- (xw (car (cdr (cdr disp)))))
- ;;(if (xwidgetp xw) xw nil)
- (if (equal 'xwidget (car disp)) xw)))
+ (xw (car (cdr (cdr disp)))))
+ (when (xwidget-live-p xw) xw)))
@@ -88,6 +93,29 @@ This returns the result of `make-xwidget'."
(require 'seq)
(require 'url-handlers)
+(defgroup xwidget-webkit nil
+ "Displaying webkit xwidgets in Emacs buffers."
+ :version "29.1"
+ :group 'web
+ :prefix "xwidget-webkit-")
+
+(defcustom xwidget-webkit-buffer-name-format "*xwidget-webkit: %T*"
+ "Template for naming `xwidget-webkit' buffers.
+It can use the following special constructs:
+
+ %T -- the title of the Web page loaded by the xwidget.
+ %U -- the URI of the Web page loaded by the xwidget."
+ :type 'string
+ :version "29.1")
+
+(defcustom xwidget-webkit-cookie-file nil
+ "The name of the file where `xwidget-webkit-browse-url' will store cookies.
+They will be stored as plain text in Mozilla \"cookies.txt\"
+format. If nil, do not store cookies. You must kill all xwidget-webkit
+buffers for this setting to take effect after setting it to nil."
+ :type '(choice (const :tag "Do not store cookies" nil) file)
+ :version "29.1")
+
;;;###autoload
(defun xwidget-webkit-browse-url (url &optional new-session)
"Ask xwidget-webkit to browse URL.
@@ -111,7 +139,7 @@ Interactively, URL defaults to the string looking like a url around point."
Get the URL of current session, then browse to the URL
in `split-window-below' with a new xwidget webkit session."
(interactive nil xwidget-webkit-mode)
- (let ((url (xwidget-webkit-current-url)))
+ (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
(with-selected-window (split-window-below)
(xwidget-webkit-new-session url))))
@@ -120,10 +148,49 @@ in `split-window-below' with a new xwidget webkit session."
Get the URL of current session, then browse to the URL
in `split-window-right' with a new xwidget webkit session."
(interactive nil xwidget-webkit-mode)
- (let ((url (xwidget-webkit-current-url)))
+ (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
(with-selected-window (split-window-right)
(xwidget-webkit-new-session url))))
+(declare-function xwidget-perform-lispy-event "xwidget.c")
+
+(defvar xwidget-webkit--input-method-events nil
+ "Internal variable used to store input method events.")
+
+(defvar-local xwidget-webkit--loading-p nil
+ "Whether or not a page is being loaded.")
+
+(defvar-local xwidget-webkit--progress-update-timer nil
+ "Timer that updates the display of page load progress in the header line.")
+
+(defun xwidget-webkit-pass-command-event-with-input-method ()
+ "Handle a `with-input-method' event."
+ (interactive)
+ (let ((key (pop unread-command-events)))
+ (setq xwidget-webkit--input-method-events
+ (funcall input-method-function key))
+ (exit-minibuffer)))
+
+(defun xwidget-webkit-pass-command-event ()
+ "Pass `last-command-event' to the current buffer's WebKit widget.
+If `current-input-method' is non-nil, consult `input-method-function'
+for the actual events that will be sent."
+ (interactive)
+ (if (and current-input-method
+ (characterp last-command-event))
+ (let ((xwidget-webkit--input-method-events nil)
+ (minibuffer-local-map (make-keymap)))
+ (define-key minibuffer-local-map [with-input-method]
+ 'xwidget-webkit-pass-command-event-with-input-method)
+ (push last-command-event unread-command-events)
+ (push 'with-input-method unread-command-events)
+ (read-from-minibuffer "" nil nil nil nil nil t)
+ (dolist (event xwidget-webkit--input-method-events)
+ (xwidget-perform-lispy-event (xwidget-webkit-current-session)
+ event)))
+ (xwidget-perform-lispy-event (xwidget-webkit-current-session)
+ last-command-event)))
+
;;todo.
;; - check that the webkit support is compiled in
(defvar xwidget-webkit-mode-map
@@ -133,11 +200,14 @@ in `split-window-right' with a new xwidget webkit session."
(define-key map "b" 'xwidget-webkit-back)
(define-key map "f" 'xwidget-webkit-forward)
(define-key map "r" 'xwidget-webkit-reload)
- (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
(define-key map "\C-m" 'xwidget-webkit-insert-string)
(define-key map "w" 'xwidget-webkit-current-url)
(define-key map "+" 'xwidget-webkit-zoom-in)
(define-key map "-" 'xwidget-webkit-zoom-out)
+ (define-key map "e" 'xwidget-webkit-edit-mode)
+ (define-key map "\C-r" 'xwidget-webkit-isearch-mode)
+ (define-key map "\C-s" 'xwidget-webkit-isearch-mode)
+ (define-key map "H" 'xwidget-webkit-browse-history)
;;similar to image mode bindings
(define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
@@ -164,6 +234,70 @@ in `split-window-right' with a new xwidget webkit session."
map)
"Keymap for `xwidget-webkit-mode'.")
+(easy-menu-define nil xwidget-webkit-mode-map "Xwidget WebKit menu."
+ (list "Xwidget WebKit"
+ ["Browse URL" xwidget-webkit-browse-url
+ :active t
+ :help "Prompt for a URL, then instruct WebKit to browse it"]
+ ["Back" xwidget-webkit-back t]
+ ["Forward" xwidget-webkit-forward t]
+ ["Reload" xwidget-webkit-reload t]
+ ["History" xwidget-webkit-browse-history t]
+ ["Insert String" xwidget-webkit-insert-string
+ :active t
+ :help "Insert a string into the currently active field"]
+ ["Zoom In" xwidget-webkit-zoom-in t]
+ ["Zoom Out" xwidget-webkit-zoom-out t]
+ ["Edit Mode" xwidget-webkit-edit-mode
+ :active t
+ :style toggle
+ :selected xwidget-webkit-edit-mode
+ :help "Send self inserting characters to the WebKit widget"]
+ ["Save Selection" xwidget-webkit-copy-selection-as-kill
+ :active t
+ :help "Save the browser's selection in the kill ring"]
+ ["Incremental Search" xwidget-webkit-isearch-mode
+ :active (not xwidget-webkit-isearch-mode)
+ :help "Perform incremental search inside the WebKit widget"]
+ ["Stop Loading" xwidget-webkit-stop
+ :active xwidget-webkit--loading-p]))
+
+(defvar xwidget-webkit-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ (prog1 map
+ (tool-bar-local-item-from-menu 'xwidget-webkit-stop
+ "cancel"
+ map
+ xwidget-webkit-mode-map)
+ (tool-bar-local-item-from-menu 'xwidget-webkit-back
+ "left-arrow"
+ map
+ xwidget-webkit-mode-map)
+ (tool-bar-local-item-from-menu 'xwidget-webkit-forward
+ "right-arrow"
+ map
+ xwidget-webkit-mode-map)
+ (tool-bar-local-item-from-menu 'xwidget-webkit-reload
+ "refresh"
+ map
+ xwidget-webkit-mode-map)
+ (tool-bar-local-item-from-menu 'xwidget-webkit-zoom-in
+ "zoom-in"
+ map
+ xwidget-webkit-mode-map)
+ (tool-bar-local-item-from-menu 'xwidget-webkit-zoom-out
+ "zoom-out"
+ map
+ xwidget-webkit-mode-map)
+ (tool-bar-local-item-from-menu 'xwidget-webkit-browse-url
+ "connect-to-url"
+ map
+ xwidget-webkit-mode-map)
+ (tool-bar-local-item-from-menu 'xwidget-webkit-isearch-mode
+ "search"
+ map
+ xwidget-webkit-mode-map))))
+
(defun xwidget-webkit-zoom-in ()
"Increase webkit view zoom factor."
(interactive nil xwidget-webkit-mode)
@@ -214,23 +348,36 @@ If N is omitted or nil, scroll down by one line."
(defun xwidget-webkit-scroll-forward (&optional n)
"Scroll webkit horizontally by N chars.
-The width of char is calculated with `window-font-width'.
-If N is omitted or nil, scroll forwards by one char."
+If the widget is larger than the window, hscroll by N columns
+instead. The width of char is calculated with
+`window-font-width'. If N is omitted or nil, scroll forwards by
+one char."
(interactive "p" xwidget-webkit-mode)
- (xwidget-webkit-execute-script
- (xwidget-webkit-current-session)
- (format "window.scrollBy(%d, 0);"
- (* n (window-font-width)))))
+ (let ((session (xwidget-webkit-current-session)))
+ (if (> (- (aref (xwidget-info session) 2)
+ (window-text-width nil t))
+ (window-font-width))
+ (set-window-hscroll nil (+ (window-hscroll) n))
+ (xwidget-webkit-execute-script session
+ (format "window.scrollBy(%d, 0);"
+ (* n (window-font-width)))))))
(defun xwidget-webkit-scroll-backward (&optional n)
"Scroll webkit back by N chars.
-The width of char is calculated with `window-font-width'.
-If N is omitted or nil, scroll backwards by one char."
+If the widget is larger than the window, hscroll backwards by N
+columns instead. The width of char is calculated with
+`window-font-width'. If N is omitted or nil, scroll backwards by
+one char."
(interactive "p" xwidget-webkit-mode)
- (xwidget-webkit-execute-script
- (xwidget-webkit-current-session)
- (format "window.scrollBy(-%d, 0);"
- (* n (window-font-width)))))
+ (let ((session (xwidget-webkit-current-session)))
+ (if (and (> (- (aref (xwidget-info session) 2)
+ (window-text-width nil t))
+ (window-font-width))
+ (> (window-hscroll) 0))
+ (set-window-hscroll nil (- (window-hscroll) n))
+ (xwidget-webkit-execute-script session
+ (format "window.scrollBy(%-d, 0);"
+ (* n (window-font-width)))))))
(defun xwidget-webkit-scroll-top ()
"Scroll webkit to the very top."
@@ -246,10 +393,13 @@ If N is omitted or nil, scroll backwards by one char."
(xwidget-webkit-current-session)
"window.scrollTo(pageXOffset, window.document.body.scrollHeight);"))
-;; The xwidget event needs to go into a higher level handler
-;; since the xwidget can generate an event even if it's offscreen.
-;; TODO this needs to use callbacks and consider different xwidget event types.
-(define-key (current-global-map) [xwidget-event] #'xwidget-event-handler)
+;; The xwidget event needs to go in the special map. To receive
+;; xwidget events, you should place a callback in the property list of
+;; the xwidget, instead of handling these events manually.
+;;
+;; See `xwidget-webkit-new-session' for an example of how to do this.
+(define-key special-event-map [xwidget-event] #'xwidget-event-handler)
+
(defun xwidget-log (&rest msg)
"Log MSG to a buffer."
(let ((buf (get-buffer-create " *xwidget-log*")))
@@ -265,7 +415,18 @@ If N is omitted or nil, scroll backwards by one char."
((xwidget-event-type (nth 1 last-input-event))
(xwidget (nth 2 last-input-event))
(xwidget-callback (xwidget-get xwidget 'callback)))
- (funcall xwidget-callback xwidget xwidget-event-type)))
+ (when xwidget-callback
+ (funcall xwidget-callback xwidget xwidget-event-type))))
+
+(defun xwidget-webkit--update-progress-timer-function (xwidget)
+ "Force an update of the header line of XWIDGET's buffer."
+ (with-current-buffer (xwidget-buffer xwidget)
+ (force-mode-line-update)))
+
+(defun xwidget-webkit-buffer-kill ()
+ "Clean up an xwidget-webkit buffer before it is killed."
+ (when (timerp xwidget-webkit--progress-update-timer)
+ (cancel-timer xwidget-webkit--progress-update-timer)))
(defun xwidget-webkit-callback (xwidget xwidget-event-type)
"Callback for xwidgets.
@@ -273,30 +434,58 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
(if (not (buffer-live-p (xwidget-buffer xwidget)))
(xwidget-log
"error: callback called for xwidget with dead buffer")
- (with-current-buffer (xwidget-buffer xwidget)
- (cond ((eq xwidget-event-type 'load-changed)
- (let ((title (xwidget-webkit-title xwidget)))
- (xwidget-log "webkit finished loading: %s" title)
- ;; Do not adjust webkit size to window here, the selected window
- ;; can be the mini-buffer window unwantedly.
- (rename-buffer (format "*xwidget webkit: %s *" title) t)))
- ((eq xwidget-event-type 'decide-policy)
- (let ((strarg (nth 3 last-input-event)))
- (if (string-match ".*#\\(.*\\)" strarg)
- (xwidget-webkit-show-id-or-named-element
- xwidget
- (match-string 1 strarg)))))
- ;; TODO: Response handling other than download.
- ((eq xwidget-event-type 'download-callback)
- (let ((url (nth 3 last-input-event))
- (mime-type (nth 4 last-input-event))
- (file-name (nth 5 last-input-event)))
- (xwidget-webkit-save-as-file url mime-type file-name)))
- ((eq xwidget-event-type 'javascript-callback)
- (let ((proc (nth 3 last-input-event))
- (arg (nth 4 last-input-event)))
- (funcall proc arg)))
- (t (xwidget-log "unhandled event:%s" xwidget-event-type))))))
+ (cond ((eq xwidget-event-type 'load-changed)
+ (let ((title (xwidget-webkit-title xwidget))
+ (uri (xwidget-webkit-uri xwidget)))
+ (when-let ((buffer (get-buffer "*Xwidget WebKit History*")))
+ (with-current-buffer buffer
+ (revert-buffer)))
+ (with-current-buffer (xwidget-buffer xwidget)
+ (if (string-equal (nth 3 last-input-event)
+ "load-finished")
+ (progn
+ (setq xwidget-webkit--loading-p nil)
+ (cancel-timer xwidget-webkit--progress-update-timer))
+ (unless xwidget-webkit--loading-p
+ (setq xwidget-webkit--loading-p t
+ xwidget-webkit--progress-update-timer
+ (run-at-time 0.5 0.5 #'xwidget-webkit--update-progress-timer-function
+ xwidget)))))
+ ;; This function will be called multi times, so only
+ ;; change buffer name when the load actually completes
+ ;; this can limit buffer-name flicker in mode-line.
+ (when (or (string-equal (nth 3 last-input-event)
+ "load-finished")
+ (> (length title) 0))
+ (with-current-buffer (xwidget-buffer xwidget)
+ (force-mode-line-update)
+ (xwidget-log "webkit finished loading: %s" title)
+ ;; Do not adjust webkit size to window here, the
+ ;; selected window can be the mini-buffer window
+ ;; unwantedly.
+ (rename-buffer
+ (format-spec
+ xwidget-webkit-buffer-name-format
+ `((?T . ,title)
+ (?U . ,uri)))
+ t)))))
+ ((eq xwidget-event-type 'decide-policy)
+ (let ((strarg (nth 3 last-input-event)))
+ (if (string-match ".*#\\(.*\\)" strarg)
+ (xwidget-webkit-show-id-or-named-element
+ xwidget
+ (match-string 1 strarg)))))
+ ;; TODO: Response handling other than download.
+ ((eq xwidget-event-type 'download-callback)
+ (let ((url (nth 3 last-input-event))
+ (mime-type (nth 4 last-input-event))
+ (file-name (nth 5 last-input-event)))
+ (xwidget-webkit-save-as-file url mime-type file-name)))
+ ((eq xwidget-event-type 'javascript-callback)
+ (let ((proc (nth 3 last-input-event))
+ (arg (nth 4 last-input-event)))
+ (funcall proc arg)))
+ (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))
(defvar bookmark-make-record-function)
(when (memq window-system '(mac ns))
@@ -309,8 +498,21 @@ If non-nil, plugins are enabled. Otherwise, disabled."
(define-derived-mode xwidget-webkit-mode special-mode "xwidget-webkit"
"Xwidget webkit view mode."
(setq buffer-read-only t)
+ (add-hook 'kill-buffer-hook #'xwidget-webkit-buffer-kill)
+ (setq-local tool-bar-map xwidget-webkit-tool-bar-map)
(setq-local bookmark-make-record-function
#'xwidget-webkit-bookmark-make-record)
+ (setq-local header-line-format
+ (list "WebKit: "
+ '(:eval
+ (xwidget-webkit-title (xwidget-webkit-current-session)))
+ '(:eval
+ (when xwidget-webkit--loading-p
+ (let ((session (xwidget-webkit-current-session)))
+ (format " [%d%%%%]"
+ (* 100
+ (xwidget-webkit-estimated-load-progress
+ session))))))))
;; Keep track of [vh]scroll when switching buffers
(image-mode-setup-winprops))
@@ -343,24 +545,31 @@ directory, URL is saved at the specified directory as FILE-NAME."
;;; Bookmarks integration
(defcustom xwidget-webkit-bookmark-jump-new-session nil
- "Control bookmark jump to use new session or not.
-If non-nil, use a new xwidget webkit session after bookmark jump.
-Otherwise, it will use `xwidget-webkit-last-session'.
-When you set this variable to nil, consider further customization with
-`xwidget-webkit-last-session-buffer'."
+ "Whether to jump to a bookmarked URL in a new xwidget webkit session.
+If non-nil, create a new xwidget webkit session, otherwise use
+the value of `xwidget-webkit-last-session'."
:version "28.1"
:type 'boolean)
(defun xwidget-webkit-bookmark-make-record ()
- "Create bookmark record in webkit xwidget.
-See `xwidget-webkit-bookmark-jump-new-session' for whether this
-should create a new session or not."
+ "Create a bookmark record for a webkit xwidget."
(nconc (bookmark-make-record-default t t)
`((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session)))
- (handler . (lambda (bmk)
- (xwidget-webkit-browse-url
- (bookmark-prop-get bmk 'page)
- xwidget-webkit-bookmark-jump-new-session))))))
+ (handler . xwidget-webkit-bookmark-jump-handler))))
+
+;;;###autoload
+(defun xwidget-webkit-bookmark-jump-handler (bookmark)
+ "Jump to the web page bookmarked by the bookmark record BOOKMARK.
+If `xwidget-webkit-bookmark-jump-new-session' is non-nil, create
+a new xwidget-webkit session, otherwise use an existing session."
+ (let* ((url (bookmark-prop-get bookmark 'page))
+ (xwbuf (if (or xwidget-webkit-bookmark-jump-new-session
+ (not (xwidget-webkit-current-session)))
+ (xwidget-webkit--create-new-session-buffer url)
+ (xwidget-buffer (xwidget-webkit-current-session)))))
+ (with-current-buffer xwbuf
+ (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
+ (set-buffer xwbuf)))
;;; xwidget webkit session
@@ -386,6 +595,10 @@ The latter might be nil."
(let ((size (xwidget-size-request xw)))
(xwidget-resize xw (car size) (cadr size))))
+(defun xwidget-webkit-stop ()
+ "Stop trying to load the current page."
+ (interactive)
+ (xwidget-webkit-stop-loading (xwidget-webkit-current-session)))
(defvar xwidget-webkit-activeelement-js"
function findactiveelement(doc){
@@ -604,34 +817,91 @@ For example, use this to display an anchor."
(add-to-list 'window-size-change-functions
'xwidget-webkit-adjust-size-in-frame))
-(defun xwidget-webkit-new-session (url &optional callback)
- "Create a new webkit session buffer with URL."
- (let*
- ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
- (callback (or callback #'xwidget-webkit-callback))
- xw)
- (setq xwidget-webkit-last-session-buffer (switch-to-buffer
- (get-buffer-create bufname)))
+(defun xwidget-webkit--create-new-session-buffer (url &optional callback)
+ "Create a new webkit session buffer to display URL in an xwidget.
+Optional function CALLBACK specifies the callback for webkit xwidgets;
+see `xwidget-webkit-callback'."
+ (let* ((bufname
+ ;; Generate a temp-name based on current buffer name. The
+ ;; buffer will subsequently be renamed by
+ ;; `xwidget-webkit-callback'. This approach can avoid
+ ;; flicker of buffer-name in mode-line.
+ (generate-new-buffer-name (buffer-name)))
+ (callback (or callback #'xwidget-webkit-callback))
+ (current-session (xwidget-webkit-current-session))
+ xw)
+ (setq xwidget-webkit-last-session-buffer (get-buffer-create bufname))
;; The xwidget id is stored in a text property, so we need to have
;; at least character in this buffer.
;; Insert invisible url, good default for next `g' to browse url.
- (let ((start (point)))
- (insert url)
- (put-text-property start (+ start (length url)) 'invisible t)
- (setq xw (xwidget-insert
- start 'webkit bufname
- (xwidget-window-inside-pixel-width (selected-window))
- (xwidget-window-inside-pixel-height (selected-window)))))
- (xwidget-put xw 'callback callback)
- (xwidget-webkit-mode)
- (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
-
+ (with-current-buffer xwidget-webkit-last-session-buffer
+ (let ((start (point)))
+ (insert url)
+ (put-text-property start (+ start (length url)) 'invisible t)
+ (setq xw (xwidget-insert
+ start 'webkit bufname
+ (xwidget-window-inside-pixel-width (selected-window))
+ (xwidget-window-inside-pixel-height (selected-window))
+ nil current-session)))
+ (when xwidget-webkit-cookie-file
+ (xwidget-webkit-set-cookie-storage-file
+ xw (expand-file-name xwidget-webkit-cookie-file)))
+ (xwidget-put xw 'callback callback)
+ (xwidget-put xw 'display-callback #'xwidget-webkit-display-callback)
+ (xwidget-webkit-mode))
+ xwidget-webkit-last-session-buffer))
+
+(defun xwidget-webkit-new-session (url)
+ "Display URL in a new webkit xwidget."
+ (switch-to-buffer (xwidget-webkit--create-new-session-buffer url))
+ (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))
+
+(defun xwidget-webkit-import-widget (xwidget)
+ "Create a new webkit session buffer from XWIDGET, an existing xwidget.
+Return the buffer."
+ (let* ((bufname
+ ;; Generate a temp-name based on current buffer name. it
+ ;; will be renamed by `xwidget-webkit-callback' in the
+ ;; future. This approach can limit flicker of buffer-name in
+ ;; mode-line.
+ (generate-new-buffer-name (buffer-name)))
+ (callback #'xwidget-webkit-callback)
+ (buffer (get-buffer-create bufname)))
+ (with-current-buffer buffer
+ (setq xwidget-webkit-last-session-buffer buffer)
+ (save-excursion
+ (erase-buffer)
+ (insert ".")
+ (put-text-property (point-min) (point-max)
+ 'display (list 'xwidget :xwidget xwidget)))
+ (xwidget-put xwidget 'callback callback)
+ (xwidget-put xwidget 'display-callback
+ #'xwidget-webkit-display-callback)
+ (set-xwidget-buffer xwidget buffer)
+ (xwidget-webkit-mode))
+ buffer))
+
+(defun xwidget-webkit-display-event (event)
+ "Trigger display callback for EVENT."
+ (interactive "e")
+ (let ((xwidget (cadr event))
+ (source (caddr event)))
+ (when (xwidget-get source 'display-callback)
+ (funcall (xwidget-get source 'display-callback)
+ xwidget source))))
+
+(defun xwidget-webkit-display-callback (xwidget _source)
+ "Import XWIDGET and display it."
+ (display-buffer (xwidget-webkit-import-widget xwidget)))
+
+(define-key special-event-map [xwidget-display-event] 'xwidget-webkit-display-event)
(defun xwidget-webkit-goto-url (url)
"Goto URL with xwidget webkit."
(if (xwidget-webkit-current-session)
(progn
- (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
+ (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url)
+ (switch-to-buffer (xwidget-buffer (xwidget-webkit-current-session))))
(xwidget-webkit-new-session url)))
(defun xwidget-webkit-back ()
@@ -655,6 +925,15 @@ For example, use this to display an anchor."
(let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
(message "URL: %s" (kill-new (or url "")))))
+(defun xwidget-webkit-browse-history ()
+ "Display a buffer containing the history of page loads."
+ (interactive)
+ (setq xwidget-webkit-last-session-buffer (current-buffer))
+ (let ((buffer (get-buffer-create "*Xwidget WebKit History*")))
+ (with-current-buffer buffer
+ (xwidget-webkit-history-mode))
+ (display-buffer buffer)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xwidget-webkit-get-selection (proc)
"Get the webkit selection and pass it to PROC."
@@ -684,7 +963,276 @@ You can retrieve the value with `xwidget-get'."
(set-xwidget-plist xwidget
(plist-put (xwidget-plist xwidget) propname value)))
+(defvar xwidget-webkit-edit-mode-map (make-keymap))
+
+(define-key xwidget-webkit-edit-mode-map [backspace] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [tab] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [left] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [right] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [up] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [down] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [return] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [C-left] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [C-right] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [C-up] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [C-down] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [C-return] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [S-left] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [S-right] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [S-up] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [S-down] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [S-return] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [M-left] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [M-right] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [M-up] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [M-down] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [M-return] 'xwidget-webkit-pass-command-event)
+(define-key xwidget-webkit-edit-mode-map [C-backspace] 'xwidget-webkit-pass-command-event)
+
+(define-minor-mode xwidget-webkit-edit-mode
+ "Minor mode for editing the content of WebKit buffers.
+
+This defines most self-inserting characters and some common
+keyboard shortcuts to `xwidget-webkit-pass-command-event', which
+will pass the key events corresponding to these characters to the
+WebKit widget."
+ :keymap xwidget-webkit-edit-mode-map)
+
+(substitute-key-definition 'self-insert-command
+ 'xwidget-webkit-pass-command-event
+ xwidget-webkit-edit-mode-map
+ global-map)
+
+(declare-function xwidget-webkit-search "xwidget.c")
+(declare-function xwidget-webkit-next-result "xwidget.c")
+(declare-function xwidget-webkit-previous-result "xwidget.c")
+(declare-function xwidget-webkit-finish-search "xwidget.c")
+
+(defvar-local xwidget-webkit-isearch--string ""
+ "The current search query.")
+(defvar-local xwidget-webkit-isearch--is-reverse nil
+ "Whether or not the current isearch should be reverse.")
+(defvar xwidget-webkit-isearch--read-string-buffer nil
+ "The buffer we are reading input method text for, if any.")
+
+(defun xwidget-webkit-isearch--update (&optional only-message)
+ "Update the current buffer's WebKit widget's search query.
+If ONLY-MESSAGE is non-nil, the query will not be sent to the
+WebKit widget. The query will be set to the contents of
+`xwidget-webkit-isearch--string'."
+ (unless only-message
+ (xwidget-webkit-search xwidget-webkit-isearch--string
+ (xwidget-webkit-current-session)
+ t xwidget-webkit-isearch--is-reverse t))
+ (let ((message-log-max nil))
+ (message "%s" (concat (propertize "Search contents: " 'face 'minibuffer-prompt)
+ xwidget-webkit-isearch--string))))
+
+(defun xwidget-webkit-isearch-erasing-char (count)
+ "Erase the last COUNT characters of the current query."
+ (interactive (list (prefix-numeric-value current-prefix-arg)))
+ (when (> (length xwidget-webkit-isearch--string) 0)
+ (setq xwidget-webkit-isearch--string
+ (substring xwidget-webkit-isearch--string 0
+ (- (length xwidget-webkit-isearch--string) count))))
+ (xwidget-webkit-isearch--update))
+
+(defun xwidget-webkit-isearch-with-input-method ()
+ "Handle a request to use the input method to modify the search query."
+ (interactive)
+ (let ((key (car unread-command-events))
+ events)
+ (setq unread-command-events (cdr unread-command-events)
+ events (funcall input-method-function key))
+ (dolist (k events)
+ (with-current-buffer xwidget-webkit-isearch--read-string-buffer
+ (setq xwidget-webkit-isearch--string
+ (concat xwidget-webkit-isearch--string
+ (char-to-string k)))))
+ (exit-minibuffer)))
+
+(defun xwidget-webkit-isearch-printing-char-with-input-method (char)
+ "Handle printing char CHAR with the current input method."
+ (let ((minibuffer-local-map (make-keymap))
+ (xwidget-webkit-isearch--read-string-buffer (current-buffer)))
+ (define-key minibuffer-local-map [with-input-method]
+ 'xwidget-webkit-isearch-with-input-method)
+ (setq unread-command-events
+ (cons 'with-input-method
+ (cons char unread-command-events)))
+ (read-string "Search contents: "
+ xwidget-webkit-isearch--string
+ 'junk-hist nil t)
+ (xwidget-webkit-isearch--update)))
+
+(defun xwidget-webkit-isearch-printing-char (char &optional count)
+ "Add ordinary character CHAR to the search string and search.
+With argument, add COUNT copies of CHAR."
+ (interactive (list last-command-event
+ (prefix-numeric-value current-prefix-arg)))
+ (if current-input-method
+ (xwidget-webkit-isearch-printing-char-with-input-method char)
+ (setq xwidget-webkit-isearch--string (concat xwidget-webkit-isearch--string
+ (make-string (or count 1) char))))
+ (xwidget-webkit-isearch--update))
+
+(defun xwidget-webkit-isearch-forward (count)
+ "Move to the next search result COUNT times."
+ (interactive (list (prefix-numeric-value current-prefix-arg)))
+ (let ((was-reverse xwidget-webkit-isearch--is-reverse))
+ (setq xwidget-webkit-isearch--is-reverse nil)
+ (when was-reverse
+ (xwidget-webkit-isearch--update)
+ (setq count (1- count))))
+ (let ((i 0))
+ (while (< i count)
+ (xwidget-webkit-next-result (xwidget-webkit-current-session))
+ (cl-incf i)))
+ (xwidget-webkit-isearch--update t))
+
+(defun xwidget-webkit-isearch-backward (count)
+ "Move to the previous search result COUNT times."
+ (interactive (list (prefix-numeric-value current-prefix-arg)))
+ (let ((was-reverse xwidget-webkit-isearch--is-reverse))
+ (setq xwidget-webkit-isearch--is-reverse t)
+ (unless was-reverse
+ (xwidget-webkit-isearch--update)
+ (setq count (1- count))))
+ (let ((i 0))
+ (while (< i count)
+ (xwidget-webkit-previous-result (xwidget-webkit-current-session))
+ (cl-incf i)))
+ (xwidget-webkit-isearch--update t))
+
+(defun xwidget-webkit-isearch-exit ()
+ "Exit incremental search of a WebKit buffer."
+ (interactive)
+ (xwidget-webkit-isearch-mode 0))
+
+(defvar xwidget-webkit-isearch-mode-map (make-keymap)
+ "The keymap used inside xwidget-webkit-isearch-mode.")
+
+(set-char-table-range (nth 1 xwidget-webkit-isearch-mode-map)
+ (cons 0 (max-char))
+ 'xwidget-webkit-isearch-exit)
+
+(substitute-key-definition 'self-insert-command
+ 'xwidget-webkit-isearch-printing-char
+ xwidget-webkit-isearch-mode-map
+ global-map)
+
+(define-key xwidget-webkit-isearch-mode-map (kbd "DEL")
+ 'xwidget-webkit-isearch-erasing-char)
+(define-key xwidget-webkit-isearch-mode-map [backspace] 'xwidget-webkit-isearch-erasing-char)
+(define-key xwidget-webkit-isearch-mode-map [return] 'xwidget-webkit-isearch-exit)
+(define-key xwidget-webkit-isearch-mode-map "\r" 'xwidget-webkit-isearch-exit)
+(define-key xwidget-webkit-isearch-mode-map "\C-g" 'xwidget-webkit-isearch-exit)
+(define-key xwidget-webkit-isearch-mode-map "\C-r" 'xwidget-webkit-isearch-backward)
+(define-key xwidget-webkit-isearch-mode-map "\C-s" 'xwidget-webkit-isearch-forward)
+(define-key xwidget-webkit-isearch-mode-map "\C-y" 'xwidget-webkit-isearch-yank-kill)
+(define-key xwidget-webkit-isearch-mode-map "\C-\\" 'toggle-input-method)
+(define-key xwidget-webkit-isearch-mode-map "\t" 'xwidget-webkit-isearch-printing-char)
+
+(let ((meta-map (make-keymap)))
+ (set-char-table-range (nth 1 meta-map)
+ (cons 0 (max-char))
+ 'xwidget-webkit-isearch-exit)
+ (define-key xwidget-webkit-isearch-mode-map (char-to-string meta-prefix-char) meta-map))
+
+(define-minor-mode xwidget-webkit-isearch-mode
+ "Minor mode for performing incremental search inside WebKit buffers.
+
+This resembles the regular incremental search, but it does not
+support recursive edits.
+
+If this mode is activated with `\\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-backward]', then the search will by default
+start in the reverse direction.
+
+To navigate around the search results, type
+\\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-forward] to move forward, and
+\\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-backward] to move backward.
+
+To insert the string at the front of the kill ring into the
+search query, type \\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-yank-kill].
+
+Press \\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-exit] to exit incremental search."
+ :keymap xwidget-webkit-isearch-mode-map
+ (if xwidget-webkit-isearch-mode
+ (progn
+ (setq xwidget-webkit-isearch--string "")
+ (setq xwidget-webkit-isearch--is-reverse (eq last-command-event ?\C-r))
+ (xwidget-webkit-isearch--update))
+ (xwidget-webkit-finish-search (xwidget-webkit-current-session))))
+(defun xwidget-webkit-isearch-yank-kill ()
+ "Append the most recent kill from `kill-ring' to the current query."
+ (interactive)
+ (unless xwidget-webkit-isearch-mode
+ (xwidget-webkit-isearch-mode t))
+ (setq xwidget-webkit-isearch--string
+ (concat xwidget-webkit-isearch--string
+ (current-kill 0)))
+ (xwidget-webkit-isearch--update))
+
+(defvar-local xwidget-webkit-history--session nil
+ "The xwidget this history buffer controls.")
+
+(define-button-type 'xwidget-webkit-history 'action #'xwidget-webkit-history-select-item)
+
+(defun xwidget-webkit-history--insert-item (item)
+ "Insert specified ITEM into the current buffer."
+ (let ((idx (car item))
+ (title (cadr item))
+ (uri (caddr item)))
+ (push (list idx (vector (list (number-to-string idx)
+ :type 'xwidget-webkit-history)
+ (list title :type 'xwidget-webkit-history)
+ (list uri :type 'xwidget-webkit-history)))
+ tabulated-list-entries)))
+
+(defun xwidget-webkit-history-select-item (pos)
+ "Navigate to the history item underneath POS."
+ (interactive "P")
+ (let ((id (tabulated-list-get-id pos)))
+ (xwidget-webkit-goto-history xwidget-webkit-history--session id))
+ (xwidget-webkit-history-reload))
+
+(defun xwidget-webkit-history-reload (&rest ignored)
+ "Reload the current history buffer."
+ (interactive)
+ (setq tabulated-list-entries nil)
+ (let* ((back-forward-list
+ (xwidget-webkit-back-forward-list xwidget-webkit-history--session))
+ (back-list (car back-forward-list))
+ (here (cadr back-forward-list))
+ (forward-list (caddr back-forward-list)))
+ (mapc #'xwidget-webkit-history--insert-item (nreverse forward-list))
+ (xwidget-webkit-history--insert-item here)
+ (mapc #'xwidget-webkit-history--insert-item back-list)
+ (tabulated-list-print t nil)
+ (goto-char (point-min))
+ (let ((position (line-beginning-position (1+ (length back-list)))))
+ (goto-char position)
+ (setq-local overlay-arrow-position (make-marker))
+ (set-marker overlay-arrow-position position))))
+
+(define-derived-mode xwidget-webkit-history-mode tabulated-list-mode
+ "Xwidget Webkit History"
+ "Major mode for browsing the history of an Xwidget Webkit buffer.
+Each line describes an entry in history."
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (setq tabulated-list-format [("Index" 10 nil)
+ ("Title" 50 nil)
+ ("URL" 100 nil)])
+ (setq tabulated-list-entries nil)
+ (setq xwidget-webkit-history--session (xwidget-webkit-current-session))
+ (xwidget-webkit-history-reload)
+ (setq-local revert-buffer-function #'xwidget-webkit-history-reload)
+ (tabulated-list-init-header))
+
+(define-key xwidget-webkit-history-mode-map (kbd "RET")
+ #'xwidget-webkit-history-select-item)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar xwidget-view-list) ; xwidget.c
diff --git a/lisp/yank-media.el b/lisp/yank-media.el
new file mode 100644
index 00000000000..5cd75eb3186
--- /dev/null
+++ b/lisp/yank-media.el
@@ -0,0 +1,190 @@
+;;; yank-media.el --- Yanking images and HTML -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; Author: Lars Ingebrigtsen <larsi@gnus.org>
+;; Keywords: utility
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'seq)
+
+(defvar yank-media--registered-handlers nil)
+
+;;;###autoload
+(defun yank-media ()
+ "Yank media (images, HTML and the like) from the clipboard.
+This command depends on the current major mode having support for
+accepting the media type. The mode has to register itself using
+the `yank-media-handler' mechanism.
+
+Also see `yank-media-types' for a command that lets you explore
+all the different selection types."
+ (interactive)
+ (unless yank-media--registered-handlers
+ (user-error "The `%s' mode hasn't registered any handlers" major-mode))
+ (let ((all-types nil))
+ (pcase-dolist (`(,handled-type . ,handler)
+ yank-media--registered-handlers)
+ (dolist (type (yank-media--find-matching-media handled-type))
+ (push (cons type handler) all-types)))
+ (unless all-types
+ (user-error
+ "No handler in the current buffer for anything on the clipboard"))
+ ;; We have a handler in the current buffer; if there's just
+ ;; matching type, just call the handler.
+ (if (length= all-types 1)
+ (funcall (cdar all-types) (caar all-types)
+ (yank-media--get-selection (caar all-types)))
+ ;; More than one type the user for what type to insert.
+ (let ((type
+ (intern
+ (completing-read "Several types available, choose one: "
+ (mapcar #'car all-types) nil t))))
+ (funcall (alist-get type all-types)
+ type (yank-media--get-selection type))))))
+
+(defun yank-media--find-matching-media (handled-type)
+ (seq-filter
+ (lambda (type)
+ (pcase-let ((`(,major ,minor) (split-string (symbol-name type) "/")))
+ (if (and (equal major "image")
+ (not (image-type-available-p (intern minor))))
+ ;; Just filter out all the image types that Emacs doesn't
+ ;; support, because the clipboard is full of things like
+ ;; `image/x-win-bitmap'.
+ nil
+ ;; Check that the handler wants this type.
+ (and (if (symbolp handled-type)
+ (eq handled-type type)
+ (string-match-p handled-type (symbol-name type)))
+ ;; An element may be in TARGETS but be empty.
+ (yank-media--get-selection type)))))
+ (gui-get-selection 'CLIPBOARD 'TARGETS)))
+
+(defun yank-media--get-selection (data-type)
+ (when-let ((data (gui-backend-get-selection 'CLIPBOARD data-type)))
+ (if (string-match-p "\\`text/" (symbol-name data-type))
+ (yank-media-types--format data-type data)
+ data)))
+
+;;;###autoload
+(defun yank-media-handler (types handler)
+ "Register HANDLER for dealing with `yank-media' actions for TYPES.
+TYPES should be a MIME media type symbol, a regexp, or a list
+that can contain both symbols and regexps.
+
+HANDLER is a function that will be called with two arguments: The
+MIME type (a symbol on the form `image/png') and the selection
+data (a string)."
+ (make-local-variable 'yank-media--registered-handlers)
+ (dolist (type (ensure-list types))
+ (setf (alist-get type yank-media--registered-handlers nil nil #'equal)
+ handler)))
+
+(defun yank-media-types (&optional all)
+ "Yank any element present in the primary selection or the clipboard.
+This is primarily meant as a debugging tool -- many of the
+elements (like images) will be inserted as raw data into the
+current buffer. See `yank-media' instead for a command that
+inserts images as images.
+
+By default, data types that aren't supported by
+`gui-get-selection' (i.e., that returns nothing if you actually
+try to look at the selection) are not included by this command.
+If ALL (interactively, the prefix), also include these
+non-supported selection data types."
+ (interactive "P")
+ (let ((elements nil))
+ ;; First gather all the data.
+ (dolist (type '(PRIMARY CLIPBOARD))
+ (when-let ((data-types (gui-get-selection type 'TARGETS)))
+ (when (vectorp data-types)
+ (seq-do (lambda (data-type)
+ (unless (memq data-type '( TARGETS MULTIPLE
+ DELETE SAVE_TARGETS))
+ (let ((data (gui-get-selection type data-type)))
+ (when (or data all)
+ ;; Remove duplicates -- the data in PRIMARY and
+ ;; CLIPBOARD are sometimes (mostly) identical,
+ ;; and sometimes not.
+ (let ((old (assq data-type elements)))
+ (when (or (not old)
+ (not (equal (nth 2 old) data)))
+ (push (list data-type type data)
+ elements)))))))
+ data-types))))
+ ;; Then query the user.
+ (unless elements
+ (user-error "No elements in the primary selection or the clipboard"))
+ (let ((spec
+ (completing-read
+ "Yank type: "
+ (mapcar (lambda (e)
+ (format "%s:%s" (downcase (symbol-name (cadr e)))
+ (car e)))
+ elements)
+ nil t)))
+ (dolist (elem elements)
+ (when (equal (format "%s:%s" (downcase (symbol-name (cadr elem)))
+ (car elem))
+ spec)
+ (insert (yank-media-types--format (car elem) (nth 2 elem))))))))
+
+(defun yank-media-types--format (data-type data)
+ (cond
+ ((not (stringp data))
+ (format "%s" data))
+ ((string-match-p "\\`text/" (symbol-name data-type))
+ ;; We may have utf-16, which Emacs won't detect automatically.
+ (let ((coding-system (yank-media--utf-16-p data)))
+ (if coding-system
+ (decode-coding-string data coding-system)
+ ;; Some programs add a nul character at the end of text/*
+ ;; selections. Remove that.
+ (if (zerop (elt data (1- (length data))))
+ (substring data 0 (1- (length data)))
+ data))))
+ (t
+ data)))
+
+(defun yank-media--utf-16-p (data)
+ (and (zerop (mod (length data) 2))
+ (let ((stats (vector 0 0)))
+ (dotimes (i (length data))
+ (when (zerop (elt data i))
+ (setf (aref stats (mod i 2))
+ (1+ (aref stats (mod i 2))))))
+ ;; If we have more than 90% every-other nul, then it's
+ ;; pretty likely to be utf-16.
+ (cond
+ ((> (/ (float (elt stats 0)) (/ (length data) 2))
+ 0.9)
+ ;; Big endian.
+ 'utf-16-be)
+ ((> (/ (float (elt stats 1)) (/ (length data) 2))
+ 0.9)
+ ;; Little endian.
+ 'utf-16-le)))))
+
+(provide 'yank-media)
+
+;;; yank-media.el ends here