summary refs log blame commit diff stats
path: root/src/fe-gtk/gtkutil.c
blob: 7b4f8b06b52ba6db9843da90a358a5be59cd4090 (plain) (tree)
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924























                                                                            
                  
 


























                                      
 


                             

                   
      











                                                            






                                           




































































































                                                                                            























































































































































































                                                                                                     







                                                                                  



















































                                                                                              













                                                                                                                                      
 

                                                                                                         


































































































































































































































































































































































































































































































                                                                                                                                        
/* X-Chat
 * Copyright (C) 1998 Peter Zelezny.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 */
#define _FILE_OFFSET_BITS 64 /* allow selection of large files */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>

#include "fe-gtk.h"

#include <gtk/gtkbutton.h>
#include <gtk/gtkclist.h>
#include <gtk/gtkscrolledwindow.h>
#include <gtk/gtkmessagedialog.h>
#include <gtk/gtkwindow.h>
#include <gtk/gtkhbox.h>
#include <gtk/gtkimage.h>
#include <gtk/gtktooltips.h>
#include <gtk/gtklabel.h>
#include <gtk/gtkentry.h>
#include <gtk/gtkstock.h>
#include <gtk/gtkspinbutton.h>
#include <gtk/gtkclipboard.h>
#include <gtk/gtktreeview.h>
#include <gtk/gtktreeselection.h>
#include <gtk/gtkcellrenderertext.h>
#include <gtk/gtkcellrenderertoggle.h>
#include <gtk/gtkversion.h>
#include <gtk/gtkfilechooserdialog.h>

#include "../common/xchat.h"
#include "../common/fe.h"
#include "../common/util.h"
#include "gtkutil.h"
#include "pixmaps.h"

#ifdef WIN32
#include "../common/fe.h"
#include "../common/thread.h"
#else
#include <unistd.h>
#endif

/* gtkutil.c, just some gtk wrappers */

extern void path_part (char *file, char *path, int pathlen);


struct file_req
{
	GtkWidget *dialog;
	void *userdata;
	filereqcallback callback;
	int flags;		/* FRF_* flags */

#ifdef WIN32
	int multiple;
	thread *th;
	char *title;	/* native locale */
	char *filter;
#endif
};

static char last_dir[256] = "";


static void
gtkutil_file_req_destroy (GtkWidget * wid, struct file_req *freq)
{
	freq->callback (freq->userdata, NULL);
	free (freq);
}

static void
gtkutil_check_file (char *file, struct file_req *freq)
{
	struct stat st;
	int axs = FALSE;

	path_part (file, last_dir, sizeof (last_dir));

	/* check if the file is readable or writable */
	if (freq->flags & FRF_WRITE)
	{
		if (access (last_dir, W_OK) == 0)
			axs = TRUE;
	} else
	{
		if (stat (file, &st) != -1)
		{
			if (!S_ISDIR (st.st_mode) || (freq->flags & FRF_CHOOSEFOLDER))
				axs = TRUE;
		}
	}

	if (axs)
	{
		char *utf8_file;
		/* convert to UTF8. It might be converted back to locale by
			server.c's g_convert */
		utf8_file = xchat_filename_to_utf8 (file, -1, NULL, NULL, NULL);
		if (utf8_file)
		{
			freq->callback (freq->userdata, utf8_file);
			g_free (utf8_file);
		} else
		{
			fe_message ("Filename encoding is corrupt.", FE_MSG_ERROR);
		}
	} else
	{
		if (freq->flags & FRF_WRITE)
			fe_message (_("Cannot write to that file."), FE_MSG_ERROR);
		else
			fe_message (_("Cannot read that file."), FE_MSG_ERROR);
	}
}

static void
gtkutil_file_req_done (GtkWidget * wid, struct file_req *freq)
{
	GSList *files, *cur;
	GtkFileChooser *fs = GTK_FILE_CHOOSER (freq->dialog);

	if (freq->flags & FRF_MULTIPLE)
	{
		files = cur = gtk_file_chooser_get_filenames (fs);
		while (cur)
		{
			gtkutil_check_file (cur->data, freq);
			g_free (cur->data);
			cur = cur->next;
		}
		if (files)
			g_slist_free (files);
	} else
	{
		if (freq->flags & FRF_CHOOSEFOLDER)
			gtkutil_check_file (gtk_file_chooser_get_current_folder (fs), freq);
		else
			gtkutil_check_file (gtk_file_chooser_get_filename (fs), freq);
	}

	/* this should call the "destroy" cb, where we free(freq) */
	gtk_widget_destroy (freq->dialog);
}

static void
gtkutil_file_req_response (GtkWidget *dialog, gint res, struct file_req *freq)
{
	switch (res)
	{
	case GTK_RESPONSE_ACCEPT:
		gtkutil_file_req_done (dialog, freq);
		break;

	case GTK_RESPONSE_CANCEL:
		/* this should call the "destroy" cb, where we free(freq) */
		gtk_widget_destroy (freq->dialog);
	}
}

#ifdef WIN32
static int
win32_openfile (char *file_buf, int file_buf_len, char *title_text, char *filter,
			   int multiple)
{
	OPENFILENAME o;

	memset (&o, 0, sizeof (o));

	o.lStructSize = sizeof (o);
	o.lpstrFilter = filter;
	o.lpstrFile = file_buf;
	o.nMaxFile = file_buf_len;
	o.lpstrTitle = title_text;
	o.Flags = 0x02000000 | OFN_FILEMUSTEXIST | OFN_HIDEREADONLY |
				OFN_NOCHANGEDIR | OFN_EXPLORER | OFN_LONGNAMES | OFN_NONETWORKBUTTON;
	if (multiple)
	{
		o.Flags |= OFN_ALLOWMULTISELECT;
	}

	return GetOpenFileName (&o);
}

static int
win32_savefile (char *file_buf, int file_buf_len, char *title_text, char *filter,
               int multiple)
{
	/* we need the filter to get the default filename. it is from fe-gtk.c (fe_confirm);
	 * but that filter is actually the whole filename, so apply an empty filter and all good.
	 * in win32_thread2 we copy the filter ( = the filename) after the last dir into our
	 * LPTSTR file buffer to make it actually work. the docs for this amazingly retard api:
	 *
	 * http://msdn.microsoft.com/en-us/library/ms646839%28VS.85%29.aspx
	 */

	OPENFILENAME o;

	memset (&o, 0, sizeof (o));

	o.lStructSize = sizeof (o);
	o.lpstrFilter = "All files\0*.*\0\0";
	o.lpstrFile = file_buf;
	o.nMaxFile = file_buf_len;
	o.lpstrTitle = title_text;
	o.Flags = 0x02000000 | OFN_FILEMUSTEXIST | OFN_HIDEREADONLY |
				OFN_NOCHANGEDIR | OFN_EXPLORER | OFN_LONGNAMES | OFN_NONETWORKBUTTON;
	if (multiple)
	{
		o.Flags |= OFN_ALLOWMULTISELECT;
	}

	return GetSaveFileName (&o);
}

static void *
win32_thread (struct file_req *freq)
{
	char buf[1024 + 32];
	char file[1024];

	memset (file, 0, sizeof (file));
	safe_strcpy (file, last_dir, sizeof (file));

	if (win32_openfile (file, sizeof (file), freq->title, freq->filter, freq->multiple))
	{
		if (freq->multiple)
		{
			char *f = file;

			if (f[strlen (f) + 1] == 0)	/* only selected one file */
			{
				snprintf (buf, sizeof (buf), "1\n%s\n", file);
				write (freq->th->pipe_fd[1], buf, strlen (buf));
			} else
			{
				f += strlen (f) + 1; /* skip first, it's only the dir */
				while (f[0])
				{
					snprintf (buf, sizeof (buf), "1\n%s\\%s\n", /*dir!*/file, f);
					write (freq->th->pipe_fd[1], buf, strlen (buf));
					f += strlen (f) + 1;
				}
			}

		} else
		{
			snprintf (buf, sizeof (buf), "1\n%s\n", file);
			write (freq->th->pipe_fd[1], buf, strlen (buf));
		}
	}

	write (freq->th->pipe_fd[1], "0\n", 2);
	Sleep (2000);

	return NULL;
}

