├── .gitignore
├── .gitmodules
├── Makefile
├── README.md
├── bin-version.l
├── crank.sh
├── examples
├── README
├── git2bk.l
├── photos.l
├── pod2html.l
├── svn2bk.l
└── weather.l
├── msys_release
├── platform
└── remote.sh
/.gitignore:
--------------------------------------------------------------------------------
1 | L/
2 |
--------------------------------------------------------------------------------
/.gitmodules:
--------------------------------------------------------------------------------
1 | [submodule "pcre"]
2 | path = pcre
3 | url = https://github.com/bitkeeper-scm/pcre.git
4 | [submodule "tcl"]
5 | path = tcl
6 | url = https://github.com/bitkeeper-scm/tcl.git
7 | [submodule "tk"]
8 | path = tk
9 | url = https://github.com/bitkeeper-scm/tk.git
10 |
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | # "make install" locations
2 | PREFIX = /opt/little-lang
3 | BINDIR := $(PREFIX)/bin
4 | LGUI_OSX_INSTALL_DIR = /Applications # for the OS X application bundle
5 |
6 | MAJOR=1
7 | MINOR=0
8 | L_BUILD_ROOT = ./L
9 | LGUI_BUILD_ROOT = ./Lgui
10 | LIBPCRE = pcre/lib/libpcre.a
11 |
12 | BKUSER := $(USER)
13 | HERE := $(shell pwd)
14 | ROOT := $(HERE)
15 | REPO := $(shell basename $(HERE))
16 | URL := $(shell echo bk://work/$(ROOT) | sed s,/home/bk/,,)
17 | LOG := $(shell echo LOG-$(BKUSER))
18 | OSTYPE := $(shell bash -c 'echo $$OSTYPE')
19 |
20 | # platform-specific build options
21 | PLATFORM = $(shell ./platform)
22 | EXE=
23 | ifeq "$(PLATFORM)" "win"
24 | S := win
25 | EXE=.exe
26 | TCLSH_NAME=tclsh.exe
27 | WISH_NAME=wish86.exe
28 | WISH=$(L_BUILD_ROOT)/$(BINDIR)/$(WISH_NAME)
29 | TCLSH_CONFIGURE_OPTS=--enable-shared
30 | TK_CONFIGURE_OPTS=--enable-shared
31 | ifeq "$(shell ./msys_release)" "1.0.11"
32 | CFLAGS := -D_OLDMINGW
33 | export CFLAGS
34 | endif
35 | endif
36 | ifeq "$(PLATFORM)" "macosx"
37 | S := unix
38 | TCLSH_NAME=tclsh
39 | WISH_NAME=wish8.6
40 | WISH=$(LGUI_BUILD_ROOT)/$(BINDIR)/$(WISH_NAME)
41 | TCLSH_CONFIGURE_OPTS=--enable-64bit --disable-shared
42 | TK_CONFIGURE_OPTS=--enable-64bit --enable-framework --enable-aqua
43 | endif
44 | ifeq "$(PLATFORM)" "unix"
45 | S := unix
46 | TCLSH_NAME=tclsh
47 | WISH_NAME=wish8.6
48 | WISH=$(L_BUILD_ROOT)/$(BINDIR)/$(WISH_NAME)
49 | TCLSH_CONFIGURE_OPTS=--enable-64bit --disable-shared
50 | TK_CONFIGURE_OPTS=--enable-64bit --disable-xss --enable-xft --disable-shared
51 | endif
52 | TCLSH=$(L_BUILD_ROOT)/$(BINDIR)/$(TCLSH_NAME)
53 | L=$(L_BUILD_ROOT)/$(BINDIR)/L$(EXE)
54 | L-gui=$(L_BUILD_ROOT)/$(BINDIR)/L-gui$(EXE)
55 |
56 | all: ## default, build for `./platform`
57 | $(MAKE) $(PLATFORM)
58 |
59 | unix win: ## build for unix or windows
60 | $(MAKE) $(TCLSH)
61 | $(MAKE) $(WISH)
62 |
63 | macosx: ## build for macos
64 | $(MAKE) $(TCLSH)
65 | $(MAKE) $(LGUI_BUILD_ROOT)/tk/Wish.app
66 |
67 | tcl/$(S)/Makefile:
68 | cd tcl/$(S) && \
69 | ./configure --enable-pcre=default --with-pcre=../../pcre \
70 | $(TCLSH_CONFIGURE_OPTS)
71 |
72 | $(TCLSH):
73 | $(MAKE) $(LIBPCRE)
74 | $(MAKE) tcl/$(S)/Makefile
75 | echo "proc Lver {} { return \"$(MAJOR).$(MINOR)\" }" >tcl/library/Lver.tcl
76 | cd tcl/$(S) && \
77 | $(MAKE) prefix=$(PREFIX) exec_prefix=$(PREFIX) libdir=$(PREFIX)/lib \
78 | INSTALL_ROOT=../../$(L_BUILD_ROOT) \
79 | install-binaries install-libraries
80 | mv $(TCLSH) $(L)
81 |
82 | tk/$(S)/Makefile:
83 | cd tk/$(S) && \
84 | ./configure --with-tcl=../../tcl/$(S) $(TK_CONFIGURE_OPTS)
85 |
86 | $(WISH):
87 | $(MAKE) $(TCLSH)
88 | $(MAKE) tk/$(S)/Makefile
89 | cd tk/$(S) && \
90 | $(MAKE) XLIBS=`pwd`/../../$(LIBPCRE) \
91 | prefix=$(PREFIX) exec_prefix=$(PREFIX) libdir=$(PREFIX)/lib \
92 | INSTALL_ROOT=../../$(L_BUILD_ROOT) \
93 | install-binaries install-libraries; \
94 | pwd
95 | mv $(WISH) $(L-gui)
96 |
97 | $(LGUI_BUILD_ROOT)/tk/Wish.app:
98 | $(MAKE) $(TCLSH)
99 | $(MAKE) tk/$(S)/Makefile
100 | rm -rf $(LGUI_BUILD_ROOT)
101 | (cd tcl/macosx && \
102 | $(MAKE) EXTRA_CONFIGURE_ARGS="--enable-pcre=default --with-pcre=`pwd`/../../pcre" \
103 | embedded)
104 | (cd tk/macosx && \
105 | $(MAKE) XLIBS="../../../$(LIBPCRE)" \
106 | EXTRA_CONFIGURE_ARGS="--enable-aqua" embedded)
107 | (cd build/tk; \
108 | mv Wish.app Lgui.app; \
109 | ln -s Lgui.app Wish.app; \
110 | rm -f "Wish Shell.app" wish*; \
111 | ln -sf Lgui.app/Contents/MacOS/Lgui Lgui; \
112 | cd Lgui.app/Contents; \
113 | sed "s/>Wish>LguiWiSH>Lgui" Info.plist >NewInfo.plist; \
114 | mv NewInfo.plist Info.plist; \
115 | cd MacOS; \
116 | mv Wish Lgui; \
117 | cd ../../../../..)
118 | mv build $(LGUI_BUILD_ROOT)
119 |
120 | $(LIBPCRE): pcre/Makefile
121 | cd pcre && $(MAKE) && $(MAKE) install
122 |
123 | pcre/Makefile:
124 | cd pcre && ./configure --disable-cpp --disable-shared --enable-utf8=yes --prefix=`pwd`
125 |
126 | test test-l: $(TCLSH)
127 | $(MAKE) -C tcl/$(S) test-l
128 |
129 | clean: ## clean up after a build
130 | -test -f pcre/Makefile && { \
131 | echo === clean pcre ===; \
132 | $(MAKE) -C pcre distclean; \
133 | cd pcre && rm -rf bin include lib share; \
134 | }
135 | -test -f tcl/$(S)/Makefile && { \
136 | echo === clean tcl ===; \
137 | $(MAKE) -C tcl/$(S) distclean; \
138 | cd tcl/doc/L && make clean; \
139 | }
140 | -test -f tk/$(S)/Makefile && { \
141 | echo === clean tk ===; \
142 | $(MAKE) -C tk/$(S) distclean; \
143 | }
144 | rm -rf $(L_BUILD_ROOT) $(LGUI_BUILD_ROOT) build
145 |
146 | clobber: ## really clean up, assumes BK, cleans everything
147 | @$(MAKE) clean
148 | rm -rf L
149 |
150 | doc: $(L) ## build little.html, some docs
151 | $(MAKE) INTERP=$(HERE)/$(L) -C tcl/doc/L little.html
152 | $(MAKE) -C tcl/doc/l-paper little.pdf
153 | mkdir -p $(L_BUILD_ROOT)/$(PREFIX)/doc
154 | -cp tcl/doc/L/little.html $(L_BUILD_ROOT)/$(PREFIX)/doc
155 | -cp tcl/doc/l-paper/little.pdf $(L_BUILD_ROOT)/$(PREFIX)/doc
156 |
157 | install: all ## install to $(PREFIX) (default /opt/little-lang)
158 | @$(MAKE) doc
159 | @test -d $(PREFIX) || mkdir $(PREFIX)
160 | @test -w $(PREFIX) || { echo cannot write $(PREFIX); exit 1; }
161 | cp -pr $(L_BUILD_ROOT)/$(PREFIX)/* $(PREFIX)
162 | -test "$(PLATFORM)" = "macosx" && cp -pr $(LGUI_BUILD_ROOT)/tk/Lgui.app $(LGUI_OSX_INSTALL_DIR)
163 |
164 | help:
165 | @grep -h -E '^[a-zA-Z_\ -]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "make %-20s %s\n", $$1, $$2}'
166 | @echo Suggested: make -j
167 |
168 | src-tar: ## make source tarball
169 | @(DIR=little-lang-src-$(MAJOR).$(MINOR) ; \
170 | TAR="$$DIR".tar.gz ; \
171 | echo "Creating $$TAR ..." ; \
172 | rm -rf "$$DIR" ; \
173 | bk export -tplain -r+ "$$DIR" ; \
174 | tar zcf "$$TAR" "$$DIR" ; \
175 | rm -rf "$$DIR" ; \
176 | echo Done ; \
177 | )
178 |
179 | bin-tar: all ## make binary tarball
180 | @(ARCH=`./L/bin/L ./bin-version.l` ; \
181 | DIR=little-lang-$(MAJOR).$(MINOR)-$$ARCH ; \
182 | TAR="$$DIR".tar.gz ; \
183 | echo "Creating $$TAR ..." ; \
184 | rm -rf "$$DIR" ; \
185 | mkdir "$$DIR" ; \
186 | mv L Lgui "$$DIR" ; \
187 | tar zcf "$$TAR" "$$DIR" ; \
188 | rm -rf "$$DIR" ; \
189 | echo Done ; \
190 | )
191 |
192 | crankturn: crank.sh remote.sh ## Run a clean-build + regressions in cluster
193 | REPO=$(REPO) URL=$(URL) REMOTE=remote.sh LOG=$(LOG) bash crank.sh
194 |
195 | .PHONY: unix macosx win src-tar bin-tar crankturn
196 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # INTRODUCTION
2 |
3 | Little is a compiled-to-byte-code language that draws heavily from
4 | C and Perl. From C, Little gets C syntax, simple types (int, float,
5 | string), and complex types (arrays, structs). From Perl, Little gets
6 | associative arrays and regular expressions (PCRE). And from neither,
7 | Little gets its own simplistic form of classes.
8 |
9 | The name "Little", abbreviated as simply "L", alludes to the language's
10 | simplicity. The idea was to distill the useful parts of other languages
11 | and combine them into a scripting language, with type checking,
12 | classes (not full-blown OO but useful none the less), direct access to
13 | a cross-platform graphical toolkit, and a library drawn from Perl and
14 | the standard C library.
15 |
16 | L is built on top of the Tcl/Tk system. The L compiler generates Tcl byte
17 | codes and uses the Tcl calling convention. This means that L and Tcl code
18 | may be intermixed. More importantly, it means that Little may use all
19 | of the Tcl API and libraries as well as TK widgets. The net result is a
20 | type-checked scripting language which may be used for cross-platform GUIs.
21 |
22 | Little is open source under the same license as Tcl/TK (BSD like) with
23 | any bits that are unencumbered by the Tcl license also being available
24 | under the Apache License, Version 2.0.
25 |
26 | Little is based on interim Tcl and Tk releases
27 | http://core.tcl.tk/tcl/info/497b93405b3435aa and
28 | http://core.tcl.tk/tk/info/407bae5e576b5ef7.
29 |
30 | ## PREREQUISITES
31 |
32 | * bison
33 | * flex
34 | * libxft2-dev (Linux only)
35 |
36 | ## COMPILING L
37 |
38 | Little can be built with or without Tk. Without Tk, you get only an tclsh
39 | executable named "L". With Tk, you get that and a version of wish
40 | with Little named "L-gui" (on OS X, an application bundle is created instead).
41 | The accompanying Makefile builds L and L-gui for Linux, OS X, and Windows.
42 |
43 | Because Little is integrated into Tcl/Tk, the instructions for configuring
44 | and compiling Tcl and Tk apply. See `tcl/README` and `tk/README` if you
45 | need to tweak anything. L adds Perl-compatible regular expressions
46 | (PCRE) and the `--with-pcre=` configure option to Tcl.
47 |
48 | A Windows build wants msys or cygwin. A `make help` explains the make
49 | targets.
50 |
51 | L uses git submodules to distribute Tcl, Tk, and PCRE. To compile from
52 | source:
53 |
54 | ```
55 | $ git submodule init
56 | $ git submodule update
57 | $ make
58 | ```
59 | ### Extra notes for compiling on Windows
60 |
61 | The build requires the MinGW project, available from:
62 |
63 | http://mingw.org
64 |
65 | If you did not already have MinGW installed, you will need to install it.
66 | Installation instructions can be found here:
67 |
68 | http://mingw.org/wiki/Getting_Started
69 |
70 | You should install the MSYS base system as well as the developer toolkit
71 | (they were not part of the initial basic installation at this writing).
72 |
73 | One you have MSYS installed, you can open an MSYS window by running
74 | msys.bat as described on the Getting Started page.
75 |
76 | In this window you will be presented with a shell (bash) prompt and you
77 | can type:
78 |
79 | cd /c/...
80 |
81 | where ... is the path to where you unpacked this file. Now you should
82 | be able to type:
83 |
84 | make
85 |
86 | ## INSTALLING
87 |
88 | On Linux and Windows, a `make install` will install L and L-gui in
89 | `/opt/little-lang` (can be overridden with `PREFIX=$DIR`).
90 |
91 | For OS X, Little is similarly installed, but the L-gui application bundle
92 | is copied to `LGUI_OSX_INSTALL_DIR` which defaults to `/Applications`.
93 |
94 | ## DOCUMENTATION
95 |
96 | `make install` will create `$(PREFIX)/doc/L.html`
97 |
98 | If the build machine has `groff` and a postscript to PDF converter
99 | installed then you also get `$(PREFIX)/doc/little.pdf`.
100 |
101 | Alternatively, see `tcl/doc/l-paper` for ["The L Programming
102 | language"](http://www.tcl.tk/community/tcl2006/papers/Larry_McVoy/l.pdf)
103 | published in the Proceedings of the [13th Annual Tcl/Tk
104 | Conference](http://www.tcl.tk/community/tcl2006/schedule.html).
105 |
--------------------------------------------------------------------------------
/bin-version.l:
--------------------------------------------------------------------------------
1 | # print TCL's platform string
2 |
3 | require("platform");
4 |
5 | puts(platform::generic());
6 |
--------------------------------------------------------------------------------
/crank.sh:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 | # Copyright 2000-2003,2011,2014-2016 BitMover, Inc
3 | #
4 | # Licensed under the Apache License, Version 2.0 (the "License");
5 | # you may not use this file except in compliance with the License.
6 | # You may obtain a copy of the License at
7 | #
8 | # http://www.apache.org/licenses/LICENSE-2.0
9 | #
10 | # Unless required by applicable law or agreed to in writing, software
11 | # distributed under the License is distributed on an "AS IS" BASIS,
12 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 | # See the License for the specific language governing permissions and
14 | # limitations under the License.
15 |
16 | # If you edit this, please apply those changes to the master template in
17 | # /home/bk/crankturn/crank.sh
18 |
19 | set -a
20 |
21 | test -d SCCS && {
22 | echo CRANK does not work in repo with SCCS dirs
23 | exit 1
24 | }
25 |
26 | test "X$REMOTE" = X && {
27 | echo You need to set \$REMOTE before cranking
28 | exit 1
29 | }
30 | test -r "$REMOTE" || {
31 | echo No remote crank shell script found
32 | exit 1
33 | }
34 | test "X$HOSTS" = X && HOSTS=`chosts little`
35 | test "X$HOSTS" = X && {
36 | echo No build hosts found.
37 | exit 1
38 | }
39 | test "X$URL" = X && URL=bk://`bk gethost`/`pwd | sed s,/home/bk/,,`
40 | test "X$REPO" = X && REPO=`pwd | sed 's,.*/,,'`
41 | case "$REPO" in
42 | */*)
43 | echo "REPO identifier may not contain a / (slash)"
44 | exit 1
45 | ;;
46 | esac
47 | U=`bk getuser`
48 | test "X$LOG" = X && LOG=LOG.${REPO}-$U
49 |
50 | remote() {
51 | $RSH $host "env LOG=$LOG BK_USER=$U URL=$URL REPO=$REPO \
52 | /bin/bash /build/.$REPO.$U $@"
53 | }
54 |
55 |
56 | for host in $HOSTS
57 | do
58 | RCP=rcp
59 | RSH=rsh
60 | if [ "$host" = "macos106" ]
61 | then
62 | RCP="scp -q"
63 | RSH=ssh
64 | fi
65 | (
66 | test "X$@" = Xstatus && {
67 | printf "%-10s %s\n" $host "`remote status`"
68 | continue
69 | }
70 | test "X$@" = Xclean && {
71 | printf "%-10s %s\n" $host "`remote clean`"
72 | continue
73 | }
74 | trap "rm -f .[st].$host; exit" 0 1 2 3 15
75 | $RCP $REMOTE ${host}:/build/.$REPO.$U
76 | /usr/bin/time -o .t.$host -f "%E" $RSH $host \
77 | "env LOG=$LOG BK_USER=$U URL=$URL REPO=$REPO \
78 | /bin/bash /build/.$REPO.$U $@"
79 | remote status > .s.$host
80 | printf \
81 | "%-10s took %s and %s\n" $host `sed 's/\.[0-9][0-9]$//' < .t.$host` "`cat .s.$host`"
82 | rm -f
83 | ) &
84 | done
85 | wait
86 | exit 0
87 |
--------------------------------------------------------------------------------
/examples/README:
--------------------------------------------------------------------------------
1 | This directory contains samples of L code.
2 |
3 | pod2html.l:
4 | Converts pod docs to html.
5 | Example output at http://www.mcvoy.com/lm/L/L.html
6 |
7 | photos.l:
8 | Generates photo galleries.
9 |
10 | weather.l:
11 | Polls a Davis Vantage Pro 2 weather station for data
12 | and uploads to the Weather Underground.
13 |
--------------------------------------------------------------------------------
/examples/git2bk.l:
--------------------------------------------------------------------------------
1 | #!/usr/libexec/bitkeeper/gui/bin/tclsh -L
2 |
3 | /*
4 | * This is a little git to BK importer written in L. It operates on a
5 | * git repo and creates BK history in place so the repo is both git and
6 | * bk (seems weird but you clone it when you are done to get a BK only
7 | * repo).
8 | *
9 | * Default is to import tagged csets only (the importer runs at about
10 | * 15 seconds/cset for the linux kernel and more than half of that is git).
11 | *
12 | * To make it run as fast as possible:
13 | * A) Run with /tmp and the repo in SSD or ramdisk
14 | * B) Run on the fastest CPU possible (4x 4Ghz is better than 12x 3Ghz)
15 | * C) More cores do help so if you have an 8 core 4Ghz machine, use that.
16 | *
17 | * Incremental imports
18 | * Update the git repo with this syntax:
19 | * git pull master:master
20 | * The master:master is needed to get the tags, without that no tags;
21 | * adjust as necessary if you are doing a different branch.
22 | *
23 | * Run the import again. An easy test is to run the import and then
24 | * bk undo the last 20 csets, run the import again again.
25 | */
26 |
27 | /*
28 | * TODO
29 | * In the NTP tree an undo -fsaNTP_4_3_41 or 4_3_25 and then an import
30 | * barfs. Don't know why but it is repeatable.
31 | *
32 | * This does not handle all git repos; when we tested it about 1/3 of
33 | * them fail. If anyone figures out why and has a fix, please send
34 | * a patch.
35 | */
36 |
37 | typedef struct {
38 | string user; // username who did the check in
39 | string host; // hostname where check in was done
40 | string date; // 2007-05-13 03:21:54 -0700
41 | string cmts[]; // array of comments for the commit
42 | } delta;
43 |
44 | delta log{string}; // cache of the entire log
45 | string q = "-q"; // -v turns this off and makes bk/git noisy
46 | string host = "git2bk.arpa";
47 | string start; // --start=rev
48 | string branch; // so we can switch back to head
49 | string tagpats[]; // --tag= - try and get these tags
50 | string tagskip[]; // --tagskip= - try to not get these
51 | string tags{string}; // tags{gitrev} = tagname
52 | string skip[]; // list of directories/files to not import
53 | string tmpdir = "/tmp"; // --tmp=/hfs/tmp
54 | int nospaces = 0; // --strip-spaces removes leading spaces
55 | int n = 0, done = 0;
56 | int stride = 1; // --stride=%d
57 | int debug = 0;
58 | int dryrun = 0; // --dryrun
59 | int verify = 0; // --verify compares plain exports
60 | int findcset = 0; // --findcset, skip commits
61 | // bk -r _findcset -i -B -t1
62 | int repack = 0; // --repack=%d, repack that often
63 | int tagged = 1; // do tagged only csets, override w/ --all
64 |
65 | int
66 | main(_argused int ac, string av[])
67 | {
68 | string c, buf;
69 | int rcs = 0;
70 | int i, want;
71 | int renamelimit; // so we can restore it
72 | int listrevs = 0; // --list-revs: print the revs and exit
73 | string stop; // --stop=rev exits at that rev (testing)
74 | string revs[]; // ordered list of revs for this branch
75 | string parent; // parent of the current cset
76 | string tmp[];
77 | string lopts[] = {
78 | "all", // include all changesets, not just tags
79 | "branch:", // override default of --branch=master
80 | "debug", // like it says
81 | "dry-run", // not sure if this is useful
82 | "dryrun", // UNDOC: alias
83 | "findcset", // UNDOC: experimental, don't use
84 | "help", // this help
85 | "host:", // override default --host=git2bk.arpa
86 | "list-revs", // sort of like dryrun, list and exit
87 | "rcs", // UNDOC: support RCS keywords
88 | "repack:", // UNDOC: experimental, don't use
89 | "skip:", // --skip=skip_this_file, can repeat
90 | "start:", // UNDOC: experimental, don't use
91 | "stop:", // UNDOC: ditto
92 | "stride:", // do every Nth cset
93 | "strip-spaces", // UNDOC: I dunno what this is, some Wayne thing?
94 | "tag:", // wanted tag pattern (regexp, can repeat)
95 | "tagskip:", // unwanted tag pattern (regexp, can repeat)
96 | "tmp:", // override /tmp
97 | "verify|", // --verify[=%d] verify every %d, default 1
98 | };
99 |
100 |
101 | branch = "master";
102 |
103 | while (c = getopt(av, "dv", lopts)) {
104 | switch (c) {
105 | case "all":
106 | tagged = 0;
107 | break;
108 | case "branch":
109 | branch = optarg;
110 | break;
111 | case "d":
112 | case "debug":
113 | debug++;
114 | break;
115 | case "dryrun":
116 | case "dry-run":
117 | dryrun = 1;
118 | break;
119 | case "findcset":
120 | findcset = 1;
121 | break;
122 | case "help":
123 | help();
124 | exit(0);
125 | case "host":
126 | host = optarg;
127 | break;
128 | case "list-revs":
129 | listrevs = 1;
130 | break;
131 | case "rcs":
132 | rcs = 1;
133 | break;
134 | case "repack":
135 | repack = (int)optarg;
136 | break;
137 | case "skip":
138 | push(&skip, optarg);
139 | break;
140 | case "start":
141 | start = optarg;
142 | break;
143 | case "stop":
144 | stop = optarg;
145 | break;
146 | case "stride":
147 | stride = (int)optarg;
148 | break;
149 | case "strip-spaces":
150 | nospaces = 1;
151 | break;
152 | case "tag":
153 | push(&tagpats, optarg);
154 | break;
155 | case "tagskip":
156 | push(&tagskip, optarg);
157 | break;
158 | case "tmp":
159 | tmpdir = optarg;
160 | break;
161 | case "v": q = ""; break;
162 | case "verify":
163 | verify = 1;
164 | if (defined(optarg)) verify = (int)optarg;
165 | break;
166 | default: die("bad optarg");
167 | }
168 | }
169 | /* git may have these if we are coming from a bk->GIT tree */
170 | push(&skip, "BitKeeper/etc/config");
171 | push(&skip, "BitKeeper/etc/ignore");
172 | push(&skip, "BitKeeper/etc/gone");
173 |
174 | if (tagged && (stride > 1)) die("--tagged or --stride but not both");
175 |
176 | if (av[optind]) chdir(av[optind]);
177 |
178 | unless (isdir(".git")) die("not in a git repo.\n");
179 | if (exists(".gitmodules")) die("submodule imports not supported.\n");
180 |
181 | versions();
182 |
183 | // restored below
184 | renamelimit = (int)`get config --get diff.renameLimit`;
185 | sys("git config diff.renameLimit 5000");
186 | sys("git checkout -f -q ${branch} --");
187 |
188 | fprintf(stderr, "### Importing branch: %s in %s ###\n", branch, `pwd`);
189 | revs = longest_path(&parent);
190 | for (i = 0; defined(revs[i]); i++) {
191 | if (tagged && !tags{revs[i]}) continue;
192 | want = 1;
193 | foreach (buf in tagskip) {
194 | if (tags{revs[i]} =~ /${buf}/) {
195 | if (debug) warn("Skipping %s\n", tags{revs[i]});
196 | want = 0;
197 | break;
198 | }
199 | }
200 | unless (want) continue;
201 | push(&tmp, revs[i]);
202 | n++;
203 | if (listrevs) {
204 | warn("%s %s\n",
205 | revs[i], tags{revs[i]} ? tags{revs[i]} : "");
206 | }
207 | if (stop && (revs[i] == stop)) break;
208 | }
209 | if (tagged) {
210 | if (debug) warn("%d => %d tagged\n", length(revs), length(tmp));
211 | revs = tmp;
212 | }
213 | if (listrevs) exit(0);
214 |
215 | if (setup(revs[0], rcs)) die("unable to complete setup");
216 |
217 | for (i = 0; defined(revs[i]); i += stride) {
218 | if ((i > 0) && tagged && !tags{revs[i]}) continue;
219 | assert(cset(parent, revs[i]) == 0);
220 | if (repack && !(done % repack) && !dryrun) {
221 | sys("bk -?_BK_FORCE_REPACK=YES repocheck");
222 | }
223 | if (stop && (revs[i] == stop)) break;
224 | parent = revs[i];
225 | }
226 | unless (dryrun) sys("bk repocheck");
227 | sys("git checkout -f -q ${branch} --"); // restores HEAD
228 | if (renamelimit > 0) sys("git config diff.renameLimit ${renamelimit}");
229 | return (0);
230 | }
231 |
232 | void
233 | help(void)
234 | {
235 | string header, c, help, buf;
236 | string script = "${`bk bin`}/lscripts/git2bk.l";
237 | FILE f = fopen(script, "r");
238 | int in_header = 0, in_opts = 0;
239 |
240 | fprintf(stderr, "usage: bk git2bk [options] path/to/git/repo\n");
241 | fprintf(stderr, "\nOptions:\n\t");
242 | while (buf = ) {
243 | switch (in_header) {
244 | case 0:
245 | if (buf =~ m|/\*|) in_header = 1;
246 | break;
247 | case 1:
248 | if (buf =~ m|\*/|) {
249 | in_header = -1;
250 | } else {
251 | buf =~ s|^ \*||;
252 | buf =~ s|^ ||;
253 | header .= buf;
254 | header .= "\n";
255 | }
256 | break;
257 | }
258 |
259 | unless (in_opts) {
260 | if (buf =~ /string\s+lopts\[\] = {/) in_opts = 1;
261 | continue;
262 | }
263 | if (buf =~ /^\s+};/) break;
264 | /* "branch:", // override default of --branch=master */
265 | if (buf =~ /UNDOC:/) continue;
266 | unless (buf =~ m|\s+"([^"]+)".*// (.*)|) continue;
267 | c = $1;
268 | help = $2;
269 | if (c =~ /(.*)[:;]$/) {
270 | c = $1;
271 | buf = format("--%s= ", c);
272 | } else if (c =~ /(.*)\|$/) {
273 | c = $1;
274 | buf = format("--%s[=] ", c);
275 | } else {
276 | buf = format("--%s ", c);
277 | }
278 | fprintf(stderr, "%-20s // %s \n\t", buf, help);
279 | }
280 | fprintf(stderr, "\n%s", header);
281 | fprintf(stderr,
282 | "\nNote: this is community contributed unsupported software.\n"
283 | "Source is in ${`bk bin`}/lscripts/git2bk.l\n"
284 | "Please send any patches to dev@bitkeeper.com.\n");
285 | exit(0);
286 |
287 | }
288 |
289 | /*
290 | * Make sure we have a BK that does the right thing
291 | * Make sure we have a git that works.
292 | */
293 | void
294 | versions(void)
295 | {
296 | string git = `git --version`;
297 |
298 | unless (defined(git)) {
299 | fprintf(stderr, "No git installed?\n");
300 | exit(1);
301 | }
302 | /* anything 2.x or later should be fine */
303 | unless (git =~ /version [23456789]/) {
304 | git =~ /version 1\.(\d+)\./;
305 | /* 1.8 and later should be fine */
306 | unless ((int)$1 > 7) {
307 | unless (git =~ /version 1\.\d+\.(\d+)/) {
308 | fprintf(stderr, "Unable to parse: %s\n", git);
309 | exit(1);
310 | }
311 | // I don't remember why I needed this one, I think
312 | // it had to do with longest path. ob might know.
313 | unless ((int)$1 >= 4) {
314 | fprintf(stderr, "git 1.7.4 or later needed.\n");
315 | exit(1);
316 | }
317 | }
318 | }
319 | }
320 |
321 | /*
322 | * Create an empty bk repo and the intial git repo
323 | * We want to end up with .bk next to .git
324 | */
325 | int
326 | setup(string start_rev, int rcs)
327 | {
328 | FILE f;
329 | int i;
330 |
331 | if (dryrun) return (0);
332 |
333 | if (isdir(".bk")) {
334 | env();
335 | system("bk repocheck -q"); // fixes checkout:edit
336 | sys("bk repocheck"); // has to work
337 | return (0);
338 | }
339 |
340 | /*
341 | * Set up a repo inside the git repo
342 | * Wayne wants the date to be the first cset, how do I get that?
343 | */
344 | putenv("BK_DATE_TIME_ZONE=1970-01-01 01:00:00-0");
345 | putenv("BK_USER=git2bk");
346 | putenv("BK_HOST=${host}");
347 | putenv("BK_RANDOM=%s", sprintf("%.16s", start_rev));
348 | f = fopen(".bk_config", "w");
349 | fprintf(f, "checkout:edit\n");
350 | fprintf(f, "clock_skew:on\n");
351 | fprintf(f, "partial_check:on\n");
352 | fprintf(f, "compression:gzip\n");
353 | if (rcs) fprintf(f, "keyword:rcs\n");
354 | fclose(f);
355 |
356 | /*
357 | * Since we're running in a git tree we can't init "." so create
358 | * a subrepo called .bk_empty and then plop it on top of the git repo.
359 | */
360 | unless (sys("bk setup -f -c.bk_config .bk_empty") == 0) {
361 | return (1);
362 | }
363 | sys("tar -C.bk_empty -cf- . | tar -xf-");
364 | for (i = 0; i < 10; ++i) {
365 | if (system("rm -rf .bk_config .bk_empty") == 0) break;
366 | sleep(1);
367 | }
368 |
369 | env();
370 |
371 | /*
372 | * would 'touch .git/.bk_skip' be better than adding a cset to
373 | * the user's data?
374 | *
375 | * Also a lot of other code would be simplified if you would
376 | * also tell git to ignore BitKeeper and .bk.
377 | */
378 | sys("bk _eula -a");
379 |
380 | // tell bk to ignore git's data
381 | f = fopen(".git/.bk_skip", "w");
382 | fclose(f);
383 |
384 | // tell git to ignore bk's data
385 | f = fopen(".git/info/exclude", "w");
386 | fprintf(f, "BitKeeper/\n");
387 | fprintf(f, ".bk/\n");
388 | fclose(f);
389 |
390 | return (0);
391 | }
392 |
393 | void
394 | env(void)
395 | {
396 | putenv("BK_CONFIG=clock_skew:2!;compression:none!;checkout:edit!");
397 | }
398 |
399 | /*
400 | * Import a GIT commit.
401 | * We get the updates, then
402 | * - for each file that is not checked out, git deleted it so we delete it
403 | * - for each modified/extra we check those in with the comment/user/date
404 | * from the log message.
405 | */
406 | int
407 | cset(string parent, string rev)
408 | {
409 | FILE f;
410 | string buf, tmp, out, out2, err;
411 | string rm[];
412 | int rc, do_commit = 0;
413 |
414 | if (++done > n/stride) return (0);
415 |
416 | fprintf(stderr, "### GIT ${rev} %d/%d ###\n", done, n/stride);
417 | if (dryrun && tags{rev}) fprintf(stderr, "Tag: %s\n", tags{rev});
418 | getlog(rev);
419 |
420 | if (dryrun) return (0);
421 |
422 | // In case this is a BK tree, we don't want git's idea of the BK files
423 | unlink("BitKeeper/etc/config");
424 | unlink("BitKeeper/etc/ignore");
425 | unlink("BitKeeper/etc/gone");
426 | // Do a -f since git doesn't seem to want to checkout on top of a
427 | // touched but unchanged file without it. We get these after a
428 | // rename because we checkout the file.
429 | unless (sys("git checkout -q -f ${rev} --") == 0) return (1);
430 | foreach (buf in skip) system("rm -rf ./${buf}");
431 |
432 | tmp = "BitKeeper/tmp/comments";
433 | f = fopen(tmp, "w");
434 | foreach (buf in log{rev}.cmts) {
435 | fprintf(f, "%s\n", buf);
436 | }
437 | // Needed so findcset will clump nicely.
438 | if (findcset) fprintf(f, "GIT: %s\n", rev);
439 | fclose(f);
440 |
441 | /* tell BK to cons up random bits from the rest of the key */
442 | putenv("BK_RANDOM=cons");
443 | putenv("BK_USER=%s", log{rev}.user);
444 | putenv("BK_HOST=%s", defined(log{rev}.host) ? log{rev}.host : host);
445 | putenv("BK_DATE_TIME_ZONE=%s", log{rev}.date);
446 | if (parent) {
447 | types();
448 | renames(parent, rev);
449 | }
450 | system("bk -U^G", undef, &rm, undef);
451 | rmExtras(rm);
452 | system("bk -axcU", undef, "BitKeeper/tmp/list", undef);
453 | if (size("BitKeeper/tmp/list") > 0) {
454 | do_delta("cat BitKeeper/tmp/list | bk -j ci ${q} -alY${tmp} -");
455 | do_commit = 1;
456 | } else {
457 | /*
458 | * This catches a cset that has nothing in it except deletes.
459 | */
460 | system("bk pending", undef, "BitKeeper/tmp/list", undef);
461 | if (size("BitKeeper/tmp/list") > 0) {
462 | do_commit = 1;
463 | }
464 | }
465 | unless (do_commit) {
466 | warn("Nothing to commit:\n");
467 | system("git log -1 ${rev} | cat");
468 | }
469 | if (do_commit && !findcset) {
470 | // Add the git hash to the cset comments only.
471 | f = fopen(tmp, "a");
472 | fprintf(f, "GIT: %s\n", rev);
473 | fclose(f);
474 | sys("bk commit ${q} -Y${tmp}");
475 | }
476 | unlink("BitKeeper/tmp/list");
477 | if (tags{rev} && !findcset) {
478 | // fix up bad tags
479 | if (tags{rev} =~ /^[0-9]/) tags{rev} = "git_${tags{rev}}";
480 | if (tags{rev} =~ m|/|) tags{rev} =~ s|/|.|g;
481 | sys("bk tag " . tags{rev});
482 | }
483 | unless (verify) return (0);
484 |
485 | /*
486 | * Make sure we are in sync with Git.
487 | */
488 | system("git status -s", undef, &out, &err);
489 | out .= err;
490 | err = undef;
491 | foreach (buf in split(/\n/, out)) {
492 | if (buf =~ m|^\?\? \.bk/$|) continue;
493 | if (buf =~ m|^\?\? BitKeeper/|) continue;
494 | if (buf =~ m| D BitKeeper/|) continue;
495 | if (buf =~ /^ M (.*)/) {
496 | rc = system("git diff --ignore-space-at-eol '${$1}'",
497 | undef, &out2, undef);
498 | unless (rc) continue;
499 | }
500 | err .= buf . "\n";
501 | }
502 | if (defined(err)) die("GIT: %s", err);
503 |
504 | /*
505 | * Make sure we are in sync with BK
506 | */
507 | system("bk -cxgr", undef, &out, &err);
508 | out .= err;
509 | if (length(out) > 0) {
510 | /*
511 | * Tcl has a binhex file that switches \n to \r, clean it.
512 | */
513 | foreach (buf in split(/\n/, out)) {
514 | system("bk clean ${buf}");
515 | system("bk edit -q ${buf}");
516 | }
517 | system("bk -cxgr", undef, &out, &err);
518 | out .= err;
519 | if (length(out) > 0) die("BK: %s", out);
520 | }
521 |
522 | if (verify && !(done % verify)) {
523 | /* Be really paranoid and compare the plain trees */
524 | string bkplain = sprintf("${tmpdir}/bk-plain.%d", pid());
525 | string gitplain = sprintf("${tmpdir}/git-plain.%d", pid());
526 | string bkfiles[], gitfiles[];
527 | int found{string};
528 | int i;
529 | string savedir = pwd();
530 |
531 | fprintf(stderr, "### VERIFYING ${rev[0..5]} ###\n");
532 | system("rm -rf ${bkplain} ${gitplain}");
533 | system("bk export -tplain -kr+ ${bkplain}");
534 | cd(bkplain);
535 | system("find . -type f", undef, &bkfiles, undef);
536 | if (mkdir(gitplain)) die("could not mkdir ${gitplain}");
537 | cd(gitplain);
538 | putenv("GIT_DIR=${savedir}/.git");
539 | system("git checkout -qf ${rev} --");
540 | unset("::env(GIT_DIR)");
541 | system("find . -type f", undef, &gitfiles, undef);
542 | for (i = 0; defined(bkfiles[i]); i++) {
543 | cmp("${gitplain}/${bkfiles[i]}",
544 | "${bkplain}/${bkfiles[i]}");
545 | found{bkfiles[i]} = 1;
546 | }
547 | for (i = 0; defined(gitfiles[i]); i++) {
548 | if (found{gitfiles[i]}) continue;
549 | cmp("${gitplain}/${gitfiles[i]}",
550 | "${bkplain}/${gitfiles[i]}");
551 | found{gitfiles[i]} = 1;
552 | }
553 | for (i = 0; defined(bkfiles[i]); i++) {
554 | unless (found{bkfiles[i]}) {
555 | die("only in bk ${bkfiles[i]}");
556 | }
557 | }
558 | for (i = 0; defined(gitfiles[i]); i++) {
559 | unless (found{gitfiles[i]}) {
560 | die("only in git ${bkfiles[i]}");
561 | }
562 | }
563 | cd(savedir);
564 | }
565 | return (0);
566 | }
567 |
568 | void
569 | cmp(string git, string bk)
570 | {
571 | string bkbuf, gitbuf;
572 | FILE bkf, gitf;
573 |
574 | unless (gitf = fopen(git, "r")) die("git file ${git} not found");
575 | fconfigure(gitf, translation: "auto");
576 | unless (bkf = fopen("${bk}", "r")) die("bk file ${bk} not found");
577 | fconfigure(bkf, translation: "auto");
578 | read(bkf, &bkbuf);
579 | read(gitf, &gitbuf);
580 | unless (bkbuf == gitbuf) die("DIFF: %s %s\n", bk, git);
581 | fclose(gitf);
582 | fclose(bkf);
583 | }
584 |
585 | /*
586 | * Load up the log, we'll use it for our commits.
587 | * commit 97ed77243efe3d2baccbe1bdcbdcb84efb16781e
588 | * Author: kennykb <>
589 | * Date: Wed Dec 1 16:42:38 2010 +0000
590 | *
591 | * merge
592 | *
593 | * etc.
594 | */
595 | void
596 | getlog(string rev)
597 | {
598 | FILE f;
599 | string cmts[];
600 | string buf, c, buf2;
601 | string strip = undef;
602 |
603 | f = popen("git log -n 1 ${rev}", "r");
604 | unless (buf = ) die("git log ${rev}");
605 | unless (buf =~ /^commit /) die(buf);
606 | buf = ;
607 | if (buf =~ /^Merge:/) buf = ;
608 | if (buf =~ /Author: .* <(.*)@(.*)>/) {
609 | log{rev}.host = $2;
610 | } else if (buf =~
611 | /Author: .*([a-zA-Z0-9._-]+)[ -_][aA][tT][ -_]([a-zA-Z0-9.-]+)>/) {
612 | log{rev}.host = $2;
613 | } else if (buf =~ /Author: ([a-zA-Z0-9._-]+) <>/) {
614 | log{rev}.host = host;
615 | } else if (buf =~ /Author: .* <(.*)>/) {
616 | log{rev}.host = host;
617 | } else if (buf =~ /Author: <(.*)>/) {
618 | log{rev}.host = host;
619 | } else {
620 | log{rev}.host = host;
621 | $1 = "nobody";
622 | }
623 | log{rev}.user = $1;
624 |
625 | // Author:
626 | if (log{rev}.user =~ m|(.*)/.*|) {
627 | log{rev}.user = $1;
628 | }
629 | if (log{rev}.host =~ m|(.*)/.*|) {
630 | log{rev}.host = $1;
631 | }
632 |
633 | // cjolley@394f415c-e224-0410-a11c-cb241aa5d150? WTF?
634 | unless (log{rev}.host =~ /\./) log{rev}.host = host;
635 |
636 | // Author: Eric Sesterhenn <[mailto:snakebyte@gmx.de]>
637 | if (log{rev}.host =~ /\[mailto:(.*)\]/) {
638 | log{rev}.host = $1;
639 | log{rev}.host =~ s/^\s*//;
640 | log{rev}.host =~ s/\s*$//;
641 | }
642 |
643 | // sane: bad host name: "xayide.techfak.uni-bielefeld.de[ro]".
644 | if (log{rev}.host =~ /(.*)\[.*\]/) {
645 | log{rev}.host = $1;
646 | }
647 |
648 | buf = ;
649 | unless (buf =~ /^Date:\s+(.*)/) {
650 | die("expected rev/date: ${buf}\n");
651 | }
652 | log{rev}.date = date($1);
653 | buf = ; // toss the blank line
654 | undef(cmts); // toss previous comments
655 | while (buf = ) {
656 | if (nospaces) {
657 | unless (strip) {
658 | buf =~ /^(\s+)/;
659 | strip = $1;
660 | }
661 | buf =~ s/^${strip}//;
662 | } else {
663 | buf =~ s/^ //;
664 | }
665 | /*
666 | * Wayne says he needed this in his importer,
667 | * it's translating all the control chars.
668 | * 077 is ?
669 | */
670 | if (buf =~ /[\001-\010\013-\037]/) {
671 | buf2 = "";
672 | foreach (c in buf) {
673 | if (c =~ /[\001-\010\013-\037]/) {
674 | c = sprintf("\\%03o", ord(c));
675 | }
676 | buf2 .= c;
677 | }
678 | buf = buf2;
679 | }
680 | push(&cmts, buf);
681 | }
682 | pclose(f);
683 |
684 | /*
685 | * Lose trailing blank lines, they serve no purpose.
686 | * But bk doesn't like empty comments files so add something.
687 | */
688 | while (cmts[END] =~ /^\s*$/) pop(&cmts);
689 | unless (defined(cmts[0])) cmts[0] = "(no comments)";
690 | log{rev}.cmts = cmts;
691 | }
692 |
693 | /*
694 | * Git does: Wed Jun 17 18:19:11 1998
695 | * 1998-01-11 20:00:00-08 (RCS -zLT)
696 | */
697 | string m2d{string} = {
698 | "Jan" => "01",
699 | "Feb" => "02",
700 | "Mar" => "03",
701 | "Apr" => "04",
702 | "May" => "05",
703 | "Jun" => "06",
704 | "Jul" => "07",
705 | "Aug" => "08",
706 | "Sep" => "09",
707 | "Oct" => "10",
708 | "Nov" => "11",
709 | "Dec" => "12",
710 | };
711 |
712 | string
713 | date(string git)
714 | {
715 | // Wed Jun 17 18:19:11 1998 +0000
716 | // $1 $2 $3 $4 $5
717 | unless (git =~ /\w+ (\w+) (\d+) ([0-9:]+) (\d+)\s+(.*)/) die(git);
718 | return (sprintf("%d-%s-%02d %s\n", (int)$4, m2d{$1}, (int)$2, $3, $5));
719 | }
720 |
721 | int
722 | sys(string command)
723 | {
724 | int rc = system(command);
725 |
726 | if (rc || debug) fprintf(stderr, "%s = %d\n", command, rc);
727 | if (rc) {
728 | warn("Caller: %s\n", caller(1));
729 | exit(rc);
730 | }
731 | return (rc);
732 | }
733 |
734 | /*
735 | * For every file under BK control, see if it changed types. If it did,
736 | * rm the old file, we'll let the rest of the code add stuff as needed.
737 | */
738 | void
739 | types(void)
740 | {
741 | string buf, file, dir;
742 | string err[], fix[];
743 |
744 | system("bk -U log -r+ -nd:I:", undef, "/dev/null", &err);
745 | foreach (buf in err) {
746 | if (debug) fprintf(stderr, "TYPES: %s\n", buf);
747 | if (buf =~ m|(.*) has different file types, treating this file as read only.$|) {
748 | if (debug) fprintf(stderr, "MATCH: %s\n", $1);
749 | push(&fix, $1);
750 | }
751 | if (buf =~ m|unsupported file type: .* \((.*)\) \d+$|) {
752 | if (debug) fprintf(stderr, "MATCH: %s\n", $1);
753 | push(&fix, $1);
754 | }
755 | }
756 | foreach (file in fix) {
757 | sys("mv '${file}' .bk-save0");
758 | sys("bk rm '${file}'");
759 | dir = dirname(file);
760 | if ((length(dir) > 0) && !isdir(dir)) mkdir(dir);
761 | sys("mv .bk-save0 '${file}'");
762 | }
763 | }
764 |
765 | /*
766 | * Find renames from the git diff-tree output and do them in the bk tree.
767 | * This logic is taken from Wayne's bk-git-import perl script.
768 | */
769 | void
770 | renames(string fromRev, string toRev)
771 | {
772 | FILE f;
773 | string cmd, s;
774 | int first = 1;
775 |
776 | cmd = "git diff-tree -r -M ${fromRev} ${toRev}";
777 | unless (defined(f = popen(cmd, "r"))) die(cmd);
778 | while (defined(s = )) {
779 | if (s =~ /^:(\d+) (\d+) \S+ \S+ ([R])\d*\t([^\t]+)(\t(.+))?$/) {
780 | if (($4 =~ m|^BitKeeper/etc/|) ||
781 | ($6 =~ m|^BitKeeper/etc/|) ||
782 | ($4 =~ m|^BitKeeper/triggers/|) ||
783 | ($6 =~ m|^BitKeeper/triggers/|)) {
784 | continue;
785 | }
786 | if (first && debug) {
787 | warn("%s\n", cmd);
788 | first = 0;
789 | }
790 | if ($1 != $2) warn("TYPES: %s %s\n", $1, $2);
791 | if (debug) warn("%s\n", s);
792 | sys("rm -f '${$6}'");
793 | sys("bk mv '${$4}' '${$6}'");
794 | sys("bk edit -q '${$6}'");
795 | sys("git checkout -f ${toRev} -- '${$6}'");
796 | }
797 | }
798 | pclose(f);
799 | }
800 |
801 | /*
802 | * If the bk rm -f fails, check for errors like
803 | * unsupported file type: SCCS/s.file1 (file1) 0040775
804 | * which occurs when a regular file or symlink is replaced
805 | * by a directory without telling bk about it. Move the
806 | * directory out of the way, bk rm the original file, then
807 | * move the directory back.
808 | */
809 | int
810 | rmExtras(string files[])
811 | {
812 | string file, sdir, dir, err, errs[];
813 | int rc;
814 |
815 | unless (files) return (0);
816 |
817 | foreach (file in files) {
818 | if (file =~ m|(.*)/(.[^/]+)$|) {
819 | sdir = ".bk/" . $1 . "/SCCS";
820 | } else {
821 | sdir = ".bk/SCCS";
822 | }
823 | if (debug > 1) {
824 | if (exists(file)) sys("ls -l ${file}");
825 | sys("ls -l ${sdir}");
826 | }
827 | rc = system("bk rm -f ${file}", undef, undef, &errs);
828 | if (debug) fprintf(stderr, "rm %s = %d\n", file, rc);
829 | unless (rc) continue;
830 | foreach (err in errs) {
831 | if (debug) fprintf(stderr, "RM ERR: %s\n", err);
832 | if (err =~ /unsupported file type: .* \((.*)\) [0-9]+/){
833 | file = $1;
834 | sys("mv '${file}' .bk-save1");
835 | sys("bk rm '${file}'");
836 | dir = dirname(file);
837 | if ((length(dir) > 0) && !isdir(dir)) {
838 | mkdir(dir);
839 | }
840 | sys("mv .bk-save1 '${file}'");
841 | }
842 | }
843 | }
844 | return (sys("bk -U^G rm -f"));
845 | }
846 |
847 | /*
848 | * If the check-in fails due to an error like this
849 | * file1 has different file types, treating this file as read only
850 | * or
851 | * win/rc/SCCS/s.cursor8a.cur: file format is ascii, delta is binary.
852 | * because, for example, git changed a regular file to a symlink,
853 | * bk rm the file and re-add it.
854 | */
855 | int
856 | do_delta(string command)
857 | {
858 | string file, dir, err, errs[];
859 | int did_it{string};
860 | int rc = system(command, undef, undef, &errs);
861 |
862 | if (debug) fprintf(stderr, "%s = %d\n", command, rc);
863 | unless (rc) return (0);
864 |
865 | foreach (err in errs) {
866 | if ((err =~ /(.*) has different file types/) ||
867 | (err =~ /(.*): file format is ascii, delta is binary./)) {
868 | file = $1;
869 | if (file =~ m|(.*)SCCS/s.(.*)|) file = $1 . $2;
870 | if (did_it{file}) continue;
871 | sys("mv '${file}' .bk-save2");
872 | sys("bk rm '${file}'");
873 | dir = file;
874 | dir = dirname(file);
875 | if ((length(dir) > 0) && !isdir(dir)) mkdir(dir);
876 | sys("mv .bk-save2 '${file}'");
877 | sys("bk new -q '${file}'");
878 | did_it{file} = 1;
879 | }
880 | }
881 | return (sys(command));
882 | }
883 |
884 | /*
885 | * Given a GIT repository, calculate the longest path through the graph.
886 | * If tags are given, then weight paths containing the tags more heavily
887 | * so as to include as many tags as possible.
888 | */
889 | string node;
890 | string[] edges{string};
891 | string[] nodes;
892 | int dist{string};
893 | string previous{string};
894 | int weight{string};
895 |
896 | string[]
897 | longest_path(string &parent)
898 | {
899 | FILE f;
900 | string range, buf, t, tag;
901 | string maxnode, v, w, edg;
902 | string inc = "";
903 | string revs[];
904 | int maxpath = 0;
905 | int want;
906 |
907 | f = popen("git show-ref --tags --dereference", "r");
908 | while (buf = ) {
909 | want = 1;
910 | buf =~ m|refs/tags/(.*)|;
911 | tag = $1;
912 | tag =~ s/{}$//;
913 | tag =~ s/\^$//;
914 | if (tagpats[0]) {
915 | want = 0;
916 | foreach (t in tagpats) {
917 | if (tag =~ /${t}/) {
918 | want = 1;
919 | break;
920 | }
921 | }
922 | }
923 | if (want) {
924 | revs = split(buf);
925 | tags{revs[0]} = tag;
926 | }
927 | }
928 | if (debug) warn("%d tags\n", length(tags));
929 | pclose(f);
930 | if (start) {
931 | range = "${start}..${branch}";
932 | } else {
933 | range = "${branch}";
934 | }
935 |
936 | /*
937 | * If BK is here already, we're doing incremental, go find the last
938 | * rev converted.
939 | * Stuff it in parent, the rename logic wants that.
940 | * XXX - --start is overridden by this.
941 | */
942 | if (exists(".bk")) {
943 | parent = `bk changes -r+ | grep GIT:`;
944 | if (debug) fprintf(stderr, "PREV: %s\n", parent);
945 | parent =~ s/\s*GIT: //;
946 | range = "${parent}..${branch}";
947 | inc = "--ancestry-path";
948 | }
949 | if (debug) fprintf(stderr, "RANGE: %s\n", range);
950 | f = popen("git rev-list --reverse "
951 | "--topo-order --parents ${inc} ${range} --", "r");
952 | while (buf = ) {
953 | revs = split(buf);
954 | push(&nodes, revs[0]);
955 | dist{revs[0]} = 0;
956 | if (tags{revs[0]}) {
957 | /*
958 | * Weight assigned to tags, basically how many
959 | * more revs there need to be in another path
960 | * before we are willing to sacrifice this
961 | * tagged path.
962 | */
963 | weight{revs[0]} = 100;
964 | } else {
965 | weight{revs[0]} = 1;
966 | }
967 | foreach (node in revs[1..END]) {
968 | push(&edges{node}, revs[0]);
969 | }
970 | }
971 | pclose(f);
972 |
973 | // longest path
974 | maxpath = 0;
975 | foreach (node in nodes) {
976 | v = node;
977 | foreach (edg in edges{node}) {
978 | w = edg;
979 | if (dist{w} <= dist{v} + weight{w}) {
980 | dist{w} = dist{v} + weight{w};
981 | previous{w} = v;
982 | }
983 | if (dist{w} > maxpath) {
984 | maxpath = dist{w};
985 | maxnode = w;
986 | }
987 | }
988 | }
989 |
990 | undef(revs);
991 | node = maxnode;
992 | while (node) {
993 | push(&revs, node);
994 | node = previous{node};
995 | }
996 | if (debug) warn("%d in longest path\n", length(revs));
997 | return (lreverse(revs));
998 | }
999 |
--------------------------------------------------------------------------------
/examples/photos.l:
--------------------------------------------------------------------------------
1 | #!/usr/bin/bk tclsh
2 | /*
3 | * A rewrite of Eric Pop's fine igal program in L. I talked to Eric and he
4 | * really doesn't want anything to do with supporting igal or copycats so
5 | * while credit here is cool, don't stick his name on the web pages.
6 | * I completely understand that, people still ask me about webroff and
7 | * lmbench.
8 | *
9 | * First version by Larry McVoy Sun Dec 19 2010.
10 | *
11 | * usage photos [options] [dir]
12 | *
13 | * TODO
14 | * - slideshow mode
15 | * - move the next/prev/index to the sides along w/ EXIF info
16 | */
17 | int bigy = 750; // --bigy=%d for medium images
18 | int dates = 0; // --date-split
19 | int exif = 0; // --exif under titles
20 | int exif_hover = 0; // --exif-hover, exif data in thumbnail hover
21 | int exif_thumbs = 0; // --exif-thumbnails, use the camera thumbnail
22 | int force = 0; // -f force regen of everything
23 | int names = 0; // put names below the image
24 | int nav = 0; // month/year nav
25 | int parallel = 1; // -j%d for multiple processes
26 | int sharpen = 0; // --sharpen to turn it on
27 | int thumbnails = 0; // force regen of those
28 | int quiet = 1; // turn off verbose
29 | string title = "McVoy photos"; // --title=whatever
30 | int ysize = 120; // -ysize=%d for thumbnails
31 | int rotate[]; // amount to rotate, -+90
32 | string indexf = "~/.photos/index.html";
33 | string slidef = "~/.photos/slide.html";
34 |
35 | int
36 | main(int ac, string av[])
37 | {
38 | string c;
39 | string lopts[] = {
40 | "bigy:",
41 | "date-split",
42 | "exif",
43 | "exif-thumbnails",
44 | "exif-hover",
45 | "force",
46 | "index:",
47 | "names",
48 | "nav",
49 | "parallel:",
50 | "quiet",
51 | "regen",
52 | "sharpen",
53 | "slide:",
54 | "thumbnails",
55 | "title:",
56 | "ysize:",
57 | };
58 |
59 | if (0) ac = 0; // lint
60 | parallel = cpus();
61 | dotfiles();
62 |
63 | while (c = getopt(av, "fj:", lopts)) {
64 | switch (c) {
65 | case "bigy": bigy = (int)optarg; break;
66 | case "date-split": dates = 1; break;
67 | case "exif": exif = 1; break;
68 | case "exif-hover": exif_hover = 1; break;
69 | case "exif-thumbnails": exif_thumbs = 1; break;
70 | case "f":
71 | case "force":
72 | case "regen":
73 | force = 1; break;
74 | case "index": indexf = optarg; break;
75 | case "j":
76 | case "parallel": parallel = (int)optarg; break;
77 | case "quiet": quiet = 1; break;
78 | case "names": names = 1; break;
79 | case "nav": nav = 1; break;
80 | case "sharpen": sharpen = 1; break;
81 | case "slide": slidef = optarg; break;
82 | case "title": title = optarg; break;
83 | case "thumbnails": thumbnails = 1; break;
84 | case "ysize": ysize = (int)optarg; break;
85 | default:
86 | printf("Usage: photos.l");
87 | foreach(c in lopts) {
88 | if (c =~ /(.*):/) {
89 | printf(" --%s=", $1);
90 | } else {
91 | printf(" --%s", c);
92 | }
93 | }
94 | printf("\n");
95 | return(0);
96 | }
97 | }
98 | unless (av[optind]) {
99 | dir(".");
100 | } else {
101 | while (av[optind]) dir(av[optind++]);
102 | }
103 | return (0);
104 | }
105 |
106 | void
107 | dir(string d)
108 | {
109 | string jpegs[];
110 | string tmp[];
111 | string buf;
112 | int i;
113 |
114 | if (chdir(d)) die("can't chdir to %s", d);
115 | tmp = getdir(".", "*.jpeg");
116 | unless (tmp[0]) tmp = getdir(".", "*.jpg");
117 | unless (tmp[0]) tmp = getdir(".", "*.png");
118 | unless (tmp[0]) tmp = getdir(".", "*.PNG");
119 | unless (tmp[0]) die("No jpegs found in %s", d);
120 | // XXX - should getdir do this?
121 | for (i = 0; defined(tmp[i]); i++) tmp[i] =~ s|^\./||;
122 |
123 | /* so we start at one not zero */
124 | jpegs[0] = '.';
125 | rotate[0] = 0;
126 | // XXX - I want push(&jpegs, list)
127 | foreach (buf in tmp) {
128 | push(&jpegs, buf);
129 | push(&rotate, rotation(buf));
130 | }
131 |
132 | slides(jpegs);
133 | thumbs(jpegs);
134 | html(jpegs);
135 | }
136 |
137 | /*
138 | * Create .thumb-$file if
139 | * - it does not exist
140 | * - .ysize is different than ysize
141 | * - $file is newer than thumbnail
142 | */
143 | void
144 | thumbs(string jpegs[])
145 | {
146 | string cmd[];
147 | string jpeg, file, slide;
148 | int i;
149 | int all = 0;
150 | int my_parallel = parallel, bg = 0;
151 | int pid, reaped;
152 | int pids{int};
153 |
154 | unless (exists(".ysize")) {
155 | save: Fprintf(".ysize", "%d\n", ysize);
156 | }
157 | if ((int)`cat .ysize` != ysize) {
158 | all = 1;
159 | goto save;
160 | }
161 | if (force || thumbnails) all = 1;
162 | if (exif_thumbs) my_parallel = 1;
163 | for (i = 1; defined(jpeg = jpegs[i]); i++) {
164 | file = sprintf(".thumb-%s", jpeg);
165 | slide = sprintf(".slide-%s", jpeg);
166 | if (!all && exists(file) && (mtime(file) > mtime(jpeg))) {
167 | continue;
168 | }
169 |
170 | if (exif_thumbs && do_exif(undef, jpeg)) {
171 | unlink(file);
172 | cmd = {
173 | "exif",
174 | "-e",
175 | "-o", file,
176 | jpeg
177 | };
178 | } else {
179 | cmd = {
180 | "convert",
181 | "-thumbnail",
182 | "x${ysize}",
183 | "-quality", "85",
184 | };
185 | if (sharpen) {
186 | push(&cmd, "-unsharp");
187 | //push(&cmd, "0x.5");
188 | push(&cmd, "2x0.5+0.7+0");
189 | }
190 | push(&cmd, exists(slide) ? slide : jpeg);
191 | push(&cmd, file);
192 | }
193 | while (bg >= parallel) {
194 | reaped = 0;
195 | foreach (pid in keys(pids)) {
196 | if (waitpid(pid, undef, 1) > 0) {
197 | reaped++;
198 | bg--;
199 | undef(pids{pid});
200 | break;
201 | }
202 | }
203 | if (reaped) break;
204 | sleep(0.100);
205 | }
206 | unless (quiet) {
207 | printf("Creating %s from %s\n",
208 | file, exists(slide) ? slide : jpeg);
209 | }
210 | pid = spawn(cmd);
211 | unless (defined(stdio_status.path)) {
212 | die("%s: command not found.\n", cmd[0]);
213 | }
214 | bg++;
215 | pids{pid} = 1;
216 | }
217 | foreach (pid in keys(pids)) waitpid(pid, undef, 0);
218 | }
219 |
220 | /*
221 | * Create .slide-$file if
222 | * - it does not exist
223 | * - .bigy is different than bigy
224 | * - $file is newer than slide
225 | * - $file is bigger than bigy
226 | */
227 | void
228 | slides(string jpegs[])
229 | {
230 | string cmd[];
231 | string jpeg, file;
232 | int all = 0;
233 | int i;
234 | int bg = 0;
235 | int pid, reaped;
236 | int pids{int};
237 |
238 | unless (exists(".bigy")) {
239 | save: Fprintf(".bigy", "%d\n", bigy);
240 | }
241 | if ((int)`cat .bigy` != bigy) {
242 | all = 1;
243 | goto save;
244 | }
245 | if (force) all = 1;
246 | for (i = 1; defined(jpeg = jpegs[i]); i++) {
247 | file = sprintf(".slide-%s", jpeg);
248 | if (!all && exists(file) && (mtime(file) > mtime(jpeg))) {
249 | continue;
250 | }
251 | if (small(jpeg)) {
252 | unlink(file);
253 | if (link(jpeg, file)) warn("link ${jpeg} ${file}");
254 | continue;
255 | }
256 | cmd = {
257 | "convert",
258 | "+profile", "*",
259 | "-scale", "x" . "${bigy}",
260 | "-quality", "85",
261 | };
262 | if (rotate[i]) {
263 | push(&cmd, "-rotate");
264 | push(&cmd, sprintf("%d", rotate[i]));
265 | }
266 | if (sharpen) {
267 | push(&cmd, "-unsharp");
268 | //push(&cmd, "0x.5");
269 | push(&cmd, "2x0.5+0.7+0");
270 | }
271 | push(&cmd, jpeg);
272 | push(&cmd, file);
273 | while (bg >= parallel) {
274 | reaped = 0;
275 | foreach (pid in keys(pids)) {
276 | if (waitpid(pid, undef, 1) > 0) {
277 | reaped++;
278 | bg--;
279 | undef(pids{pid});
280 | break;
281 | }
282 | }
283 | if (reaped) break;
284 | sleep(0.150);
285 | }
286 | unless (quiet) {
287 | printf("Creating %s from %s\n", file, jpeg);
288 | }
289 | printf("%s\n", join(" ", cmd));
290 | pid = spawn(cmd);
291 | unless (defined(stdio_status.path)) {
292 | die("%s: command not found.\n", cmd[0]);
293 | }
294 | bg++;
295 | pids{pid} = 1;
296 | }
297 | foreach (pid in keys(pids)) waitpid(pid, undef, 0);
298 | }
299 |
300 | int
301 | small(string file)
302 | {
303 | string buf;
304 |
305 | // Hack to avoid exif calls on small files
306 | if (size(file) < 100000) return (1);
307 | if (size(file) > 200000) return (0);
308 | unless (buf = `identify '${file}'`) return (0);
309 | if (buf =~ /JPEG (\d+)x(\d+)/) return ((int)$2 <= bigy);
310 | return (0);
311 | }
312 |
313 | string num2mon{int} = {
314 | 1 => "January",
315 | 2 => "February",
316 | 3 => "March",
317 | 4 => "April",
318 | 5 => "May",
319 | 6 => "June",
320 | 7 => "July",
321 | 8 => "August",
322 | 9 => "September",
323 | 10 => "October",
324 | 11 => "November",
325 | 12 => "December",
326 | };
327 |
328 | typedef struct {
329 | int day; // day 1..31
330 | int mon; // month 1..12
331 | int year; // year as YYYY
332 | string sdate; // YYYY-MM-DD
333 | } date;
334 |
335 | /*
336 | * Return the date either from the filename if it is one of date ones,
337 | * or from the exif data,
338 | * or fall back to mtime.
339 | */
340 | date
341 | f2date(string file)
342 | {
343 | date d;
344 | string buf;
345 | FILE f;
346 | int t;
347 |
348 | if (file =~ /^(\d\d\d\d)-(\d\d)-(\d\d)/) {
349 | match:
350 | buf = (string)$3; buf =~ s/^0//; d.day = (int)buf;
351 | buf = (string)$2; buf =~ s/^0//; d.mon = (int)buf;
352 | d.year = (int)$1;
353 | d.sdate = sprintf("%d-%02d-%02d", d.year, d.mon, d.day);
354 | return (d);
355 | }
356 |
357 | if (f = popen("exif -t DateTime '${file}' 2>/dev/null", "r")) {
358 | while (buf = ) {
359 | // Value: 2006:02:04 22:59:24
360 | if (buf =~ /Value: (\d\d\d\d):(\d\d):(\d\d)/) {
361 | pclose(f);
362 | goto match;
363 | }
364 | }
365 | pclose(f);
366 | // fall through to mtime
367 | }
368 |
369 | if (t = mtime(file)) {
370 | buf = Clock_format(t, format: "%Y:%m:%d");
371 | buf =~ /(\d\d\d\d):(\d\d):(\d\d)/;
372 | goto match;
373 | }
374 |
375 | return (undef);
376 | }
377 |
378 | /*
379 | * Create the html slide files and index.html
380 | * XXX - could stub this out if mtime(html) > mtime(.slide) etc.
381 | */
382 | void
383 | html(string jpegs[])
384 | {
385 | string template, file, stitle, ntitle, ptitle, buf;
386 | string cap = '';
387 | string date_nav = '';
388 | string dir, jpeg, escaped, thumbs = '';
389 | int i, next, prev;
390 | int first = 1;
391 | FILE f;
392 | string map[];
393 | string exdata;
394 | date d, d2;
395 |
396 | unless (f = fopen(slidef, "rv")) die("slide.html");
397 | read(f, &template, -1);
398 | fclose(f);
399 |
400 | for (i = 1; defined(jpeg = jpegs[i]); i++) {
401 | file = sprintf("%d.html", i);
402 | if (i > 1) {
403 | prev = i - 1;
404 | } else {
405 | prev = length(jpegs) - 1;
406 | }
407 | if (jpegs[i+1]) {
408 | next = i + 1;
409 | } else {
410 | next = 1;
411 | }
412 | undef(map);
413 | stitle = jpeg;
414 | stitle =~ s/\.jp.*//;
415 | ntitle = jpegs[next];
416 | ntitle =~ s/\.jp.*//;
417 | ptitle = jpegs[prev];
418 | ptitle =~ s/\.jp.*//;
419 | escaped = jpeg;
420 | escaped =~ s/:/%3A/g;
421 | dir = `pwd`;
422 | dir =~ s|.*/||;
423 | map = {
424 | "%FOLDER%",
425 | dir,
426 | "%TITLE%",
427 | stitle,
428 | "%NEXT_HTML%",
429 | sprintf("%d.html", next),
430 | "%NEXT_TITLE%",
431 | ntitle,
432 | "%PREV_HTML%",
433 | sprintf("%d.html", prev),
434 | "%PREV_TITLE%",
435 | ptitle,
436 | "%NEXT_SLIDE%",
437 | sprintf(".slide-%s", jpegs[next]),
438 | "%ORIG%",
439 | escaped,
440 | "%SLIDE%",
441 | sprintf(".slide-%s", escaped),
442 | };
443 | push(&map, "%CAPTION%");
444 | if (names || exif) cap = '';
445 | if (names) {
446 | cap .= stitle .
447 | ' ' .
448 | sprintf("(%d/%d)\n", i, length(jpegs) - 1);
449 | }
450 | undef(exdata);
451 | if (exif) {
452 | do_exif(&exdata, jpeg);
453 | if (names) cap .= " ";
454 | cap .= exdata;
455 | }
456 | if (names || exif) cap .= "
\n";
457 | push(&map, cap);
458 |
459 | push(&map, "%NAV%");
460 | date_nav = '';
461 | do_nav(&date_nav, jpeg, prev, next, 1);
462 | push(&map, date_nav);
463 |
464 | buf = String_map(map, template);
465 | Fprintf(file, "%s\n", buf);
466 |
467 | if (dates &&
468 | defined(d2 = f2date(jpeg)) &&
469 | (first || (d.sdate != d2.sdate))) {
470 | d = d2;
471 | unless (first) thumbs .= "\n";
472 | buf = num2mon{d.mon};
473 | thumbs .= "";
474 | cap = "${buf} ${d.day} ${d.year}";
475 | thumbs .= cap . " ";
476 | cap = ".cap-${buf}-${d.day}-${d.year}";
477 | // .cap-January-09-2011, if exists, is appended
478 | if (exists(cap) && (cap = `cat ${cap}`)) {
479 | thumbs .= ': ' . cap;
480 | }
481 | thumbs .= " \n
\n";
482 | }
483 |
484 | if (exif && exif_hover) stitle .= " " . exdata;
485 | thumbs .= sprintf(
486 | '
' .
487 | ' ' .
488 | ' ' . "\n",
489 | file, escaped, stitle, stitle);
490 | first = 0;
491 | }
492 |
493 | /* do index.html */
494 | unless (f = fopen(indexf, "rv")) die("index.html");
495 | read(f, &template, -1);
496 | fclose(f);
497 | undef(map);
498 | push(&map, "%TITLE%");
499 | push(&map, title);
500 | push(&map, "%THUMBS%");
501 | thumbs .= "
\n";
502 | push(&map, thumbs);
503 | date_nav = '';
504 | push(&map, "%NAV%");
505 | do_nav(&date_nav, jpegs[1], undef, undef, 0);
506 | push(&map, date_nav);
507 | buf = String_map(map, template);
508 | if (exists(".index-include")) {
509 | buf .= `cat .index-include`;
510 | }
511 | Fprintf("index.html", "%s", buf);
512 | unless (f = fopen("~/.photos/photos.css", "rv")) die("photos.css");
513 | read(f, &buf, -1);
514 | fclose(f);
515 | Fprintf("photos.css", "%s", buf);
516 | }
517 |
518 | /*
519 | * XXX - what this needs is a hash and then at the end I push the info
520 | * I want in the order I want.
521 | */
522 | int
523 | do_exif(string &cap, string jpeg)
524 | {
525 | FILE f = popen("exiftags -a '${jpeg}'", "rv");
526 | string save, buf, maker = '';
527 | string v[];
528 | string iso = undef;
529 | int thumb = 0;
530 | int i;
531 | string tags{string};
532 |
533 | while (buf = ) {
534 | switch (trim(buf)) {
535 | case /^Equipment Make: (.*)/:
536 | maker = $1;
537 | if (maker == "OLYMPUS IMAGING CORP.") {
538 | maker = "Olympus";
539 | }
540 | if (maker == "NIKON CORPORATION") {
541 | maker = "Nikon";
542 | }
543 | break;
544 | case /^Camera Model: (.*)/:
545 | save = $1;
546 | if (save =~ /${maker}/i) {
547 | tags{"camera"} = save;
548 | } else {
549 | tags{"camera"} = "${maker} ${save}";
550 | }
551 | if (save == "TG-1") tags{"lens"} = "25-100mm f2.0";
552 | if (save =~ /Canon PowerShot S95/) {
553 | tags{"lens"} = "28-105 mm";
554 | }
555 | if (save =~ /Canon PowerShot S100/) {
556 | tags{"lens"} = "24-120mm";
557 | }
558 | break;
559 | case /Lens Name: (.*)/:
560 | if ($1 =~ /EF\d/) $1 =~ s/EF/EF /;
561 | if ($1 =~ /EF-S\d/) $1 =~ s/EF-S/EF-S /;
562 | if ($1 =~ / USM/) $1 =~ s/ USM//;
563 | if ($1 == "30mm") $1 = "Sigma 30mm f/1.4";
564 | if ($1 == "90mm") $1 = "Tamron 90mm macro";
565 | if ($1 == "18-200mm") $1 = "Tamron 18-200mm";
566 | if ($1 == "18-250mm") $1 = "Tamron 18-250mm";
567 | if ($1 == "18-270mm") $1 = "Tamron 18-270mm";
568 | if ($1 == "170-500mm") $1 = "Sigma 170-500mm";
569 | $1 =~ s|f/|f|;
570 | tags{"lens"} = $1;
571 | break;
572 | case /Lens Size: 10.00 - 22.00 mm/:
573 | tags{"lens"} = "EF-S 10-22mm f/3.5-4.5";
574 | break;
575 | case /Exposure Bias: (.*)/:
576 | if ($1 != "0 EV") {
577 | unless ($1 =~ /^-/) $1 = "+" . $1;
578 | tags{"bias"} = $1;
579 | }
580 | break;
581 | case /^Exposure Time: (.*)/:
582 | save = $1;
583 | $1 =~ /(\d+)\/(\d+) sec/;
584 | if ((int)$1 > 1) {
585 | i = (int)$2/(int)$1;
586 | save = "1/${i}";
587 | }
588 | tags{"time"} = save;
589 | break;
590 | case /Lens Aperture: (.*)/:
591 | case /F-Number: (.*)/:
592 | $1 =~ s|/||;
593 | tags{"fstop"} = $1;
594 | break;
595 | case /ISO Speed Rating: (.*)/:
596 | iso = undef;
597 | if ($1 == "Auto") {
598 | iso = "ISO ${$1}";
599 | } else if ($1 == "Unknown") {
600 | ;
601 | } else unless ((int)$1 == 0) {
602 | iso = "ISO ${$1}";
603 | }
604 | if (defined(iso)) tags{"iso"} = iso;
605 | break;
606 | case /Focal Length .35mm Equiv.: (.*)/:
607 | case /Focal Length: (.*)/:
608 | save = $1;
609 | if (tags{"camera"} =~ /Canon PowerShot S95/) {
610 | save =~ s/ mm//;
611 | save = (string)(int)((float)save * 4.7);
612 | save .= " mm";
613 | }
614 | if (tags{"camera"} =~ /Canon PowerShot S100/) {
615 | save =~ s/ mm//;
616 | save = (string)(int)((float)save * 4.61538);
617 | save .= " mm";
618 | }
619 | unless (defined(tags{"focal"})) {
620 | tags{"focal"} = save;
621 | }
622 | break;
623 | case /Metering Mode: (.*)/:
624 | unless (defined(tags{"metering"})) {
625 | tags{"metering"} = "${$1} metering";
626 | }
627 | break;
628 | case /White Balance: (.*)/:
629 | unless ($1 =~ /white balance/) $1 .= " white balance";
630 | $1 =~ s/white balance/WB/;
631 | unless (defined(tags{"balance"})) {
632 | tags{"balance"} = $1;
633 | }
634 | break;
635 | case /Compression Scheme: JPEG Compression .Thumbnail./:
636 | thumb = 1;
637 | break;
638 | }
639 | }
640 | fclose(f);
641 | cap = "";
642 | if (defined(tags{"camera"})) push(&v, tags{"camera"});
643 | if (defined(tags{"lens"})) {
644 | if (defined(tags{"focal"}) &&
645 | (tags{"lens"} =~ /[0-9]-[0-9]/)) {
646 | tags{"lens"} .= " @ " . tags{"focal"};
647 | }
648 | push(&v, tags{"lens"});
649 | }
650 | if (defined(tags{"fstop"})) push(&v, tags{"fstop"});
651 | if (defined(tags{"time"})) push(&v, tags{"time"});
652 | if (defined(tags{"bias"})) push(&v, tags{"bias"});
653 | if (defined(tags{"iso"})) push(&v, tags{"iso"});
654 | if (defined(tags{"metering"})) push(&v, tags{"metering"});
655 | if (defined(tags{"balance"})) push(&v, tags{"balance"});
656 | if (defined(v)) cap = join(", ", v);
657 | return (thumb);
658 | }
659 |
660 | int
661 | rotation(string file)
662 | {
663 | string r = `exif -m -t Orientation '${file}'`;
664 |
665 | switch (r) {
666 | case /right.*top/i:
667 | return (90);
668 | case /left.*bottom/i:
669 | return (-90);
670 | default:
671 | return (0);
672 | }
673 | }
674 |
675 | /*
676 | * This is called for both index nav and slide nav.
677 | * For index nav, unless nav is set, do nothing.
678 | * For slide nav, always do at least
679 | * prev | index | next
680 | * and optionally
681 | * prev | next | prev month | index | next month | prev year | next year
682 | */
683 | void
684 | do_nav(string &date_nav, string jpeg, int prev, int next, int slide)
685 | {
686 | int i, mon, did_it;
687 | string buf, month;
688 | date d;
689 |
690 | date_nav = '';
691 | if (!nav && !slide) return;
692 |
693 | unless (defined(d = f2date(jpeg))) return;
694 | month = num2mon{d.mon}[0..2];
695 |
696 | if (slide) {
697 | /* <<< prev | January | next >>> */
698 | date_nav .= '<< prev pic ';
700 | date_nav .= "\n";
701 | unless (nav) {
702 | date_nav .= 'Index ';
703 | date_nav .= "\n";
704 | }
705 | date_nav .= 'next pic >> ';
707 | date_nav .= "\n";
708 |
709 | unless (nav) return;
710 | }
711 |
712 | /* <<< prev | next >>> | <<< January >>> | <<< 2003 >>> */
713 | date_nav .= "\n";
714 | date_nav .= ' ';
715 | date_nav .= "\n";
716 |
717 | /* do the <<< for the prev month */
718 | for (i = 0; i < 12; i++) {
719 | mon = d.mon - i;
720 | if (mon == 1) {
721 | buf = sprintf("../../%d/%02d/index.html", d.year-1, 12);
722 | } else {
723 | buf = sprintf("../../%d/%02d/index.html", d.year,mon-1);
724 | }
725 | if (exists(buf)) break;
726 | }
727 | if (exists(buf)) date_nav .= '<<< ';
728 | date_nav .= "\n";
729 |
730 | /* do the link to index.html for this month */
731 | if (slide) {
732 | date_nav .= ' ' .
733 | month . " index" . ' ';
734 | } else {
735 | date_nav .= " ${month} ";
736 | }
737 | date_nav .= "\n";
738 |
739 | /* do the >>> for next month */
740 | for (i = 0; i < 12; i++) {
741 | mon = d.mon + i;
742 | if (mon == 12) {
743 | buf = sprintf("../../%d/%02d/index.html", d.year+1, 1);
744 | } else {
745 | buf = sprintf("../../%d/%02d/index.html", d.year,mon+1);
746 | }
747 | if (exists(buf)) break;
748 | }
749 | if (exists(buf)) {
750 | date_nav .= '>>> ';
751 | }
752 |
753 | date_nav .= "\n";
754 | date_nav .= ' ';
755 | date_nav .= "\n";
756 |
757 | did_it = 0;
758 | buf = sprintf("../../%d/%02d/index.html", d.year - 1, d.mon);
759 | unless (exists(buf)) for (i = 1; i < 12; i++) {
760 | buf = sprintf("../../%d/%02d/index.html", d.year - 1, d.mon+i);
761 | if (exists(buf)) break;
762 | buf = sprintf("../../%d/%02d/index.html", d.year - 1, d.mon-i);
763 | if (exists(buf)) break;
764 | }
765 | if (exists(buf)) {
766 | date_nav .= '<<< ' . "${d.year}";
768 | date_nav .= "\n";
769 | did_it++;
770 | }
771 | buf = sprintf("../../%d/%02d/index.html", d.year + 1, d.mon);
772 | unless (exists(buf)) for (i = 1; i < 12; i++) {
773 | buf = sprintf("../../%d/%02d/index.html", d.year + 1, d.mon+i);
774 | if (exists(buf)) break;
775 | buf = sprintf("../../%d/%02d/index.html", d.year + 1, d.mon-i);
776 | if (exists(buf)) break;
777 | }
778 | if (exists(buf)) {
779 | unless (did_it) date_nav .= "${d.year}";
780 | date_nav .= ' >>> ';
781 | date_nav .= "\n";
782 | }
783 | }
784 |
785 | void
786 | dotfiles(void)
787 | {
788 | string file, buf;
789 |
790 | unless (isdir("~/.photos")) mkdir("~/.photos");
791 | file = "~/.photos/slide.html";
792 | unless (exists(file)) {
793 | buf = <<'END'
794 |
795 |
796 |
797 |
798 | %TITLE%
799 |
800 |
801 |
802 |
803 |
810 |
811 |
812 |
813 |
814 | %NAV%
815 |
816 |
817 |
818 |
819 |
820 |
821 |
824 |
825 |
826 |
827 |
828 | %CAPTION%
829 |
830 |
831 |
832 | END;
833 | Fprintf(file, "%s", buf);
834 | }
835 | file = "~/.photos/index.html";
836 | unless (exists(file)) {
837 | buf = <<'END'
838 |
839 |
840 |
841 |
842 |
843 | %TITLE%
844 |
845 |
846 |
847 |
848 | %TITLE%
849 |
850 |
851 |
852 |
853 | %NAV%
854 |
855 | %THUMBS%
856 |
857 | %NAV%
858 |
859 | For each picture there are 3 sizes:
860 | (1) the index thumbnails you are looking at,
861 | (2) a mid sized picture that you get to by clicking the thumbnail,
862 | (3) the original that you get to by clicking the midsize.
863 | Legal crud: everything is copyrighted by whoever took the picture.
864 | In the unlikely event you want to use a picture, please ask just to make
865 | us feel good.
866 |
867 |
868 |
869 | END;
870 | Fprintf(file, "%s", buf);
871 | }
872 | file = "~/.photos/photos.css";
873 | unless (exists(file)) {
874 | buf = <<'END'
875 | .center {
876 | text-align: center;
877 | }
878 |
879 | .center table {
880 | margin-left: auto;
881 | margin-right: auto;
882 | text-align: center;
883 | }
884 |
885 | body {
886 | font-family: verdana, sans-serif;
887 | background: #000000;
888 | color: #DDDDDD;
889 | }
890 |
891 | a:link {
892 | color: #95DDFF;
893 | background: transparent;
894 | }
895 |
896 | a:visited {
897 | color: #AAAAAA;
898 | background: transparent;
899 | }
900 |
901 | a:hover {
902 | color: #BBDDFF;
903 | background: #555555;
904 | }
905 |
906 | .small {
907 | font-size: 50%;
908 | }
909 |
910 | .large {
911 | font-size: 200%;
912 | }
913 |
914 | .tiled {
915 | background-image: url(".tile.png");
916 | background-repeat: repeat-x;
917 | background-color: #000000;
918 | padding: 0;
919 | }
920 |
921 | .thumb {
922 | background-color: #000000;
923 | text-align: center;
924 | vertical-align: middle;
925 | }
926 |
927 | .slide {
928 | background-color: #ffffff;
929 | text-align: center;
930 | vertical-align: middle;
931 | }
932 | END;
933 | Fprintf(file, "%s", buf);
934 | }
935 | }
936 |
--------------------------------------------------------------------------------
/examples/pod2html.l:
--------------------------------------------------------------------------------
1 | #!../../unix/tclsh
2 |
3 | int
4 | main(string av[])
5 | {
6 | FILE f;
7 | int i, ul;
8 | int space = 0, dd = 0, p = 0, pre = 0;
9 | string buf, c, tmp, title, trim, all[];
10 |
11 | /*
12 | * -t or --title=
13 | */
14 | while (c = getopt(av, "t:", {"title:"})) {
15 | switch (c) {
16 | case "t":
17 | case "title":
18 | title = optarg;
19 | break;
20 | }
21 | }
22 | unless (av[optind] && (f = fopen(av[optind], "r"))) {
23 | die("usage: ${av[0]} filename");
24 | }
25 | unless (title) title = av[optind];
26 |
27 | header(title);
28 |
29 | /*
30 | * Load up the whole file in all[] and spit out the index.
31 | */
32 | puts("");
33 | ul = 1;
34 | while (buf = ) {
35 | push(&all, buf);
36 | if (buf =~ /^=head(\d+)\s+(.*)/) {
37 | i = (int)$1;
38 | while (ul > i) {
39 | puts(" ");
40 | ul--;
41 | }
42 | while (i > ul) {
43 | puts("");
44 | ul++;
45 | }
46 | tmp = $2;
47 | tmp =~ s/\s+/_/g;
48 | buf =~ s/^=head(\d+)\s+//;
49 | puts("${buf} ");
50 | }
51 | }
52 | while (ul--) puts(" ");
53 | fclose(f);
54 |
55 | /*
56 | * Now walk all[] and process the markup. We currently handle:
57 | * =head%d title
58 | * =over
59 | * =item name
60 | * =proto return_type func(args)
61 | * =back
62 | *
63 | * B
64 | * C
65 | * I
66 | */
67 | // The <= is intentional to run an empty string through at the end
68 | // to kick out any final etc.
69 | for (i = 0; i <= length(all); i++) {
70 | buf = inline(all[i]);
71 | if (buf =~ /^=head(\d+)\s+(.*)/) {
72 | if ((int)$1 == 1) puts(" ");
73 | tmp = $2;
74 | tmp =~ s/\s+/_/g;
75 | printf("%s \n",
76 | $1, tmp, $2, $1);
77 | } else if (buf =~ /^=over/) {
78 | puts("");
79 | } else if (buf =~ /^=item\s+(.*)/) {
80 | if (dd) {
81 | puts("");
82 | dd--;
83 | }
84 | puts("${$1} ");
85 | dd++;
86 | } else if (buf =~ /^=proto\s+([^ \t]+)\s+(.*)/) {
87 | if (dd) {
88 | puts(" ");
89 | dd--;
90 | }
91 | puts("${$1} ${$2} ");
92 | dd++;
93 | } else if (buf =~ /^=back/) {
94 | if (dd) {
95 | puts(" ");
96 | dd--;
97 | }
98 | puts(" ");
99 | } else if (buf =~ /^\s*$/) {
100 | if (p) {
101 | puts("
");
102 | p = 0;
103 | }
104 | if (pre) {
105 | /*
106 | * If we see a blank line in a preformatted
107 | * block, we don't want to stop the pre
108 | * unless the next line is not indented.
109 | * So peek ahead.
110 | */
111 | if (defined(buf = all[i+1]) && (buf =~ /^\s/)) {
112 | puts("");
113 | continue;
114 | }
115 | puts("");
116 | pre = 0;
117 | trim = undef;
118 | }
119 | space = 1;
120 | } else {
121 | if (space) {
122 | if (buf =~ /^(\s+)[^ \t]+/) {
123 | trim = $1;
124 | puts("");
125 | pre = 1;
126 | } else {
127 | puts("");
128 | p = 1;
129 | }
130 | space = 0;
131 | }
132 | if (defined(trim)) buf =~ s/^${trim}//;
133 | puts(buf);
134 | }
135 | }
136 | puts("