"Fossies" - the Fresh Open Source Software Archive 
Member "namefix.pl/libs/gui/bookmarks.pm" (13 Dec 2008, 7633 Bytes) of package /linux/privat/old/namefix.pl_4.0.2.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "bookmarks.pm" see the
Fossies "Dox" file reference documentation.
1 # bookmark functions
2
3 use strict;
4 use warnings;
5
6 # bm_add -> bm_redraw_menu -> bm_list_bookmarks
7
8 #--------------------------------------------------------------------------------------------------------------
9 # Regarding the bookmark hack:
10 #
11 # before any1 says anything !, I couldnt see any other way to quickly make a bookmarks menu,
12 # without printing to file then executing, $u is always the last url in the bookmarks file.
13 #
14 # -command=> function floats around until called rather being declared as it literally is
15 # this is the normal behaviour, but when I try to spool off several menu commands from a loop
16 # problems are encountered - cant use variables that are redeclared, Ive tried hashes and breifly constants
17 # ended up with grief
18 #
19 # I know there is a proper way todo this, but for the life of me I dont know - and Ive googled all the topics I
20 # can think of, will post to a forum for help after 3.5 (tried with no luck).
21 #
22 # Feel free tu suggest a better way, hack is nicely documented :)
23
24 #--------------------------------------------------------------------------------------------------------------
25 # Bookmark add
26 #--------------------------------------------------------------------------------------------------------------
27
28 sub bm_add
29 {
30 my $name = shift;
31 my $dir = shift;
32
33 print "\$name = $name\n";
34
35 if($name !~ /\:(\\|\/)$/)
36 {
37 $name =~ s/(.*)(\\|\/)(.*?$)/$3/; # set name to directory
38 }
39 &file_append($main::bookmark_file, "$name\t\t$dir\n");
40
41 &bm_redraw_menu;
42 }
43
44 #--------------------------------------------------------------------------------------------------------------
45 # bookmark redraw menu
46 #--------------------------------------------------------------------------------------------------------------
47
48 sub bm_redraw_menu
49 {
50 my $n = "";
51 my $u = "";
52 my $count = 0;
53
54 # delete bookmarks menu (also have to delete help as it comes after bookmarks else menu ordering gets screwed up).
55
56 if($main::bookmarks)
57 {
58 my $index = $main::mbar->index("Bookmarks");
59 $main::mbar->delete($index);
60 }
61 if($main::help)
62 {
63 my $index = $main::mbar->index("Help");
64 $main::mbar->delete($index);
65 }
66
67 # create empty bookmarks menu
68
69 $main::bookmarks = $main::mbar -> cascade
70 (
71 -label=>"Bookmarks",
72 -underline=>0,
73 -tearoff=>0,
74 );
75
76 # menu command - bookmark cur dir
77 $main::bookmarks -> command
78 (
79 -label=>"Bookmark current Directory",
80 -command=> sub
81 {
82 &bm_add($main::dir, $main::dir);
83 }
84 );
85
86 # menu command - edit bookmarks
87 $main::bookmarks -> command
88 (
89 -label=>"Edit Bookmarks",
90 -command=> sub
91 {
92 &edit_bookmark_list;
93 }
94 );
95
96 #create help menu
97 # NOTE: this is here, to stop the bookmarks menu switch places upon updating.
98
99 $main::help = $main::mbar -> cascade
100 (
101 -label =>"Help",
102 -underline=>0,
103 -tearoff => 0
104 );
105 $main::help -> command
106 (
107 -label=>'Help',
108 -command=>\&show_help
109 );
110
111 $main::help -> separator();
112
113 $main::help -> command
114 (
115 -label=>'About',
116 -command=>\&show_about
117 );
118
119 $main::help -> command
120 (
121 -label=>"Changelog",
122 -command=>\&show_changelog
123 );
124
125 $main::help -> command
126 (
127 -label=>"Todo List",
128 -command=>\&show_todo
129 );
130
131 $main::help -> command
132 (
133 -label=>'Credits/ Thanks',
134 -command=>\&show_thanks
135 );
136
137 $main::help -> separator();
138
139 $main::help -> command
140 (
141 -label=>"Links",
142 -command=>\&show_links
143 );
144
145 &bm_list_bookmarks;
146 }
147
148 #--------------------------------------------------------------------------------------------------------------
149 # bookmark list bookmarks
150 #--------------------------------------------------------------------------------------------------------------
151 # This is the hack mentioned above
152
153 # Explanation:
154 # this code reads from namefix.pl's simple bookmark list,
155 # generates some perl/tk code to draw the menu
156 # writes said code to bm.pl
157 # executes bm.pl
158
159 sub bm_list_bookmarks
160 {
161 &plog(3, "sub bm_list_bookmarks:");
162
163 my $n = "";
164 my $u = "";
165 # add bookmarks, this is where code gets ugly
166
167 $main::bookmarks -> separator();
168
169
170 &plog(4, "sub bm_list_bookmarks: generating bookmark code");
171 if(!-f $main::bookmark_file)
172 {
173 # no bookmarks, return
174 &plog(0, "bookmarks.pm cant find file $main::bookmark_file");
175 return;
176 }
177
178 my @tmp_arr = &readf($main::bookmark_file);
179
180 open(FILE, ">$main::bm_pl") or die "couldnt open $main::bm_pl $!\n";
181
182 print FILE "\# add bookmarks to menu\n# Dont edit me.\n\n";
183
184 for(@tmp_arr)
185 {
186 if(/^\n/) { next; }
187 ($n, $u) = split(/\t+/);
188 chomp $n;
189 chomp $u;
190
191 # if win32 and dir = network path swap \ with /
192 # (makes it easier for namefix.pl to work with and perl doesnt mind)
193 if($^O eq "MSWin32" && $u =~ /^\\/)
194 {
195 $u =~ s/\\/\//g;
196 }
197
198 print FILE
199 "
200 \$bookmarks -> command
201 (
202 -label=>\"$n\",
203 -command=> sub
204 {
205 \$main::dir = q\{$u\};
206 &ls_dir;
207 }
208 );
209 "
210 ;
211 }
212 close(FILE);
213
214 &plog(3, "sub bm_list_bookmarks: executing generated bookmark code");
215 do "$main::bm_pl" or die "ERROR: dir.pm, cant do $main::bm_pl: $! $@\n";
216
217 return 1;
218 }
219
220
221 #--------------------------------------------------------------------------------------------------------------
222 # Edit Bookmarks.
223 #--------------------------------------------------------------------------------------------------------------
224
225 sub edit_bookmark_list
226 {
227 &plog(3, "sub edit_bookmark_list:");
228 my $dtext = "";
229
230 if(-f $main::bookmark_file)
231 {
232 $dtext = &readjf("$main::bookmark_file");
233 }
234 else
235 {
236 $dtext = "";
237 }
238
239 my $top = $main::mw -> Toplevel();
240 $top -> title("Edit Bookmark List");
241
242 $top->Label
243 (
244 -text=>"Format: <Bookmark Name><TAB><TAB><url>"
245 )
246 ->grid(-row => 1, -column => 1, -columnspan => 2);
247
248 my $txt = $top -> Scrolled
249 (
250 'Text',
251 -scrollbars=>"osoe",
252 -font=>$main::dialog_font,
253 -wrap=>'none',
254 -width=>80,
255 -height=>15
256 )
257 -> grid
258 (
259 -row=>2,
260 -column=>1,
261 -columnspan=>2
262 );
263 $txt->menu(undef);
264
265 $txt->insert('end', "$dtext");
266
267 $top -> Button
268 (
269 -text=>"Save",
270 -activebackground => 'white',
271 -command => sub
272 {
273 &save_file
274 (
275 "$main::bookmark_file",
276 $txt -> get
277 (
278 '0.0',
279 'end'
280 )
281 );
282 &bm_redraw_menu;
283 }
284 )
285 -> grid(
286 -row=>4,
287 -column=>1,
288 -sticky=>"ne"
289 );
290
291 my $but_close = $top -> Button
292 (
293 -text=>"Close",
294 -activebackground=>'white',
295 -command => sub
296 {
297 destroy $top;
298 }
299 )
300 -> grid
301 (
302 -row=>4,
303 -column=>2,
304 -sticky=>"nw"
305 );
306
307 $top->resizable(0,0);
308 }
309
310
311 1;