static void *
win32_thread2 (struct file_req *freq)
{
	char buf[1024 + 32];
	char file[1024];

	memset (file, 0, sizeof (file));
	safe_strcpy (file, last_dir, sizeof (file));
	safe_strcpy (file, freq->filter, sizeof (file));

	if (win32_savefile (file, sizeof (file), freq->title, NULL, freq->multiple))
	{
		if (freq->multiple)
		{
			char *f = file;

			if (f[strlen (f) + 1] == 0)    /* only selected one file */
			{
				snprintf (buf, sizeof (buf), "1\n%s\n", file);
				write (freq->th->pipe_fd[1], buf, strlen (buf));
			} else
			{
				f += strlen (f) + 1; /* skip first, it's only the dir */
				while (f[0])
				{
					snprintf (buf, sizeof (buf), "1\n%s\\%s\n", /*dir!*/file, f);
					write (freq->th->pipe_fd[1], buf, strlen (buf));
					f += strlen (f) + 1;
				}
			}

		} else
		{
			snprintf (buf, sizeof (buf), "1\n%s\n", file);
			write (freq->th->pipe_fd[1], buf, strlen (buf));
		}
	}

	write (freq->th->pipe_fd[1], "0\n", 2);
	Sleep (2000);

	return NULL;
}

static gboolean
win32_close_pipe (int fd)
{
	close (fd);
	return 0;
}

static gboolean
win32_read_thread (GIOChannel *source, GIOCondition cond, struct file_req *freq)
{
	char buf[512];
	char *file;

	waitline2 (source, buf, sizeof buf);

	switch (buf[0])
	{
	case '0':	/* filedialog has closed */
		freq->callback (freq->userdata, NULL);
		break;

	case '1':	/* got a filename! */
		waitline2 (source, buf, sizeof buf);
		file = g_filename_to_utf8 (buf, -1, 0, 0, 0);
		freq->callback (freq->userdata, file);
		g_free (file);
		return TRUE;
	}

	/* it doesn't work to close them here, because of the weird
		way giowin32 works. We must _return_ before closing them */
	g_timeout_add(3000, (GSourceFunc)win32_close_pipe, freq->th->pipe_fd[0]);
	g_timeout_add(2000, (GSourceFunc)win32_close_pipe, freq->th->pipe_fd[1]);

	g_free (freq->title);
	free (freq->th);
	free (freq);

	return FALSE;
}
#endif

void
gtkutil_file_req (const char *title, void *callback, void *userdata, char *filter,
						int flags)
{
	struct file_req *freq;
	GtkWidget *dialog;
	extern char *get_xdir_fs (void);

#ifdef WIN32
	if (!(flags & FRF_WRITE))
	{
		freq = malloc (sizeof (struct file_req));
		freq->th = thread_new ();
		freq->flags = 0;
		freq->multiple = (flags & FRF_MULTIPLE);
		freq->callback = callback;
		freq->userdata = userdata;
		freq->title = g_locale_from_utf8 (title, -1, 0, 0, 0);
		if (!filter)
		{
			freq->filter =	"All files\0*.*\0"
							"Executables\0*.exe\0"
							"ZIP files\0*.zip\0\0";
		}
		else
		{
			freq->filter = filter;
		}

		thread_start (freq->th, win32_thread, freq);
		fe_input_add (freq->th->pipe_fd[0], FIA_FD|FIA_READ, win32_read_thread, freq);

		return;

	}
	
	else {
		freq = malloc (sizeof (struct file_req));
		freq->th = thread_new ();
		freq->flags = 0;
		freq->multiple = (flags & FRF_MULTIPLE);
		freq->callback = callback;
		freq->userdata = userdata;
		freq->title = g_locale_from_utf8 (title, -1, 0, 0, 0);
		if (!filter)
		{
			freq->filter = "All files\0*.*\0\0";
		}
		else
		{
			freq->filter = filter;
		}

		thread_start (freq->th, win32_thread2, freq);
		fe_input_add (freq->th->pipe_fd[0], FIA_FD|FIA_READ, win32_read_thread, freq);

	return;
	}
#endif

	if (flags & FRF_WRITE)
	{
		dialog = gtk_file_chooser_dialog_new (title, NULL,
												GTK_FILE_CHOOSER_ACTION_SAVE,
												GTK_STOCK_CANCEL, GTK_RESPONSE_CANCEL,
												GTK_STOCK_SAVE, GTK_RESPONSE_ACCEPT,
												NULL);
		if (filter && filter[0])	/* filter becomes initial name when saving */
		{
			char temp[1024];
			path_part (filter, temp, sizeof (temp));
			gtk_file_chooser_set_current_folder (GTK_FILE_CHOOSER (dialog), temp);
			gtk_file_chooser_set_current_name (GTK_FILE_CHOOSER (dialog), file_part (filter));
		}

		if (!(flags & FRF_NOASKOVERWRITE))
			gtk_file_chooser_set_do_overwrite_confirmation (GTK_FILE_CHOOSER (dialog), TRUE);
	}
	else
		dialog = gtk_file_chooser_dialog_new (title, NULL,
												GTK_FILE_CHOOSER_ACTION_OPEN,
												GTK_STOCK_CANCEL, GTK_RESPONSE_CANCEL,
												GTK_STOCK_OK, GTK_RESPONSE_ACCEPT,
												NULL);
	if (flags & FRF_MULTIPLE)
		gtk_file_chooser_set_select_multiple (GTK_FILE_CHOOSER (dialog), TRUE);
	if (last_dir[0])
		gtk_file_chooser_set_current_folder (GTK_FILE_CHOOSER (dialog), last_dir);
	if (flags & FRF_ADDFOLDER)
		gtk_file_chooser_add_shortcut_folder (GTK_FILE_CHOOSER (dialog),
														  get_xdir_fs (), NULL);
	if (flags & FRF_CHOOSEFOLDER)
	{
		gtk_file_chooser_set_action (GTK_FILE_CHOOSER (dialog), GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER);
		gtk_file_chooser_set_current_folder (GTK_FILE_CHOOSER (dialog), filter);
	}
	else
	{
		if (filter && (flags & FRF_FILTERISINITIAL))
			gtk_file_chooser_set_current_folder (GTK_FILE_CHOOSER (dialog), filter);
	}

	freq = malloc (sizeof (struct file_req));
	freq->dialog = dialog;
	freq->flags = flags;
	freq->callback = callback;
	freq->userdata = userdata;

	g_signal_connect (G_OBJECT (dialog), "response",
							G_CALLBACK (gtkutil_file_req_response), freq);
	g_signal_connect (G_OBJECT (dialog), "destroy",
						   G_CALLBACK (gtkutil_file_req_destroy), (gpointer) freq);
	gtk_widget_show (dialog);
}

void
gtkutil_destroy (GtkWidget * igad, GtkWidget * dgad)
{
	gtk_widget_destroy (dgad);
}

static void
gtkutil_get_str_response (GtkDialog *dialog, gint arg1, gpointer entry)
{
	void (*callback) (int cancel, char *text, void *user_data);
	char *text;
	void *user_data;

	text = (char *) gtk_entry_get_text (GTK_ENTRY (entry));
	callback = g_object_get_data (G_OBJECT (dialog), "cb");
	user_data = g_object_get_data (G_OBJECT (dialog), "ud");

	switch (arg1)
	{
	case GTK_RESPONSE_REJECT:
		callback (TRUE, text, user_data);
		gtk_widget_destroy (GTK_WIDGET (dialog));
		break;
	case GTK_RESPONSE_ACCEPT:
		callback (FALSE, text, user_data);
		gtk_widget_destroy (GTK_WIDGET (dialog));
		break;
	}
}

static void
gtkutil_str_enter (GtkWidget *entry, GtkWidget *dialog)
{
	gtk_dialog_response (GTK_DIALOG (dialog), GTK_RESPONSE_ACCEPT);
}

