From c0806599d0f9c5c6074186df6135b222b54e3a6e Mon Sep 17 00:00:00 2001 From: cvsdist Date: Thu, 9 Sep 2004 04:33:25 +0000 Subject: [PATCH] =?UTF-8?q?auto-import=20changelog=20data=20from=20emacs-2?= =?UTF-8?q?1.1-2.7.src.rpm=20Thu=20Dec=2006=202001=20Trond=20Eivind=20Glom?= =?UTF-8?q?sr=F8d=20=2021.1-2.7=20-=20Increase=20recursive?= =?UTF-8?q?-load-depth-limit=20from=2010=20to=2050=20Wed=20Dec=2005=202001?= =?UTF-8?q?=20Trond=20Eivind=20Glomsr=F8d=20=2021.1-2=20-?= =?UTF-8?q?=20Make=20it=20conflict=20with=20old=20versions=20of=20gettext?= =?UTF-8?q?=20Thu=20Nov=2029=202001=20Trond=20Eivind=20Glomsr=F8d=20=2021.1-1=20-=20rpm-spec-mode=200.11h,=20should=20fix?= =?UTF-8?q?=20#56748=20Tue=20Nov=2006=202001=20Trond=20Eivind=20Glomsr=F8d?= =?UTF-8?q?=20=2021.1-0.4=20-=20php=20mode=201.0.1.=20Shou?= =?UTF-8?q?ld=20fix=20some=20speedbar=20problems.=20Tue=20Oct=2023=202001?= =?UTF-8?q?=20Trond=20Eivind=20Glomsr=F8d=20=2021.1-0.3=20?= =?UTF-8?q?-=20Minor=20cleanups=20-=20add=20ssl.el=20Mon=20Oct=2022=202001?= =?UTF-8?q?=20Trond=20Eivind=20Glomsr=F8d=20=2021.1-0.2=20?= =?UTF-8?q?-=20Add=20more=20files=20from=20the=20libexec=20directory=20(#5?= =?UTF-8?q?4874,=20#54875)=20Sun=20Oct=2021=202001=20Trond=20Eivind=20Glom?= =?UTF-8?q?sr=F8d=20=2021.1-0.1=20-=2021.1=20-=20Build=20o?= =?UTF-8?q?n=20IA64=20again=20-=20the=20default=20config=20now=20handles?= =?UTF-8?q?=20it=20-=20Drop=20all=20old=20patches=20-=20Misc=20cleanups=20?= =?UTF-8?q?-=20Update=20the=20elisp=20manual=20to=2021-2.7=20-=20Deprecate?= =?UTF-8?q?=20the=20emacs-nox=20and=20emacs-X11=20subpackages.=20Simplify?= =?UTF-8?q?=20build=20=20=20=20=20procedure=20to=20match.=20-=20Update=20p?= =?UTF-8?q?hp-mode=20to=201.0.0=20Mon=20Oct=2015=202001=20Trond=20Eivind?= =?UTF-8?q?=20Glomsr=F8d=20=2020.7-43=20-=20Add=20php-mode?= =?UTF-8?q?=200.9.9=20-=20Add=20URL=20(#54603)=20-=20don't=20run=20autocon?= =?UTF-8?q?f/libtoolize=20during=20build=20-=20they're=20broken=20-=20don'?= =?UTF-8?q?t=20build=20on=20IA64=20until=20they=20are=20fixed=20Sun=20Sep?= =?UTF-8?q?=2016=202001=20Trond=20Eivind=20Glomsr=F8d=20?= =?UTF-8?q?=2020.7-42=20-=20Update=20python-mode=20to=20the=20version=20in?= =?UTF-8?q?=20the=20python=202.2a3=20-=20Include=20po-mode=20in=20emacs,?= =?UTF-8?q?=20instead=20of=20including=20in=20gettext?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .cvsignore | 7 +- emacs.spec | 307 ++---- php-mode-init.el | 6 + po-mode-init.el | 12 + po-mode.el | 2693 ++++++++++++++++++++++++++++++++++++++++++++++ python-mode.el | 285 +++-- rpm-spec-mode.el | 4 +- sources | 7 +- ssl.el | 201 ++++ 9 files changed, 3239 insertions(+), 283 deletions(-) create mode 100644 php-mode-init.el create mode 100644 po-mode-init.el create mode 100644 po-mode.el create mode 100644 ssl.el diff --git a/.cvsignore b/.cvsignore index e4b8978..5791ace 100644 --- a/.cvsignore +++ b/.cvsignore @@ -1,5 +1,4 @@ -elisp-manual-21-2.6.tar.bz2 -emacs-20.7.tar.bz2 +elisp-manual-21-2.7.tar.bz2 +emacs-21.1.tar.bz2 emacs-asian.tar.bz2 -gnus-5.8.8-compiled.tar.bz2 -leim-20.7.tar.bz2 +leim-21.1.tar.bz2 diff --git a/emacs.spec b/emacs.spec index a001804..492c151 100644 --- a/emacs.spec +++ b/emacs.spec @@ -1,8 +1,9 @@ Summary: The libraries needed to run the GNU Emacs text editor. Name: emacs -Version: 20.7 -Release: 41 +Version: 21.1 +Release: 2.7 License: GPL +URL: http://www.gnu.org/software/emacs/ Group: Applications/Editors Source0: ftp://ftp.gnu.org/gnu/emacs/emacs-%{version}.tar.bz2 Source1: ftp://ftp.gnu.org/gnu/emacs/leim-%{version}.tar.bz2 @@ -10,37 +11,25 @@ Source3: emacs.desktop Source4: emacs.png Source5: dotemacs Source6: site-start.el -Source7: http://www.python.org/emacs/python-mode/python-mode.el -# From /usr/X11R6/lib/X11/locale/locale.alias -Source8: emacs.locale.alias -Source11: http://www.tihlde.org/~stigb/rpm-spec-mode.el -Source12: mwheel.el -Source13: lisp-startup-localealias.patch -Source14: ftp://ftp.gnus.org/pub/gnus/gnus-5.8.8-compiled.tar.bz2 -Source15: emacs-asian.tar.bz2 -Source16: ftp://ftp.gnu.org/gnus/emacs/elisp-manual-21-2.6.tar.bz2 -Patch0: emacs-20.7-xaw3d.patch -Patch2: emacs-20.3-tmprace.patch -Patch3: emacs-20.3-linkscr.patch -Patch4: emacs-20.4-nmhlocation.patch -Patch5: emacs-20.5-loadup.patch -Patch6: emacs-20.6-kbdbuffer.patch -Patch7: emacs-20.6-ia64.patch -Patch8: emacs-20.6-ia64-2.patch -Patch9: emacs-20.6-ia64-3.patch -Patch10: emacs-20.7-manboption.patch -Patch11: emacs-20.7-proto.patch -Patch12: emacs-cpp-Makefile.patch -Patch13: emacs-20.7-makeregexp.patch - +# From Python-2.2a3 +Source7: python-mode.el +Source8: http://www.tihlde.org/~stigb/rpm-spec-mode.el +Source9: emacs-asian.tar.bz2 +Source10: ftp://ftp.gnu.org/gnu/emacs/elisp-manual-21-2.7.tar.bz2 +# 1.0.0 - http://prdownloads.sourceforge.net/php-mode/php-mode-100.el +Source11: php-mode.el +Source12: php-mode-init.el +Source13: ssl.el +Source14: po-mode.el +Source15: po-mode-init.el +Patch0: emacs-21.1-recloadlimit.patch Patch50: emacs-20.7-s390.patch - Buildroot: %{_tmppath}/%{name}-%{version}-root Prereq: /sbin/install-info BuildRequires: Xaw3d-devel glibc-devel gcc XFree86-devel bzip2 ncurses-devel -BuildRequires: zlib-devel libpng-devel libjpeg-devel libungif-devel libtiff-devel -# temporary hack. roll tamago into base emacs package -#Requires: tamago +BuildRequires: zlib-devel libpng-devel libjpeg-devel libungif-devel libtiff-devel +Obsoletes: emacs-nox emacs-X11 +Conflicts: gettext < 0.10.40 %description Emacs is a powerful, customizable, self-documenting, modeless text @@ -50,7 +39,7 @@ without leaving the editor. This package includes the libraries you need to run the Emacs editor, You also need to install the actual Emacs program package (emacs-nox or -emacs-X11). Install emacs-nox if you are not going to use the X +emacs-X11). Install emacs-nox if you are not going to use the X Window System; install emacs-X11 if you will be using X. %package el @@ -78,54 +67,12 @@ user must press in order to input a particular character in a non-English character set. Input methods for many different character sets are included in this package. -%package nox -Summary: The Emacs text editor without support for the X Window System. -Group: Applications/Editors -Requires: emacs -Prereq: fileutils - -%description nox -Emacs-nox is the Emacs text editor program without support for the X -Window System. - -You need to install this package only if you plan on exclusively using -Emacs without the X Window System (emacs-X11 will work both in X and -out of X, but emacs-nox will only work outside of X). You'll also -need to install the emacs package in order to run Emacs. - -%package X11 -Summary: The Emacs text editor for the X Window System. -Group: Applications/Editors -Requires: emacs - -%description X11 -Emacs-X11 includes the Emacs text editor program for use with the X -Window System (it provides support for the mouse and other GUI -elements). Emacs-X11 will also run Emacs outside of X, but it has a -larger memory footprint than the 'non-X' Emacs package (emacs-nox). - -Install emacs-X11 if you're going to use Emacs with the X Window -System. You should also install emacs-X11 if you're going to run -Emacs both with and without X (it will work fine both ways). You'll -also need to install the emacs package in order to run Emacs. - %prep %setup -q -b 1 %patch0 -p1 -%patch2 -p1 -%patch3 -p1 -%patch4 -p1 -%patch5 -p1 -%patch6 -p1 -%patch7 -p1 -%patch8 -p1 -%patch9 -p1 -%patch10 -p1 -%patch11 -p1 -%patch12 -p1 -%patch13 -p1 + %ifarch s390 s390x %patch50 -p1 -b .s390 @@ -133,50 +80,22 @@ also need to install the emacs package in order to run Emacs. %build -PUREDEF="-DNCURSES_OSPEED_T" -XPUREDEF="-DNCURSES_OSPEED_T" -libtoolize --force --copy -autoconf -CONFOPTS="--mandir=%{_mandir} --infodir=%{_infodir} --prefix=/usr --libexecdir=/usr/lib --sharedstatedir=/var --with-gcc --with-pop" +export CFLAGS="-DMAIL_USE_LOCKF $RPM_OPT_FLAGS" +#to find installinfo +export PATH="$PATH:/sbin:/usr/sbin" -BuildEmacs() { - dir=$1 - configflags=$2 - [ -d build-$1 ] && rm -rf build-$1 - mkdir build-$1 && cd build-$1 - CFLAGS="-DMAIL_USE_LOCKF $RPM_OPT_FLAGS $PUREDEF" LDFLAGS=-s \ - ../configure ${CONFOPTS} $2 ${RPM_ARCH}-redhat-linux-gnu - # blarg - echo "#include " >> src/config.h - make - cd .. -} +%configure --with-gcc --with-pop --with-sound +make -#Build binary with X support -BuildEmacs withx "--with-x-toolkit" - -%define recompile build-withx/src/emacs -batch --no-init-file --no-site-file -f batch-byte-compile - -#change the locale.alias for the nox builds -#patch lisp/startup.el %SOURCE10 -#rm -fv lisp/startup.elc -#%{recompile} lisp/startup.el - -#Build binary without X support -BuildEmacs nox "--with-x=no" - -#change the locale.alias back for packaging -#patch -R lisp/startup.el %SOURCE10 -#rm -fv lisp/startup.elc -#%{recompile} lisp/startup.el +%define recompile src/emacs -batch --no-init-file --no-site-file -f batch-byte-compile # recompile patched .el files %{recompile} lisp/mail/mh-utils.el lisp/progmodes/make-mode.el -# bytecompile python-mode, mwheel and rpm-spec-mode -cp %SOURCE7 %SOURCE11 %SOURCE12 . -%{recompile} python-mode.el mwheel.el rpm-spec-mode.el +# bytecompile python-mode, ssl, php-mode and rpm-spec-mode +cp %SOURCE7 %SOURCE8 %SOURCE11 %SOURCE13 %SOURCE14 . +%{recompile} python-mode.el rpm-spec-mode.el php-mode.el ssl.el po-mode.el @@ -186,51 +105,20 @@ mkdir -p $RPM_BUILD_ROOT/usr mkdir -p $RPM_BUILD_ROOT/usr/share/emacs/site-lisp/site-start.d mkdir -p $RPM_BUILD_ROOT/%{_infodir} -make install -C build-withx \ - prefix=$RPM_BUILD_ROOT/usr \ - libexecdir=$RPM_BUILD_ROOT/usr/lib \ - sharedstatedir=$RPM_BUILD_ROOT/var \ - mandir=$RPM_BUILD_ROOT/%{_mandir} \ - infodir=$RPM_BUILD_ROOT/%{_infodir} -# install the locale file -install -m 644 %SOURCE8 $RPM_BUILD_ROOT/usr/share/emacs/locale.alias +%makeinstall #install lisp files for Japanese and other Asian languages pushd $RPM_BUILD_ROOT -tar --use-compress-program=bzip2 -xf %{SOURCE15} -popd - -# We want a newer gnus -tar --use-compress-program=bzip2 -xf %{SOURCE14} -pushd gnus-5.8.8 -#PATH=$RPM_BUILD_ROOT/usr/bin:$PATH ./configure -#make - -rm -f $RPM_BUILD_ROOT//usr/share/emacs/%{version}/lisp/gnus/* -install -m 644 lisp/* $RPM_BUILD_ROOT//usr/share/emacs/%{version}/lisp/gnus/ -rm -f $RPM_BUILD_ROOT/%{_infodir}/gnus* -install -m 644 texi/{gnus,gnus-?,gnus-??} $RPM_BUILD_ROOT/%{_infodir} +tar --use-compress-program=bzip2 -xf %{SOURCE9} popd rm -f $RPM_BUILD_ROOT/%{_infodir}/dir gzip -9nf $RPM_BUILD_ROOT/%{_infodir}/* - -#change the locale.alias for this one and regenerate -# Do it this way, using the macro here seems to confuse RPM -patch lisp/startup.el %SOURCE13 - -rm -fv lisp/startup.elc -%{recompile} lisp/startup.el -rm -f build-nox/src/emacs-%{version}* -make -C build-nox -install -c -m755 build-nox/src/emacs $RPM_BUILD_ROOT/usr/bin/emacs-nox - -install -c -m755 build-nox/src/emacs $RPM_BUILD_ROOT/usr/bin/emacs-nox install -m 644 %SOURCE6 $RPM_BUILD_ROOT/usr/share/emacs/site-lisp/site-start.el -mkdir -p $RPM_BUILD_ROOT/usr/lib/emacs/site-lisp +mkdir -p $RPM_BUILD_ROOT/usr/share/emacs/site-lisp mv $RPM_BUILD_ROOT%{_mandir}/man1/ctags.1 $RPM_BUILD_ROOT%{_mandir}/man1/gctags.1 mv $RPM_BUILD_ROOT/usr/bin/ctags $RPM_BUILD_ROOT/usr/bin/gctags @@ -242,11 +130,14 @@ install -c -m 0644 %SOURCE3 $RPM_BUILD_ROOT/etc/X11/applnk/Applications/ mkdir -p $RPM_BUILD_ROOT/usr/share/pixmaps install -c -m 0644 %SOURCE4 $RPM_BUILD_ROOT/usr/share/pixmaps/ -install -c -m644 build-nox/etc/DOC-* $RPM_BUILD_ROOT/usr/share/emacs/%{version}/etc +mkdir -p $RPM_BUILD_ROOT/usr/share/emacs/%{version}/etc +install -c -m644 etc/DOC-* $RPM_BUILD_ROOT/usr/share/emacs/%{version}/etc -# Python mode, mwheel and rpm-spec mode +# Python mode, php mode and rpm-spec mode -install -c -m0644 python-mode.el python-mode.elc mwheel.el mwheel.elc rpm-spec-mode.el rpm-spec-mode.elc $RPM_BUILD_ROOT/usr/share/emacs/site-lisp/ +install -c -m0644 po-mode.el po-mode.elc php-mode.el php-mode.elc python-mode.el python-mode.elc rpm-spec-mode.el rpm-spec-mode.elc ssl.el ssl.elc $RPM_BUILD_ROOT/usr/share/emacs/site-lisp/ +install -m0644 %SOURCE12 $RPM_BUILD_ROOT/usr/share/emacs/site-lisp/site-start.d/php-mode-init.el +install -m0644 %SOURCE15 $RPM_BUILD_ROOT/usr/share/emacs/site-lisp/site-start.d/po-mode-init.el # default initialization file mkdir -p $RPM_BUILD_ROOT/etc/skel @@ -263,17 +154,15 @@ rm -f $RPM_BUILD_ROOT/%{_mandir}/man1/*ctags* rm -f $RPM_BUILD_ROOT/usr/share/emacs/%{version}/etc/ctags* # The elisp reference manual -bzcat %{SOURCE16} | tar xf - -pushd elisp-manual-21-2.6 +bzcat %{SOURCE10} | tar xf - +pushd elisp-manual-21-2.7 install -m 644 elisp elisp-? elisp-?? $RPM_BUILD_ROOT/%{_infodir} popd -find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/lisp \ - -name '*.elc' -print | sed "s^$RPM_BUILD_ROOT^^" > core-filelist +find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/lisp -type f\ + -not -name '*.el' -print | sed "s^$RPM_BUILD_ROOT^^" > core-filelist find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/lisp \ -type d -printf "%%%%dir %%p\n" | sed "s^$RPM_BUILD_ROOT^^" >> core-filelist -find $RPM_BUILD_ROOT/usr/lib/emacs/%{version} -type f | \ - sed "s^$RPM_BUILD_ROOT^^" | grep -v movemail >> core-filelist # Include .el files which lack a corresponding byte compiled form for I in `find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/lisp \ @@ -284,8 +173,8 @@ for I in `find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/lisp \ done >> core-filelist # Include all non elisp files which emacs installs -find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/lisp -type f | \ - sed "s^$RPM_BUILD_ROOT^^" | grep -v "\.el\(c\)\?$" >> core-filelist +#find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/lisp -type f | \ +# sed "s^$RPM_BUILD_ROOT^^" | grep -v "\.el\(c\)\?$" >> core-filelist find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/leim \ @@ -310,8 +199,6 @@ find $RPM_BUILD_ROOT/usr/share/emacs/%{version}/leim \ %clean rm -rf $RPM_BUILD_ROOT -rm -rf build-nox -rm -rf build-withx %define info_files ccmode cl dired-x ediff emacs forms gnus info message mh-e reftex sc vip viper widget elisp %post @@ -327,65 +214,47 @@ for f in %{info_files}; do done fi -%triggerin nox -- emacs-X11 -if [ -L /usr/bin/emacs ]; then - rm /usr/bin/emacs -fi - -%triggerpostun nox -- emacs-X11 -[ $2 = 0 ] || exit 0 -if [ ! -L /usr/bin/emacs ]; then - ln -sf emacs-nox /usr/bin/emacs -fi - -%post nox -if [ ! -x /usr/bin/emacs -a ! -L /usr/bin/emacs ]; then - ln -sf emacs-nox /usr/bin/emacs -fi - -%postun nox -[ $1 = 0 ] || exit 0 -if [ -L /usr/bin/emacs ]; then - rm /usr/bin/emacs -fi %files -f core-filelist %defattr(-,root,root) %config(noreplace) /etc/skel/.emacs -%doc etc/NEWS BUGS README etc/FAQ +%doc etc/NEWS BUGS README /usr/bin/b2m /usr/bin/emacsclient /usr/bin/etags /usr/bin/rcs-checkin %{_mandir}/*/* %{_infodir}/* -/usr/share/emacs/locale.alias /usr/share/emacs/site-lisp/python-mode.elc -/usr/share/emacs/site-lisp/mwheel.elc +/usr/share/emacs/site-lisp/php-mode.elc +/usr/share/emacs/site-lisp/po-mode.elc /usr/share/emacs/site-lisp/rpm-spec-mode.elc +/usr/share/emacs/site-lisp/ssl.elc /usr/share/emacs/site-lisp/subdirs.el - /usr/share/emacs/site-lisp/site-start.d/lang.emacs.el +/usr/share/emacs/site-lisp/site-start.d/php-mode-init.el +/usr/share/emacs/site-lisp/site-start.d/po-mode-init.el /usr/share/emacs/site-lisp/lang - -%dir /usr/lib/emacs -%dir /usr/lib/emacs/site-lisp -%dir /usr/lib/emacs/%{version} -%dir /usr/lib/emacs/%{version}/* -%attr(0755,root,root) /usr/lib/emacs/%{version}/*/movemail - +%dir /usr/share/emacs %dir /usr/share/emacs/site-lisp +%dir /usr/share/emacs/%{version} +%dir /usr/share/emacs/%{version}/* +/usr/share/emacs/%{version}/etc/* +/usr/libexec/emacs/%{version}/*/* +%attr(0755,root,root) /usr/libexec/emacs/%{version}/*/movemail %attr(0644,root,root) %config /usr/share/emacs/site-lisp/site-start.el %dir /usr/share/emacs/site-lisp/site-start.d -%dir /usr/share/emacs/%{version} -%dir /usr/share/emacs/%{version}/site-lisp -%dir /usr/share/emacs/%{version}/leim -/usr/share/emacs/%{version}/etc +%attr(755,root,root) /usr/bin/emacs +%attr(755,root,root) /usr/bin/emacs-%{version} +%config(noreplace) /etc/X11/applnk/Applications/emacs.desktop +/usr/share/pixmaps/emacs.png %files -f el-filelist el %defattr(-,root,root) /usr/share/emacs/site-lisp/python-mode.el -/usr/share/emacs/site-lisp/mwheel.el +/usr/share/emacs/site-lisp/php-mode.el +/usr/share/emacs/site-lisp/po-mode.el +/usr/share/emacs/site-lisp/ssl.el /usr/share/emacs/site-lisp/rpm-spec-mode.el %files -f leim-filelist leim @@ -393,18 +262,46 @@ fi /usr/share/emacs/%{version}/leim/leim-list.el %dir /usr/share/emacs/%{version}/leim -%files nox -%defattr(-,root,root) -/usr/bin/emacs-nox - -%files X11 -%defattr(-,root,root) -%attr(755,root,root) /usr/bin/emacs -%attr(755,root,root) /usr/bin/emacs-%{version} -%config(noreplace) /etc/X11/applnk/Applications/emacs.desktop -/usr/share/pixmaps/emacs.png - %changelog +* Thu Dec 6 2001 Trond Eivind Glomsrød 21.1-2.7 +- Increase recursive-load-depth-limit from 10 to 50 + +* Wed Dec 5 2001 Trond Eivind Glomsrød 21.1-2 +- Make it conflict with old versions of gettext + +* Thu Nov 29 2001 Trond Eivind Glomsrød 21.1-1 +- rpm-spec-mode 0.11h, should fix #56748 + +* Tue Nov 6 2001 Trond Eivind Glomsrød 21.1-0.4 +- php mode 1.0.1. Should fix some speedbar problems. + +* Tue Oct 23 2001 Trond Eivind Glomsrød 21.1-0.3 +- Minor cleanups +- add ssl.el + +* Mon Oct 22 2001 Trond Eivind Glomsrød 21.1-0.2 +- Add more files from the libexec directory (#54874, #54875) + +* Sun Oct 21 2001 Trond Eivind Glomsrød 21.1-0.1 +- 21.1 +- Build on IA64 again - the default config now handles it +- Drop all old patches +- Misc cleanups +- Update the elisp manual to 21-2.7 +- Deprecate the emacs-nox and emacs-X11 subpackages. + Simplify build procedure to match. +- Update php-mode to 1.0.0 + +* Mon Oct 15 2001 Trond Eivind Glomsrød 20.7-43 +- Add php-mode 0.9.9 +- Add URL (#54603) +- don't run autoconf/libtoolize during build - they're broken +- don't build on IA64 until they are fixed + +* Sun Sep 16 2001 Trond Eivind Glomsrød 20.7-42 +- Update python-mode to the version in the python 2.2a3 +- Include po-mode in emacs, instead of including in gettext + * Mon Jul 30 2001 Trond Eivind Glomsrød - Minor fix to make-mode fontify regexp (#50010) - Build without emacs being installed (#49085) diff --git a/php-mode-init.el b/php-mode-init.el new file mode 100644 index 0000000..402ed2f --- /dev/null +++ b/php-mode-init.el @@ -0,0 +1,6 @@ +;; Use php-mode for .php,.php3,.php4 and .phtml files + +(autoload 'php-mode "php-mode") +(setq auto-mode-alist (cons '("\\.php[34]\\|.php\\|.phtml" . php-mode) + auto-mode-alist)) + diff --git a/po-mode-init.el b/po-mode-init.el new file mode 100644 index 0000000..63db02f --- /dev/null +++ b/po-mode-init.el @@ -0,0 +1,12 @@ +;; Use po-mode for translation files + +(autoload 'po-mode "po-mode") +(setq auto-mode-alist (cons '("\\.po[tx]?\\'\\|\\.po\\." . po-mode) + auto-mode-alist)) + +;;; To automatically use proper fonts under Emacs 20, also add: + +(autoload 'po-find-file-coding-system "po-mode") +(modify-coding-system-alist 'file "\\.po[tx]?\\'\\|\\.po\\." + 'po-find-file-coding-system) + diff --git a/po-mode.el b/po-mode.el new file mode 100644 index 0000000..a599290 --- /dev/null +++ b/po-mode.el @@ -0,0 +1,2693 @@ +;;; po-mode.el -- for helping GNU gettext lovers to edit PO files. +;;; Copyright (C) 1995-1998, 2000, 2001 Free Software Foundation, Inc. +;;; François Pinard , 1995. +;;; Helped by Greg McGary . + +;; This file is part of GNU gettext. + +;; GNU gettext 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 2, or (at your option) +;; any later version. + +;; GNU gettext 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; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + +;;; This package provides the tools meant to help editing PO files, +;;; as documented in the GNU gettext user's manual. See this manual +;;; for user documentation, which is not repeated here. + +;;; To install, merely put this file somewhere GNU Emacs will find it, +;;; then add the following lines to your .emacs file: +;;; +;;; (autoload 'po-mode "po-mode" +;;; "Major mode for translators to edit PO files" t) +;;; (setq auto-mode-alist (cons '("\\.po[tx]?\\'\\|\\.po\\." . po-mode) +;;; auto-mode-alist)) +;;; +;;; To automatically use the right coding system under Emacs 20, also add: +;;; +;;; (autoload 'po-find-file-coding-system "po-mode") +;;; (modify-coding-system-alist 'file "\\.po[tx]?\\'\\|\\.po\\." +;;; 'po-find-file-coding-system) +;;; +;;; You may also adjust some variables, below, by defining them in your +;;; `.emacs' file, either directly or through command `M-x customize'. + +;;; Emacs portability matters. + +;;; Most portability matters are addressed in this page. All other cases +;;; involve one of `eval-and-compile' or `fboundp', just search for these. + +;; Identify which Emacs variety is being used. +(eval-and-compile + (cond ((string-match "Lucid\\|XEmacs" emacs-version) + (setq po-EMACS20 nil po-XEMACS t)) + ((and (string-lessp "19" emacs-version) (featurep 'faces)) + (setq po-EMACS20 t po-XEMACS nil)) + (t (setq po-EMACS20 nil po-XEMACS nil)))) + +;; Experiment with Emacs LISP message internationalisation. +(eval-and-compile + (or (fboundp 'set-translation-domain) + (defsubst set-translation-domain (string) nil)) + (or (fboundp 'translate-string) + (defsubst translate-string (string) string))) +(defsubst _ (string) (translate-string string)) +(defsubst N_ (string) string) + +;; Handle missing `customs' package. +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +;; Protect string comparisons from text properties. +(eval-and-compile + (fset 'po-buffer-substring + (symbol-function (if (fboundp 'buffer-substring-no-properties) + 'buffer-substring-no-properties + 'buffer-substring)))) + +;; Handle missing `with-temp-buffer' function. +(eval-and-compile + (if nil ; FIXME: just testing... (fboundp 'with-temp-buffer) + + (fset 'po-with-temp-buffer (symbol-function 'with-temp-buffer)) + + (defmacro po-with-temp-buffer (&rest forms) + "Create a temporary buffer, and evaluate FORMS there like `progn'." + (let ((curr-buffer (make-symbol "curr-buffer")) + (temp-buffer (make-symbol "temp-buffer"))) + `(let ((,curr-buffer (current-buffer)) + (,temp-buffer (get-buffer-create + (generate-new-buffer-name " *po-temp*")))) + (unwind-protect + (progn + (set-buffer ,temp-buffer) + ,@forms) + (set-buffer ,curr-buffer) + (and (buffer-name ,temp-buffer) + (kill-buffer ,temp-buffer)))))))) + +;; Handle missing `kill-new' function. +(eval-and-compile + (if (fboundp 'kill-new) + + (fset 'po-kill-new (symbol-function 'kill-new)) + + (defun po-kill-new (string) + "Push STRING onto the kill ring, for Emacs 18 where kill-new is missing." + (po-with-temp-buffer + (insert string) + (kill-region (point-min) (point-max)))))) + +;; Handle missing `read-event' function. +(eval-and-compile + (fset 'po-read-event + (cond ((fboundp 'read-event) + ;; GNU Emacs. + 'read-event) + ((fboundp 'next-command-event) + ;; XEmacs. + 'next-command-event) + (t + ;; Older Emacses. + 'read-char)))) + +;; Handle missing `force-mode-line-update' function. +(eval-and-compile + (if (fboundp 'force-mode-line-update) + + (fset 'po-force-mode-line-update + (symbol-function 'force-mode-line-update)) + + (defun po-force-mode-line-update () + "Force the mode-line of the current buffer to be redisplayed." + (set-buffer-modified-p (buffer-modified-p))))) + +;; Handle portable highlighting. Code has been adapted (OK... stolen! :-) +;; from `ispell.el'. +(eval-and-compile + (cond + (po-EMACS20 + + (defun po-create-overlay () + "Create and return a deleted overlay structure. +The variable `po-highlight-face' selects the face to use for highlighting." + (let ((overlay (make-overlay (point) (point)))) + (overlay-put overlay 'face po-highlight-face) + ;; The fun thing is that a deleted overlay retains its face, and is + ;; movable. + (delete-overlay overlay) + overlay)) + + (defun po-highlight (overlay start end &optional buffer) + "Use OVERLAY to highlight the string from START to END. +If limits are not relative to the current buffer, use optional BUFFER." + (move-overlay overlay start end (or buffer (current-buffer)))) + + (defun po-rehighlight (overlay) + "Ensure OVERLAY is highlighted." + ;; There is nothing to do, as GNU Emacs allows multiple highlights. + nil) + + (defun po-dehighlight (overlay) + "Display normally the last string which OVERLAY highlighted. +The current buffer should be in PO mode, when this function is called." + (delete-overlay overlay))) + + (po-XEMACS + + (defun po-create-overlay () + "Create and return a deleted overlay structure." + (cons (make-marker) (make-marker))) + + (defun po-highlight (overlay start end &optional buffer) + "Use OVERLAY to highlight the string from START to END. +If limits are not relative to the current buffer, use optional BUFFER." + (if buffer + (save-excursion + (set-buffer buffer) + (isearch-highlight start end)) + (isearch-highlight start end)) + (set-marker (car overlay) start (or buffer (current-buffer))) + (set-marker (cdr overlay) end (or buffer (current-buffer)))) + + (defun po-rehighlight (overlay) + "Ensure OVERLAY is highlighted." + (let ((buffer (marker-buffer (car overlay))) + (start (marker-position (car overlay))) + (end (marker-position (cdr overlay)))) + (and buffer + (name-buffer buffer) + (po-highlight overlay start end buffer)))) + + (defun po-dehighlight (overlay) + "Display normally the last string which OVERLAY highlighted." + (isearch-dehighlight t) + (setcar overlay (make-marker)) + (setcdr overlay (make-marker)))) + + (t + + (defun po-create-overlay () + "Create and return a deleted overlay structure." + (cons (make-marker) (make-marker))) + + (defun po-highlight (overlay start end &optional buffer) + "Use OVERLAY to highlight the string from START to END. +If limits are not relative to the current buffer, use optional BUFFER. +No doubt that highlighting, when Emacs does not allow it, is a kludge." + (save-excursion + (and buffer (set-buffer buffer)) + (let ((modified (buffer-modified-p)) + (buffer-read-only nil) + (inhibit-quit t) + (buffer-undo-list t) + (text (buffer-substring start end))) + (goto-char start) + (delete-region start end) + (insert-char ? (- end start)) + (sit-for 0) + (setq inverse-video (not inverse-video)) + (delete-region start end) + (insert text) + (sit-for 0) + (setq inverse-video (not inverse-video)) + (set-buffer-modified-p modified))) + (set-marker (car overlay) start (or buffer (current-buffer))) + (set-marker (cdr overlay) end (or buffer (current-buffer)))) + + (defun po-rehighlight (overlay) + "Ensure OVERLAY is highlighted." + (let ((buffer (marker-buffer (car overlay))) + (start (marker-position (car overlay))) + (end (marker-position (cdr overlay)))) + (and buffer + (name-buffer buffer) + (po-highlight overlay start end buffer)))) + + (defun po-dehighlight (overlay) + "Display normally the last string which OVERLAY highlighted." + (let ((buffer (marker-buffer (car overlay))) + (start (marker-position (car overlay))) + (end (marker-position (cdr overlay)))) + (if buffer + (save-excursion + (set-buffer buffer) + (let ((modified (buffer-modified-p)) + (buffer-read-only nil) + (inhibit-quit t) + (buffer-undo-list t)) + (let ((text (buffer-substring start end))) + (goto-char start) + (delete-region start end) + (insert-char ? (- end start)) + (sit-for 0) + (delete-region start end) + (insert text) + (sit-for 0) + (set-buffer-modified-p modified))))) + (setcar overlay (make-marker)) + (setcdr overlay (make-marker)))) + + ))) + +;;; Customisation. + +(defgroup po nil + "Major mode for editing PO files" + :group 'i18n) + +(defcustom po-auto-edit-with-msgid nil + "*Automatically use msgid when editing untranslated entries." + :type 'boolean + :group 'po) + +(defcustom po-auto-fuzzy-on-edit nil + "*Automatically mark entries fuzzy when being edited." + :type 'boolean + :group 'po) + +(defcustom po-auto-select-on-unfuzzy nil + "*Automatically select some new entry while making an entry not fuzzy." + :type 'boolean + :group 'po) + +(defcustom po-auto-replace-revision-date 'ask + "*Automatically revise date in headers. Value is nil, t, or ask." + :type '(choice (const nil) + (const t) + (const ask)) + :group 'po) + +(defcustom po-default-file-header "\ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR Free Software Foundation, Inc. +# FIRST AUTHOR , YEAR. +# +#, fuzzy +msgid \"\" +msgstr \"\" +\"Project-Id-Version: PACKAGE VERSION\\n\" +\"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n\" +\"Last-Translator: FULL NAME \\n\" +\"Language-Team: LANGUAGE \\n\" +\"MIME-Version: 1.0\\n\" +\"Content-Type: text/plain; charset=CHARSET\\n\" +\"Content-Transfer-Encoding: 8bit\\n\" +" + "*Default PO file header." + :type 'string + :group 'po) + +(defcustom po-highlighting (or po-EMACS20 po-XEMACS) + "*Highlight text whenever appropriate, when non-nil. However, on older +Emacses, a yet unexplained highlighting bug causes files to get mangled." + :type 'boolean + :group 'po) + +(defcustom po-highlight-face 'highlight + "*The face used for PO mode highlighting. For Emacses with overlays. +Possible values are `highlight', `modeline', `secondary-selection', +`region', and `underline'. +This variable can be set by the user to whatever face they desire. +It's most convenient if the cursor color and highlight color are +slightly different." + :type 'face + :group 'po) + +(defcustom po-gzip-uuencode-command "gzip -9 | uuencode -m" + "*The filter to use for preparing a mail invoice of the PO file. +Normally \"gzip -9 | uuencode -m\", remove the -9 for lesser compression, +or remove the -m if you are not using the GNU version of `uuencode'." + :type 'string + :group 'po) + +;;; The following block of declarations has the main purpose of avoiding +;;; byte compiler warnings. It also introduces some documentation for +;;; each of these variables, all meant to be local to PO mode buffers. + +;; Flag telling that MODE-LINE-STRING should be displayed. See `Window' +;; page below. Exceptionally, this variable is local to *all* buffers. + +(defvar po-mode-flag) + +;; PO buffers are kept read-only to prevent random modifications. READ-ONLY +;; holds the value of the read-only flag before PO mode was entered. + +(defvar po-read-only) + +;; The current entry extends from START-OF-ENTRY to END-OF-ENTRY, it +;; includes preceding whitespace and excludes following whitespace. The +;; start of keyword lines are START-OF-MSGID and START-OF-MSGSTR. +;; ENTRY-TYPE classifies the entry. + +(defvar po-start-of-entry) +(defvar po-start-of-msgid) +(defvar po-start-of-msgstr) +(defvar po-end-of-entry) +(defvar po-entry-type) + +;; A few counters are usefully shown in the Emacs mode line. + +(defvar po-translated-counter) +(defvar po-fuzzy-counter) +(defvar po-untranslated-counter) +(defvar po-obsolete-counter) +(defvar po-mode-line-string) + +;; PO mode keeps track of fields being edited, for one given field should +;; have one editing buffer at most, and for exiting a PO buffer properly +;; should offer to close all pending edits. Variable EDITED-FIELDS holds an +;; an list of "slots" of the form: (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO). +;; To allow simultaneous edition of the comment and the msgstr of an entry, +;; ENTRY-MARKER points to the msgid line if a comment is being edited, or to +;; the msgstr line if the msgstr is being edited. EDIT-BUFFER is the +;; temporary Emacs buffer used to edit the string. OVERLAY-INFO, when not +;; nil, holds an overlay (or if overlays are not supported, a cons of two +;; markers) for this msgid string which became highlighted for the edit. + +(defvar po-edited-fields) + +;; We maintain a set of movable pointers for returning to entries. + +(defvar po-marker-stack) + +;; SEARCH path contains a list of directories where files may be found, +;; in a format suitable for read completion. Each directory includes +;; its trailing slash. PO mode starts with "./" and "../". + +(defvar po-search-path) + +;; The following variables are meaningful only when REFERENCE-CHECK +;; is identical to START-OF-ENTRY, else they should be recomputed. +;; REFERENCE-ALIST contains all known references for the current +;; entry, each list element is (PROMPT FILE LINE), where PROMPT may +;; be used for completing read, FILE is a string and LINE is a number. +;; REFERENCE-CURSOR is a cycling cursor into REFERENCE-ALIST. + +(defvar po-reference-alist) +(defvar po-reference-cursor) +(defvar po-reference-check) + +;; The following variables are for marking translatable strings in program +;; sources. KEYWORDS is the list of keywords for marking translatable +;; strings, kept in a format suitable for reading with completion. +;; NEXT-FILE-LIST is the list of source files to visit, gotten from the tags +;; table. STRING-START is the position for the beginning of the last found +;; string, or nil if the string is invalidated. STRING-END is the position +;; for the end of the string and indicates where the search should be +;; resumed, or nil for the beginning of the current file. MARKING-OVERLAY, +;; if not `nil', holds the overlay which highlight the last found string; +;; for older Emacses, it holds the cons of two markers around the +;; highlighted region. + +(defvar po-keywords) +(defvar po-next-file-list) +(defvar po-string-start) +(defvar po-string-end) +(defvar po-marking-overlay) + +;;; PO mode variables and constants (usually not to customize). + +;; The textdomain should really be "gettext", only trying it for now. +;; All this requires more thinking, we cannot just do this like that. +(set-translation-domain "po-mode") + +(defun po-mode-version () + "Show Emacs PO mode version." + (interactive) + (message (_"Emacs PO mode, version %s") (substring "$Revision: 1.1.1.1 $" 11 -2))) + +(defconst po-help-display-string + (_"\ +PO Mode Summary Next Previous Miscellaneous +*: Later, /: Docum n p Any type . Redisplay + /t /M-t Translated /v Version info +Moving around f M-f Fuzzy ?, h This help +< First if any o M-o Obsolete = Current index +> Last if any u M-u Untranslated O Other window +/SPC Auto select V Validate + Msgstr Comments M Mail officially +Modifying entries RET # Call editor U Undo +TAB Remove fuzzy mark k K Kill to E Edit out full +/DEL Fuzzy or fade out w W Copy to Q Forceful quit +LFD Init with msgid y Y Yank from q Confirm and quit + +gettext Keyword Marking Position Stack +, Find next string Compendiums m Mark and push current +M-, Mark translatable *c To compendium r Pop and return +M-. Change mark, mark *M-C Select, save x Exchange current/top + +Program Sources Auxiliary Files Lexicography +s Cycle reference a Cycle file *l Lookup translation +M-s Select reference M-a Select file *M-l Add/edit translation +S Consider path A Consider PO file *L Consider lexicon +M-S Ignore path M-A Ignore PO file *M-L Ignore lexicon +") + "Help page for PO mode.") + +(defconst po-mode-menu-layout + '("PO" + ("Moving around" + ["Auto select" po-auto-select-entry t] + "---" + "Forward" + ["Any next" po-next-entry t] + ["Next translated" po-next-translated-entry t] + ["Next fuzzy" po-next-fuzzy-entry t] + ["Next obsolete" po-next-obsolete-entry t] + ["Next untranslated" po-next-untranslated-entry t] + ["Last file entry" po-last-entry t] + "---" + "Backward" + ["Any previous" po-previous-entry t] + ["Previous translated" po-previous-translated-entry t] + ["Previous fuzzy" po-previous-fuzzy-entry t] + ["Previous obsolete" po-previous-obsolete-entry t] + ["Previous untranslated" po-previous-untranslated-entry t] + ["First file entry" po-first-entry t] + "---" + "Position stack" + ["Mark and push current" po-push-location t] + ["Pop and return" po-pop-location t] + ["Exchange current/top" po-exchange-location t] + "---" + ["Redisplay" po-current-entry t] + ["Current index" po-statistics t]) + ("Modifying entries" + ["Undo" po-undo t] + "---" + "Msgstr" + ["Edit msgstr" po-edit-msgstr t] + ["Kill msgstr" po-kill-msgstr t] + ["Save msgstr" po-kill-ring-save-msgstr t] + ["Yank msgstr" po-yank-msgstr t] + "---" + "Comments" + ["Edit comment" po-edit-comment t] + ["Kill comment" po-kill-comment t] + ["Save comment" po-kill-ring-save-comment t] + ["Yank comment" po-yank-comment t] + "---" + ["Remove fuzzy mark" po-unfuzzy t] + ["Fuzzy or fade out" po-fade-out-entry t] + ["Init with msgid" po-msgid-to-msgstr t]) + ("Other files" + ["Other window" po-other-window t] + "---" + "Program sources" + ["Cycle reference" po-cycle-source-reference t] + ["Select reference" po-select-source-reference t] + ["Consider path" po-consider-source-path t] + ["Ignore path" po-ignore-source-path t] + "---" + "Compendiums" + ["To compendium" po-save-entry nil] + ["Select, save" po-select-and-save-entry nil] + "---" + "Auxiliary files" + ["Cycle file" po-cycle-auxiliary t] + ["Select file" po-select-auxiliary t] + ["Consider file" po-consider-as-auxiliary t] + ["Ignore file" po-ignore-as-auxiliary t] + "---" + "Lexicography" + ["Lookup translation" po-lookup-lexicons nil] + ["Add/edit translation" po-edit-lexicon-entry nil] + ["Consider lexicon" po-consider-lexicon-file nil] + ["Ignore lexicon" po-ignore-lexicon-file nil]) + "---" + "Source marking" + ["Find first string" (po-tags-search '(nil)) t] + ["Prefer keyword" (po-select-mark-and-mark '(nil)) t] + ["Find next string" po-tags-search t] + ["Mark preferred" po-mark-translatable t] + ["Mark with keyword" po-select-mark-and-mark t] + "---" + ["Version info" po-mode-version t] + ["Help page" po-help t] + ["Validate" po-validate t] + ["Mail officially" po-send-mail t] + ["Edit out full" po-edit-out-full t] + "---" + ["Forceful quit" po-quit t] + ["Soft quit" po-confirm-and-quit t]) + "Menu layout for PO mode.") + +;; FIXME: subedit mode should also have its own layout. + +(defconst po-subedit-message + (_"Type `C-c C-c' once done, or `C-c C-k' to abort edit") + "Message to post in the minibuffer when an edit buffer is displayed.") + +(defconst po-content-type-charset-alist + '(; Note: Emacs 20 doesn't support all encodings, thus the missing entries. + (ASCII . undecided) + (ANSI_X3.4-1968 . undecided) + (US-ASCII . undecided) + (ISO-8859-1 . iso-8859-1) + (ISO_8859-1 . iso-8859-1) + (ISO-8859-2 . iso-8859-2) + (ISO_8859-2 . iso-8859-2) + (ISO-8859-3 . iso-8859-3) + (ISO_8859-3 . iso-8859-3) + (ISO-8859-4 . iso-8859-4) + (ISO_8859-4 . iso-8859-4) + (ISO-8859-5 . iso-8859-5) + (ISO_8859-5 . iso-8859-5) + ;(ISO-8859-6 . ??) + ;(ISO_8859-6 . ??) + (ISO-8859-7 . iso-8859-7) + (ISO_8859-7 . iso-8859-7) + (ISO-8859-8 . iso-8859-8) + (ISO_8859-8 . iso-8859-8) + (ISO-8859-9 . iso-8859-9) + (ISO_8859-9 . iso-8859-9) + ;(ISO-8859-13 . ??) + ;(ISO_8859-13 . ??) + (ISO-8859-15 . iso-8859-15) ; requires Emacs 21 + (ISO_8859-15 . iso-8859-15) ; requires Emacs 21 + (KOI8-R . koi8-r) + ;(KOI8-U . ??) + ;(CP850 . ??) + ;(CP866 . ??) + ;(CP874 . ??) + ;(CP932 . ??) + ;(CP949 . ??) + ;(CP950 . ??) + ;(CP1250 . ??) + ;(CP1251 . ??) + ;(CP1252 . ??) + ;(CP1253 . ??) + ;(CP1254 . ??) + ;(CP1255 . ??) + ;(CP1256 . ??) + ;(CP1257 . ??) + (GB2312 . cn-gb-2312) ; also named 'gb2312' in XEmacs 21 or Emacs 21 + ; also named 'euc-cn' in Emacs 20 or Emacs 21 + (EUC-JP . euc-jp) + (EUC-KR . euc-kr) + ;(EUC-TW . ??) + (BIG5 . big5) + ;(BIG5-HKSCS . ??) + ;(GBK . ??) + ;(GB18030 . ??) + (SHIFT_JIS . shift_jis) + ;(JOHAB . ??) + (TIS-620 . tis-620) ; requires Emacs 20 or Emacs 21 + (VISCII . viscii) ; requires Emacs 20 or Emacs 21 + (UTF-8 . utf-8) ; requires Mule-UCS in Emacs 20, or Emacs 21 + ) + "How to convert a GNU libc/libiconv canonical charset name as seen in +Content-Type into a Mule coding system.") + +(defvar po-auxiliary-list nil + "List of auxiliary PO files, in completing read format.") + +(defvar po-auxiliary-cursor nil + "Cursor into the `po-auxiliary-list'.") + +(defvar po-translation-project-address + "translation@iro.umontreal.ca" + "Electronic mail address of the Translation Project.") + +(defvar po-compose-mail-function + (let ((functions '(compose-mail-other-window + message-mail-other-window + compose-mail + message-mail)) + result) + (while (and (not result) functions) + (if (fboundp (car functions)) + (setq result (car functions)) + (setq functions (cdr functions)))) + (cond (result) + ((fboundp 'mail-other-window) + (function (lambda (to subject) + (mail-other-window nil to subject)))) + ((fboundp 'mail) + (function (lambda (to subject) + (mail nil to subject)))) + (t (function (lambda (to subject) + (error (_"I do not know how to mail to `%s'") to)))))) + "Function to start composing an electronic message.") + +(defvar po-any-msgid-regexp + "^\\(#~?[ \t]*\\)?msgid.*\n\\(\\(#~?[ \t]*\\)?\".*\n\\)*" + "Regexp matching a whole msgid field, whether obsolete or not.") + +(defvar po-any-msgstr-regexp + ;; "^\\(#~?[ \t]*\\)?msgstr.*\n\\(\\(#~?[ \t]*\\)?\".*\n\\)*" + "^\\(#~?[ \t]*\\)?msgstr\\(\\[[0-9]\\]\\)?.*\n\\(\\(#~?[ \t]*\\)?\".*\n\\)*" + "Regexp matching a whole msgstr or msgstr[] field, whether obsolete or not.") + +(defvar po-msgstr-idx-keyword-regexp + "^\\(#~?[ \t]*\\)?msgstr\\[[0-9]\\]" + "Regexp matching an indexed msgstr keyword, whether obsolete or not.") + +(defvar po-msgfmt-program "msgfmt" + "Path to msgfmt program from GNU gettext package.") + +;; Font lock based highlighting code. +(defconst po-font-lock-keywords + '( + ;; ("^\\(msgid \\|msgstr \\)?\"\\|\"$" . font-lock-keyword-face) + ;; (regexp-opt + ;; '("msgid " "msgid_plural " "msgstr " "msgstr[0] " "msgstr[1] ")) + ("^\\(\\(msg\\(id\\(_plural\\)?\\|str\\(\\[[0-9]\\]\\)?\\)?\\) \\)?\"\\|\"$" + . font-lock-keyword-face) + ("\\\\.\\|%\\*?[-.0-9ul]*[a-zA-Z]" . font-lock-variable-name-face) + ("^# .*\\|^#[:,]?" . font-lock-comment-face) + ("^#:\\(.*\\)" 1 font-lock-reference-face) + ;; The following line does not work, and I wonder why. + ;;("^#,\\(.*\\)" 1 font-function-name-reference-face) + ) + "Additional expressions to highlight in PO mode.") + +;; Old activator for `font lock'. Is it still useful? I don't think so. +;; +;;(if (boundp 'font-lock-keywords) +;; (put 'po-mode 'font-lock-keywords 'po-font-lock-keywords)) + +;; `hilit19' based highlighting code has been disabled, as most probably +;; nobody really needs it (it also generates ugly byte-compiler warnings). +;; +;;(if (fboundp 'hilit-set-mode-patterns) +;; (hilit-set-mode-patterns 'po-mode +;; '(("^# .*\\|^#$" nil comment) +;; ("^#[.,:].*" nil include) +;; ("^\\(msgid\\|msgstr\\) *\"" nil keyword) +;; ("^\"\\|\"$" nil keyword)))) + +;;; Mode activation. + +(eval-and-compile + (if (or po-EMACS20 po-XEMACS) + (defun po-find-file-coding-system-guts (operation filename) + "Return a Mule (DECODING . ENCODING) pair, according to PO file charset. +Called through file-coding-system-alist, before the file is visited for real." + (and (eq operation 'insert-file-contents) + (with-temp-buffer + (let ((coding-system-for-read 'no-conversion)) + ;; Is 4096 enough? FIXME: Retry as needed! + (insert-file-contents filename nil 0 4096) + (if (re-search-forward + "^\"Content-Type: text/plain;[ \t]*charset=\\([^\\]+\\)" + nil t) + (let* ((charset (buffer-substring + (match-beginning 1) (match-end 1))) + (charset-upper (intern (upcase charset))) + (charset-lower (intern (downcase charset)))) + (list (or (cdr (assq charset-upper + po-content-type-charset-alist)) + (if (memq charset-lower (coding-system-list)) + charset-lower + 'no-conversion)))) + '(no-conversion))))))) + + (if po-EMACS20 + (defun po-find-file-coding-system (arg-list) + "Return a Mule (DECODING . ENCODING) pair, according to PO file charset. +Called through file-coding-system-alist, before the file is visited for real." + (po-find-file-coding-system-guts (car arg-list) (car (cdr arg-list))))) + + (if po-XEMACS + (defun po-find-file-coding-system (operation filename) + "Return a Mule (DECODING . ENCODING) pair, according to PO file charset. +Called through file-coding-system-alist, before the file is visited for real." + (po-find-file-coding-system-guts operation filename))) + + ) + +(defvar po-mode-map nil + "Keymap for PO mode.") +(if po-mode-map + () + ;; The following line because (make-sparse-keymap) does not work on Demacs. + (setq po-mode-map (make-keymap)) + (suppress-keymap po-mode-map) + (define-key po-mode-map "\C-i" 'po-unfuzzy) + (define-key po-mode-map "\C-j" 'po-msgid-to-msgstr) + (define-key po-mode-map "\C-m" 'po-edit-msgstr) + (define-key po-mode-map " " 'po-auto-select-entry) + (define-key po-mode-map "?" 'po-help) + (define-key po-mode-map "#" 'po-edit-comment) + (define-key po-mode-map "," 'po-tags-search) + (define-key po-mode-map "." 'po-current-entry) + (define-key po-mode-map "<" 'po-first-entry) + (define-key po-mode-map "=" 'po-statistics) + (define-key po-mode-map ">" 'po-last-entry) + (define-key po-mode-map "a" 'po-cycle-auxiliary) +;;;; (define-key po-mode-map "c" 'po-save-entry) + (define-key po-mode-map "f" 'po-next-fuzzy-entry) + (define-key po-mode-map "h" 'po-help) + (define-key po-mode-map "k" 'po-kill-msgstr) +;;;; (define-key po-mode-map "l" 'po-lookup-lexicons) + (define-key po-mode-map "m" 'po-push-location) + (define-key po-mode-map "n" 'po-next-entry) + (define-key po-mode-map "o" 'po-next-obsolete-entry) + (define-key po-mode-map "p" 'po-previous-entry) + (define-key po-mode-map "q" 'po-confirm-and-quit) + (define-key po-mode-map "r" 'po-pop-location) + (define-key po-mode-map "s" 'po-cycle-source-reference) + (define-key po-mode-map "t" 'po-next-translated-entry) + (define-key po-mode-map "u" 'po-next-untranslated-entry) + (define-key po-mode-map "v" 'po-mode-version) + (define-key po-mode-map "w" 'po-kill-ring-save-msgstr) + (define-key po-mode-map "x" 'po-exchange-location) + (define-key po-mode-map "y" 'po-yank-msgstr) + (define-key po-mode-map "A" 'po-consider-as-auxiliary) + (define-key po-mode-map "E" 'po-edit-out-full) + (define-key po-mode-map "K" 'po-kill-comment) +;;;; (define-key po-mode-map "L" 'po-consider-lexicon-file) + (define-key po-mode-map "M" 'po-send-mail) + (define-key po-mode-map "O" 'po-other-window) + (define-key po-mode-map "Q" 'po-quit) + (define-key po-mode-map "S" 'po-consider-source-path) + (define-key po-mode-map "U" 'po-undo) + (define-key po-mode-map "V" 'po-validate) + (define-key po-mode-map "W" 'po-kill-ring-save-comment) + (define-key po-mode-map "Y" 'po-yank-comment) + (define-key po-mode-map "\177" 'po-fade-out-entry) + (define-key po-mode-map "\M-," 'po-mark-translatable) + (define-key po-mode-map "\M-." 'po-select-mark-and-mark) + (define-key po-mode-map "\M-a" 'po-select-auxiliary) +;;;; (define-key po-mode-map "\M-c" 'po-select-and-save-entry) + (define-key po-mode-map "\M-f" 'po-previous-fuzzy-entry) +;;;; (define-key po-mode-map "\M-l" 'po-edit-lexicon-entry) + (define-key po-mode-map "\M-o" 'po-previous-obsolete-entry) + (define-key po-mode-map "\M-t" 'po-previous-translated-entry) + (define-key po-mode-map "\M-u" 'po-previous-untranslated-entry) + (define-key po-mode-map "\M-s" 'po-select-source-reference) + (define-key po-mode-map "\M-A" 'po-ignore-as-auxiliary) +;;;; (define-key po-mode-map "\M-L" 'po-ignore-lexicon-file) + (define-key po-mode-map "\M-S" 'po-ignore-source-path) + ) + +(defun po-mode () + "Major mode for translators when they edit PO files. +Special commands:\\{po-mode-map} +Turning on PO mode calls the value of the variable `po-mode-hook', +if that value is non-nil. Behaviour may be adjusted through some variables, +all reachable through `M-x customize', in group `Emacs.Editing.I18n.Po'." + + (interactive) + (kill-all-local-variables) + (setq major-mode 'po-mode + mode-name "PO") + (use-local-map po-mode-map) + (if (fboundp 'easy-menu-define) + (progn + (easy-menu-define po-mode-menu po-mode-map "" po-mode-menu-layout) + (and po-XEMACS (easy-menu-add po-mode-menu)))) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(po-font-lock-keywords t)) + + (make-local-variable 'po-read-only) + (setq po-read-only buffer-read-only + buffer-read-only t) + + (make-local-variable 'po-start-of-entry) + (make-local-variable 'po-start-of-msgid) + (make-local-variable 'po-start-of-msgstr) + (make-local-variable 'po-end-of-entry) + (make-local-variable 'po-entry-type) + + (make-local-variable 'po-translated-counter) + (make-local-variable 'po-fuzzy-counter) + (make-local-variable 'po-untranslated-counter) + (make-local-variable 'po-obsolete-counter) + (make-local-variable 'po-mode-line-string) + + (setq po-mode-flag t) + + (po-check-file-header) + (po-compute-counters nil) + + (make-local-variable 'po-edited-fields) + (setq po-edited-fields nil) + + (make-local-variable 'po-marker-stack) + (setq po-marker-stack nil) + + (make-local-variable 'po-search-path) + (setq po-search-path '(("./") ("../"))) + + (make-local-variable 'po-reference-alist) + (make-local-variable 'po-reference-cursor) + (make-local-variable 'po-reference-check) + (setq po-reference-alist nil + po-reference-cursor nil + po-reference-check 0) + + (make-local-variable 'po-keywords) + (make-local-variable 'po-next-file-list) + (make-local-variable 'po-string-start) + (make-local-variable 'po-string-end) + (make-local-variable 'po-marking-overlay) + (setq po-keywords '(("gettext") ("gettext_noop") ("_") ("N_")) + po-next-file-list nil + po-string-start nil + po-string-end nil + po-marking-overlay (po-create-overlay)) + + (message (_"You may type `h' or `?' for a short PO mode reminder.")) + (run-hooks 'po-mode-hook)) + +;;; Window management. + +(make-variable-buffer-local 'po-mode-flag) + +(defvar po-mode-line-entry '(po-mode-flag (" " po-mode-line-string)) + "Mode line format entry displaying MODE-LINE-STRING.") + +;; Insert MODE-LINE-ENTRY in mode line, but on first load only. +(or (member po-mode-line-entry mode-line-format) + (let ((entry (member 'global-mode-string mode-line-format))) + (setcdr entry (cons po-mode-line-entry (cdr entry))))) + +(defun po-update-mode-line-string () + "Compute a new statistics string to display in mode line." + (setq po-mode-line-string + (concat (format "%dt" po-translated-counter) + (if (> po-fuzzy-counter 0) + (format "+%df" po-fuzzy-counter)) + (if (> po-untranslated-counter 0) + (format "+%du" po-untranslated-counter)) + (if (> po-obsolete-counter 0) + (format "+%do" po-obsolete-counter)))) + (po-force-mode-line-update)) + +(defun po-type-counter () + "Return the symbol name of the counter appropriate for the current entry." + (cond ((eq po-entry-type 'obsolete) 'po-obsolete-counter) + ((eq po-entry-type 'fuzzy) 'po-fuzzy-counter) + ((eq po-entry-type 'translated) 'po-translated-counter) + ((eq po-entry-type 'untranslated) 'po-untranslated-counter) + (t (error (_"Unknown entry type"))))) + +(defun po-decrease-type-counter () + "Decrease the counter corresponding to the nature of the current entry." + (let ((counter (po-type-counter))) + (set counter (1- (eval counter))))) + +(defun po-increase-type-counter () + "Increase the counter corresponding to the nature of the current entry. +Then, update the mode line counters." + (let ((counter (po-type-counter))) + (set counter (1+ (eval counter)))) + (po-update-mode-line-string)) + +;; Avoid byte compiler warnings. +(defvar po-fuzzy-regexp) +(defvar po-untranslated-regexp) + +(defun po-compute-counters (flag) + "Prepare counters for mode line display. If FLAG, also echo entry position." + (and flag (po-find-span-of-entry)) + (setq po-translated-counter 0 + po-fuzzy-counter 0 + po-untranslated-counter 0 + po-obsolete-counter 0) + (let ((position 0) (total 0) here) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward po-any-msgstr-regexp nil t) + (and (= (% total 20) 0) + (if flag + (message (_"Position %d/%d") position total) + (message (_"Position %d") total))) + (setq here (point)) + (goto-char (match-beginning 0)) + (setq total (1+ total)) + (and flag (eq (point) po-start-of-msgstr) (setq position total)) + (cond ((eq (following-char) ?#) + (setq po-obsolete-counter (1+ po-obsolete-counter))) + ((looking-at po-untranslated-regexp) + (setq po-untranslated-counter (1+ po-untranslated-counter))) + (t (setq po-translated-counter (1+ po-translated-counter)))) + (goto-char here)) + + ;; Make another pass just for the fuzzy entries, kind of kludgey. + ;; FIXME: Counts will be wrong if untranslated entries are fuzzy, yet + ;; this should not normally happen. + (goto-char (point-min)) + (while (re-search-forward po-fuzzy-regexp nil t) + (setq po-fuzzy-counter (1+ po-fuzzy-counter))) + (setq po-translated-counter (- po-translated-counter po-fuzzy-counter))) + + ;; Push the results out. + (if flag + (message (_"\ +Position %d/%d; %d translated, %d fuzzy, %d untranslated, %d obsolete") + position total po-translated-counter po-fuzzy-counter + po-untranslated-counter po-obsolete-counter) + (message ""))) + (po-update-mode-line-string)) + +(defun po-redisplay () + "Redisplay the current entry." + ;; FIXME: Should try to fit the whole entry on the window. If this is not + ;; possible, should try to fit the comment and the msgid. Otherwise, + ;; should try to fit the msgid. Else, the first line of the msgid should + ;; be at the top of the window. + (goto-char po-start-of-msgid)) + +(defun po-other-window () + "Get the cursor into another window, out of PO mode." + (interactive) + (if (one-window-p t) + (progn + (split-window) + (switch-to-buffer (other-buffer))) + (other-window 1))) + +;;; Processing the PO file header entry. + +(defun po-check-file-header () + "Create a missing PO mode file header, or replace an oldish one." + (save-excursion + (let ((buffer-read-only po-read-only) + insert-flag end-of-header) + (goto-char (point-min)) + (if (re-search-forward po-any-msgstr-regexp nil t) + (progn + + ;; There is at least one entry. + (goto-char (match-beginning 0)) + (previous-line 1) + (setq end-of-header (match-end 0)) + (if (looking-at "msgid \"\"\n") + + ;; There is indeed a PO file header. + (if (re-search-forward "\n\"PO-Revision-Date: " + end-of-header t) + nil + + ;; This is an oldish header. Replace it all. + (goto-char end-of-header) + (while (> (point) (point-min)) + (previous-line 1) + (insert "#~ ") + (beginning-of-line)) + (beginning-of-line) + (setq insert-flag t)) + + ;; The first entry is not a PO file header, insert one. + (setq insert-flag t))) + + ;; Not a single entry found. + (setq insert-flag t)) + + (goto-char (point-min)) + (and insert-flag (insert po-default-file-header "\n"))))) + +(defun po-replace-revision-date () + "Replace the revision date by current time in the PO file header." + (if (fboundp 'format-time-string) + (if (or (eq po-auto-replace-revision-date t) + (and (eq po-auto-replace-revision-date 'ask) + (y-or-n-p (_"May I set PO-Revision-Date? ")))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^\"PO-Revision-Date:.*" nil t) + (let* ((buffer-read-only po-read-only) + (time (current-time)) + (seconds (or (car (current-time-zone time)) 0)) + (minutes (/ (abs seconds) 60)) + (zone (format "%c%02d%02d" + (if (< seconds 0) ?- ?+) + (/ minutes 60) + (% minutes 60)))) + (replace-match + (concat "\"PO-Revision-Date: " + (format-time-string "%Y-%m-%d %H:%M" time) + zone "\\n\"") + t t)))) + (message "")) + (message (_"PO-Revision-Date should be adjusted...")))) + +;;; Handling span of entry, entry type and entry attributes. + +(defun po-find-span-of-entry () + "Find the extent of the PO file entry where the cursor is. Set variables +PO-START-OF-ENTRY, PO-START-OF-MSGID, PO-START-OF-MSGSTR, PO-END-OF-ENTRY +and PO-ENTRY-TYPE to meaningful values. Decreasing priority of type +interpretation is: obsolete, fuzzy, untranslated or translated." + (let ((here (point))) + (if (re-search-backward po-any-msgstr-regexp nil t) + (progn + + ;; After a backward match, (match-end 0) will not extend + ;; beyond point, in case point was *inside* the regexp. We + ;; need a dependable (match-end 0), so we redo the match in + ;; the forward direction. + (re-search-forward po-any-msgstr-regexp) + (if (<= (match-end 0) here) + (progn + + ;; We most probably found the msgstr of the previous + ;; entry. The current entry then starts just after + ;; its end, save this information just in case. + (setq po-start-of-entry (match-end 0)) + + ;; However, it is also possible that we are located in + ;; the crumb after the last entry in the file. If + ;; yes, we know the middle and end of last PO entry. + (setq po-start-of-msgstr (match-beginning 0) + po-end-of-entry (match-end 0)) + + (if (re-search-forward po-any-msgstr-regexp nil t) + (progn + + ;; We definitely were not in the crumb. + (setq po-start-of-msgstr (match-beginning 0) + po-end-of-entry (match-end 0))) + + ;; We were in the crumb. The start of the last PO + ;; file entry is the end of the previous msgstr if + ;; any, or else, the beginning of the file. + (goto-char po-start-of-msgstr) + (setq po-start-of-entry + (if (re-search-backward po-any-msgstr-regexp nil t) + (match-end 0) + (point-min))))) + + ;; The cursor was inside msgstr of the current entry. + (setq po-start-of-msgstr (match-beginning 0) + po-end-of-entry (match-end 0)) + ;; The start of this entry is the end of the previous + ;; msgstr if any, or else, the beginning of the file. + (goto-char po-start-of-msgstr) + (setq po-start-of-entry + (if (re-search-backward po-any-msgstr-regexp nil t) + (match-end 0) + (point-min))))) + + ;; The cursor was before msgstr in the first entry in the file. + (setq po-start-of-entry (point-min)) + (goto-char po-start-of-entry) + ;; There is at least the PO file header, so this should match. + (re-search-forward po-any-msgstr-regexp) + (setq po-start-of-msgstr (match-beginning 0) + po-end-of-entry (match-end 0))) + + ;; Find start of msgid. + (goto-char po-start-of-entry) + (re-search-forward po-any-msgid-regexp) + (setq po-start-of-msgid (match-beginning 0)) + + ;; Classify the entry. + (setq po-entry-type + (if (eq (following-char) ?#) + 'obsolete + (goto-char po-start-of-entry) + (if (re-search-forward po-fuzzy-regexp po-start-of-msgid t) + 'fuzzy + (goto-char po-start-of-msgstr) + (if (looking-at po-untranslated-regexp) + 'untranslated + 'translated)))) + + ;; Put the cursor back where it was. + (goto-char here))) + +(defun po-add-attribute (name) + "Add attribute NAME to the current entry, unless it is already there." + (save-excursion + (let ((buffer-read-only po-read-only)) + (goto-char po-start-of-entry) + (if (re-search-forward "\n#[,!] .*" po-start-of-msgid t) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (goto-char (point-min)) + (if (re-search-forward (concat "\\b" name "\\b") nil t) + nil + (goto-char (point-max)) + (insert ", " name))) + (skip-chars-forward "\n") + (while (eq (following-char) ?#) + (next-line 1)) + (insert "#, " name "\n"))))) + +(defun po-delete-attribute (name) + "Delete attribute NAME from the current entry, if any." + (save-excursion + (let ((buffer-read-only po-read-only)) + (goto-char po-start-of-entry) + (if (re-search-forward "\n#[,!] .*" po-start-of-msgid t) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (goto-char (point-min)) + (if (re-search-forward + (concat "\\(\n#[,!] " name "$\\|, " name "$\\| " name ",\\)") + nil t) + (replace-match "" t t))))))) + +;;; Entry positionning. + +(defun po-say-location-depth () + "Tell how many entries in the entry location stack." + (let ((depth (length po-marker-stack))) + (cond ((= depth 0) (message (_"Empty location stack"))) + ((= depth 1) (message (_"One entry in location stack"))) + (t (message (_"%d entries in location stack") depth))))) + +(defun po-push-location () + "Stack the location of the current entry, for later return." + (interactive) + (po-find-span-of-entry) + (save-excursion + (goto-char po-start-of-msgid) + (setq po-marker-stack (cons (point-marker) po-marker-stack))) + (po-say-location-depth)) + +(defun po-pop-location () + "Unstack a saved location, and return to the corresponding entry." + (interactive) + (if po-marker-stack + (progn + (goto-char (car po-marker-stack)) + (setq po-marker-stack (cdr po-marker-stack)) + (po-current-entry) + (po-say-location-depth)) + (error (_"The entry location stack is empty")))) + +(defun po-exchange-location () + "Exchange the location of the current entry with the top of stack." + (interactive) + (if po-marker-stack + (progn + (po-find-span-of-entry) + (goto-char po-start-of-msgid) + (let ((location (point-marker))) + (goto-char (car po-marker-stack)) + (setq po-marker-stack (cons location (cdr po-marker-stack)))) + (po-current-entry) + (po-say-location-depth)) + (error (_"The entry location stack is empty")))) + +(defun po-current-entry () + "Display the current entry." + (interactive) + (po-find-span-of-entry) + (po-redisplay)) + +(defun po-first-entry-with-regexp (regexp) + "Display the first entry in the file which msgstr matches REGEXP." + (let ((here (point))) + (goto-char (point-min)) + (if (re-search-forward regexp nil t) + (progn + (goto-char (match-beginning 0)) + (po-current-entry)) + (goto-char here) + (error (_"There is no such entry"))))) + +(defun po-last-entry-with-regexp (regexp) + "Display the last entry in the file which msgstr matches REGEXP." + (let ((here (point))) + (goto-char (point-max)) + (if (re-search-backward regexp nil t) + (po-current-entry) + (goto-char here) + (error (_"There is no such entry"))))) + +(defun po-next-entry-with-regexp (regexp wrap) + "Display the entry following the current entry which msgstr matches REGEXP. +If WRAP is not nil, the search may wrap around the buffer." + (po-find-span-of-entry) + (let ((here (point))) + (goto-char po-end-of-entry) + (if (re-search-forward regexp nil t) + (progn + (goto-char (match-beginning 0)) + (po-current-entry)) + (if (and wrap + (progn + (goto-char (point-min)) + (re-search-forward regexp po-start-of-entry t))) + (progn + (goto-char (match-beginning 0)) + (po-current-entry) + (message (_"Wrapping around the buffer"))) + (goto-char here) + (error (_"There is no such entry")))))) + +(defun po-previous-entry-with-regexp (regexp wrap) + "Redisplay the entry preceding the current entry which msgstr matches REGEXP. +If WRAP is not nil, the search may wrap around the buffer." + (po-find-span-of-entry) + (let ((here (point))) + (goto-char po-start-of-entry) + (if (re-search-backward regexp nil t) + (po-current-entry) + (if (and wrap + (progn + (goto-char (point-max)) + (re-search-backward regexp po-end-of-entry t))) + (progn + (po-current-entry) + (message (_"Wrapping around the buffer"))) + (goto-char here) + (error (_"There is no such entry")))))) + +;; Any entries. + +(defun po-first-entry () + "Display the first entry." + (interactive) + (po-first-entry-with-regexp po-any-msgstr-regexp)) + +(defun po-last-entry () + "Display the last entry." + (interactive) + (po-last-entry-with-regexp po-any-msgstr-regexp)) + +(defun po-next-entry () + "Display the entry following the current entry." + (interactive) + (po-next-entry-with-regexp po-any-msgstr-regexp nil)) + +(defun po-previous-entry () + "Display the entry preceding the current entry." + (interactive) + (po-previous-entry-with-regexp po-any-msgstr-regexp nil)) + +;; Untranslated entries. + +(defvar po-after-entry-regexp + "\\(\\'\\|\\(#[ \t]*\\)?[^\"]\\)" + "Regexp which should be true after a full msgstr string matched.") + +(defvar po-untranslated-regexp + (concat "^msgstr[ \t]*\"\"\n" po-after-entry-regexp) + "Regexp matching a whole msgstr field, but only if active and empty.") + +(defun po-next-untranslated-entry () + "Find the next untranslated entry, wrapping around if necessary." + (interactive) + (po-next-entry-with-regexp po-untranslated-regexp t)) + +(defun po-previous-untranslated-entry () + "Find the previous untranslated entry, wrapping around if necessary." + (interactive) + (po-previous-entry-with-regexp po-untranslated-regexp t)) + +(defun po-msgid-to-msgstr () + "Use another window to edit msgstr reinitialized with msgid." + (interactive) + (po-find-span-of-entry) + (if (or (eq po-entry-type 'untranslated) + (eq po-entry-type 'obsolete) + (y-or-n-p (_"Really loose previous translation? "))) + (po-set-msgstr (po-get-msgid nil))) + (message "")) + +;; Obsolete entries. + +(defvar po-obsolete-msgstr-regexp + "^#~?[ \t]*msgstr.*\n\\(#~?[ \t]*\".*\n\\)*" + "Regexp matching a whole msgstr field of an obsolete entry.") + +(defun po-next-obsolete-entry () + "Find the next obsolete entry, wrapping around if necessary." + (interactive) + (po-next-entry-with-regexp po-obsolete-msgstr-regexp t)) + +(defun po-previous-obsolete-entry () + "Find the previous obsolete entry, wrapping around if necessary." + (interactive) + (po-previous-entry-with-regexp po-obsolete-msgstr-regexp t)) + +;; Fuzzy entries. + +(defvar po-fuzzy-regexp "^#[,!] .*fuzzy" + "Regexp matching the string inserted by msgmerge for translations +which does not match exactly.") + +(defun po-next-fuzzy-entry () + "Find the next fuzzy entry, wrapping around if necessary." + (interactive) + (po-next-entry-with-regexp po-fuzzy-regexp t)) + +(defun po-previous-fuzzy-entry () + "Find the next fuzzy entry, wrapping around if necessary." + (interactive) + (po-previous-entry-with-regexp po-fuzzy-regexp t)) + +(defun po-unfuzzy () + "Remove the fuzzy attribute for the current entry." + (interactive) + (po-find-span-of-entry) + (cond ((eq po-entry-type 'fuzzy) + (po-decrease-type-counter) + (po-delete-attribute "fuzzy") + (po-current-entry) + (po-increase-type-counter))) + (if po-auto-select-on-unfuzzy + (po-auto-select-entry)) + (po-update-mode-line-string)) + +;; Translated entries. + +(defun po-next-translated-entry () + "Find the next untranslated entry, wrapping around if necessary." + (interactive) + (if (= po-translated-counter 0) + (error (_"There is no such entry")) + (po-next-entry-with-regexp po-untranslated-regexp t) + (po-find-span-of-entry) + (while (not (eq po-entry-type 'translated)) + (po-next-entry-with-regexp po-any-msgstr-regexp t) + (po-find-span-of-entry)))) + +(defun po-previous-translated-entry () + "Find the previous untranslated entry, wrapping around if necessary." + (interactive) + (if (= po-translated-counter 0) + (error (_"There is no such entry")) + (po-previous-entry-with-regexp po-any-msgstr-regexp t) + (po-find-span-of-entry) + (while (not (eq po-entry-type 'translated)) + (po-previous-entry-with-regexp po-untranslated-regexp t) + (po-find-span-of-entry)))) + +;; Auto-selection feature. + +(defun po-auto-select-entry () + "Select the next entry having the same type as the current one. +If none, wrap from the beginning of the buffer with another type, +going from untranslated to fuzzy, and from fuzzy to obsolete. +Plain translated entries are always disregarded unless there are +no entries of the other types." + (interactive) + (po-find-span-of-entry) + (goto-char po-end-of-entry) + (if (and (= po-untranslated-counter 0) + (= po-fuzzy-counter 0) + (= po-obsolete-counter 0)) + + ;; All entries are plain translated. Next entry will do, or + ;; wrap around if there is none. + (if (re-search-forward po-any-msgstr-regexp nil t) + (goto-char (match-beginning 0)) + (goto-char (point-min))) + + ;; If over a translated entry, look for an untranslated one first. + ;; Else, look for an entry of the same type first. + (let ((goal (if (eq po-entry-type 'translated) + 'untranslated + po-entry-type))) + (while goal + + ;; Find an untranslated entry, or wrap up for a fuzzy entry. + (if (eq goal 'untranslated) + (if (and (> po-untranslated-counter 0) + (re-search-forward po-untranslated-regexp nil t)) + (progn + (goto-char (match-beginning 0)) + (setq goal nil)) + (goto-char (point-min)) + (setq goal 'fuzzy))) + + ;; Find a fuzzy entry, or wrap up for an obsolete entry. + (if (eq goal 'fuzzy) + (if (and (> po-fuzzy-counter 0) + (re-search-forward po-fuzzy-regexp nil t)) + (progn + (goto-char (match-beginning 0)) + (setq goal nil)) + (goto-char (point-min)) + (setq goal 'obsolete))) + + ;; Find an obsolete entry, or wrap up for an untranslated entry. + (if (eq goal 'obsolete) + (if (and (> po-obsolete-counter 0) + (re-search-forward po-obsolete-msgstr-regexp nil t)) + (progn + (goto-char (match-beginning 0)) + (setq goal nil)) + (goto-char (point-min)) + (setq goal 'untranslated)))))) + + ;; Display this entry nicely. + (po-current-entry)) + +;;; Killing and yanking fields. + +(defun po-extract-unquoted (buffer start end) + "Extract and return the unquoted string in BUFFER going from START to END. +Crumb preceding or following the quoted string is ignored." + (po-with-temp-buffer + (insert-buffer-substring buffer start end) + ;; Remove preceding crumb. + (goto-char (point-min)) + (search-forward "\"") + (delete-region (point-min) (point)) + ;; Remove following crumb. + (goto-char (point-max)) + (search-backward "\"") + (delete-region (point) (point-max)) + ;; Glue concatenated strings. + (goto-char (point-min)) + (while (re-search-forward "\"[ \t]*\\\\?\n\\(#~?\\)?[ \t]*\"" nil t) + (replace-match "" t t)) + ;; Remove escaped newlines. + (goto-char (point-min)) + (while (re-search-forward "\\\\[ \t]*\n" nil t) + (replace-match "" t t)) + ;; Unquote individual characters. + (goto-char (point-min)) + (while (re-search-forward "\\\\[\"abfnt\\0-7]" nil t) + (cond ((eq (preceding-char) ?\") (replace-match "\"" t t)) + ((eq (preceding-char) ?a) (replace-match "\a" t t)) + ((eq (preceding-char) ?b) (replace-match "\b" t t)) + ((eq (preceding-char) ?f) (replace-match "\f" t t)) + ((eq (preceding-char) ?n) (replace-match "\n" t t)) + ((eq (preceding-char) ?t) (replace-match "\t" t t)) + ((eq (preceding-char) ?\\) (replace-match "\\" t t)) + (t (let ((value (- (preceding-char) ?0))) + (replace-match "" t t) + (while (looking-at "[0-7]") + (setq value (+ (* 8 value) (- (following-char) ?0))) + (replace-match "" t t)) + (insert value))))) + (buffer-string))) + +(defun po-eval-requoted (form prefix obsolete) + "Eval FORM, which inserts a string, and return the string fully requoted. +If PREFIX, precede the result with its contents. If OBSOLETE, comment all +generated lines in the returned string. Evaluating FORM should insert the +wanted string in the buffer which is current at the time of evaluation. +If FORM is itself a string, then this string is used for insertion." + (po-with-temp-buffer + (if (stringp form) + (insert form) + (push-mark) + (eval form)) + (goto-char (point-min)) + (let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t))) + (goto-char (point-min)) + (while (re-search-forward "[\"\a\b\f\n\t\\]" nil t) + (cond ((eq (preceding-char) ?\") (replace-match "\\\"" t t)) + ((eq (preceding-char) ?\a) (replace-match "\\a" t t)) + ((eq (preceding-char) ?\b) (replace-match "\\b" t t)) + ((eq (preceding-char) ?\f) (replace-match "\\f" t t)) + ((eq (preceding-char) ?\n) + (replace-match (if (or (not multi-line) (eobp)) + "\\n" + "\\n\"\n\"") + t t)) + ((eq (preceding-char) ?\t) (replace-match "\\t" t t)) + ((eq (preceding-char) ?\\) (replace-match "\\\\" t t)))) + (goto-char (point-min)) + (if prefix (insert prefix " ")) + (insert (if multi-line "\"\"\n\"" "\"")) + (goto-char (point-max)) + (insert "\"") + (if prefix (insert "\n")) + (if obsolete + (progn + (goto-char (point-min)) + (while (not (eobp)) + (or (eq (following-char) ?\n) (insert "#~ ")) + (search-forward "\n")))) + (buffer-string)))) + +(defun po-get-msgid (kill) + "Extract and return the unquoted msgid string. +If KILL, then add the unquoted string to the kill ring." + (let ((string (po-extract-unquoted (current-buffer) + po-start-of-msgid po-start-of-msgstr))) + (if kill (po-kill-new string)) + string)) + +(defun po-get-msgstr (kill) + "Extract and return the unquoted msgstr string. +If KILL, then add the unquoted string to the kill ring." + (let ((string (po-extract-unquoted (current-buffer) + po-start-of-msgstr po-end-of-entry))) + (if kill (po-kill-new string)) + string)) + +(defun po-set-msgid (form) + "Replace the current msgid, using FORM to get a string. +Evaluating FORM should insert the wanted string in the current buffer. If +FORM is itself a string, then this string is used for insertion. The string +is properly requoted before the replacement occurs. + +Returns `nil' if the buffer has not been modified, for if the new msgid +described by FORM is merely identical to the msgid already in place." + (let ((string (po-eval-requoted form "msgid" (eq po-entry-type 'obsolete)))) + (save-excursion + (goto-char po-start-of-entry) + (re-search-forward po-any-msgid-regexp po-start-of-msgstr) + (and (not (string-equal (po-buffer-substring (match-beginning 0) + (match-end 0)) + string)) + (let ((buffer-read-only po-read-only)) + (replace-match string t t) + (goto-char po-start-of-msgid) + (po-find-span-of-entry) + t))))) + +(defun po-set-msgstr (form) + "Replace the current msgstr or msgstr[], using FORM to get a string. +Evaluating FORM should insert the wanted string in the current buffer. If +FORM is itself a string, then this string is used for insertion. The string +is properly requoted before the replacement occurs. + +Returns `nil' if the buffer has not been modified, for if the new msgstr +described by FORM is merely identical to the msgstr already in place." + (let ((string (po-eval-requoted form "msgstr" (eq po-entry-type 'obsolete))) + (msgstr-idx nil)) + (save-excursion + (goto-char po-start-of-entry) + (save-excursion ; check for an indexed msgstr + (when (re-search-forward po-msgstr-idx-keyword-regexp po-end-of-entry t) + (setq msgstr-idx (buffer-substring-no-properties + (match-beginning 0) (match-end 0))))) + (re-search-forward po-any-msgstr-regexp po-end-of-entry) + (and (not (string-equal (po-buffer-substring (match-beginning 0) + (match-end 0)) + string)) + (let ((buffer-read-only po-read-only)) + (po-decrease-type-counter) + (replace-match string t t) + (goto-char (match-beginning 0)) + (unless (eq msgstr-idx nil) ; hack: replace msgstr with msgstr[d] + (progn + (insert msgstr-idx) + (looking-at "\\(#~?[ \t]*\\)?msgstr") + (replace-match ""))) + (goto-char po-start-of-msgid) + (po-find-span-of-entry) + (po-increase-type-counter) + t))))) + +(defun po-kill-ring-save-msgstr () + "Push the msgstr string from current entry on the kill ring." + (interactive) + (po-find-span-of-entry) + (po-get-msgstr t)) + +(defun po-kill-msgstr () + "Empty the msgstr string from current entry, pushing it on the kill ring." + (interactive) + (po-kill-ring-save-msgstr) + (po-set-msgstr "")) + +(defun po-yank-msgstr () + "Replace the current msgstr string by the top of the kill ring." + (interactive) + (po-find-span-of-entry) + (po-set-msgstr (if (eq last-command 'yank) '(yank-pop 1) '(yank))) + (setq this-command 'yank)) + +(defun po-fade-out-entry () + "Mark an active entry as fuzzy; obsolete a fuzzy or untranslated entry; +or completely delete an obsolete entry, saving its msgstr on the kill ring." + (interactive) + (po-find-span-of-entry) + + (cond ((eq po-entry-type 'translated) + (po-decrease-type-counter) + (po-add-attribute "fuzzy") + (po-current-entry) + (po-increase-type-counter)) + + ((or (eq po-entry-type 'fuzzy) + (eq po-entry-type 'untranslated)) + (if (yes-or-no-p (_"Should I really obsolete this entry? ")) + (progn + (po-decrease-type-counter) + (save-excursion + (save-restriction + (narrow-to-region po-start-of-entry po-end-of-entry) + (let ((buffer-read-only po-read-only)) + (goto-char (point-min)) + (skip-chars-forward "\n") + (while (not (eobp)) + (insert "#~ ") + (search-forward "\n"))))) + (po-current-entry) + (po-increase-type-counter))) + (message "")) + + ((and (eq po-entry-type 'obsolete) + (po-check-for-pending-edit po-start-of-msgid) + (po-check-for-pending-edit po-start-of-msgstr)) + (po-decrease-type-counter) + (po-update-mode-line-string) + (po-get-msgstr t) + (let ((buffer-read-only po-read-only)) + (delete-region po-start-of-entry po-end-of-entry)) + (goto-char po-start-of-entry) + (if (re-search-forward po-any-msgstr-regexp nil t) + (goto-char (match-beginning 0)) + (re-search-backward po-any-msgstr-regexp nil t)) + (po-current-entry) + (message "")))) + +;;; Killing and yanking comments. + +(defvar po-active-comment-regexp + "^\\(#\n\\|# .*\n\\)+" + "Regexp matching the whole editable comment part of an active entry.") + +(defvar po-obsolete-comment-regexp + "^\\(#~? #\n\\|#~? # .*\n\\)+" + "Regexp matching the whole editable comment part of an obsolete entry.") + +(defun po-get-comment (kill-flag) + "Extract and return the editable comment string, uncommented. +If KILL-FLAG, then add the unquoted comment to the kill ring." + (let ((buffer (current-buffer)) + (obsolete (eq po-entry-type 'obsolete))) + (save-excursion + (goto-char po-start-of-entry) + (if (re-search-forward (if obsolete po-obsolete-comment-regexp + po-active-comment-regexp) + po-end-of-entry t) + (po-with-temp-buffer + (insert-buffer-substring buffer (match-beginning 0) (match-end 0)) + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at (if obsolete "#~? # ?" "#~? ?")) + (replace-match "" t t)) + (forward-line 1)) + (and kill-flag (copy-region-as-kill (point-min) (point-max))) + (buffer-string)) + "")))) + +(defun po-set-comment (form) + "Using FORM to get a string, replace the current editable comment. +Evaluating FORM should insert the wanted string in the current buffer. +If FORM is itself a string, then this string is used for insertion. +The string is properly recommented before the replacement occurs." + (let ((obsolete (eq po-entry-type 'obsolete)) + string) + (po-with-temp-buffer + (if (stringp form) + (insert form) + (push-mark) + (eval form)) + (if (not (or (bobp) (= (preceding-char) ?\n))) + (insert "\n")) + (goto-char (point-min)) + (while (not (eobp)) + (insert (if (= (following-char) ?\n) + (if obsolete "#~ #" "#") + (if obsolete "#~ # " "# "))) + (search-forward "\n")) + (setq string (buffer-string))) + (goto-char po-start-of-entry) + (if (re-search-forward + (if obsolete po-obsolete-comment-regexp po-active-comment-regexp) + po-end-of-entry t) + (if (not (string-equal (po-buffer-substring (match-beginning 0) + (match-end 0)) + string)) + (let ((buffer-read-only po-read-only)) + (replace-match string t t))) + (skip-chars-forward " \t\n") + (let ((buffer-read-only po-read-only)) + (insert string)))) + (po-current-entry)) + +(defun po-kill-ring-save-comment () + "Push the msgstr string from current entry on the kill ring." + (interactive) + (po-find-span-of-entry) + (po-get-comment t)) + +(defun po-kill-comment () + "Empty the msgstr string from current entry, pushing it on the kill ring." + (interactive) + (po-kill-ring-save-comment) + (po-set-comment "") + (po-redisplay)) + +(defun po-yank-comment () + "Replace the current comment string by the top of the kill ring." + (interactive) + (po-find-span-of-entry) + (po-set-comment (if (eq last-command 'yank) '(yank-pop 1) '(yank))) + (setq this-command 'yank) + (po-redisplay)) + +;;; Editing management and submode. + +;; In a string edit buffer, BACK-POINTER points to one of the slots of the +;; list EDITED-FIELDS kept in the PO buffer. See its description elsewhere. +;; Reminder: slots have the form (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO). + +(defvar po-subedit-back-pointer) + +(defun po-clean-out-killed-edits () + "From EDITED-FIELDS, clean out any edit having a killed edit buffer." + (let ((cursor po-edited-fields)) + (while cursor + (let ((slot (car cursor))) + (setq cursor (cdr cursor)) + (if (buffer-name (nth 1 slot)) + nil + (let ((overlay (nth 2 slot))) + (and overlay (po-dehighlight overlay))) + (setq po-edited-fields (delete slot po-edited-fields))))))) + +(defun po-check-all-pending-edits () + "Resume any pending edit. Return nil if some remains." + (po-clean-out-killed-edits) + (or (null po-edited-fields) + (let ((slot (car po-edited-fields))) + (goto-char (nth 0 slot)) + (pop-to-buffer (nth 1 slot)) + (let ((overlay (nth 2 slot))) + (and overlay (po-rehighlight overlay))) + (message po-subedit-message) + nil))) + +(defun po-check-for-pending-edit (position) + "Resume any pending edit at POSITION. Return nil if such edit exists." + (po-clean-out-killed-edits) + (let ((marker (make-marker))) + (set-marker marker position) + (let ((slot (assoc marker po-edited-fields))) + (if slot + (progn + (goto-char marker) + (pop-to-buffer (nth 1 slot)) + (let ((overlay (nth 2 slot))) + (and overlay (po-rehighlight overlay))) + (message po-subedit-message))) + (not slot)))) + +(defun po-edit-out-full () + "Get out of PO mode, leaving PO file buffer in fundamental mode." + (interactive) + (if (and (po-check-all-pending-edits) + (yes-or-no-p (_"Should I let you edit the whole PO file? "))) + (progn + (setq buffer-read-only po-read-only) + (fundamental-mode) + (message (_"Type `M-x po-mode RET' once done"))))) + +(defvar po-subedit-mode-map nil + "Keymap while editing a PO mode entry (or the full PO file).") +(if po-subedit-mode-map + () + (setq po-subedit-mode-map (make-sparse-keymap)) + (define-key po-subedit-mode-map "\C-c\C-a" 'po-subedit-cycle-auxiliary) + (define-key po-subedit-mode-map "\C-c\C-c" 'po-subedit-exit) + (define-key po-subedit-mode-map "\C-c\C-k" 'po-subedit-abort)) + +(defun po-subedit-abort () + "Exit the subedit buffer, merely discarding its contents." + (interactive) + (let* ((edit-buffer (current-buffer)) + (back-pointer po-subedit-back-pointer) + (marker (nth 0 back-pointer)) + (overlay (nth 2 back-pointer)) + (buffer (marker-buffer marker))) + (if (null buffer) + (error (_"Corresponding PO buffer does not exist anymore")) + (or (one-window-p) (delete-window)) + (switch-to-buffer buffer) + (goto-char marker) + (and overlay (po-dehighlight overlay)) + (kill-buffer edit-buffer) + (setq po-edited-fields (delete back-pointer po-edited-fields))))) + +(defun po-subedit-exit () + "Exit the subedit buffer, replacing the string in the PO buffer." + (interactive) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (if (eq (preceding-char) ?<) + (delete-region (1- (point)) (point-max))) + (run-hooks 'po-subedit-exit-hook) + (let ((string (buffer-string))) + (po-subedit-abort) + (po-find-span-of-entry) + (cond ((= (point) po-start-of-msgid) + (po-set-comment string) + (po-redisplay)) + ((= (point) po-start-of-msgstr) + (let ((replaced (po-set-msgstr string))) + (if (and replaced + po-auto-fuzzy-on-edit + (eq po-entry-type 'translated)) + (progn + (po-decrease-type-counter) + (po-add-attribute "fuzzy") + (po-current-entry) + (po-increase-type-counter))))) + (t (debug))))) + +(defun po-edit-string (string type expand-tabs) + "Prepare a pop up buffer for editing STRING, which is of a given TYPE. +TYPE may be 'comment or 'msgstr. If EXPAND-TABS, expand tabs to spaces. +Run functions on po-subedit-mode-hook." + (let ((marker (make-marker))) + (set-marker marker (cond ((eq type 'comment) po-start-of-msgid) + ((eq type 'msgstr) po-start-of-msgstr))) + (if (po-check-for-pending-edit marker) + (let ((edit-buffer (generate-new-buffer + (concat "*" (buffer-name) "*"))) + (buffer (current-buffer)) + overlay slot) + (if (and (eq type 'msgstr) po-highlighting) + ;; ;; Try showing all of msgid in the upper window while editing. + ;; (goto-char (1- po-start-of-msgstr)) + ;; (recenter -1) + (save-excursion + (goto-char po-start-of-entry) + (re-search-forward po-any-msgid-regexp nil t) + (let ((end (1- (match-end 0)))) + (goto-char (match-beginning 0)) + (re-search-forward "msgid +" nil t) + (setq overlay (po-create-overlay)) + (po-highlight overlay (point) end buffer)))) + (setq slot (list marker edit-buffer overlay) + po-edited-fields (cons slot po-edited-fields)) + (pop-to-buffer edit-buffer) + (make-local-variable 'po-subedit-back-pointer) + (setq po-subedit-back-pointer slot) + (erase-buffer) + (insert string "<") + (goto-char (point-min)) + (and expand-tabs (setq indent-tabs-mode nil)) + (use-local-map po-subedit-mode-map) + (run-hooks 'po-subedit-mode-hook) + (message po-subedit-message))))) + +(defun po-edit-comment () + "Use another window to edit the current translator comment." + (interactive) + (po-find-span-of-entry) + (po-edit-string (po-get-comment nil) 'comment nil)) + +(defun po-edit-msgstr () + "Use another window to edit the current msgstr." + (interactive) + (po-find-span-of-entry) + (po-edit-string (if (and po-auto-edit-with-msgid + (eq po-entry-type 'untranslated)) + (po-get-msgid nil) + (po-get-msgstr nil)) + 'msgstr + t)) + +;;; String normalization and searching. + +(defun po-normalize-old-style (explain) + "Normalize old gettext style fields using K&R C multiline string syntax. +To minibuffer messages sent while normalizing, add the EXPLAIN string." + (let ((here (point-marker)) + (counter 0) + (buffer-read-only po-read-only)) + (goto-char (point-min)) + (message (_"Normalizing %d, %s") counter explain) + (while (re-search-forward + "\\(^#?[ \t]*msg\\(id\\|str\\)[ \t]*\"\\|[^\" \t][ \t]*\\)\\\\\n" + nil t) + (if (= (% counter 10) 0) + (message (_"Normalizing %d, %s") counter explain)) + (replace-match "\\1\"\n\"" t nil) + (setq counter (1+ counter))) + (goto-char here) + (message (_"Normalizing %d...done") counter))) + +(defun po-normalize-field (field explain) + "Normalize FIELD of all entries. FIELD is either the symbol msgid or msgstr. +To minibuffer messages sent while normalizing, add the EXPLAIN string." + (let ((here (point-marker)) + (counter 0)) + (goto-char (point-min)) + (while (re-search-forward po-any-msgstr-regexp nil t) + (if (= (% counter 10) 0) + (message (_"Normalizing %d, %s") counter explain)) + (goto-char (match-beginning 0)) + (po-find-span-of-entry) + (cond ((eq field 'msgid) (po-set-msgid (po-get-msgid nil))) + ((eq field 'msgstr) (po-set-msgstr (po-get-msgstr nil)))) + (goto-char po-end-of-entry) + (setq counter (1+ counter))) + (goto-char here) + (message (_"Normalizing %d...done") counter))) + +;; Normalize, but the British way! :-) +(defsubst po-normalise () (po-normalize)) + +(defun po-normalize () + "Normalize all entries in the PO file." + (interactive) + (po-normalize-old-style (_"pass 1/3")) + (po-normalize-field t (_"pass 2/3")) + (po-normalize-field nil (_"pass 3/3")) + ;; The last PO file entry has just been processed. + (if (not (= po-end-of-entry (point-max))) + (let ((buffer-read-only po-read-only)) + (kill-region po-end-of-entry (point-max)))) + ;; A bizarre format might have fooled the counters, so recompute + ;; them to make sure their value is dependable. + (po-compute-counters nil)) + +;;; Multiple PO files. + +(defun po-show-auxiliary-list () + "Echo the current auxiliary list in the message area." + (if po-auxiliary-list + (let ((cursor po-auxiliary-cursor) + string) + (while cursor + (setq string (concat string (if string " ") (car (car cursor))) + cursor (cdr cursor))) + (setq cursor po-auxiliary-list) + (while (not (eq cursor po-auxiliary-cursor)) + (setq string (concat string (if string " ") (car (car cursor))) + cursor (cdr cursor))) + (message string)) + (message (_"No auxiliary files.")))) + +(defun po-consider-as-auxiliary () + "Add the current PO file to the list of auxiliary files." + (interactive) + (if (member (list buffer-file-name) po-auxiliary-list) + nil + (setq po-auxiliary-list + (nconc po-auxiliary-list (list (list buffer-file-name)))) + (or po-auxiliary-cursor + (setq po-auxiliary-cursor po-auxiliary-list))) + (po-show-auxiliary-list)) + +(defun po-ignore-as-auxiliary () + "Delete the current PO file from the list of auxiliary files." + (interactive) + (setq po-auxiliary-list (delete (list buffer-file-name) po-auxiliary-list) + po-auxiliary-cursor po-auxiliary-list) + (po-show-auxiliary-list)) + +(defun po-seek-equivalent-translation (name string) + "Search a PO file NAME for a `msgid' STRING having a non-empty `msgstr'. +STRING is the full quoted msgid field, including the `msgid' keyword. When +found, display the file over the current window, with the `msgstr' field +possibly highlighted, the cursor at start of msgid, then return `t'. +Otherwise, move nothing, and just return `nil'." + (let ((current (current-buffer)) + (buffer (find-file-noselect name))) + (set-buffer buffer) + (let ((start (point)) + found) + (goto-char (point-min)) + (while (and (not found) (search-forward string nil t)) + ;; Screen out longer `msgid's. + (if (looking-at "^msgstr ") + (progn + (po-find-span-of-entry) + ;; Ignore an untranslated entry. + (or (string-equal + (buffer-substring po-start-of-msgstr po-end-of-entry) + "msgstr \"\"\n") + (setq found t))))) + (if found + (progn + (switch-to-buffer buffer) + (po-find-span-of-entry) + (if po-highlighting + (progn + (goto-char po-start-of-entry) + (re-search-forward po-any-msgstr-regexp nil t) + (let ((end (1- (match-end 0)))) + (goto-char (match-beginning 0)) + (re-search-forward "msgstr +" nil t) + ;; FIXME: + (po-highlight (po-create-overlay) (point) end)))) + (goto-char po-start-of-msgid)) + (goto-char start) + (po-find-span-of-entry) + (select-buffer current)) + found))) + +(defun po-cycle-auxiliary () + "Select the next auxiliary file having an entry with same `msgid'." + (interactive) + (po-find-span-of-entry) + (if po-auxiliary-list + (let ((string (buffer-substring po-start-of-msgid po-start-of-msgstr)) + (cursor po-auxiliary-cursor) + found name) + (while (and (not found) cursor) + (setq name (car (car cursor))) + (if (and (not (string-equal buffer-file-name name)) + (po-seek-equivalent-translation name string)) + (setq found t + po-auxiliary-cursor cursor)) + (setq cursor (cdr cursor))) + (setq cursor po-auxiliary-list) + (while (and (not found) cursor) + (setq name (car (car cursor))) + (if (and (not (string-equal buffer-file-name name)) + (po-seek-equivalent-translation name string)) + (setq found t + po-auxiliary-cursor cursor)) + (setq cursor (cdr cursor))) + (or found (message (_"No other translation found"))) + found))) + +(defun po-subedit-cycle-auxiliary () + "Cycle auxiliary file, but from the translation edit buffer." + (interactive) + (if po-buffer-of-edited-entry + (let ((buffer (current-buffer))) + (pop-to-buffer po-buffer-of-edited-entry) + (po-cycle-auxiliary) + (pop-to-buffer buffer)) + (error (_"Not editing a PO file entry")))) + +(defun po-select-auxiliary () + "Select one of the available auxiliary files and locate an equivalent +entry. If an entry having the same `msgid' cannot be found, merely select +the file without moving its cursor." + (interactive) + (po-find-span-of-entry) + (if po-auxiliary-list + (let ((string (buffer-substring po-start-of-msgid po-start-of-msgstr)) + (name (car (assoc (completing-read (_"Which auxiliary file? ") + po-auxiliary-list nil t) + po-auxiliary-list)))) + (po-consider-as-auxiliary) + (or (po-seek-equivalent-translation name string) + (find-file name))))) + +;;; Original program sources as context. + +(defun po-show-source-path () + "Echo the current source search path in the message area." + (if po-search-path + (let ((cursor po-search-path) + string) + (while cursor + (setq string (concat string (if string " ") (car (car cursor))) + cursor (cdr cursor))) + (message string)) + (message (_"Empty source path.")))) + +(defun po-consider-source-path (directory) + "Add a given DIRECTORY, requested interactively, to the source search path." + (interactive "DDirectory for search path: ") + (setq po-search-path (cons (list (if (string-match "/$" directory) + directory + (concat directory "/"))) + po-search-path)) + (setq po-reference-check 0) + (po-show-source-path)) + +(defun po-ignore-source-path () + "Delete a directory, selected with completion, from the source search path." + (interactive) + (setq po-search-path + (delete (list (completing-read (_"Directory to remove? ") + po-search-path nil t)) + po-search-path)) + (setq po-reference-check 0) + (po-show-source-path)) + +(defun po-ensure-source-references () + "Extract all references into a list, with paths resolved, if necessary." + (po-find-span-of-entry) + (if (= po-start-of-entry po-reference-check) + () + (setq po-reference-alist nil) + (save-excursion + (goto-char po-start-of-entry) + (if (re-search-forward "^#:" po-start-of-msgid t) + (while (looking-at "\\(\n#:\\)? *\\([^: ]+\\):\\([0-9]+\\)") + (goto-char (match-end 0)) + (let* ((name (po-buffer-substring (match-beginning 2) + (match-end 2))) + (line (po-buffer-substring (match-beginning 3) + (match-end 3))) + (path po-search-path) + file) + (while (and (progn (setq file (concat (car (car path)) name)) + (not (file-exists-p file))) + path) + (setq path (cdr path))) + (if path + (setq po-reference-alist + (cons (list (concat file ":" line) + file + (string-to-int line)) + po-reference-alist))))))) + (setq po-reference-alist (nreverse po-reference-alist) + po-reference-cursor po-reference-alist + po-reference-check po-start-of-entry))) + +(defun po-show-source-context (triplet) + "Show the source context given a TRIPLET which is (PROMPT FILE LINE)." + (find-file-other-window (car (cdr triplet))) + (goto-line (car (cdr (cdr triplet)))) + (other-window 1) + (let ((maximum 0) + position + (cursor po-reference-alist)) + (while (not (eq triplet (car cursor))) + (setq maximum (1+ maximum) + cursor (cdr cursor))) + (setq position (1+ maximum) + po-reference-cursor cursor) + (while cursor + (setq maximum (1+ maximum) + cursor (cdr cursor))) + (message (_"Displaying %d/%d: \"%s\"") position maximum (car triplet)))) + +(defun po-cycle-source-reference () + "Display some source context for the current entry. +If the command is repeated many times in a row, cycle through contexts." + (interactive) + (po-ensure-source-references) + (if po-reference-cursor + (po-show-source-context + (car (if (eq last-command 'po-cycle-source-reference) + (or (cdr po-reference-cursor) po-reference-alist) + po-reference-cursor))) + (error (_"No resolved source references")))) + +(defun po-select-source-reference () + "Select one of the available source contexts for the current entry." + (interactive) + (po-ensure-source-references) + (if po-reference-alist + (po-show-source-context + (assoc + (completing-read (_"Which source context? ") po-reference-alist nil t) + po-reference-alist)) + (error (_"No resolved source references")))) + +;;; Program sources strings though tags table. + +;;; C mode. + +;;; A few long string cases (submitted by Ben Pfaff). + +;; #define string "This is a long string " \ +;; "that is continued across several lines " \ +;; "in a macro in order to test \\ quoting\\" \ +;; "\\ with goofy strings.\\" + +;; char *x = "This is just an ordinary string " +;; "continued across several lines without needing " +;; "to use \\ characters at end-of-line."; + +;; char *y = "Here is a string continued across \ +;; several lines in the manner that was sanctioned \ +;; in K&R C compilers and still works today, \ +;; even though the method used above is more esthetic."; + +;;; End of long string cases. + +(defun po-find-c-string (keywords) + "Find the next C string, excluding those marked by any of KEYWORDS. +Returns (START . END) for the found string, or (nil . nil) if none found." + (let (start end) + (while (and (not start) + (re-search-forward "\\([\"']\\|/\\*\\|//\\)" nil t)) + (cond ((= (preceding-char) ?*) + ;; Disregard comments. + (search-forward "*/")) + + ((= (preceding-char) ?/) + ;; Disregard C++ comments. + (end-of-line) + (forward-char 1)) + + ((= (preceding-char) ?\') + ;; Disregard character constants. + (forward-char (if (= (following-char) ?\\) 3 2))) + + ((save-excursion + (beginning-of-line) + (looking-at "^# *\\(include\\|line\\)")) + ;; Disregard lines being #include or #line directives. + (end-of-line)) + + ;; Else, find the end of the (possibly concatenated) string. + (t (setq start (1- (point)) + end nil) + (while (not end) + (cond ((= (following-char) ?\") + (if (looking-at "\"[ \t\n\\\\]*\"") + (goto-char (match-end 0)) + (forward-char 1) + (setq end (point)))) + ((= (following-char) ?\\) (forward-char 2)) + (t (skip-chars-forward "^\"\\\\")))) + + ;; Check before string for keyword and opening parenthesis. + (goto-char start) + (skip-chars-backward " \n\t") + (if (= (preceding-char) ?\() + (progn + (backward-char 1) + (skip-chars-backward " \n\t") + (let ((end-keyword (point))) + (skip-chars-backward "_A-Za-z0-9") + (if (member (list (po-buffer-substring (point) + end-keyword)) + keywords) + + ;; Disregard already marked strings. + (progn + (goto-char end) + (setq start nil + end nil))))))))) + + ;; Return the found string, if any. + (cons start end))) + +(defun po-mark-c-string (start end keyword) + "Mark the C string, from START to END, with KEYWORD. +Return the adjusted value for END." + (goto-char end) + (insert ")") + (goto-char start) + (insert keyword) + (if (not (string-equal keyword "_")) + (progn (insert " ") (setq end (1+ end)))) + (insert "(") + (+ end 2 (length keyword))) + +;;; Emacs LISP mode. + +(defun po-find-emacs-lisp-string (keywords) + "Find the next Emacs LISP string, excluding those marked by any of KEYWORDS. +Returns (START . END) for the found string, or (nil . nil) if none found." + (let (start end) + (while (and (not start) + (re-search-forward "[;\"?]" nil t)) + + (cond ((= (preceding-char) ?\;) + ;; Disregard comments. + (search-forward "\n")) + + ((= (preceding-char) ?\?) + ;; Disregard character constants. + (forward-char (if (= (following-char) ?\\) 2 1))) + + ;; Else, find the end of the string. + (t (setq start (1- (point))) + (while (not (= (following-char) ?\")) + (skip-chars-forward "^\"\\\\") + (if (= (following-char) ?\\) (forward-char 2))) + (forward-char 1) + (setq end (point)) + + ;; Check before string for keyword and opening parenthesis. + (goto-char start) + (skip-chars-backward " \n\t") + (let ((end-keyword (point))) + (skip-chars-backward "-_A-Za-z0-9") + (if (and (= (preceding-char) ?\() + (member (list (po-buffer-substring (point) + end-keyword)) + keywords)) + + ;; Disregard already marked strings. + (progn + (goto-char end) + (setq start nil + end nil))))))) + + ;; Return the found string, if any. + (cons start end))) + +(defun po-mark-emacs-lisp-string (start end keyword) + "Mark the Emacs LISP string, from START to END, with KEYWORD. +Return the adjusted value for END." + (goto-char end) + (insert ")") + (goto-char start) + (insert "(" keyword) + (if (not (string-equal keyword "_")) + (progn (insert " ") (setq end (1+ end)))) + (+ end 2 (length keyword))) + +;;; Processing generic to all programming modes. + +(eval-and-compile + (autoload 'visit-tags-table-buffer "etags")) + +(defun po-tags-search (restart) + "Find an unmarked translatable string through all files in tags table. +Disregard some simple strings which are most probably non-translatable. +With prefix argument, restart search at first file." + (interactive "P") + + ;; Take care of restarting the search if necessary. + (if restart (setq po-next-file-list nil)) + + ;; Loop doing things until an interesting string is found. + (let ((keywords po-keywords) + found buffer start + (end po-string-end)) + (while (not found) + + ;; Reinitialize the source file list if necessary. + (if (not po-next-file-list) + (progn + (setq po-next-file-list + (save-excursion + (visit-tags-table-buffer) + (copy-sequence (tags-table-files)))) + (or po-next-file-list (error (_"No files to process"))) + (setq end nil))) + + ;; Try finding a string after resuming the search position. + (message (_"Scanning %s...") (car po-next-file-list)) + (save-excursion + (setq buffer (find-file-noselect (car po-next-file-list))) + (set-buffer buffer) + (goto-char (or end (point-min))) + + (cond ((member mode-name '("C" "C++")) + (let ((pair (po-find-c-string keywords))) + (setq start (car pair) + end (cdr pair)))) + ((string-equal mode-name "Emacs-Lisp") + (let ((pair (po-find-emacs-lisp-string keywords))) + (setq start (car pair) + end (cdr pair)))) + (t (message (_"Unknown source mode for PO mode, skipping...")) + (setq start nil + end nil)))) + + ;; Advance to next file if no string was found. + (if (not start) + (progn + (setq po-next-file-list (cdr po-next-file-list)) + (if po-next-file-list + (setq end nil) + (setq po-string-end nil) + (and po-highlighting (po-dehighlight po-marking-overlay)) + (error (_"All files processed")))) + + ;; Push the string just found string into a work buffer for study. + (po-with-temp-buffer + (insert (po-extract-unquoted buffer start end)) + (goto-char (point-min)) + + ;; Do not disregard if at least three letters in a row. + (if (re-search-forward "[A-Za-z][A-Za-z][A-Za-z]" nil t) + (setq found t) + + ;; Disregard if two letters, and more punctuations than letters. + (if (re-search-forward "[A-Za-z][A-Za-z]" nil t) + (let ((total (buffer-size))) + (goto-char (point-min)) + (while (re-search-forward "[A-Za-z]+" nil t) + (replace-match "" t t)) + (if (< (* 2 (buffer-size)) total) + (setq found t)))) + + ;; Disregard if single letters or no letters at all. + )))) + + ;; Ensure the string is being displayed. + + (if (one-window-p t) (split-window) (other-window 1)) + (switch-to-buffer buffer) + (goto-char start) + (or (pos-visible-in-window-p start) (recenter '(nil))) + (if (pos-visible-in-window-p end) + (goto-char end) + (goto-char end) + (recenter -1)) + (other-window 1) + (and po-highlighting (po-highlight po-marking-overlay start end buffer)) + + ;; Save the string for later commands. + (message (_"Scanning %s...done") (car po-next-file-list)) + (setq po-string-start start + po-string-end end))) + +(defun po-mark-found-string (keyword) + "Mark last found string in program sources as translatable, using KEYWORD." + (and po-highlighting (po-dehighlight po-marking-overlay)) + (let ((buffer (find-file-noselect (car po-next-file-list))) + (start po-string-start) + (end po-string-end) + line string) + + ;; Mark string in program sources. + (setq string (po-extract-unquoted buffer start end)) + (save-excursion + (set-buffer buffer) + (setq line (count-lines (point-min) start) + end (cond ((member mode-name '("C" "C++")) + (po-mark-c-string start end keyword)) + ((string-equal mode-name "Emacs-Lisp") + (po-mark-emacs-lisp-string start end keyword)) + (t (error (_"Cannot mark in unknown source mode")))))) + (setq po-string-end end) + + ;; Add PO file entry. + (let ((buffer-read-only po-read-only)) + (goto-char (point-max)) + (insert "\n" (format "#: %s:%d\n" (car po-next-file-list) line)) + (save-excursion + (insert (po-eval-requoted string "msgid" nil) "msgstr \"\"\n")) + (setq po-untranslated-counter (1+ po-untranslated-counter)) + (po-update-mode-line-string)))) + +(defun po-mark-translatable () + "Mark last found string in program sources as translatable, using `_'." + (interactive) + (if (and po-string-start po-string-end) + (progn + (po-mark-found-string "_") + (setq po-string-start nil)) + (error (_"No such string")))) + +(defun po-select-mark-and-mark (arg) + "Mark last found string in program sources as translatable, ask for keywoard, +using completion. With prefix argument, just ask the name of a preferred +keyword for subsequent commands, also added to possible completions." + (interactive "P") + (if arg + (let ((keyword (list (read-from-minibuffer (_"Keyword: "))))) + (setq po-keywords (cons keyword (delete keyword po-keywords)))) + (if (and po-string-start po-string-end) + (let* ((default (car (car po-keywords))) + (keyword (completing-read (format (_"Mark with keywoard? [%s] ") + default) + po-keywords nil t ))) + (if (string-equal keyword "") (setq keyword default)) + (po-mark-found-string keyword) + (setq po-string-start nil)) + (error (_"No such string"))))) + +;;; Miscellaneous features. + +(defun po-help () + "Provide an help window for PO mode." + (interactive) + (po-with-temp-buffer + (insert po-help-display-string) + (goto-char (point-min)) + (save-window-excursion + (switch-to-buffer (current-buffer)) + (delete-other-windows) + (message (_"Type any character to continue")) + (po-read-event)))) + +(defun po-undo () + "Undo the last change to the PO file." + (interactive) + (let ((buffer-read-only po-read-only)) + (undo)) + (po-compute-counters nil)) + +(defun po-statistics () + "Say how many entries in each category, and the current position." + (interactive) + (po-compute-counters t)) + +(defun po-validate () + "Use `msgfmt' for validating the current PO file contents." + (interactive) + + ;; If modifications were done already, change the last revision date. + (if (buffer-modified-p) + (po-replace-revision-date)) + + ;; This `let' is for protecting the previous value of compile-command. + (let ((compile-command (concat po-msgfmt-program + " --statistics -c -v -o /dev/null " + buffer-file-name))) + (compile compile-command))) + +(defun po-guess-archive-name () + "Return the ideal file name for this PO file in the central archives." + (let (start-of-header end-of-header package version team) + (save-excursion + ;; Find the PO file header entry. + (goto-char (point-min)) + (re-search-forward po-any-msgstr-regexp) + (setq start-of-header (match-beginning 0) + end-of-header (match-end 0)) + ;; Get the package and version. + (goto-char start-of-header) + (if (re-search-forward + "\n\"Project-Id-Version:\\( GNU\\)? \\([^\n ]+\\) \\([^\n ]+\\)\\\\n\"$" + end-of-header t) + (setq package (buffer-substring (match-beginning 2) (match-end 2)) + version (buffer-substring (match-beginning 3) (match-end 3)))) + (if (or (not package) (string-equal package "PACKAGE") + (not version) (string-equal version "VERSION")) + (error (_"Project-Id-Version field does not have a proper value"))) + ;; Get the team. + (goto-char start-of-header) + (if (re-search-forward "\n\"Language-Team:.*<\\(.*\\)@li.org>\\\\n\"$" + end-of-header t) + (setq team (buffer-substring (match-beginning 1) (match-end 1)))) + (if (or (not team) (string-equal team "LL")) + (error (_"Language-Team field does not have a proper value"))) + ;; Compose the name. + (concat package "-" version "." team ".po")))) + +(defun po-guess-team-address () + "Return the team address related to this PO file." + (let (team) + (save-excursion + (goto-char (point-min)) + (re-search-forward po-any-msgstr-regexp) + (goto-char (match-beginning 0)) + (if (re-search-forward + "\n\"Language-Team: +\\(.*<\\(.*\\)@li.org>\\)\\\\n\"$" + (match-end 0) t) + (setq team (buffer-substring (match-beginning 2) (match-end 2)))) + (if (or (not team) (string-equal team "LL")) + (error (_"Language-Team field does not have a proper value"))) + (buffer-substring (match-beginning 1) (match-end 1))))) + +(defun po-send-mail () + "Start composing a letter, possibly including the current PO file." + (interactive) + (let* ((team-flag (y-or-n-p + (_"\ +Write to your team? (`n' means writing to translation project) "))) + (address (if team-flag + (po-guess-team-address) + po-translation-project-address))) + (if (not (y-or-n-p (_"Include current PO file? "))) + (apply po-compose-mail-function address + (read-string (_"Subject? ")) nil) + (if (buffer-modified-p) + (error (_"The file is not even saved, you did not validate it."))) + (if (and (y-or-n-p (_"You validated (`V') this file, didn't you? ")) + (or (zerop po-untranslated-counter) + (y-or-n-p + (format (_"%d entries are untranslated, include anyway? ") + po-untranslated-counter))) + (or (zerop po-fuzzy-counter) + (y-or-n-p + (format (_"%d entries are still fuzzy, include anyway? ") + po-fuzzy-counter))) + (or (zerop po-obsolete-counter) + (y-or-n-p + (format (_"%d entries are obsolete, include anyway? ") + po-obsolete-counter)))) + (let ((buffer (current-buffer)) + (name (po-guess-archive-name)) + (transient-mark-mode nil)) + (apply po-compose-mail-function address + (if team-flag + (read-string (_"Subject? ")) + (format "TP-Robot %s" name)) + nil) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (save-excursion + (insert-buffer buffer) + (shell-command-on-region + (region-beginning) (region-end) + (concat po-gzip-uuencode-command " " name ".gz") t)))))) + (message "")) + +(defun po-confirm-and-quit () + "Confirm if quit should be attempted and then, do it. +This is a failsafe. Confirmation is asked if only the real quit would not." + (interactive) + (if (po-check-all-pending-edits) + (progn + (if (or (buffer-modified-p) + (> po-untranslated-counter 0) + (> po-fuzzy-counter 0) + (> po-obsolete-counter 0) + (y-or-n-p (_"Really quit editing this PO file? "))) + (po-quit)) + (message "")))) + +(defun po-quit () + "Save the PO file and kill buffer. However, offer validation if +appropriate and ask confirmation if untranslated strings remain." + (interactive) + (if (po-check-all-pending-edits) + (let ((quit t)) + + ;; Offer validation of newly modified entries. + (if (and (buffer-modified-p) + (not (y-or-n-p + (_"File was modified; skip validation step? ")))) + (progn + (message "") + (po-validate) + ;; If we knew that the validation was all successful, we should + ;; just quit. But since we do not know yet, as the validation + ;; might be asynchronous with PO mode commands, the safest is to + ;; stay within PO mode, even if this implies that another + ;; `po-quit' command will be later required to exit for true. + (setq quit nil))) + + ;; Offer to work on untranslated entries. + (if (and quit + (or (> po-untranslated-counter 0) + (> po-fuzzy-counter 0) + (> po-obsolete-counter 0)) + (not (y-or-n-p + (_"Unprocessed entries remain; quit anyway? ")))) + (progn + (setq quit nil) + (po-auto-select-entry))) + + ;; Clear message area. + (message "") + + ;; Or else, kill buffers and quit for true. + (if quit + (progn + (and (buffer-modified-p) (po-replace-revision-date)) + (save-buffer) + (kill-buffer (current-buffer))))))) + +;;; po-mode.el ends here diff --git a/python-mode.el b/python-mode.el index 187e15c..7740cef 100644 --- a/python-mode.el +++ b/python-mode.el @@ -2,13 +2,13 @@ ;; Copyright (C) 1992,1993,1994 Tim Peters -;; Author: 1995-1998 Barry A. Warsaw +;; Author: 1995-2001 Barry A. Warsaw ;; 1992-1994 Tim Peters ;; Maintainer: python-mode@python.org ;; Created: Feb 1992 ;; Keywords: python languages oop -(defconst py-version "3.105" +(defconst py-version "$Revision: 4.6 $" "`python-mode' version number.") ;; This software is provided as-is, without express or implied @@ -25,30 +25,34 @@ ;; and is the current maintainer. Tim's now back but disavows all ;; responsibility for the mode. Smart Tim :-) -;; This version of python-mode.el is no longer compatible with Emacs -;; 18. I am striving to maintain compatibility with the X/Emacs 19 -;; lineage but as time goes on that becomes more and more difficult. -;; I current recommend that you upgrade to the latest stable released -;; version of your favorite branch: Emacs 20.3 or better, or XEmacs -;; 20.4 or better (XEmacs 21.0 is in beta testing as of this writing -;; 27-Oct-1998 appears to work fine with this version of -;; python-mode.el). Even Windows users should be using at least -;; NTEmacs 20.3, and XEmacs 21.0 will work very nicely on Windows when -;; it is released. +;; pdbtrack support contributed by Ken Manheimer, April 2001. + +;; This version of python-mode.el has only been tested with XEmacs +;; 21.1.14 and Emacs 20.7 as these are the latest versions of these +;; Emacsen as of this writing (11-Apr-2001). I have no intent to test +;; it with earlier Emacsen, but I will accept patches if they are +;; small and reasonable. Please use the SourceForge Python project to +;; submit bugs or patches: +;; +;; http://sourceforge.net/projects/python ;; FOR MORE INFORMATION: -;; For more information on installing python-mode.el, especially with -;; respect to compatibility information, please see -;; +;; There is some information on python-mode.el at + ;; http://www.python.org/emacs/python-mode/ ;; -;; This site also contains links to other packages that you might find -;; useful, such as pdb interfaces, OO-Browser links, etc. +;; but this link is fairly out of date, due to the current difficulty +;; in updating that site. It does contain links to other packages that +;; you might find useful, such as pdb interfaces, OO-Browser links, +;; etc. Eventually, we'll be able to update it much more easily. ;; BUG REPORTING: -;; To submit bug reports, use C-c C-b. Please include a complete, but +;; As mentioned above, please use the SourceForge Python project for +;; submitting bug reports or patches. The old recommendation, to use +;; C-c C-b will still work, but those reports have a higher chance of +;; getting buried in my mailbox. Please include a complete, but ;; concise code sample and a recipe for reproducing the bug. Send ;; suggestions and other comments to python-mode@python.org. @@ -56,40 +60,11 @@ ;; doubtful that a texinfo manual would be very useful, but if you ;; want to contribute one, I'll certainly accept it! -;; TO DO LIST: - -;; - Better integration with pdb.py and gud-mode for debugging. -;; - Rewrite according to GNU Emacs Lisp standards. -;; - have py-execute-region on indented code act as if the region is -;; left justified. Avoids syntax errors. -;; - add a py-goto-block-down, bound to C-c C-d - ;;; Code: (require 'comint) (require 'custom) -(eval-when-compile - (require 'cl) - (if (not (and (condition-case nil - (require 'custom) - (error nil)) - ;; Stock Emacs 19.34 has a broken/old Custom library - ;; that does more harm than good. Fortunately, it is - ;; missing defcustom - (fboundp 'defcustom))) - (error "STOP! STOP! STOP! STOP! - -The Custom library was not found or is out of date. A more current -version is required. Please download and install the latest version -of the Custom library from: - - - -See the Python Mode home page for details: - - -"))) - +(require 'cl) ;; user definable variables @@ -148,6 +123,14 @@ you're editing someone else's Python code." :type 'integer :group 'python) +(defcustom py-continuation-offset 4 + "*Additional amount of offset to give for some continuation lines. +Continuation lines are those that immediately follow a backslash +terminated line. Only those continuation lines for a block opening +statement are given this extra offset." + :type 'integer + :group 'python) + (defcustom py-smart-indentation t "*Should `python-mode' try to automagically set some indentation variables? When this variable is non-nil, two things happen when a buffer is set @@ -276,6 +259,22 @@ When non-nil, arguments are printed." :group 'python) (make-variable-buffer-local 'py-indent-offset) +(defcustom py-pdbtrack-do-tracking-p t + "*Controls whether the pdbtrack feature is enabled or not. +When non-nil, pdbtrack is enabled in all comint-based buffers, +e.g. shell buffers and the *Python* buffer. When using pdb to debug a +Python program, pdbtrack notices the pdb prompt and displays the +source file and line that the program is stopped at, much the same way +as gud-mode does for debugging C programs with gdb." + :type 'boolean + :group 'python) +(make-variable-buffer-local 'py-pdbtrack-do-tracking-p) + +(defcustom py-pdbtrack-minor-mode-string " PDB" + "*String to use in the minor mode list when pdbtrack is enabled." + :type 'string + :group 'python) + ;; Not customizable (defvar py-master-file nil "If non-nil, execute the named file instead of the buffer's file. @@ -299,13 +298,6 @@ buffer is prepended to come up with a file name.") (defconst py-emacs-features (let (features) - ;; NTEmacs 19.34.6 has a broken make-temp-name; it always returns - ;; the same string. - (let ((tmp1 (make-temp-name "")) - (tmp2 (make-temp-name ""))) - (if (string-equal tmp1 tmp2) - (push 'broken-temp-names features))) - ;; return the features features) "A list of features extant in the Emacs you are using. There are many flavors of Emacs out there, with different levels of @@ -319,7 +311,7 @@ support for features needed by `python-mode'.") "from" "global" "if" "import" "in" "is" "lambda" "not" "or" "pass" "print" "raise" - "return" "while" + "return" "while" "yield" ) "\\|")) (kw2 (mapconcat 'identity @@ -332,6 +324,8 @@ support for features needed by `python-mode'.") ;; block introducing keywords with immediately following colons. ;; Yes "except" is in both lists. (cons (concat "\\b\\(" kw2 "\\)[ \n\t(]") 1) + ;; `as' but only in "import foo as bar" + '("[ \t]*\\(\\bfrom\\b.*\\)?\\bimport\\b.*\\b\\(as\\)\\b" . 2) ;; classes '("\\bclass[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)" 1 font-lock-type-face) @@ -347,6 +341,9 @@ support for features needed by `python-mode'.") "Queue of Python temp files awaiting execution. Currently-active file is at the head of the list.") +(defvar py-pdbtrack-is-tracking-p nil) + + ;; Constants @@ -428,6 +425,17 @@ Currently-active file is at the head of the list.") "[ \t]+File \"\\([^\"]+\\)\", line \\([0-9]+\\)" "Regular expression that describes tracebacks.") +;; pdbtrack contants +(defconst py-pdbtrack-stack-entry-regexp + "> \\([^(]+\\)(\\([0-9]+\\))[?a-zA-Z0-9_]+()" + "Regular expression pdbtrack uses to find a stack trace entry.") + +(defconst py-pdbtrack-input-prompt "\n[(<]?pdb[>)]? " + "Regular expression pdbtrack uses to recognize a pdb prompt.") + +(defconst py-pdbtrack-track-range 10000 + "Max number of characters from end of buffer to search for stack entry.") + ;; Major mode boilerplate @@ -489,6 +497,7 @@ Currently-active file is at the head of the list.") ;; Miscellaneous (define-key py-mode-map "\C-c:" 'py-guess-indent-offset) (define-key py-mode-map "\C-c\t" 'py-indent-region) + (define-key py-mode-map "\C-c\C-d" 'py-pdbtrack-toggle-stack-tracking) (define-key py-mode-map "\C-c\C-n" 'py-next-statement) (define-key py-mode-map "\C-c\C-p" 'py-previous-statement) (define-key py-mode-map "\C-c\C-u" 'py-goto-block-up) @@ -1091,6 +1100,70 @@ This function is appropriate for `comint-output-filter-functions'." (py-execute-file pyproc (car py-file-queue)))) )) +(defun py-pdbtrack-overlay-arrow (activation) + "Activate or de arrow at beginning-of-line in current buffer." + ;; This was derived/simplified from edebug-overlay-arrow + (cond (activation + (setq overlay-arrow-position (make-marker)) + (setq overlay-arrow-string "=>") + (set-marker overlay-arrow-position (py-point 'bol) (current-buffer)) + (setq py-pdbtrack-is-tracking-p t)) + (overlay-arrow-position + (setq overlay-arrow-position nil) + (setq py-pdbtrack-is-tracking-p nil)) + )) + +(defun py-pdbtrack-track-stack-file (text) + "Show the file indicated by the pdb stack entry line, in a separate window. + +Activity is disabled if the buffer-local variable +`py-pdbtrack-do-tracking-p' is nil. + +We depend on the pdb input prompt matching `py-pdbtrack-input-prompt' +at the beginning of the line." + ;; Instead of trying to piece things together from partial text + ;; (which can be almost useless depending on Emacs version), we + ;; monitor to the point where we have the next pdb prompt, and then + ;; check all text from comint-last-input-end to process-mark. + ;; + ;; KLM: It might be nice to provide an optional override, so this + ;; routine could be fed debugger output strings as the text + ;; argument, for deliberate application elsewhere. + ;; + ;; KLM: We're very conservative about clearing the overlay arrow, to + ;; minimize residue. This means, for instance, that executing other + ;; pdb commands wipes out the highlight. + (let* ((origbuf (current-buffer)) + (currproc (get-buffer-process origbuf))) + (if (not (and currproc py-pdbtrack-do-tracking-p)) + (py-pdbtrack-overlay-arrow nil) + (let* (;(origdir default-directory) + (procmark (process-mark currproc)) + (block (buffer-substring (max comint-last-input-end + (- procmark + py-pdbtrack-track-range)) + procmark)) + fname lineno) + (if (not (string-match (concat py-pdbtrack-input-prompt "$") block)) + (py-pdbtrack-overlay-arrow nil) + (if (not (string-match + (concat ".*" py-pdbtrack-stack-entry-regexp ".*") + block)) + (py-pdbtrack-overlay-arrow nil) + (setq fname (match-string 1 block) + lineno (match-string 2 block)) + (if (file-exists-p fname) + (progn + (find-file-other-window fname) + (goto-line (string-to-int lineno)) + (message "pdbtrack: line %s, file %s" lineno fname) + (py-pdbtrack-overlay-arrow t) + (pop-to-buffer origbuf t) ) + (if (= (elt fname 0) ?\<) + (message "pdbtrack: (Non-file source: '%s')" fname) + (message "pdbtrack: File not found: %s" fname)) + ))))))) + (defun py-postprocess-output-buffer (buf) "Highlight exceptions found in BUF. If an exception occurred return t, otherwise return nil. BUF must exist." @@ -1227,6 +1300,9 @@ filter." (setq comint-prompt-regexp "^>>> \\|^[.][.][.] \\|^(pdb) ") (add-hook 'comint-output-filter-functions 'py-comint-output-filter-function) + ;; pdbtrack + (add-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file) + (setq py-pdbtrack-do-tracking-p t) (set-syntax-table py-mode-syntax-table) (use-local-map py-shell-map) )) @@ -1278,11 +1354,24 @@ is inserted at the end. See also the command `py-clear-queue'." (format "python-%d-%d" sn pid) (format "python-%d" sn))) (make-temp-name "python-"))) - (file (expand-file-name temp py-temp-directory))) - (write-region start end file nil 'nomsg) + (file (expand-file-name temp py-temp-directory)) + (cur (current-buffer)) + (buf (get-buffer-create file))) + ;; Write the contents of the buffer, watching out for indented regions. + (save-excursion + (goto-char start) + (let ((needs-if (/= (py-point 'bol) (py-point 'boi)))) + (set-buffer buf) + (when needs-if + (insert "if 1:\n")) + (insert-buffer-substring cur start end))) (cond ;; always run the code in its own asynchronous subprocess (async + ;; User explicitly wants this to run in its own async subprocess + (save-excursion + (set-buffer buf) + (write-region (point-min) (point-max) file nil 'nomsg)) (let* ((buf (generate-new-buffer-name py-output-buffer)) ;; TBD: a horrible hack, but why create new Custom variables? (arg (if (string-equal py-which-bufname "Python") @@ -1290,11 +1379,15 @@ is inserted at the end. See also the command `py-clear-queue'." (start-process py-which-bufname buf py-which-shell arg file) (pop-to-buffer buf) (py-postprocess-output-buffer buf) + ;; TBD: clean up the temporary file! )) ;; if the Python interpreter shell is running, queue it up for ;; execution there. (proc ;; use the existing python shell + (save-excursion + (set-buffer buf) + (write-region (point-min) (point-max) file nil 'nomsg)) (if (not py-file-queue) (py-execute-file proc file) (message "File %s queued for execution" file)) @@ -1306,7 +1399,10 @@ is inserted at the end. See also the command `py-clear-queue'." (if (string-equal py-which-bufname "JPython") " -" "")))) ;; otherwise either run it synchronously in a subprocess - (shell-command-on-region start end cmd py-output-buffer) + (save-excursion + (set-buffer buf) + (shell-command-on-region (point-min) (point-max) + cmd py-output-buffer)) ;; shell-command-on-region kills the output buffer if it never ;; existed and there's no output from the command (if (not (get-buffer py-output-buffer)) @@ -1316,8 +1412,12 @@ is inserted at the end. See also the command `py-clear-queue'." (pop-to-buffer py-output-buffer) (if err-p (pop-to-buffer py-exception-buffer))) - ))) - ))) + )) + ;; TBD: delete the buffer + ) + ) + ;; Clean up after ourselves. + (kill-buffer buf))) ;; Code execution commands @@ -1708,7 +1808,8 @@ dedenting." ;; chunk of non-whitespace characters on base line, + 1 more ;; column (end-of-line) - (setq endpos (point) searching t) + (setq endpos (point) + searching t) (back-to-indentation) (setq startpos (point)) ;; look at all "=" from left to right, stopping at first @@ -1733,7 +1834,12 @@ dedenting." (progn (goto-char startpos) (skip-chars-forward "^ \t\n"))) - (1+ (current-column)))))) + ;; if this is a continuation for a block opening + ;; statement, add some extra offset. + (+ (current-column) (if (py-statement-opens-block-p) + py-continuation-offset 0) + 1) + )))) ;; not on a continuation line ((bobp) (current-indentation)) @@ -2464,6 +2570,29 @@ A `nomenclature' is a fancy way of saying AWordWithMixedCaseNotUnderscores." (py-keep-region-active)) + +;; pdbtrack functions +(defun py-pdbtrack-toggle-stack-tracking (arg) + (interactive "P") + (if (not (get-buffer-process (current-buffer))) + (error "No process associated with buffer '%s'" (current-buffer))) + ;; missing or 0 is toggle, >0 turn on, <0 turn off + (if (or (not arg) + (zerop (setq arg (prefix-numeric-value arg)))) + (setq py-pdbtrack-do-tracking-p (not py-pdbtrack-do-tracking-p)) + (setq py-pdbtrack-do-tracking-p (> arg 0))) + (message "%sabled Python's pdbtrack" + (if py-pdbtrack-do-tracking-p "En" "Dis"))) + +(defun turn-on-pdbtrack () + (interactive) + (py-pdbtrack-toggle-stack-tracking 1)) + +(defun turn-off-pdbtrack () + (interactive) + (py-pdbtrack-toggle-stack-tracking 0)) + + ;; Documentation functions @@ -2775,7 +2904,7 @@ local bindings to py-newline-and-indent.")) "Return the parse state at point (see `parse-partial-sexp' docs)." (save-excursion (let ((here (point)) - pps done) + in-listcomp pps done) (while (not done) ;; back up to the first preceding line (if any; else start of ;; buffer) that begins with a popular Python keyword, or a @@ -2784,6 +2913,13 @@ local bindings to py-newline-and-indent.")) ;; at a non-zero nesting level. It may be slow for people who ;; write huge code blocks or huge lists ... tough beans. (re-search-backward py-parse-state-re nil 'move) + ;; Watch out for landing inside a list comprehension + (save-excursion + (if (and (looking-at "[ \t]*\\<\\(if\\|for\\)\\>") + (py-safe (progn (up-list -1) t)) + (eq (char-after) ?\[)) + (setq in-listcomp (point)) + (setq in-listcomp nil))) (beginning-of-line) ;; In XEmacs, we have a much better way to test for whether ;; we're in a triple-quoted string or not. Emacs does not @@ -2806,6 +2942,9 @@ local bindings to py-newline-and-indent.")) ;; XEmacs (setq done (or (not (buffer-syntactic-context)) (bobp))) + (when in-listcomp + (goto-char in-listcomp) + (setq done nil)) (when done (setq pps (parse-partial-sexp (point) here))) )) @@ -2842,12 +2981,16 @@ If nesting level is zero, return nil." "Go to the beginning of the triple quoted string we find ourselves in. DELIM is the TQS string delimiter character we're searching backwards for." - (let ((skip (and delim (make-string 1 delim)))) + (let ((skip (and delim (make-string 1 delim))) + (continue t)) (when skip (save-excursion - (py-safe (search-backward skip)) - (if (and (eq (char-before) delim) - (eq (char-before (1- (point))) delim)) + (while continue + (py-safe (search-backward skip)) + (setq continue (and (not (bobp)) + (= (char-before) ?\\)))) + (if (and (= (char-before) delim) + (= (char-before (1- (point))) delim)) (setq skip (make-string 3 delim)))) ;; we're looking at a triple-quoted string (py-safe (search-backward skip))))) @@ -3097,6 +3240,12 @@ These are Python temporary files awaiting execution." ;; arrange to kill temp files when Emacs exists (add-hook 'kill-emacs-hook 'py-kill-emacs-hook) +(add-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file) + +;; Add a designator to the minor mode strings +(or (assq 'py-pdbtrack-minor-mode-string minor-mode-alist) + (push '(py-pdbtrack-is-tracking-p py-pdbtrack-minor-mode-string) + minor-mode-alist)) diff --git a/rpm-spec-mode.el b/rpm-spec-mode.el index 4a2d30a..554c5fa 100644 --- a/rpm-spec-mode.el +++ b/rpm-spec-mode.el @@ -4,7 +4,7 @@ ;; Author: Stig Bjørlykke, ;; Keywords: unix, languages -;; Version: 0.11g +;; Version: 0.11h ;; This file is not yet part of FSF Emacs or XEmacs. @@ -407,7 +407,7 @@ the package." (defvar rpm-spec-font-lock-keywords '( ("%[a-zA-Z0-9_]+" 0 rpm-spec-macro-face) - ("^\\([a-zA-Z0-9]+\\)\\(\([a-zA-Z0-9]+\)\\):" + ("^\\([a-zA-Z0-9]+\\)\\(\([a-zA-Z0-9,]+\)\\):" (1 rpm-spec-tag-face) (2 rpm-spec-ghost-face)) ("^\\([a-zA-Z0-9]+\\):" 1 rpm-spec-tag-face) diff --git a/sources b/sources index e7c96bf..6bdb1f8 100644 --- a/sources +++ b/sources @@ -1,5 +1,4 @@ -367bc83b70bd10b8908549087b73530d elisp-manual-21-2.6.tar.bz2 -7c55c72e7cc8f1cb49b57b670b82dba2 emacs-20.7.tar.bz2 +5fefba94ab9e079b0b0fd3db36a115c1 elisp-manual-21-2.7.tar.bz2 +a5a99bb492ac59e7dc25670076a52757 emacs-21.1.tar.bz2 606b7415499a88b839a7cf414e3caaa8 emacs-asian.tar.bz2 -9395bc6d85f12471ee8f1f9bd6988d9e gnus-5.8.8-compiled.tar.bz2 -112c8f7493ef295fc9022feb4653eab0 leim-20.7.tar.bz2 +81d338aaddaaa7c1a876f49042087ef4 leim-21.1.tar.bz2 diff --git a/ssl.el b/ssl.el new file mode 100644 index 0000000..f8a9998 --- /dev/null +++ b/ssl.el @@ -0,0 +1,201 @@ +;;; ssl.el,v --- ssl functions for emacsen without them builtin +;; Author: wmperry +;; Created: 1999/10/14 12:44:18 +;; Version: 1.2 +;; Keywords: comm + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1995, 1996 by William M. Perry +;;; Copyright (c) 1996 - 1999 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 2, 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; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cl) +(require 'base64) + +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup ssl nil + "Support for `Secure Sockets Layer' encryption." + :group 'comm) + +(defcustom ssl-certificate-directory "~/.w3/certs/" + "*Directory to store CA certificates in" + :group 'ssl + :type 'directory) + +(defcustom ssl-rehash-program-name "c_rehash" + "*Program to run after adding a cert to a directory . +Run with one argument, the directory name." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-name "x509" + "*The program to run to provide a human-readable view of a certificate." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER") + "*Arguments that should be passed to the certificate viewing program. +The certificate is piped to it. +Maybe a way of passing a file should be implemented" + :group 'ssl + :type 'list) + +(defcustom ssl-certificate-directory-style 'ssleay + "*Style of cert database to use, the only valid value right now is `ssleay'. +This means a directory of pem encoded certificates with hash symlinks." + :group 'ssl + :type '(choice (const :tag "SSLeay" :value ssleay) + (const :tag "OpenSSL" :value openssl))) + +(defcustom ssl-certificate-verification-policy 0 + "*How far up the certificate chain we should verify." + :group 'ssl + :type '(choice (const :tag "No verification" :value 0) + (const :tag "Verification required" :value 1) + (const :tag "Reject connection if verification fails" :value 3) + (const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5))) + +(defcustom ssl-program-name "openssl" + "*The program to run in a subprocess to open an SSL connection." + :group 'ssl + :type 'string) + +(defcustom ssl-program-arguments + '("s_client" + "-quiet" + "-host" host + "-port" service + "-verify" (int-to-string ssl-certificate-verification-policy) + "-CApath" ssl-certificate-directory + ) + "*Arguments that should be passed to the program `ssl-program-name'. +This should be used if your SSL program needs command line switches to +specify any behaviour (certificate file locations, etc). +The special symbols 'host and 'port may be used in the list of arguments +and will be replaced with the hostname and service/port that will be connected +to." + :group 'ssl + :type 'list) + +(defun ssl-certificate-information (der) + "Return an assoc list of information about a certificate in DER format." + (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" + (base64-encode-string der) + "\n-----END CERTIFICATE-----\n")) + (exit-code 0)) + (save-excursion + (set-buffer (get-buffer-create " *openssl*")) + (erase-buffer) + (insert certificate) + (setq exit-code (condition-case () + (call-process-region (point-min) (point-max) + ssl-program-name + t (list (current-buffer) nil) t + "x509" + "-subject" ; Print the subject DN + "-issuer" ; Print the issuer DN + "-dates" ; Both before and after dates + "-serial" ; print out serial number + "-noout" ; Don't spit out the certificate + ) + (error -1))) + (if (/= exit-code 0) + nil + (let ((vals nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\([^=\n\r]+\\)\\s *=\\s *\\(.*\\)" nil t) + (push (cons (match-string 1) (match-string 2)) vals)) + vals))))) + +(defun ssl-accept-ca-certificate () + "Ask if the user is willing to accept a new CA certificate. The buffer-name +should be the intended name of the certificate, and the buffer should probably +be in DER encoding" + ;; TODO, check if it is really new or if we already know it + (let* ((process-connection-type nil) + (tmpbuf (generate-new-buffer "X509 CA Certificate Information")) + (response (save-excursion + (and (eq 0 + (apply 'call-process-region + (point-min) (point-max) + ssl-view-certificate-program-name + nil tmpbuf t + ssl-view-certificate-program-arguments)) + (switch-to-buffer tmpbuf) + (goto-char (point-min)) + (or (recenter) t) + (yes-or-no-p + "Accept this CA to vouch for secure server identities? ") + (kill-buffer tmpbuf))))) + (if (not response) + nil + (if (not (file-directory-p ssl-certificate-directory)) + (make-directory ssl-certificate-directory)) + (case ssl-certificate-directory-style + (ssleay + (base64-encode-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "-----BEGIN CERTIFICATE-----\n") + (goto-char (point-max)) + (insert "-----END CERTIFICATE-----\n") + (let ((f (expand-file-name + (concat (file-name-sans-extension (buffer-name)) ".pem") + ssl-certificate-directory))) + (write-file f) + (call-process ssl-rehash-program-name + nil nil nil + (expand-file-name ssl-certificate-directory)))))))) + +(defun open-ssl-stream (name buffer host service) + "Open a SSL connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +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 +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (if (integerp service) (setq service (int-to-string service))) + (let* ((process-connection-type nil) + (port service) + (proc (eval + (` + (start-process name buffer ssl-program-name + (,@ ssl-program-arguments)))))) + (process-kill-without-query proc) + proc)) + +(provide 'ssl)