void
fe_get_str (char *msg, char *def, void *callback, void *userdata)
{
	GtkWidget *dialog;
	GtkWidget *entry;
	GtkWidget *hbox;
	GtkWidget *label;

	dialog = gtk_dialog_new_with_buttons (msg, NULL, 0,
										GTK_STOCK_CANCEL, GTK_RESPONSE_REJECT,
										GTK_STOCK_OK, GTK_RESPONSE_ACCEPT,
										NULL);
	gtk_box_set_homogeneous (GTK_BOX (GTK_DIALOG (dialog)->vbox), TRUE);
	gtk_window_set_position (GTK_WINDOW (dialog), GTK_WIN_POS_MOUSE);
	hbox = gtk_hbox_new (TRUE, 0);

	g_object_set_data (G_OBJECT (dialog), "cb", callback);
	g_object_set_data (G_OBJECT (dialog), "ud", userdata);

	entry = gtk_entry_new ();
	g_signal_connect (G_OBJECT (entry), "activate",
						 	G_CALLBACK (gtkutil_str_enter), dialog);
	gtk_entry_set_text (GTK_ENTRY (entry), def);
	gtk_box_pack_end (GTK_BOX (hbox), entry, 0, 0, 0);

	label = gtk_label_new (msg);
	gtk_box_pack_end (GTK_BOX (hbox), label, 0, 0, 0);

	g_signal_connect (G_OBJECT (dialog), "response",
						   G_CALLBACK (gtkutil_get_str_response), entry);

	gtk_container_add (GTK_CONTAINER (GTK_DIALOG (dialog)->vbox), hbox);

	gtk_widget_show_all (dialog);
}

static void
gtkutil_get_number_response (GtkDialog *dialog, gint arg1, gpointer spin)
{
	void (*callback) (int cancel, int value, void *user_data);
	int num;
	void *user_data;

	num = gtk_spin_button_get_value_as_int (GTK_SPIN_BUTTON (spin));
	callback = g_object_get_data (G_OBJECT (dialog), "cb");
	user_data = g_object_get_data (G_OBJECT (dialog), "ud");

	switch (arg1)
	{
	case GTK_RESPONSE_REJECT:
		callback (TRUE, num, user_data);
		gtk_widget_destroy (GTK_WIDGET (dialog));
		break;
	case GTK_RESPONSE_ACCEPT:
		callback (FALSE, num, user_data);
		gtk_widget_destroy (GTK_WIDGET (dialog));
		break;
	}
}

void
fe_get_int (char *msg, int def, void *callback, void *userdata)
{
	GtkWidget *dialog;
	GtkWidget *spin;
	GtkWidget *hbox;
	GtkWidget *label;
	GtkAdjustment *adj;

	dialog = gtk_dialog_new_with_buttons (msg, NULL, 0,
										GTK_STOCK_CANCEL, GTK_RESPONSE_REJECT,
										GTK_STOCK_OK, GTK_RESPONSE_ACCEPT,
										NULL);
	gtk_box_set_homogeneous (GTK_BOX (GTK_DIALOG (dialog)->vbox), TRUE);
	gtk_window_set_position (GTK_WINDOW (dialog), GTK_WIN_POS_MOUSE);
	hbox = gtk_hbox_new (TRUE, 0);

	g_object_set_data (G_OBJECT (dialog), "cb", callback);
	g_object_set_data (G_OBJECT (dialog), "ud", userdata);

	spin = gtk_spin_button_new (NULL, 1, 0);
	adj = gtk_spin_button_get_adjustment ((GtkSpinButton*)spin);
	adj->lower = 0;
	adj->upper = 1024;
	adj->step_increment = 1;
	gtk_adjustment_changed (adj);
	gtk_spin_button_set_value ((GtkSpinButton*)spin, def);
	gtk_box_pack_end (GTK_BOX (hbox), spin, 0, 0, 0);

	label = gtk_label_new (msg);
	gtk_box_pack_end (GTK_BOX (hbox), label, 0, 0, 0);

	g_signal_connect (G_OBJECT (dialog), "response",
						   G_CALLBACK (gtkutil_get_number_response), spin);

	gtk_container_add (GTK_CONTAINER (GTK_DIALOG (dialog)->vbox), hbox);

	gtk_widget_show_all (dialog);
}

GtkWidget *
gtkutil_button (GtkWidget *box, char *stock, char *tip, void *callback,
					 void *userdata, char *labeltext)
{
	GtkWidget *wid, *img, *bbox;

	wid = gtk_button_new ();

	if (labeltext)
	{
		gtk_button_set_label (GTK_BUTTON (wid), labeltext);
		gtk_button_set_image (GTK_BUTTON (wid), gtk_image_new_from_stock (stock, GTK_ICON_SIZE_MENU));
		gtk_button_set_use_underline (GTK_BUTTON (wid), TRUE);
		if (box)
			gtk_container_add (GTK_CONTAINER (box), wid);
	}
	else
	{
		bbox = gtk_hbox_new (0, 0);
		gtk_container_add (GTK_CONTAINER (wid), bbox);
		gtk_widget_show (bbox);

		img = gtk_image_new_from_stock (stock, GTK_ICON_SIZE_MENU);
		if (stock == GTK_STOCK_GOTO_LAST)
			gtk_widget_set_usize (img, 10, 6);
		gtk_container_add (GTK_CONTAINER (bbox), img);
		gtk_widget_show (img);
		gtk_box_pack_start (GTK_BOX (box), wid, 0, 0, 0);
	}

	g_signal_connect (G_OBJECT (wid), "clicked",
							G_CALLBACK (callback), userdata);
	gtk_widget_show (wid);
	if (tip)
		add_tip (wid, tip);

	return wid;
}

void
gtkutil_label_new (char *text, GtkWidget * box)
{
	GtkWidget *label = gtk_label_new (text);
	gtk_container_add (GTK_CONTAINER (box), label);
	gtk_widget_show (label);
}

GtkWidget *
gtkutil_entry_new (int max, GtkWidget * box, void *callback,
						 gpointer userdata)
{
	GtkWidget *entry = gtk_entry_new_with_max_length (max);
	gtk_container_add (GTK_CONTAINER (box), entry);
	if (callback)
		g_signal_connect (G_OBJECT (entry), "changed",
								G_CALLBACK (callback), userdata);
	gtk_widget_show (entry);
	return entry;
}

GtkWidget *
gtkutil_clist_new (int columns, char *titles[],
						 GtkWidget * box, int policy,
						 void *select_callback, gpointer select_userdata,
						 void *unselect_callback,
						 gpointer unselect_userdata, int selection_mode)
{
	GtkWidget *clist, *win;

	win = gtk_scrolled_window_new (0, 0);
	gtk_container_add (GTK_CONTAINER (box), win);
	gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (win),
											  GTK_POLICY_AUTOMATIC, policy);
	gtk_widget_show (win);

	if (titles)
		clist = gtk_clist_new_with_titles (columns, titles);
	else
		clist = gtk_clist_new (columns);

	gtk_clist_set_selection_mode (GTK_CLIST (clist), selection_mode);
	gtk_clist_column_titles_passive (GTK_CLIST (clist));
	gtk_container_add (GTK_CONTAINER (win), clist);
	if (select_callback)
	{
		g_signal_connect (G_OBJECT (clist), "select_row",
								G_CALLBACK (select_callback), select_userdata);
	}
	if (unselect_callback)
	{
		g_signal_connect (G_OBJECT (clist), "unselect_row",
								G_CALLBACK (unselect_callback), unselect_userdata);
	}
	gtk_widget_show (clist);

	return clist;
}

int
gtkutil_clist_selection (GtkWidget * clist)
{
	if (GTK_CLIST (clist)->selection)
		return GPOINTER_TO_INT(GTK_CLIST (clist)->selection->data);
	return -1;
}

static int
int_compare (const int * elem1, const int * elem2)
{
	return (*elem1) - (*elem2);
}

int
gtkutil_clist_multiple_selection (GtkWidget * clist, int ** rows, const int max_rows)
{
	int i = 0;
	GList *tmp_clist;
	*rows = malloc (sizeof (int) * max_rows );
	memset( *rows, -1, max_rows * sizeof(int) );

	for( tmp_clist = GTK_CLIST(clist)->selection;
			tmp_clist && i < max_rows; tmp_clist = tmp_clist->next, i++)
	{
		(*rows)[i] = GPOINTER_TO_INT( tmp_clist->data );
	}
	qsort(*rows, i, sizeof(int), (void *)int_compare);
	return i;

}

void
add_tip (GtkWidget * wid, char *text)
{
	static GtkTooltips *tip = NULL;
	if (!tip)
		tip = gtk_tooltips_new ();
	gtk_tooltips_set_tip (tip, wid, text, 0);
}

void
show_and_unfocus (GtkWidget * wid)
{
	GTK_WIDGET_UNSET_FLAGS (wid, GTK_CAN_FOCUS);
	gtk_widget_show (wid);
}

void
gtkutil_set_icon (GtkWidget *win)
{
	gtk_window_set_icon (GTK_WINDOW (win), pix_xchat);
}

extern GtkWidget *parent_window;	/* maingui.c */

GtkWidget *
gtkutil_window_new (char *title, char *role, int width, int height, int flags)
{
	GtkWidget *win;

	win = gtk_window_new (GTK_WINDOW_TOPLEVEL);
	gtkutil_set_icon (win);
#ifdef WIN32
	gtk_window_set_wmclass (GTK_WINDOW (win), "XChat", "xchat");
#endif
	gtk_window_set_title (GTK_WINDOW (win), title);
	gtk_window_set_default_size (GTK_WINDOW (win), width, height);
	gtk_window_set_role (GTK_WINDOW (win), role);
	if (flags & 1)
		gtk_window_set_position (GTK_WINDOW (win), GTK_WIN_POS_MOUSE);
	if ((flags & 2) && parent_window)
	{
		gtk_window_set_type_hint (GTK_WINDOW (win), GDK_WINDOW_TYPE_HINT_DIALOG);
		gtk_window_set_transient_for (GTK_WINDOW (win), GTK_WINDOW (parent_window));
	}

	return win;
}

/* pass NULL as selection to paste to both clipboard & X11 text */
void
gtkutil_copy_to_clipboard (GtkWidget *widget, GdkAtom selection,
                           const gchar *str)
{
	GtkWidget *win;
	GtkClipboard *clip, *clip2;

	win = gtk_widget_get_toplevel (GTK_WIDGET (widget));
	if (GTK_WIDGET_TOPLEVEL (win))
	{
		int len = strlen (str);

		if (selection)
		{
			clip = gtk_widget_get_clipboard (win, selection);
			gtk_clipboard_set_text (clip, str, len);
		} else
		{
			/* copy to both primary X selection and clipboard */
			clip = gtk_widget_get_clipboard (win, GDK_SELECTION_PRIMARY);
			clip2 = gtk_widget_get_clipboard (win, GDK_SELECTION_CLIPBOARD);
			gtk_clipboard_set_text (clip, str, len);
			gtk_clipboard_set_text (clip2, str, len);
		}
	}
}

/* Treeview util functions */

GtkWidget *
gtkutil_treeview_new (GtkWidget *box, GtkTreeModel *model,
                      GtkTreeCellDataFunc mapper, ...)
{
	GtkWidget *win, *view;
	GtkCellRenderer *renderer = NULL;
	GtkTreeViewColumn *col;
	va_list args;
	int col_id = 0;
	GType type;
	char *title, *attr;

	win = gtk_scrolled_window_new (0, 0);
	gtk_container_add (GTK_CONTAINER (box), win);
	gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (win),
											  GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
	gtk_widget_show (win);

	view = gtk_tree_view_new_with_model (model);
	/* the view now has a ref on the model, we can unref it */
	g_object_unref (G_OBJECT (model));
	gtk_container_add (GTK_CONTAINER (win), view);

	va_start (args, mapper);
	for (col_id = va_arg (args, int); col_id != -1; col_id = va_arg (args, int))
	{
		type = gtk_tree_model_get_column_type (model, col_id);
		switch (type)
		{
			case G_TYPE_BOOLEAN:
				renderer = gtk_cell_renderer_toggle_new ();
				attr = "active";
				break;
			case G_TYPE_STRING:	/* fall through */
			default:
				renderer = gtk_cell_renderer_text_new ();
				attr = "text";
				break;
		}

		title = va_arg (args, char *);
		if (mapper)	/* user-specified function to set renderer attributes */
		{
			col = gtk_tree_view_column_new_with_attributes (title, renderer, NULL);
			gtk_tree_view_column_set_cell_data_func (col, renderer, mapper,
			                                         GINT_TO_POINTER (col_id), NULL);
		} else
		{
			/* just set the typical attribute for this type of renderer */
			col = gtk_tree_view_column_new_with_attributes (title, renderer,
			                                                attr, col_id, NULL);
		}
		gtk_tree_view_append_column (GTK_TREE_VIEW (view), col);
	}

	va_end (args);

	return view;
}

gboolean
gtkutil_treemodel_string_to_iter (GtkTreeModel *model, gchar *pathstr, GtkTreeIter *iter_ret)
{
	GtkTreePath *path = gtk_tree_path_new_from_string (pathstr);
	gboolean success;

	success = gtk_tree_model_get_iter (model, iter_ret, path);
	gtk_tree_path_free (path);
	return success;
}

/*gboolean
gtkutil_treeview_get_selected_iter (GtkTreeView *view, GtkTreeIter *iter_ret)
{
	GtkTreeModel *store;
	GtkTreeSelection *select;
	
	select = gtk_tree_view_get_selection (view);
	return gtk_tree_selection_get_selected (select, &store, iter_ret);
}*/

gboolean
gtkutil_treeview_get_selected (GtkTreeView *view, GtkTreeIter *iter_ret, ...)
{
	GtkTreeModel *store;
	GtkTreeSelection *select;
	gboolean has_selected;
	va_list args;
	
	select = gtk_tree_view_get_selection (view);
	has_selected = gtk_tree_selection_get_selected (select, &store, iter_ret);

	if (has_selected) {
		va_start (args, iter_ret);
		gtk_tree_model_get_valist (store, iter_ret, args);
		va_end (args);
	}

	return has_selected;
}
>die "$0: error changing to directory $pwd: $!\n"; # cache the item list for later use warn "caching items for later use\n" if $Verbose; open( CACHE, ">$Itemcache" ) || die "$0: error open $Itemcache for writing: $!\n"; print CACHE join( ":", @Podpath ) . "\n$podroot\n"; foreach my $key ( keys %Items ) { print CACHE "$key $Items{$key}\n"; } close(CACHE); # cache the directory list for later use warn "caching directories for later use\n" if $Verbose; open( CACHE, ">$Dircache" ) || die "$0: error open $Dircache for writing: $!\n"; print CACHE join( ":", @Podpath ) . "\n$podroot\n"; foreach my $key ( keys %Pages ) { print CACHE "$key $Pages{$key}\n"; } close(CACHE); } # # scan_dir - scans the directory specified in $dir for subdirectories, .pod # files, and .pm files. notes those that it finds. this information will # be used later in order to figure out where the pages specified in L<> # links are on the filesystem. # sub scan_dir { my ( $dir, $recurse ) = @_; my ( $t, @subdirs, @pods, $pod, $dirname, @dirs ); local $_; @subdirs = (); @pods = (); opendir( DIR, $dir ) || die "$0: error opening directory $dir: $!\n"; while ( defined( $_ = readdir(DIR) ) ) { if ( -d "$dir/$_" && $_ ne "." && $_ ne ".." && ( $HiddenDirs || !/^\./ ) ) { # directory $Pages{$_} = "" unless defined $Pages{$_}; $Pages{$_} .= "$dir/$_:"; push( @subdirs, $_ ); } elsif (/\.pod\z/) { # .pod s/\.pod\z//; $Pages{$_} = "" unless defined $Pages{$_}; $Pages{$_} .= "$dir/$_.pod:"; push( @pods, "$dir/$_.pod" ); } elsif (/\.html\z/) { # .html s/\.html\z//; $Pages{$_} = "" unless defined $Pages{$_}; $Pages{$_} .= "$dir/$_.pod:"; } elsif (/\.pm\z/) { # .pm s/\.pm\z//; $Pages{$_} = "" unless defined $Pages{$_}; $Pages{$_} .= "$dir/$_.pm:"; push( @pods, "$dir/$_.pm" ); } elsif ( -T "$dir/$_" ) { # script(?) local *F; if ( open( F, "$dir/$_" ) ) { my $line; while ( defined( $line = <F> ) ) { if ( $line =~ /^=(?:pod|head1)/ ) { $Pages{$_} = "" unless defined $Pages{$_}; $Pages{$_} .= "$dir/$_.pod:"; last; } } close(F); } } } closedir(DIR); # recurse on the subdirectories if necessary if ($recurse) { foreach my $subdir (@subdirs) { scan_dir( "$dir/$subdir", $recurse ); } } } # # scan_headings - scan a pod file for head[1-6] tags, note the tags, and # build an index. # sub scan_headings { my ( $sections, @data ) = @_; my ( $tag, $which_head, $otitle, $listdepth, $index ); local $Ignore = 0; $listdepth = 0; $index = ""; # scan for =head directives, note their name, and build an index # pointing to each of them. foreach my $line (@data) { if ( $line =~ /^=(head)([1-6])\s+(.*)/ ) { ( $tag, $which_head, $otitle ) = ( $1, $2, $3 ); my $title = depod($otitle); my $name = anchorify($title); $$sections{$name} = 1; $title = process_text( \$otitle ); while ( $which_head != $listdepth ) { if ( $which_head > $listdepth ) { $index .= "\n" . ( "\t" x ($listdepth) ) . ( $listdepth > 0 ? qq{<li class="branch">\n} . "\t"x($listdepth + 1): "" ) . "<ul>"; $listdepth++; } elsif ( $which_head < $listdepth ) { $listdepth--; $index .= "\n" . ( "\t" x $listdepth ) . ( $listdepth > 0 ? "\t" : "" ) . "</ul>" . ( $listdepth >= 0 ? "\n" . ("\t"x$listdepth) . "</li>" : "" ) . "\n"; } } $index .= "\n" . ( "\t" x $listdepth ) . "<li>" . "<a href=\"#" . $name . "\">" . $title . "</a></li>"; } } # finish off the lists while ( $listdepth-- ) { $index .= "\n" . ( "\t" x $listdepth ) . ($listdepth > 0 ? "\t" : "") ."</ul>\n" . ($listdepth > 0 ? ("\t" x $listdepth) . "</li>" : "" ); } # get rid of bogus lists $index =~ s,\t*<ul>\s*</ul>\n,,g; return $index; } # # scan_items - scans the pod specified by $pod for =item directives. we # will use this information later on in resolving C<> links. # sub scan_items { my ( $itemref, $pod, @poddata ) = @_; my ( $i, $item ); local $_; $pod =~ s/\.pod\z//; $pod .= ".html" if $pod; foreach $i ( 0 .. $#poddata ) { my $txt = depod( $poddata[$i] ); # figure out what kind of item it is. # Build string for referencing this item. if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet next unless $1; $item = $1; } elsif ( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list $item = $1; } elsif ( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item $item = $1; } else { next; } my $fid = fragment_id($item); $$itemref{$fid} = "$pod" if $fid; } } # # process_head - convert a pod head[1-6] tag and convert it to HTML format. # sub process_head { my ( $tag, $heading, $hasindex ) = @_; # figure out the level of the =head $tag =~ /head([1-6])/; my $level = $1; if ($Listlevel) { warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet; while ($Listlevel) { process_back(); } } print HTML "<p>\n"; if ( $level == 1 && !$Top ) { print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n" if $hasindex and $Backlink; print HTML "</p>\n<hr />\n"; } else { print HTML "</p>\n"; } my $name = anchorify( depod($heading) ); my $convert = process_text( \$heading ); $convert =~ s{</?a[^>]+>}{}g; print HTML "<h$level><a name=\"$name\" />$convert</h$level>\n"; } # # emit_item_tag - print an =item's text # Note: The global $EmittedItem is used for inhibiting self-references. # my $EmittedItem; sub emit_item_tag($$$) { my ( $otext, $text, $compact ) = @_; my $item = fragment_id( depod($text), -generate ); Carp::confess( "Undefined fragment '$text' (" . depod($text) . ") from fragment_id() in emit_item_tag() in $Podfile" ) if !defined $item; $EmittedItem = $item; ### print STDERR "emit_item_tag=$item ($text)\n"; print HTML '<strong>'; if ( $Items_Named{$item}++ ) { print HTML process_text( \$otext ); } else { my $name = $item; $name = anchorify($name); print HTML #qq{<a name="$name" class="item">}, process_text( \$otext ), # '</a>' ; } print HTML "</strong>\n"; undef($EmittedItem); } sub emit_li { my ($tag) = @_; if ( $Items_Seen[$Listlevel]++ == 0 ) { push( @Listend, "</$tag>" ); print HTML "<$tag>\n"; } my $emitted = $tag eq 'dl' ? 'dt' : 'li'; print HTML "<$emitted>"; return $emitted; } # # process_item - convert a pod item tag and convert it to HTML format. # sub process_item { my ($otext) = @_; my $need_dd = 0; # set to 1 if we need a <dd></dd> after an item # lots of documents start a list without doing an =over. this is # bad! but, the proper thing to do seems to be to just assume # they did do an =over. so warn them once and then continue. if ( $Listlevel == 0 ) { warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; process_over(); } # formatting: insert a paragraph if preceding item has >1 paragraph if ($After_Lpar) { print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar; $After_Lpar = 0; } # remove formatting instructions from the text my $text = depod($otext); my $emitted; # the tag actually emitted, used for closing # all the list variants: if ( $text =~ /\A\*/ ) { # bullet $emitted = emit_li('ul'); if ( $text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text my $tag = $1; $otext =~ s/\A\*\s+//; emit_item_tag( $otext, $tag, 1 ); } print HTML "</li>" } elsif ( $text =~ /\A\d+/ ) { # numbered list $emitted = emit_li('ol'); if ( $text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text my $tag = $1; $otext =~ s/\A\d+\.?\s*//; emit_item_tag( $otext, $tag, 1 ); } print HTML "</li>"; } else { # definition list $emitted = emit_li('dl'); if ( $text =~ /\A(.+)\Z/s ) { # should have text emit_item_tag( $otext, $text, 1 ); } $need_dd = 1; } print HTML "\n"; return $need_dd; } # # process_over - process a pod over tag and start a corresponding HTML list. # sub process_over { # start a new list $Listlevel++; push( @Items_Seen, 0 ); $After_Lpar = 0; } # # process_back - process a pod back tag and convert it to HTML format. # sub process_back { my $need_dd = shift; if ( $Listlevel == 0 ) { warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; return; } # close off the list. note, I check to see if $Listend[$Listlevel] is # defined because an =item directive may have never appeared and thus # $Listend[$Listlevel] may have never been initialized. $Listlevel--; if ( defined $Listend[$Listlevel] ) { print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar; print HTML $Listend[$Listlevel]; print HTML "\n"; pop(@Listend); } $After_Lpar = 0; # clean up item count pop(@Items_Seen); } # # process_cut - process a pod cut tag, thus start ignoring pod directives. # sub process_cut { $Ignore = 1; } # # process_pod - process a pod tag, thus stop ignoring pod directives # until we see a corresponding cut. # sub process_pod { # no need to set $Ignore to 0 cause the main loop did it } # # process_for - process a =for pod tag. if it's for html, spit # it out verbatim, if illustration, center it, otherwise ignore it. # sub process_for { my ( $whom, $text ) = @_; if ( $whom =~ /^(pod2)?html$/i ) { print HTML $text; } elsif ( $whom =~ /^illustration$/i ) { 1 while chomp $text; for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) { $text .= $ext, last if -r "$text$ext"; } print HTML qq{<p align="center"><img src="$text" alt="$text illustration" /></p>}; } } # # process_begin - process a =begin pod tag. this pushes # whom we're beginning on the begin stack. if there's a # begin stack, we only print if it us. # sub process_begin { my ( $whom, $text ) = @_; $whom = lc($whom); push( @Begin_Stack, $whom ); if ( $whom =~ /^(pod2)?html$/ ) { print HTML $text if $text; } } # # process_end - process a =end pod tag. pop the # begin stack. die if we're mismatched. # sub process_end { my ( $whom, $text ) = @_; $whom = lc($whom); if ( !defined $Begin_Stack[-1] or $Begin_Stack[-1] ne $whom ) { Carp::confess( "Unmatched begin/end at chunk $Paragraph in pod $Podfile\n"); } pop(@Begin_Stack); } # # process_pre - indented paragraph, made into <pre></pre> # sub process_pre { my ($text) = @_; my ($rest); return if $Ignore; $rest = $$text; # insert spaces in place of tabs $rest =~ s#(.+)# my $line = $1; 1 while $line =~ s/(\t+)/' ' x ((length($1) * 8) - $-[0] % 8)/e; $line; #eg; # convert some special chars to HTML escapes $rest = html_escape($rest); # try and create links for all occurrences of perl.* within # the preformatted text. $rest =~ s{ (\s*)(perl\w+) }{ if ( defined $Pages{$2} ){ # is a link qq($1<a href="$Htmlroot/$Pages{$2}">$2</a>); } elsif (defined $Pages{dosify($2)}) { # is a link qq($1<a href="$Htmlroot/$Pages{dosify($2)}">$2</a>); } else { "$1$2"; } }xeg; $rest =~ s{ (<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)? }{ my $url ; if ( $Htmlfileurl ne '' ){ # Here, we take advantage of the knowledge # that $Htmlfileurl ne '' implies $Htmlroot eq ''. # Since $Htmlroot eq '', we need to prepend $Htmldir # on the fron of the link to get the absolute path # of the link's target. We check for a leading '/' # to avoid corrupting links that are #, file:, etc. my $old_url = $3 ; $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/}; $url = relativize_url( "$old_url.html", $Htmlfileurl ); } else { $url = "$3.html" ; } "$1$url" ; }xeg; # Look for embedded URLs and make them into links. We don't # relativize them since they are best left as the author intended. my $urls = '(' . join( '|', qw{ http telnet mailto news gopher file wais ftp } ) . ')'; my $ltrs = '\w'; my $gunk = '/#~:.?+=&%@!\-'; my $punc = '.:!?\-;'; my $any = "${ltrs}${gunk}${punc}"; $rest =~ s{ \b # start at word boundary ( # begin $1 { $urls : # need resource and a colon (?!:) # Ignore File::, among others. [$any] +? # followed by one or more of any valid # character, but be conservative and # take only what you need to.... ) # end $1 } (?= &quot; &gt; # maybe pre-quoted '<a href="...">' | # or: [$punc]* # 0 or more punctuation (?: # followed [^$any] # by a non-url char | # or $ # end of the string ) # | # or else $ # then end of the string ) }{<a href="$1">$1</a>}igox; # text should be as it is (verbatim) $$text = $rest; } # # pure text processing # # pure_text/inIS_text: differ with respect to automatic C<> recognition. # we don't want this to happen within IS # sub pure_text($) { my $text = shift(); process_puretext( $text, 1 ); } sub inIS_text($) { my $text = shift(); process_puretext( $text, 0 ); } # # process_puretext - process pure text (without pod-escapes) converting # double-quotes and handling implicit C<> links. # sub process_puretext { my ( $text, $notinIS ) = @_; ## Guessing at func() or [\$\@%&]*var references in plain text is destined ## to produce some strange looking ref's. uncomment to disable: ## $notinIS = 0; my ( @words, $lead, $trail ); # keep track of leading and trailing white-space $lead = ( $text =~ s/\A(\s+)//s ? $1 : "" ); $trail = ( $text =~ s/(\s+)\Z//s ? $1 : "" ); # split at space/non-space boundaries @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text ); # process each word individually foreach my $word (@words) { # skip space runs next if $word =~ /^\s*$/; # see if we can infer a link or a function call # # NOTE: This is a word based search, it won't automatically # mark "substr($var, 1, 2)" because the 1st word would be "substr($var" # User has to enclose those with proper C<> if ( $notinIS && $word =~ m/ ^([a-z_]{2,}) # The function name \( ([0-9][a-z]* # Manual page(1) or page(1M) |[^)]*[\$\@\%][^)]+ # ($foo), (1, @foo), (%hash) | # () ) \) ([.,;]?)$ # a possible punctuation follows /xi ) { # has parenthesis so should have been a C<> ref ## try for a pagename (perlXXX(1))? my ( $func, $args, $rest ) = ( $1, $2, $3 || '' ); if ( $args =~ /^\d+$/ ) { my $url = page_sect( $word, '' ); if ( defined $url ) { $word = qq(<a href="$url" class="man">the $word manpage</a>$rest); next; } } ## try function name for a link, append tt'ed argument list $word = emit_C( $func, '', "($args)" ) . $rest; #### disabled. either all (including $\W, $\w+{.*} etc.) or nothing. ## } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) { ## # perl variables, should be a C<> ref ## $word = emit_C( $word ); } elsif ( $word =~ m,^\w+://\w, ) { # looks like a URL # Don't relativize it: leave it as the author intended $word = qq(<a href="$word">$word</a>); } elsif ( $word =~ /[\w.-]+\@[\w-]+\.\w/ ) { # looks like an e-mail address my ( $w1, $w2, $w3 ) = ( "", $word, "" ); ( $w1, $w2, $w3 ) = ( "(", $1, ")$2" ) if $word =~ /^\((.*?)\)(,?)/; ( $w1, $w2, $w3 ) = ( "&lt;", $1, "&gt;$2" ) if $word =~ /^<(.*?)>(,?)/; $word = qq($w1<a href="mailto:$w2">$w2</a>$w3); } else { $word = html_escape($word) if $word =~ /["&<>]/; } } # put everything back together return $lead . join( '', @words ) . $trail; } # # process_text - handles plaintext that appears in the input pod file. # there may be pod commands embedded within the text so those must be # converted to html commands. # sub process_text1($$;$$); sub pattern ($) { $_[0] ? '\s+' . ( '>' x ( $_[0] + 1 ) ) : '>' } sub closing ($) { local ($_) = shift; ( defined && s/\s+\z// ) ? length : 0 } sub process_text { return if $Ignore; my ($tref) = @_; my $res = process_text1( 0, $tref ); $res =~ s/\s+$//s; $$tref = $res; } sub process_text_rfc_links { my $text = shift; # For every "RFCnnnn" or "RFC nnn", link it to the authoritative # ource. Do not use the /i modifier here. Require "RFC" to be written in # in capital letters. $text =~ s{ (?<=[^<>[:alpha:]]) # Make sure this is not an URL already (RFC\s*([0-9]{1,5}))(?![0-9]) # max 5 digits } {<a href="http://www.ietf.org/rfc/rfc$2.txt" class="rfc">$1</a>}gx; $text; } sub process_text1($$;$$) { my ( $lev, $rstr, $func, $closing ) = @_; my $res = ''; unless ( defined $func ) { $func = ''; $lev++; } if ( $func eq 'B' ) { # B<text> - boldface $res = '<strong>' . process_text1( $lev, $rstr ) . '</strong>'; } elsif ( $func eq 'C' ) { # C<code> - can be a ref or <code></code> # need to extract text my $par = go_ahead( $rstr, 'C', $closing ); ## clean-up of the link target my $text = depod($par); ### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ; ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n"; $res = emit_C( $text, $lev > 1 || ( $par =~ /[BI]</ ) ); } elsif ( $func eq 'E' ) { # E<x> - convert to character $$rstr =~ s/^([^>]*)>//; my $escape = $1; $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i; $res = "&$escape;"; } elsif ( $func eq 'F' ) { # F<filename> - italicize $res = '<em class="file">' . process_text1( $lev, $rstr ) . '</em>'; } elsif ( $func eq 'I' ) { # I<text> - italicize $res = '<em>' . process_text1( $lev, $rstr ) . '</em>'; } elsif ( $func eq 'L' ) { # L<link> - link ## L<text|cross-ref> => produce text, use cross-ref for linking ## L<cross-ref> => make text from cross-ref ## need to extract text my $par = go_ahead( $rstr, 'L', $closing ); # some L<>'s that shouldn't be: # a) full-blown URL's are emitted as-is if ( $par =~ m{^\w+://}s ) { return make_URL_href($par); } # b) C<...> is stripped and treated as C<> if ( $par =~ /^C<(.*)>$/ ) { my $text = depod($1); return emit_C( $text, $lev > 1 || ( $par =~ /[BI]</ ) ); } # analyze the contents $par =~ s/\n/ /g; # undo word-wrapped tags my $opar = $par; my $linktext; if ( $par =~ s{^([^|]+)\|}{} ) { $linktext = $1; } if( $par =~ m{^\w+://}s ) { return make_URL_href( $par, $linktext ); } # make sure sections start with a / $par =~ s{^"}{/"}; my ( $page, $section, $ident ); # check for link patterns if ( $par =~ m{^([^/]+?)/(?!")(.*?)$} ) { # name/ident # we've got a name/ident (no quotes) if ( length $2 ) { ( $page, $ident ) = ( $1, $2 ); } else { ( $page, $section ) = ( $1, $2 ); } ### print STDERR "--> L<$par> to page $page, ident $ident\n"; } elsif ( $par =~ m{^(.*?)/"?(.*?)"?$} ) { # [name]/"section" # even though this should be a "section", we go for ident first ( $page, $ident ) = ( $1, $2 ); ### print STDERR "--> L<$par> to page $page, section $section\n"; } elsif ( $par =~ /\s/ ) { # this must be a section with missing quotes ( $page, $section ) = ( '', $par ); ### print STDERR "--> L<$par> to void page, section $section\n"; } else { ( $page, $section ) = ( $par, '' ); ### print STDERR "--> L<$par> to page $par, void section\n"; } # now, either $section or $ident is defined. the convoluted logic # below tries to resolve L<> according to what the user specified. # failing this, we try to find the next best thing... my ( $url, $ltext, $fid ); RESOLVE: { if ( defined $ident ) { ## try to resolve $ident as an item ( $url, $fid ) = coderef( $page, $ident ); if ($url) { if ( !defined($linktext) ) { $linktext = $ident; $linktext .= " in " if $ident && $page; $linktext .= "the $page manpage" if $page; } ### print STDERR "got coderef url=$url\n"; last RESOLVE; } ## no luck: go for a section (auto-quoting!) $section = $ident; } ## now go for a section my $htmlsection = htmlify($section); $url = page_sect( $page, $htmlsection ); if ($url) { if ( !defined($linktext) ) { $linktext = $section; $linktext .= " in " if $section && $page; $linktext .= "the $page manpage" if $page; } ### print STDERR "got page/section url=$url\n"; last RESOLVE; } ## no luck: go for an ident if ($section) { $ident = $section; } else { $ident = $page; $page = undef(); } ( $url, $fid ) = coderef( $page, $ident ); if ($url) { if ( !defined($linktext) ) { $linktext = $ident; $linktext .= " in " if $ident && $page; $linktext .= "the $page manpage" if $page; } ### print STDERR "got section=>coderef url=$url\n"; last RESOLVE; } # warning; show some text. $linktext = $opar unless defined $linktext; warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet; } # now we have a URL or just plain code $$rstr = $linktext . '>' . $$rstr; if ( defined($url) ) { $res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>'; } else { $res = '<em>' . process_text1( $lev, $rstr ) . '</em>'; } } elsif ( $func eq 'S' ) { # S<text> - non-breaking spaces $res = process_text1( $lev, $rstr ); $res =~ s/ /&nbsp;/g; } elsif ( $func eq 'X' ) { # X<> - ignore warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n" unless $$rstr =~ s/^[^>]*>// or $Quiet; } elsif ( $func eq 'Z' ) { # Z<> - empty warn "$0: $Podfile: invalid Z<> in paragraph $Paragraph.\n" unless $$rstr =~ s/^>// or $Quiet; } else { my $term = pattern $closing; while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ) { # all others: either recurse into new function or # terminate at closing angle bracket(s) my $pt = $1; $pt .= $2 if !$3 && $lev == 1; $res .= $lev == 1 ? pure_text($pt) : inIS_text($pt); return $res if !$3 && $lev > 1; if ($3) { $res .= process_text1( $lev, $rstr, $3, closing $4 ); } } if ( $lev == 1 ) { $res .= pure_text($$rstr); } elsif ( !$Quiet ) { my $snippet = substr( $$rstr, 0, 60 ); warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph: '$snippet'.\n" } $res = process_text_rfc_links($res); } return $res; } # # go_ahead: extract text of an IS (can be nested) # sub go_ahead($$$) { my ( $rstr, $func, $closing ) = @_; my $res = ''; my @closing = ($closing); while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+\s+)?|@{[pattern $closing[0]]})//s ) { $res .= $1; unless ($3) { shift @closing; return $res unless @closing; } else { unshift @closing, closing $4; } $res .= $2; } unless ($Quiet) { my $snippet = substr( $$rstr, 0, 60 ); warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph (go_ahead): '$snippet'.\n"; } return $res; } # # emit_C - output result of C<text> # $text is the depod-ed text # sub emit_C($;$$) { my ( $text, $nocode, $args ) = @_; $args = '' unless defined $args; my $res; my ( $url, $fid ) = coderef( undef(), $text ); # need HTML-safe text my $linktext = html_escape("$text$args"); if ( $text !~ /^[\$@%]/ && defined($url) && ( !defined($EmittedItem) || $EmittedItem ne $fid ) ) { $res = "<a href=\"$url\"><code>$linktext</code></a>"; } elsif ( 0 && $nocode ) { $res = $linktext; } else { $res = "<code>$linktext</code>"; } return $res; } # # html_escape: make text safe for HTML # sub html_escape { my $rest = $_[0]; $rest =~ s/&/&amp;/g; $rest =~ s/</&lt;/g; $rest =~ s/>/&gt;/g; $rest =~ s/"/&quot;/g; # &apos; is only in XHTML, not HTML4. Be conservative #$rest =~ s/'/&apos;/g; return $rest; } # # dosify - convert filenames to 8.3 # sub dosify { my ($str) = @_; return lc($str) if $^O eq 'VMS'; # VMS just needs casing if ($Is83) { $str = lc $str; $str =~ s/(\.\w+)/substr ($1,0,4)/ge; $str =~ s/(\w+)/substr ($1,0,8)/ge; } return $str; } # # page_sect - make a URL from the text of a L<> # sub page_sect($$) { my ( $page, $section ) = @_; my ( $linktext, $page83, $link ); # work strings # check if we know that this is a section in this page if ( !defined $Pages{$page} && defined $Sections{$page} ) { $section = $page; $page = ""; ### print STDERR "reset page='', section=$section\n"; } $page83 = dosify($page); $page = $page83 if ( defined $Pages{$page83} ); if ( $page eq "" ) { $link = "#" . anchorify($section); } elsif ( $page =~ /::/ ) { $page =~ s,::,/,g; # Search page cache for an entry keyed under the html page name, # then look to see what directory that page might be in. NOTE: # this will only find one page. A better solution might be to produce # an intermediate page that is an index to all such pages. my $page_name = $page; $page_name =~ s,^.*/,,s; if ( defined( $Pages{$page_name} ) && $Pages{$page_name} =~ /([^:]*$page)\.(?:pod|pm):/ ) { $page = $1; } else { # NOTE: This branch assumes that all A::B pages are located in # $Htmlroot/A/B.html . This is often incorrect, since they are # often in $Htmlroot/lib/A/B.html or such like. Perhaps we could # analyze the contents of %Pages and figure out where any # cousins of A::B are, then assume that. So, if A::B isn't found, # but A::C is found in lib/A/C.pm, then A::B is assumed to be in # lib/A/B.pm. This is also limited, but it's an improvement. # Maybe a hints file so that the links point to the correct places # nonetheless? } $link = "$Htmlroot/$page.html"; $link .= "#" . anchorify($section) if ($section); } elsif ( !defined $Pages{$page} ) { $link = ""; } else { $section = anchorify($section) if $section ne ""; ### print STDERR "...section=$section\n"; # if there is a directory by the name of the page, then assume that an # appropriate section will exist in the subdirectory # if ($section ne "" && $Pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) { if ( $section ne "" && $Pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/ ) { $link = "$Htmlroot/$1/$section.html"; ### print STDERR "...link=$link\n"; # since there is no directory by the name of the page, the section will # have to exist within a .html of the same name. thus, make sure there # is a .pod or .pm that might become that .html } else { $section = "#$section" if $section; ### print STDERR "...section=$section\n"; # check if there is a .pod with the page name. # for L<Foo>, Foo.(pod|pm) is preferred to A/Foo.(pod|pm) if ( $Pages{$page} =~ /([^:]*)\.(?:pod|pm):/ ) { $link = "$Htmlroot/$1.html$section"; } else { $link = ""; } } } if ($link) { # Here, we take advantage of the knowledge that $Htmlfileurl ne '' # implies $Htmlroot eq ''. This means that the link in question # needs a prefix of $Htmldir if it begins with '/'. The test for # the initial '/' is done to avoid '#'-only links, and to allow # for other kinds of links, like file:, ftp:, etc. my $url; if ( $Htmlfileurl ne '' ) { $link = "$Htmldir$link" if $link =~ m{^/}s; $url = relativize_url( $link, $Htmlfileurl ); # print( " b: [$link,$Htmlfileurl,$url]\n" ); } else { $url = $link; } return $url; } else { return undef(); } } # # relativize_url - convert an absolute URL to one relative to a base URL. # Assumes both end in a filename. # sub relativize_url { my ( $dest, $source ) = @_; my ( $dest_volume, $dest_directory, $dest_file ) = File::Spec::Unix->splitpath($dest); $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ); my ( $source_volume, $source_directory, $source_file ) = File::Spec::Unix->splitpath($source); $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ); my $rel_path = ''; if ( $dest ne '' ) { $rel_path = File::Spec::Unix->abs2rel( $dest, $source ); } if ( $rel_path ne '' && substr( $rel_path, -1 ) ne '/' && substr( $dest_file, 0, 1 ) ne '#' ) { $rel_path .= "/$dest_file"; } else { $rel_path .= "$dest_file"; } return $rel_path; } # # coderef - make URL from the text of a C<> # sub coderef($$) { my ( $page, $item ) = @_; my ($url); my $fid = fragment_id($item); if ( defined($page) && $page ne "" ) { # we have been given a $page... $page =~ s{::}{/}g; Carp::confess( "Undefined fragment '$item' from fragment_id() in coderef() in $Podfile" ) if !defined $fid; # Do we take it? Item could be a section! my $base = $Items{$fid} || ""; $base =~ s{[^/]*/}{}; if ( $base ne "$page.html" ) { ### print STDERR "coderef( $page, $item ): items{$fid} = $Items{$fid} = $base => discard page!\n"; $page = undef(); } } else { # no page - local items precede cached items if ( defined($fid) ) { if ( exists $Local_Items{$fid} ) { $page = $Local_Items{$fid}; } else { $page = $Items{$fid}; } } } # if there was a pod file that we found earlier with an appropriate # =item directive, then create a link to that page. if ( defined $page ) { if ($page) { if ( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/ ) { $page = $1 . '.html'; } my $link = "$Htmlroot/$page#" . anchorify($fid); # Here, we take advantage of the knowledge that $Htmlfileurl # ne '' implies $Htmlroot eq ''. if ( $Htmlfileurl ne '' ) { $link = "$Htmldir$link"; $url = relativize_url( $link, $Htmlfileurl ); } else { $url = $link; } } else { $url = "#" . anchorify($fid); } confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/; } return ( $url, $fid ); } # # Adapted from Nick Ing-Simmons' PodToHtml package. sub relative_url { my $source_file = shift; my $destination_file = shift; my $source = URI::file->new_abs($source_file); my $uo = URI::file->new( $destination_file, $source )->abs; return $uo->rel->as_string; } # # finish_list - finish off any pending HTML lists. this should be called # after the entire pod file has been read and converted. # sub finish_list { while ( $Listlevel > 0 ) { print HTML "</dl>\n"; $Listlevel--; } } # # htmlify - converts a pod section specification to a suitable section # specification for HTML. Note that we keep spaces and special characters # except ", ? (Netscape problem) and the hyphen (writer's problem...). # sub htmlify { my ($heading) = @_; $heading =~ s/(\s+)/ /g; $heading =~ s/\s+\Z//; $heading =~ s/\A\s+//; # The hyphen is a disgrace to the English language. # $heading =~ s/[-"?]//g; $heading =~ s/["?]//g; $heading = lc($heading); return $heading; } # # similar to htmlify, but turns non-alphanumerics into underscores # sub anchorify { my ($anchor) = @_; $anchor =~ s/\([^)]*\)//; $anchor = htmlify($anchor); $anchor =~ s/\W/_/g; $anchor =~ tr/_/_/s; return $anchor; } # # depod - convert text by eliminating all interior sequences # Note: can be called with copy or modify semantics # my %E2c; $E2c{lt} = '<'; $E2c{gt} = '>'; $E2c{sol} = '/'; $E2c{verbar} = '|'; $E2c{amp} = '&'; # in Tk's pods sub depod1($;$$); sub depod($) { my $string; if ( ref( $_[0] ) ) { $string = ${ $_[0] }; ${ $_[0] } = depod1( \$string ); } else { $string = $_[0]; depod1( \$string ); } } sub depod1($;$$) { my ( $rstr, $func, $closing ) = @_; my $res = ''; return $res unless defined $$rstr; if ( !defined($func) ) { # skip to next begin of an interior sequence while ( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?//s ) { # recurse into its text $res .= $1 . depod1( $rstr, $2, closing $3); } $res .= $$rstr; } elsif ( $func eq 'E' ) { # E<x> - convert to character $$rstr =~ s/^([^>]*)>//; $res .= $E2c{$1} || ""; } elsif ( $func eq 'X' ) { # X<> - ignore $$rstr =~ s/^[^>]*>//; } elsif ( $func eq 'Z' ) { # Z<> - empty $$rstr =~ s/^>//; } else { # all others: either recurse into new function or # terminate at closing angle bracket my $term = pattern $closing; while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ) { $res .= $1; last unless $3; $res .= depod1( $rstr, $3, closing $4 ); } ## If we're here and $2 ne '>': undelimited interior sequence. ## Ignored, as this is called without proper indication of where we are. ## Rely on process_text to produce diagnostics. } return $res; } { my %seen; # static fragment record hash sub fragment_id_readable { my $text = shift; my $generate = shift; # optional flag my $orig = $text; # leave the words for the fragment identifier, # change everything else to underbars. $text =~ s/[^A-Za-z0-9_]+/_/g; # do not use \W to avoid locale dependency. $text =~ s/_{2,}/_/g; $text =~ s/\A_//; $text =~ s/_\Z//; unless ($text) { # Nothing left after removing punctuation, so leave it as is # E.g. if option is named: "=item -#" $text = $orig; } if ($generate) { if ( exists $seen{$text} ) { # This already exists, make it unique $seen{$text}++; $text = $text . $seen{$text}; } else { $seen{$text} = 1; # first time seen this fragment } } $text; } } my @HC; sub fragment_id_obfuscated { # This was the old "_2d_2d__" my $text = shift; my $generate = shift; # optional flag # text? Normalize by obfuscating the fragment id to make it unique $text =~ s/\s+/_/sg; $text =~ s{(\W)}{ defined( $HC[ord($1)] ) ? $HC[ord($1)] : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe; $text = substr( $text, 0, 50 ); $text; } # # fragment_id - construct a fragment identifier from: # a) =item text # b) contents of C<...> # sub fragment_id { my $text = shift; my $generate = shift; # optional flag $text =~ s/\s+\Z//s; if ($text) { # a method or function? return $1 if $text =~ /(\w+)\s*\(/; return $1 if $text =~ /->\s*(\w+)\s*\(?/; # a variable name? return $1 if $text =~ /^([\$\@%*]\S+)/; # some pattern matching operator? return $1 if $text =~ m|^(\w+/).*/\w*$|; # fancy stuff... like "do { }" return $1 if $text =~ m|^(\w+)\s*{.*}$|; # honour the perlfunc manpage: func [PAR[,[ ]PAR]...] # and some funnies with ... Module ... return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z,/& ][A-Z\d,/& ]*)?$}; return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$}; return fragment_id_readable( $text, $generate ); } else { return; } } # # make_URL_href - generate HTML href from URL # Special treatment for CGI queries. # sub make_URL_href($;$) { my ($url) = shift; my $linktext = shift || $url; if ( $url !~ s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ) { $url = "<a href=\"$url\">$linktext</a>"; } return $url; } 1;